Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras: - Games - Sketches and PaintBox - Flaps - CalendarMorph - SpectrumAnalyzerMorph
Here is what would still "work" through the package System: - Object storage (ImageSegment etc.) - ProjectLoading
Here is what would still work through the package Protocols: - Lexicon tool - Vocabulary framework
Here is what would be gone: - Tiles, viewers, and scripts - Players and costumes - Pen trails, Turtles, ... - References, CustomEventsRegistry, ScriptingSystem - Siblings for (Player-only) uni-classes - DeepCopier support for (Player-only) uni-classes - Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
So...should we remove Etoys from Trunk at this point?
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel
Marcel Taeumel wrote on Tue, 29 Aug 2023 15:47:19 +0200
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-) So...should we remove Etoys from Trunk at this point?
It is nice that it is possible to remove Etoys from Squeak if you want to, but I think it should always be a part of the basic distribution image. How much smaller does the image become without Etoys? About one third of what I do in Squeak involves Etoys so I see them as a single thing.
In fact, the old SqueakFest event and the "Squeakers" movie focused almost exclusively on Etoys. The official Etoys web site is called "squeakland". So my suggestion would be for an Etoyless version of open source Smalltalk adopt a new name to avoid confusion (Cuis and Pharo did that, for example).
-- Jecel
Hi Jecel --
It is nice that it is possible to remove Etoys from Squeak if you want to, but I think it should always be a part of the basic distribution image.
As you can see from the change-set, it is somewhat only working in the here and now. There are many sub-method changes, which indicate that it would probably not work anymore in a few months from now.
How much smaller does the image become without Etoys?
It's not about becoming smaller in terms of "number of classes" or "lines of code". Maintainability of Morphic and Object-Storage becomes easier without Etoys in its current form.
About one third of what I do in Squeak involves Etoys so I see them as a single thing.
With Squeak 6.0? Interesting! Please share some stories here. :-)
So my suggestion would be for an Etoyless version of open source Smalltalk adopt a new name to avoid confusion
The name "Squeak" has not been associated with "Etoys" for quite some time. Until Squeak 5.1, Etoys was not even quite working and people should use "Etoys" from the Squeakland website.
Best, Marcel
Am 29.08.2023 23:28:46 schrieb Jecel Assumpcao Jr jecel@merlintec.com: Marcel Taeumel wrote on Tue, 29 Aug 2023 15:47:19 +0200
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-) So...should we remove Etoys from Trunk at this point?
It is nice that it is possible to remove Etoys from Squeak if you want to, but I think it should always be a part of the basic distribution image. How much smaller does the image become without Etoys? About one third of what I do in Squeak involves Etoys so I see them as a single thing.
In fact, the old SqueakFest event and the "Squeakers" movie focused almost exclusively on Etoys. The official Etoys web site is called "squeakland". So my suggestion would be for an Etoyless version of open source Smalltalk adopt a new name to avoid confusion (Cuis and Pharo did that, for example).
-- Jecel
On 2023-08-29, at 6:47 AM, Marcel Taeumel via Squeak-dev squeak-dev@lists.squeakfoundation.org wrote:
So...should we remove Etoys from Trunk at this point?
All in all I think yes, we should. Personally I'd love to also get rid of quite a lot of other rarely used stuff , like islands, games, traits, environments, some of the *40* classes apparently claiming to be buttons, etc.
I also think we should consider configuring our auto-build system to add builds for - with etoys - with games - with seaside - with VMMaker - with squeaksource .. mostly for regular proof of the packages being loadable and up to date.
And then expand the website to make it easy to find, upload, and understand those composed image sets.
And beef up the squeakmap world to make it much more obvious that it is a good way to load so many of those packages that we remove from trunk.
I know that one of the more important arguments for having a full trunk is that it 'keeps everything up to date' but honestly that's just not accurate. Look at how many areas of the image are in need of repairing. Surely a better mechanism would be possible these days; we could literally scan all the code in squeaksource et al. to find senders and implementors!
tim -- tim Rowledge; tim@rowledge.org; http://www.rowledge.org/tim Useful random insult:- A gross ignoramus -- 144 times worse than an ordinary ignoramus.
Hi Tim --
Yes, a more flexible build-and-bundle infrastructure for Squeak would be awesome! Still, one should not underestimate the continuous maintenance effort that would go along with that.
Best, Marcel Am 30.08.2023 00:03:40 schrieb Tim Rowledge tim@rowledge.org:
On 2023-08-29, at 6:47 AM, Marcel Taeumel via Squeak-dev wrote:
So...should we remove Etoys from Trunk at this point?
All in all I think yes, we should. Personally I'd love to also get rid of quite a lot of other rarely used stuff , like islands, games, traits, environments, some of the *40* classes apparently claiming to be buttons, etc.
I also think we should consider configuring our auto-build system to add builds for - with etoys - with games - with seaside - with VMMaker - with squeaksource .. mostly for regular proof of the packages being loadable and up to date.
And then expand the website to make it easy to find, upload, and understand those composed image sets.
And beef up the squeakmap world to make it much more obvious that it is a good way to load so many of those packages that we remove from trunk.
I know that one of the more important arguments for having a full trunk is that it 'keeps everything up to date' but honestly that's just not accurate. Look at how many areas of the image are in need of repairing. Surely a better mechanism would be possible these days; we could literally scan all the code in squeaksource et al. to find senders and implementors!
tim -- tim Rowledge; tim@rowledge.org; http://www.rowledge.org/tim Useful random insult:- A gross ignoramus -- 144 times worse than an ordinary ignoramus.
So...should we remove Etoys from Trunk at this point?
***WHY***?????????
You ***DON'T CARE*** about preserving eToys content.
I don't personally use eToys, but I care very much about Squeak as a content-development platform. This kind of speculation I find profoundly alarming.
On Tue, 29 Aug 2023 15:47:19 +0200 Marcel Taeumel via Squeak-dev squeak-dev@lists.squeakfoundation.org wrote:
Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras:
- Games
- Sketches and PaintBox
- Flaps
- CalendarMorph
- SpectrumAnalyzerMorph
Here is what would still "work" through the package System:
- Object storage (ImageSegment etc.)
- ProjectLoading
Here is what would still work through the package Protocols:
- Lexicon tool
- Vocabulary framework
Here is what would be gone:
- Tiles, viewers, and scripts
- Players and costumes
- Pen trails, Turtles, ...
- References, CustomEventsRegistry, ScriptingSystem
- Siblings for (Player-only) uni-classes
- DeepCopier support for (Player-only) uni-classes
- Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
So...should we remove Etoys from Trunk at this point?
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel
On Tue, Aug 29, 2023 at 09:18:10PM -0400, Jim Rosenberg wrote:
So...should we remove Etoys from Trunk at this point?
***WHY***?????????
The rationale is simplicity and comprehension, primarily from the point of view of readers of the code in the Squeak image.
I am not advocating anything here WRT Etoys, but I would say that the Squeak image needs to be as simple, readable, and understandable as possible. Etoys is a wonderful thing but it can add quite a bit of cognitive clutter, and that is why the Etoys removal question is important.
You ***DON'T CARE*** about preserving eToys content.
I think that Marcel has introduced this discussion thread because he *does* care. I care about it too, and so do most of the other people who are going to reply to this thread :-)
I don't personally use eToys, but I care very much about Squeak as a content-development platform.
I agree :-)
This kind of speculation I find profoundly alarming.
But no I'm not alarmed. Preserving content (not "code" but real content) is important. It is also a hard problem, so I'm not alarmed to have that sort of discussion.
Dave
Hi Dave --
I think that Marcel has introduced this discussion thread because he *does* care.
Exactly. Thank you. :-)
Best, Marcel Am 30.08.2023 04:52:51 schrieb David T. Lewis lewis@mail.msen.com: On Tue, Aug 29, 2023 at 09:18:10PM -0400, Jim Rosenberg wrote:
So...should we remove Etoys from Trunk at this point?
***WHY***?????????
The rationale is simplicity and comprehension, primarily from the point of view of readers of the code in the Squeak image.
I am not advocating anything here WRT Etoys, but I would say that the Squeak image needs to be as simple, readable, and understandable as possible. Etoys is a wonderful thing but it can add quite a bit of cognitive clutter, and that is why the Etoys removal question is important.
You ***DON'T CARE*** about preserving eToys content.
I think that Marcel has introduced this discussion thread because he *does* care. I care about it too, and so do most of the other people who are going to reply to this thread :-)
I don't personally use eToys, but I care very much about Squeak as a content-development platform.
I agree :-)
This kind of speculation I find profoundly alarming.
But no I'm not alarmed. Preserving content (not "code" but real content) is important. It is also a hard problem, so I'm not alarmed to have that sort of discussion.
Dave
Hi Jim --
I don't personally use eToys, but I care very much about Squeak as a content-development platform.
Same here. As you can see through the change-set I provided, Etoys in its current form implies high maintenance effort. It's modularity is poor, having Etoys-specific statements all over the place.
This kind of speculation I find profoundly alarming.
Not sure what you mean by that. We care very much about robustness and backwards compatibility. Etoys in its current form makes it very hard to maintain relevant modules such as ImageSegment and DataStream.
Best, Marcel Am 30.08.2023 03:18:32 schrieb Jim Rosenberg jr@amanue.com:
So...should we remove Etoys from Trunk at this point?
***WHY***?????????
You ***DON'T CARE*** about preserving eToys content.
I don't personally use eToys, but I care very much about Squeak as a content-development platform. This kind of speculation I find profoundly alarming.
On Tue, 29 Aug 2023 15:47:19 +0200 Marcel Taeumel via Squeak-dev wrote:
Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras:
- Games
- Sketches and PaintBox
- Flaps
- CalendarMorph
- SpectrumAnalyzerMorph
Here is what would still "work" through the package System:
- Object storage (ImageSegment etc.)
- ProjectLoading
Here is what would still work through the package Protocols:
- Lexicon tool
- Vocabulary framework
Here is what would be gone:
- Tiles, viewers, and scripts
- Players and costumes
- Pen trails, Turtles, ...
- References, CustomEventsRegistry, ScriptingSystem
- Siblings for (Player-only) uni-classes
- DeepCopier support for (Player-only) uni-classes
- Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
So...should we remove Etoys from Trunk at this point?
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel
Marcel,
Thanks for posting the change set, I can see that a lot of work went into it. And thanks for starting the discussion.
I have tried the change set, and it works fine. A minor nit is that it needs a "Smalltalk cleanOutUndeclared" in the postscript.
From my point of view, I want to take some time to play with this over the next couple of weeks to form a better opinion. In particular, I don't have a good sense of how much work it would be to maintain Etoys as an optional part of the image, as opposed to just take it out once without being able to reload.
In a perfect world, I would say that Etoys should be reloadable. This means that Etoys can be removed, and later reinstalled into some working state (yes objects and content would be lost but the basic functionality would in principle be restored). However, this is not a perfect world, and making Etoys be fully reloadable requires a lot of work that is probably never going to get done.
If reloadable Etoys is never going to happen, then what might be the next best thing? For me, I think it would be a new option in the Preference Wizard. Right at the point where it asks "Do you want to install extra packages?" it might better give me the the option to also remove Etoys.
If this was an option in the Preference Wizard, I am pretty sure that I personally would not select that option. I like being able to explore the interesting concepts in Etoys. But I also really appreciate the aesthetics and design principles that we see in Cuis, and I can see that it would be really helpful to be able to reduce cognitive complexity by removing all of the Etoys clutter that is not of general interest. This might be particularly important for new Squeak users, and also for students approaching Squeak for the first time.
The thing that I don't yet understand is how much work it would be to maintain Etoys removal as an option over time. It is easy for me to say that I would like to have it in the Preference Wizard, but I can see from the unload-etoys.33.cs change set that there are *lots* of methods impacted, and I don't know how much work it might be to keep that functionality healthy in years to come.
Again, thanks Marcel for posting this.
Dave
On Tue, Aug 29, 2023 at 03:47:19PM +0200, Marcel Taeumel via Squeak-dev wrote:
Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras:
- Games
- Sketches and PaintBox
- Flaps
- CalendarMorph
- SpectrumAnalyzerMorph
Here is what would still "work" through the package System:
- Object storage (ImageSegment etc.)
- ProjectLoading
Here is what would still work through the package Protocols:
- Lexicon tool
- Vocabulary framework
Here is what would be gone:
- Tiles, viewers, and scripts
- Players and costumes
- Pen trails, Turtles, ...
- References, CustomEventsRegistry, ScriptingSystem
- Siblings for (Player-only) uni-classes
- DeepCopier support for (Player-only) uni-classes
- Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
So...should we remove Etoys from Trunk at this point?
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel ???'From Squeak6.1alpha of 26 July 2023 [latest update: #22682] on 29 August 2023 at 3:33:41 pm'!
| currentChanges | currentChanges := ChangeSet current.
MenuIcons addClassVarName: #ScriptingIcons. MenuIcons classPool at: #ScriptingIcons put: ( (Smalltalk globals at: #ScriptingSystem) formDictionary associationsSelect: [:assoc | true "keep all for now" "(assoc key beginsWith: 'Halo-') or: [assoc key beginsWith: 'Debugger']"]).
ChangeSet newChanges: (ChangeSet new name: 'move-etoys-games-to-morphicextras'). #( "Keep the games as standalone example applications" 'Etoys-Squeakland-Morphic-Games' 'MorphicExtras-Games' 'Etoys-Squeakland-Morphic-Games-Chess' 'MorphicExtras-Games-Chess' 'Etoys-Squeakland-Morphic-Games-Chess960' 'MorphicExtras-Games-Chess960' 'Etoys-Squeakland-Morphic-Demo' 'MorphicExtras-Demo' ) pairsDo: [:oldCat :newCat | (SystemOrganization listAtCategoryNamed: oldCat) do: [:className | (self environment classNamed: className) category: newCat]]. "Rescue more examples from Etoys over to MorphicExtras" (Smalltalk classNamed: #CalendarMorph) category: 'MorphicExtras-Demo'. (Smalltalk classNamed: #SpectrumAnalyzerMorph) category: 'MorphicExtras-SoundInterface'. ChangeSet newChanges: currentChanges.
(MCPackage named: #EToys) unload.!
Object subclass: #DeepCopier instanceVariableNames: 'references uniClasses newUniClasses ' classVariableNames: '' poolDictionaries: '' category: 'System-Object Storage'!
!DeepCopier commentStamp: 'mt 8/28/2023 15:05' prior: 0! DeepCopier does a veryDeepCopy.
It is a complete tree copy using a dictionary. Any object that is 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. See Object|veryDeepCopy which calls (self veryDeepCopyWith: aDeepCopier).
When a tree of morphs points at a morph outside of itself, that morph should not be copied. Use our own kind of weak pointers for the 'potentially outside' morphs. Default is that any new class will have all of its fields deeply copied. If a field needs to be weakly copied, define veryDeepInner: and veryDeepFixupWith:. veryDeepInner: has the loop that actually copies the fields. If a class defines its own copy of veryDeepInner: (to leave some fields out), then veryDeepFixupWith: will be called on that object at the end. veryDeepInner: can compute an alternate object to put in a field. (Object veryDeepCopyWith: discovers which superclasses did not define veryDeepInner:, and very deeply copies the variables defined in those classes). To decide if a class needs veryDeepInner: and veryDeepFixupWith:, ask this about an instance: If I duplicate this object, does that mean that I also want to make duplicates of the things it holds onto? If yes, (i.e. a Paragraph does want a new copy of its Text) then do nothing. If no, (i.e. an undo command does not want to copy the objects it acts upon), then define veryDeepInner: and veryDeepFixupWith:. Here is an analysis for the specific case of a morph being held by another morph. Does field X contain a morph? If not, no action needed. Is the morph in field X already a submorph of the object? Is it down lower in the submorph tree? If so, no action needed. Could the morph in field X every appear on the screen (be a submorph of some other morph)? If not, no action needed. If it could, you must write the methods veryDeepFixupWith: and veryDeepInner:, and in them, refrain from sending veryDeepCopyWith: to the contents of field X.
----- Things Ted is still considering ----- Rule: If object A has object C in a field, and A says (^ C) for the copy, but object B has A in a normal field and it gets deepCopied, and A in encountered first, then there will be two copies of C. (just be aware of it)
Dependents are now fixed up. Suppose a model has a dependent view. In the DependentFields dictionary, model -> (view ...). If only the model is copied, no dependents are created (no one knows about the new model). If only the view is copied, it is inserted into DependentFields on the right side. model -> (view copiedView ...). If both are copied, the new model has the new view as its dependent. If additional things depend on a model that is copied, the caller must add them to its dependents.
August 2023: There is no support for uni-classes at this time!!!
Model subclass: #FancyMailComposition instanceVariableNames: 'messageText theLinkToInclude to subject' classVariableNames: '' poolDictionaries: '' category: 'Nebraska-Network-Mail'! Object subclass: #MenuIcons instanceVariableNames: '' classVariableNames: 'Icons TranslatedIcons TranslationLocale ScriptingIcons ' poolDictionaries: '' category: 'Morphic-Menus'! Object subclass: #MorphExtension instanceVariableNames: 'locked visible sticky balloonText balloonTextSelector externalName isPartsDonor actorState player eventHandler otherProperties ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Kernel'! BorderedMorph subclass: #PasteUpMorph instanceVariableNames: 'presenter model cursor padding turtleTrailsForm turtlePen lastTurtlePositions isPartsBin indicateCursor wantsMouseOverHalos worldState ' classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler ' poolDictionaries: '' category: 'Morphic-Worlds'! AbstractLauncher subclass: #ProjectLauncher instanceVariableNames: 'showSplash splashURL whichFlaps eToyAuthentificationServer ' classVariableNames: 'SplashMorph ' poolDictionaries: '' category: 'System-Download'! Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl eToyUserListUrl eToyUserList keepAlive encodingName ' classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers ' poolDictionaries: '' category: 'Network-RemoteDirectory'!
!SmartRefStream commentStamp: 'mt 8/28/2023 15:44' prior: 0! Ordinary ReferenceStreams assume that the names and order of instance variables is exactly the same when an object file is written and read. SmartRefStream allows object files to be read even after instance variables have changed or the entire class has been renamed.
When an object file is written, no one knows how the classes will change in the future. Therefore, all conversion must be done when the file is read. The key is to store enough information in the file about the names of the instance variables of all outgoing classes.
SmartRefStream works best with only one tree of objects per file. You can nextPut: more than once, but each object tree gets its own class structure description, which is big.
Conversion of old objects is done by a method in each class called (convertToCurrentVersion: varDict refStream: smartRefStrm). At fileOut time, ChangeSet>>checkForConversionMethods creates a prototype of this method (if Preference #conversionMethodsAtFileOut is true). The programmer must edit this method to (1) test if the incoming object needs conversion, (2) put non-nil values into any new inst vars that need them, and (3) save the data of any inst vars that are being deleted.
Determining which old version is represented by the incoming object can be done in several ways: - noticing that a current inst var is nil when it should have data, - noticing that there is an older inst var name in the variable dictionary (varDict), - checking kinds of objects in one or more inst vars, or - retrieving the classVersion of the incoming object from the ref stream.
If a class is renamed, a method goes into SmartRefStream telling the new name.
The conversion method of the new class must be prepared to accept instances of the old class also. If no inst var names have changed, the conversion method does nothing.
An example: Suppose we change the representation of class Rectangle from ('origin' 'corner') to ('origin' 'extent'). Suppose lots of Rectangle instances are already out on files (in .pr project files, especially).
The programmer changes the class definition, modifies all the methods, and filesOut. A series of dialogs appear, asking if instances Rectangle might be in an object file, if 'extent' needs to be non-nil (yes), and if the info in 'corner' needs to be preserved (yes). This method appears:
Rectangle >> convertToCurrentVersion: varDict refStream: smartRefStrm "These variables are automatically stored into the new instance: #('origin'). Test for this particular conversion. Get values using expressions like (varDict at: 'foo')."
"New variables: #('extent'). If a non-nil value is needed, please assign it." "These are going away #('corner'). Possibly store their info in some other variable?" "Move your code above the ^ super... Delete extra comments." ^ super convertToCurrentVersion: varDict refStream: smartRefStrm
The programmer modifies it to be:
Rectangle >> convertToCurrentVersion: varDict refStream: smartRefStrm
(varDict includesKey: 'extent') ifFalse: ["old version!!" "Create the new extent, and preserve the info from the old corner" extent := (varDict at: 'corner') - origin. ]. ^ super convertToCurrentVersion: varDict refStream: smartRefStrm
This conversion method stays in the system and is ready to convert the old format of Rectangle whenever one is encountered in an object file. Note that the subclasses of Rectangle, (B3DViewport, CharacterBlock, and Quadrangle) do not need conversion methods. Their instances will be converted by the code in Rectangle.
Files written by SmartRefStream are in standard fileout format. You can mix raw objects with code to be filed in. The file starts out in the normal fileOut format. Definitions of new classes on the front.
structures Dictionary of (#Rectangle -> #(<classVersionInteger> 'origin' 'corner')). Inst var names are strings. steady Set of Classes who have the same structure now as on the incoming file. Includes classes with same inst vars except for new ones added on the end. reshaped Dictionary of Classes who have a different structure now from the incoming file. Includes those with same inst vars but new version number. (old class name -> method selector to fill in data for version to version) renamed Dictionary of Classes who have a different name. Make an instance of the new class, and send it the conversion call. (old class name symbol -> new class name). renamedConv Dictionary of conversion selector for Classes who have a different name. (old class name symbol -> conversion selector). topCall Tells if next or nextPut: are working on the top object in the tree. nil if outside, the top object if deep inside.
See DataStream.typeIDFor: for where the tangle of objects is clipped, so the whole system will not be written on the file.
No object that is written on the file is ever a class. All class definitions are filed in. A class may be stored inside an ImageSegment that itself is stored in a SmartRefStream.
UniClasses are classes for the instance specific behavior of just one instance. See #newSubclass. When a UniClass is read in, and a class of the same name already exists, the incoming one is renamed. ObjectScanner converts the filed-in code.
Values in instance variables of UniClasses are stored in the array that tells the class structure. It is the fourth of the four top level objects. #(version (class-structure) the-object ((#Player25 scripts slotInfo costumeDictionary) (#Player26 scripts slotInfo costumeDictionary))).
There is a separate subclass for doing veryDeepCopy (in memory). Currently, any object for which objectToStoreOnDataStream return an object other than self, does this: The new object (a DiskProxy) is traced. When it comes time to go through the fields of the old object, they are not found as keys in references (DiskProxies are there instead). So the old field value is left in the new object. That is OK for StrikeFont, Class, MetaClass, DisplayScreen. But the DiskProxies are evaluated, which takes a lot of time.
Some metaclasses are put into the structures table. This is for when a block has a receiver that is a class. See checkFatalReshape:.
ImageSegments: A ReferenceStream is used to enumerate objects to put inside an ImageSegment. If an instance of a UniClass is seen, the class is put in also. A SmartRefStream is used to store the ImageSegment. Roots are nil, and the segment is a wordArray. We are encoding the outPointers. Structures contains all classes from both places. Must filter out UniClasses for some things, and do include them for putting source code at end of file. Do not write any class inst vars in file.
--Ted Kaehler and Bob Arning.
How are the selectors in the '*Morphic-conversion' protocol ending with something like
ttfclpomsswfpp0
constructed and what does it mean?
Answer: It is the initials of all instance variables followed by the class version integer. The initials allow to detect most changes to the instance variables, but if this is not sufficient (perhaps because the new var had the same initial, or the vars did not change in name at all) we still have the class version.
Most classes are still at version 0, but if you check implementers of classVersion you can find a few that were incremented to force a conversion on load.!
!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:05'! veryDeepCopy "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."
| copier new | copier := DeepCopier new: self initialDeepCopierSize. new := self veryDeepCopyWith: copier. copier references associationsDo: [:assoc | assoc value veryDeepFixupWith: copier]. copier fixDependents. ^ new! !
!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:05'! veryDeepCopyUsing: copier "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. Same as veryDeepCopy except copier (with dictionary) is supplied. ** do not delete this method, even if it has no callers **"
| new refs | new := self veryDeepCopyWith: copier. copier references associationsDo: [:assoc | assoc value veryDeepFixupWith: copier]. "Fix dependents" refs := copier references. DependentsFields associationsDo: [:pair | pair value do: [:dep | | newDep newModel | (newDep := refs at: dep ifAbsent: [nil]) ifNotNil: [ newModel := refs at: pair key ifAbsent: [pair key]. newModel addDependent: newDep]]]. ^ new! !
!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:07'! veryDeepCopyWith: deepCopier "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." | class index sub subAss new sup has mine | deepCopier references at: self ifPresent: [:newer | ^ newer]. "already did him" class := self class. class isMeta ifTrue: [^ self]. "a class" new := self shallowCopy. deepCopier references at: self put: new. "remember" (class isVariable and: [class isPointers]) ifTrue: [index := self basicSize. [index > 0] whileTrue: [sub := self basicAt: index. (subAss := deepCopier references associationAt: sub ifAbsent: [nil]) ifNil: [new basicAt: index put: (sub veryDeepCopyWith: deepCopier)] ifNotNil: [new basicAt: index put: subAss value]. index := index - 1]]. "Ask each superclass if it wants to share (weak copy) any inst vars" new veryDeepInner: deepCopier. "does super a lot"
"other superclasses want all inst vars deep copied" sup := class. index := class instSize. [has := sup compiledMethodAt: #veryDeepInner: ifAbsent: [nil]. has := has ifNil: [class isSystemDefined not "is a uniClass"] ifNotNil: [true]. mine := sup instVarNames. has ifTrue: [index := index - mine size] "skip inst vars" ifFalse: [1 to: mine size do: [:xx | sub := self instVarAt: index. (subAss := deepCopier references associationAt: sub ifAbsent: [nil]) "use association, not value, so nil is an exceptional value" ifNil: [new instVarAt: index put: (sub veryDeepCopyWith: deepCopier)] ifNotNil: [new instVarAt: index put: subAss value]. index := index - 1]]. (sup := sup superclass) == nil] whileFalse. new rehash. "force Sets and Dictionaries to rehash" ^ new ! !
!Object methodsFor: 'testing' stamp: 'mt 3/8/2023 10:43'! knownName ^ nil! !
!Class methodsFor: 'testing' stamp: 'mt 8/28/2023 14:56'! officialClass "I am not a UniClass. (See MorphicModel officialClass). Return the class you use to make new subclasses."
^ self! !
!Class methodsFor: 'fileIn/Out' stamp: 'mt 8/28/2023 14:56'! objectForDataStream: refStrm "I am about to be written on an object file. Write a reference to a class in Smalltalk instead."
refStrm insideASegment ifFalse: ["Normal use" ^ DiskProxy global: self theNonMetaClass name selector: #withClassVersion: args: {self classVersion}] ifTrue: ["recording objects to go into an ImageSegment" self isSystemDefined ifFalse: [^ self]. "do trace uni-classes" (refStrm rootObject includes: self) ifTrue: [^ self]. "is in roots, intensionally write out, ^ self" "A normal class. remove it from references. Do not trace." refStrm references removeKey: self ifAbsent: []. "already there" ^ nil] ! !
!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'! toggleDiffing "Toggle whether diffs should be shown in the code pane. If any kind of diffs were being shown, stop showing diffs. If no kind of diffs were being shown, start showing whatever kind of diffs are called for by default."
| wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingAnyKindOfDiffs. self showDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'! togglePlainSource "Toggle whether plain source shown in the code pane" | wasShowingPlainSource | self okToChange ifTrue: [wasShowingPlainSource := self showingPlainSource. wasShowingPlainSource ifTrue: [self showDocumentation: true] ifFalse: [contentsSymbol := #source]. self setContentsToForceRefetch. self changed: #contents]
! !
!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'! togglePrettyDiffing "Toggle whether pretty-diffing should be shown in the code pane"
| wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingPrettyDiffs. self showPrettyDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'! togglePrettyPrint "Toggle whether pretty-print is in effectin the code pane"
self okToChange ifTrue: [self showingPrettyPrint ifTrue: [contentsSymbol := #source] ifFalse: [contentsSymbol := #prettyPrint]. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'! toggleRegularDiffing "Toggle whether regular-diffing should be shown in the code pane"
| wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingRegularDiffs. self showRegularDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'misc' stamp: 'mt 3/23/2023 11:24'! refusesToAcceptCode "Answer whether receiver, given its current contentsSymbol, could accept code happily if asked to"
^ (#(byteCodes documentation) includes: self contentsSymbol)! !
!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'! toggleDecompile "Toggle the setting of the showingDecompile flag, unless there are unsubmitted edits that the user declines to discard"
| wasShowing | self okToChange ifTrue: [wasShowing := self showingDecompile. self showDecompile: wasShowing not. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'! toggleShowDocumentation "Toggle the setting of the showingDocumentation flag, unless there are unsubmitted edits that the user declines to discard"
| wasShowing | self okToChange ifTrue: [wasShowing := self showingDocumentation. self showDocumentation: wasShowing not. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'! toggleShowingByteCodes "Toggle whether the receiver is showing bytecodes"
self showByteCodes: self showingByteCodes not. self setContentsToForceRefetch. self contentsChanged! !
!Command class methodsFor: 'dog simple ui' stamp: 'mt 7/31/2023 11:10'! undoRedoButtons "Answer a morph that offers undo and redo buttons"
| wrapper | "self currentHand attachMorph: Command undoRedoButtons" wrapper := AlignmentMorph newColumn. wrapper color: Color veryVeryLightGray lighter; borderWidth: 0; layoutInset: 0; vResizing: #shrinkWrap; hResizing: #shrinkWrap. #((CrudeUndo undoLastCommand 'undo last command done' undoEnabled CrudeUndoDisabled CrudeUndoDisabled) (CrudeRedo redoNextCommand 'redo last undone command' redoEnabled CrudeRedoDisabled CrudeRedoDisabled)) do: [:tuple | | aButton | wrapper addTransparentSpacerOfSize: (8@0). aButton := UpdatingThreePhaseButtonMorph new. aButton onImage: (MenuIcons formAtKey: tuple first); offImage: (MenuIcons formAtKey: tuple fifth); pressedImage: (MenuIcons formAtKey: tuple sixth); getSelector: tuple fourth; color: Color transparent; target: self; actionSelector: tuple second; setNameTo: tuple second; setBalloonText: tuple third; extent: aButton onImage extent. wrapper addMorphBack: aButton. wrapper addTransparentSpacerOfSize: (8@0)]. ^ wrapper! !
!Debugger methodsFor: 'toolbuilder' stamp: 'mt 3/10/2023 11:26'! buildNotifierWith: builder label: label message: messageString | windowSpec listSpec textSpec panelSpec quads | windowSpec := builder pluggableWindowSpec new model: self; extent: self initialExtentForNotifier; label: label asString; children: OrderedCollection new.
panelSpec := builder pluggablePanelSpec new. panelSpec children: OrderedCollection new. quads := self preDebugButtonQuads. (self interruptedContext selector == #doesNotUnderstand:) ifTrue: [ quads := quads copyWith: { 'Create'. #createMethod. #magenta. 'create the missing method' } ]. (#(#notYetImplemented #shouldBeImplemented #requirement) includes: self interruptedContext selector) ifTrue: [ quads := quads copyWith: { 'Create'. #createImplementingMethod. #magenta. 'implement the marked method' } ]. (self interruptedContext selector == #subclassResponsibility) ifTrue: [ quads := quads copyWith: { 'Create'. #createOverridingMethod. #magenta. 'create the missing overriding method' } ]. quads do:[:spec| | buttonSpec | buttonSpec := builder pluggableButtonSpec new. buttonSpec model: self. buttonSpec label: spec first. buttonSpec action: spec second. buttonSpec help: spec fourth. spec size >= 5 ifTrue: [buttonSpec enabled: spec fifth]. panelSpec children add: buttonSpec. ]. panelSpec layout: #horizontal. "buttons" panelSpec frame: self preDebugButtonQuadFrame. windowSpec children add: panelSpec.
messageString notNil ifFalse:[ listSpec := builder pluggableListSpec new. listSpec model: self; list: #contextStackList; getIndex: #contextStackIndex; setIndex: #debugAt:; icon: #messageIconAt:; helpItem: #messageHelpAt:; frame: self contextStackFrame. windowSpec children add: listSpec. ] ifTrue:[ message := messageString. textSpec := builder pluggableTextSpec new. textSpec model: self; getText: #preDebugMessageString; setText: nil; selection: nil; menu: #debugProceedMenu:; frame: self contextStackFrame. windowSpec children add: textSpec. ].
^windowSpec! !
!Debugger methodsFor: 'initialize' stamp: 'mt 3/10/2023 11:26'! preDebugButtonQuads
^{ {'Proceed' translated. #proceed. #blue. 'continue execution' translated. #interruptedProcessShouldResume}. self class showTerminateButton ifTrue: [ {'Terminate' translated. #terminateProcess. #black. 'terminate this execution and close this window' translated}]. self class showAbandonButton ifTrue: [ {'Abandon' translated. #abandon. #black. 'terminate this execution aggressively and close this window' translated}]. {'Debug' translated. #debug. #red. 'bring up a debugger' translated}} reject: [:quad | quad isNil] ! !
!DeepCopier methodsFor: 'like fullCopy' stamp: 'mt 3/10/2023 15:37'! checkBasicClasses "Check that no indexes of instance vars have changed in certain classes. If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated. The idea is to catch a change while it is still in the system of the programmer who made it. DeepCopier new checkVariables "
| str objCls morphCls | str := '|veryDeepCopyWith: or veryDeepInner: is out of date.'. (objCls := self objInMemory: #Object) ifNotNil: [ objCls instSize = 0 ifFalse: [self error: 'Many implementers of veryDeepCopyWith: are out of date']]. (morphCls := self objInMemory: #Morph) ifNotNil: [ morphCls superclass == Object ifFalse: [self error: 'Morph', str]. (morphCls instVarNames copyFrom: 1 to: 6) = #('bounds' 'owner' 'submorphs' 'fullBounds' 'color' 'extension') ifFalse: [self error: 'Morph', str]]. "added ones are OK"! !
!DeepCopier methodsFor: 'like fullCopy' stamp: 'mt 8/28/2023 15:08'! initialize: size
references := IdentityDictionary new: size.! !
!ExtendedClipboardUnixInterface methodsFor: 'general-api-read' stamp: 'mt 8/11/2023 15:20'! readHTMLClipboardData | bytes source | "Answer a HTMLDocument object" bytes := self readClipboardData: 'text/html'. (bytes beginsWith: '<!!DOCTYPE' asByteArray) ifTrue: ["BAD HACK for Abiword" source := bytes asString convertFromWithConverter: UTF8TextConverter new] ifFalse: ["BAD HACK for mozilla" source := bytes asString convertFromWithConverter: (UTF16TextConverter new useLittleEndian: SmalltalkImage current isLittleEndian)]. ^ source asTextFromHtml! !
!FileList2 methodsFor: 'volume list and pattern' stamp: 'mt 8/16/2023 15:54'! listForPattern: pat "Make the list be those file names which match the pattern."
| sizePad newList entries | directory ifNil: [^#()]. entries := directory entries. (fileSelectionBlock isKindOf: MessageSend) ifTrue: [ fileSelectionBlock arguments: {entries}. newList := fileSelectionBlock value. fileSelectionBlock arguments: #(). ] ifFalse: [ newList := entries select: [:entry | fileSelectionBlock value: entry value: pat]. ]. newList := newList asArray sort: self sortBlock. sizePad := (newList inject: 0 into: [:mx :entry | mx max: entry fileSize]) asStringWithCommas size - 1. ^newList collect: [ :e | self fileNameFormattedFrom: e sizePad: sizePad ]! !
!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'! morphicViewGeneralLoaderInWorld: aWorld " FileList2 morphicViewGeneralLoaderInWorld: self currentWorld " | window aFileList buttons treePane textColor1 fileListPane pane2a pane2b fileTypeInfo fileTypeButtons fileTypeRow actionRow |
fileTypeInfo := self endingSpecs. window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new directory: FileDirectory default. aFileList fileSelectionBlock: self projectOnlySelectionBlock; modalView: window. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1 px; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners.
fileTypeButtons := fileTypeInfo collect: [ :each | (self blueButtonText: each first textColor: Color gray inWindow: window) setProperty: #enabled toValue: true; hResizing: #shrinkWrap; useSquareCorners ]. buttons := {{'OK'. Color lightGreen}. {'Cancel'. Color lightRed}} collect: [ :each | self blueButtonText: each first textColor: textColor1 color: each second inWindow: window ].
treePane := aFileList morphicDirectoryTreePane extent: 250 px @ 300 px; retractable: false; borderWidth: 0. fileListPane := aFileList morphicFileListPane extent: 350 px @ 300 px; retractable: false; borderWidth: 0. window addARow: {window fancyText: 'Find...' translated font: Preferences standardWindowTitleFont color: textColor1}. fileTypeRow := window addARowCentered: fileTypeButtons cellInset: 2 px. actionRow := window addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second } cellInset: 2 px. window addARow: { (window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2a fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). pane2b fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). " buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]. " fileTypeButtons do: [ :each | each on: #mouseUp send: #value:value: to: [ :evt :morph | self update: actionRow in: window fileTypeRow: fileTypeRow morphUp: morph. ] ]. buttons first on: #mouseUp send: #okHit to: aFileList. buttons second on: #mouseUp send: #cancelHit to: aFileList. aFileList postOpen. window position: aWorld topLeft + (aWorld extent - window extent // 2). aFileList directoryChangeBlock: [ :newDir | self update: actionRow in: window fileTypeRow: fileTypeRow morphUp: nil. self enableTypeButtons: fileTypeButtons info: fileTypeInfo forDir: newDir. ]. aFileList directory: aFileList directory. window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window openInWorld: aWorld.! !
!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'! morphicViewProjectLoader2InWorld: aWorld reallyLoad: aBoolean dirFilterType: aSymbol
| window aFileList buttons treePane textColor1 fileListPane pane2a pane2b treeExtent filesExtent |
window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new. aFileList optionalButtonSpecs: aFileList servicesForProjectLoader; fileSelectionBlock: ( aSymbol == #limitedSuperSwikiDirectoryList ifTrue: [ MessageSend receiver: Project current selector: #latestProjectVersionsFromFileEntries: ] ifFalse: [ self projectOnlySelectionBlock ] ); "dirSelectionBlock: self hideSqueakletDirectoryBlock;" modalView: window. aFileList directory: FileDirectory default. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1 px; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners. buttons := {{'OK'. Color lightGreen}. {'Cancel'. Color lightRed}} collect: [ :each | self blueButtonText: each first textColor: textColor1 color: each second inWindow: window ].
aWorld width < 800 px ifTrue: [ treeExtent := 150 px @ 300 px. filesExtent := 350 px @ 300 px. ] ifFalse: [ treeExtent := 350 px @ 500 px. filesExtent := 550 px @500 px. ]. (treePane := aFileList morphicDirectoryTreePaneFiltered: aSymbol) extent: treeExtent; retractable: false; borderWidth: 0. fileListPane := aFileList morphicFileListPane extent: filesExtent; retractable: false; borderWidth: 0. window addARow: { window fancyText: 'Load A Project' translated font: Preferences standardWindowTitleFont color: textColor1 }; addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second }; addARow: { window fancyText: 'Please select a project' translated font: Preferences standardButtonFont color: textColor1 }; addARow: { (window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2a fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). pane2b fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). " buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]. " buttons first on: #mouseUp send: (aBoolean ifTrue: [#okHitForProjectLoader] ifFalse: [#okHit]) to: aFileList. buttons second on: #mouseUp send: #cancelHit to: aFileList. aFileList postOpen. window position: aWorld topLeft + (aWorld extent - window extent // 2). window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window openInWorld: aWorld.! !
!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'! morphicViewProjectSaverFor: aProject " (FileList2 morphicViewProjectSaverFor: Project current) openInWorld " | window aFileList buttons treePane pane2 textColor1 option treeExtent buttonData buttonRow |
textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new directory: ServerDirectory projectDefaultDirectory. aFileList dirSelectionBlock: self hideSqueakletDirectoryBlock. window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. aFileList modalView: window. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners.
buttonData := Preferences enableLocalSave ifTrue: [{ {'Save'. #okHit. 'Save in the place specified below, and in the Squeaklets folder on your local disk'. Color lightGreen}. {'Save on local disk only'. #saveLocalOnlyHit. 'saves in the Squeaklets folder'. Color lightGreen}. {'Cancel'. #cancelHit. 'return without saving'. Color lightRed} }] ifFalse: [{ {'Save'. #okHit. 'Save in the place specified below, and in the Squeaklets folder on your local disk'. Color lightGreen}. {'Cancel'. #cancelHit. 'return without saving'. Color lightRed} }]. buttons := buttonData collect: [ :each | (self blueButtonText: each first textColor: textColor1 color: each fourth inWindow: window) setBalloonText: each third translated; hResizing: #shrinkWrap; on: #mouseUp send: each second to: aFileList ].
option := aProject world valueOfProperty: #SuperSwikiPublishOptions ifAbsent: [#initialDirectoryList]. aProject world removeProperty: #SuperSwikiPublishOptions.
treeExtent := Project current world height < 500 px ifTrue: [ 350 px @ 150 px ] ifFalse: [ 350 px @ 300 px ].
(treePane := aFileList morphicDirectoryTreePaneFiltered: option) extent: treeExtent; retractable: false; borderWidth: 0. window addARowCentered: { window fancyText: 'Publish This Project' translated font: Preferences standardWindowTitleFont color: textColor1 }. buttonRow := OrderedCollection new. buttons do: [:button | buttonRow add: button] separatedBy: [buttonRow add: ((Morph new extent: 30 px @ 5 px) color: Color transparent)].
" addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second. (Morph new extent: 30 px@ 5 px) color: Color transparent. buttons third };" window addARowCentered: buttonRow; addARowCentered: { (window inAColumn: {(ProjectViewMorph on: aProject) lock}) layoutInset: 4 px}; addARowCentered: { window fancyText: 'Please select a folder' translated font: Preferences standardButtonFont color: textColor1 }; addARow: { ( window inAColumn: { (pane2 := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) } ) layoutInset: 10 px }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2 fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). " buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]. " window morphicLayerNumber: window class dialogLayer. aFileList postOpen. window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window ! !
!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:52'! defaultsQuadsDefiningStackToolsFlap "Answer a structure defining the items on the default system Stack Tools flap. previously in quadsDefiningStackToolsFlap"
^ { {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}. {#StackMorph. #stackHelpWindow. 'Stack Help' translatedNoop. 'Some hints about how to use Stacks' translatedNoop}. {#TextMorph . #authoringPrototype. 'Simple Text' translatedNoop. 'Text that you can edit into anything you wish' translatedNoop}. {#TextMorph . #fancyPrototype. 'Fancy Text' translatedNoop. 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop}. {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}. {#StackMorph. #previousCardButton. 'Previous Card' translatedNoop. 'A button that takes the user to the previous card in the stack' translatedNoop}. {#StackMorph. #nextCardButton. 'Next Card' translatedNoop. 'A button that takes the user to the next card in the stack' translatedNoop} } asOrderedCollection ! !
!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:52'! defaultsQuadsDefiningSuppliesFlap "Answer a list of quads which define the objects to appear in the default Supplies flap. previously in quadsDefiningSuppliesFlap"
^ { {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}. {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}. {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}. {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}. {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}. {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}. {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}. {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}. {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}. {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}. {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}. {#TabbedPalette. #authoringPrototype. 'TabbedPalette' translatedNoop. 'A structure with tabs' translatedNoop}. {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}. {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}. {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}. {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop} } asOrderedCollection! !
!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 14:38'! defaultsQuadsDefiningToolsFlap "Answer a structure defining the default Tools flap. previously in quadsDefiningToolsFlap"
^ OrderedCollection new addAll: #( (Browser prototypicalToolWindow 'Browser' 'A Browser is a tool that allows you to view all the code of all the classes in the system') (TranscriptStream openMorphicTranscript 'Transcript' 'A Transcript is a window usable for logging and debugging; browse references to #Transcript for examples of how to write to it.') (Workspace prototypicalToolWindow 'Workspace' 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.')); add: { FileList2 . #prototypicalToolWindow. 'File List'. 'A File List is a tool for browsing folders and files on disks and FTP servers.' }; addAll: #( (DualChangeSorter prototypicalToolWindow 'Change Sorter' 'Shows two change sets side by side') (SelectorBrowser prototypicalToolWindow 'Method Finder' 'A tool for discovering methods by providing sample values for arguments and results') (MessageNames prototypicalToolWindow 'Message Names' 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.') (PreferencesBrowser prototypicalToolWindow 'Preferences' 'Allows you to control numerous options') (Utilities recentSubmissionsWindow 'Recent' 'A message browser that tracks the most recently-submitted methods') (ProcessBrowser prototypicalToolWindow 'Processes' 'A Process Browser shows you all the running processes') (PackagePaneBrowser prototypicalToolWindow 'Packages' 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"') (ChangeSorter prototypicalToolWindow 'Change Set' 'A tool that allows you to view and manipulate all the code changes in a single change set')); yourself! !
!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:53'! defaultsQuadsDefiningWidgetsFlap "Answer a structure defining the default Widgets flap. previously in quadsDefiningWidgetsFlap"
^ #( (TrashCanMorph new 'Trash' 'A tool for discarding objects') (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there') (GeeMailMorph new 'Gee-Mail' 'A place to present annotated content') (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.') (FrameRateMorph authoringPrototype 'FrameRate' 'An indicator of how fast your system is running') (MagnifierMorph newRound 'Magnifier' 'A magnifying glass') (ObjectsTool newStandAlone 'ObjectCatalog' 'A tool that lets you browse the catalog of objects') ) asOrderedCollection! !
!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:50'! initializeFlapsQuads "initialize the list of dynamic flaps quads. self initializeFlapsQuads" FlapsQuads := nil. self registeredFlapsQuads at: 'Stack Tools' put: self defaultsQuadsDefiningStackToolsFlap; at: 'Supplies' put: self defaultsQuadsDefiningSuppliesFlap; at: 'Tools' put: self defaultsQuadsDefiningToolsFlap; at: 'Widgets' put: self defaultsQuadsDefiningWidgetsFlap. ^ self registeredFlapsQuads! !
!Flaps class methodsFor: 'new flap' stamp: 'mt 8/4/2023 14:02'! addLocalFlap: anEvent titled: title onEdge: edge
| flapTab menu world | flapTab := self newFlapTitled: title onEdge: edge. (world := anEvent hand world) addMorphFront: flapTab. menu := flapTab buildHandleMenu: anEvent hand. flapTab addTitleForHaloMenu: menu. flapTab computeEdgeFraction. menu popUpEvent: anEvent in: world.! !
!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 8/10/2023 11:29'! addStandardFlaps "Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed. " SharedFlapTabs ifNil: [SharedFlapTabs := OrderedCollection new]. SharedFlapTabs add: self newSqueakFlap. SharedFlapTabs add: self newSuppliesFlap. SharedFlapTabs add: self newToolsFlap. SharedFlapTabs add: self newWidgetsFlap. SharedFlapTabs add: self newStackToolsFlap.
Preferences showProjectNavigator ifTrue:[SharedFlapTabs add: self newNavigatorFlap].
SharedFlapTabs add: self newObjectsFlap. self disableGlobalFlapWithID: 'Stack Tools' translated.
Preferences showProjectNavigator ifTrue:[self disableGlobalFlapWithID: 'Navigator' translated].
^ SharedFlapTabs! !
!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 7/31/2023 11:11'! newSqueakFlap "Answer a new default 'Squeak' flap for the left edge of the screen"
| aFlap aFlapTab aButton aClock buttonColor anOffset bb aFont | aFlap := PasteUpMorph newSticky borderWidth: 0. aFlapTab := FlapTab new referent: aFlap. aFlapTab setName: 'Squeak' translated edge: #left color: Color brown lighter lighter. aFlapTab position: (0 @ ((Display height - aFlapTab height) // 2)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
aFlap cellInset: 14@14. aFlap beFlap: true. aFlap color: (Color brown muchLighter lighter "alpha: 0.3"). aFlap extent: 150 @ self currentWorld height. aFlap layoutPolicy: TableLayout new. aFlap wrapCentering: #topLeft. aFlap layoutInset: 2. aFlap listDirection: #topToBottom. aFlap wrapDirection: #leftToRight.
"self addProjectNavigationButtonsTo: aFlap." anOffset := 16.
aClock := ClockMorph newSticky. aClock color: Color red. aClock showSeconds: false. aClock font: (TextStyle default fontAt: 3). aClock step. aClock setBalloonText: 'The time of day. If you prefer to see seconds, check out my menu.' translated. aFlap addCenteredAtBottom: aClock offset: anOffset.
buttonColor := Color cyan muchLighter. bb := SimpleButtonMorph new target: Smalltalk. bb color: buttonColor. aButton := bb copy. aButton actionSelector: #saveSession. aButton setBalloonText: 'Make a complete snapshot of the current state of the image onto disk.' translated. aButton label: 'save' translated font: (aFont := Preferences standardButtonFont). aFlap addCenteredAtBottom: aButton offset: anOffset.
aButton := bb copy target: MCMcmUpdater. aButton actionSelector: #updateFromServer. aButton label: 'load code updates' translated font: aFont. aButton color: buttonColor. aButton setBalloonText: 'Check the Squeak server for any new code updates, and load any that are found.' translated. aFlap addCenteredAtBottom: aButton offset: anOffset.
aButton := SimpleButtonMorph new target: Smalltalk; actionSelector: #aboutThisSystem; label: 'about this system' translated font: aFont. aButton color: buttonColor. aButton setBalloonText: 'click here to find out version information' translated. aFlap addCenteredAtBottom: aButton offset: anOffset.
aFlap addCenteredAtBottom: (Preferences themeChoiceButtonOfColor: buttonColor font: aFont) offset: anOffset.
aButton := TrashCanMorph newSticky. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton startStepping.
^ aFlapTab
"Flaps replaceGlobalFlapwithID: 'Squeak' translated "! !
!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 8/28/2023 14:29'! newSuppliesFlapFromQuads: quads positioning: positionSymbol "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen. Use #center as the positionSymbol to have it centered at the bottom of the screen, or #right to have it placed off near the right edge."
| aFlapTab aStrip hPosition | aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: quads. "self twiddleSuppliesButtonsIn: aStrip." aFlapTab := FlapTab new referent: aStrip beSticky. aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter. hPosition := positionSymbol == #center ifTrue: [(Display width // 2) - (aFlapTab width // 2)] ifFalse: [Display width - (aFlapTab width + 22)]. aFlapTab position: (hPosition @ (self currentWorld height - aFlapTab height)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
aStrip extent: self currentWorld width @ 136. aStrip beFlap: true. aStrip autoLineLayout: true. ^ aFlapTab
"Flaps replaceGlobalFlapwithID: 'Supplies' translated"! !
!Flaps class methodsFor: 'replacement' stamp: 'mt 8/4/2023 15:19'! replaceGlobalFlapwithID: flapID "If there is a global flap with flapID, replace it with an updated one."
| replacement tabs | (tabs := self globalFlapTabsWithID: flapID) size = 0 ifTrue: [^ self]. tabs do: [:tab | self removeFlapTab: tab keepInList: false]. flapID = 'Stack Tools' translated ifTrue: [replacement := self newStackToolsFlap]. flapID = 'Supplies' translated ifTrue: [replacement := self newSuppliesFlap]. flapID = 'Tools' translated ifTrue: [replacement := self newToolsFlap]. flapID = 'Widgets' translated ifTrue: [replacement := self newWidgetsFlap]. flapID = 'Navigator' translated ifTrue: [replacement := self newNavigatorFlap]. flapID = 'Squeak' translated ifTrue: [replacement := self newSqueakFlap]. replacement ifNil: [^ self]. self addGlobalFlap: replacement. self currentWorld ifNotNil: [self currentWorld addGlobalFlaps]
"Flaps replaceFlapwithID: 'Widgets' translated "! !
!FontSubstitutionDuringLoading methodsFor: 'accessing' stamp: 'mt 8/11/2023 13:59'! defaultAction familyName ifNil: [ familyName := 'NoName' ]. pixelSize ifNil: [ pixelSize := 12 ].
^((familyName beginsWith: 'Comic') ifTrue: [ TextStyle named: (Preferences standardDefaultTextFont familyName) ] ifFalse: [ TextStyle default ]) fontOfSize: pixelSize.! !
!Form methodsFor: 'converting' stamp: 'mt 8/16/2023 16:54'! blendColor: aTranslucentColor
| form canvas | form := self deepCopy asFormOfDepth: 32. canvas := form getCanvas. canvas stencil: form at: 0 @ 0 sourceRect: (0 @ 0 extent: form extent) color: aTranslucentColor. ^ canvas form! !
!Form methodsFor: 'scaling, rotation' stamp: 'sw 4/16/2008 00:13'! scaledToHeight: newHeight "Answer the receiver, scaled such that it has the desired height."
newHeight = self height ifTrue: [^ self]. ^self magnify: self boundingBox by: (newHeight / self height) smoothing: 2. ! !
!Form methodsFor: 'scaling, rotation' stamp: 'ct 9/17/2019 18:50'! scaledToWidth: newWidth "Answer the receiver, scaled such that it has the desired width."
newWidth = self width ifTrue: [^ self]. ^self magnify: self boundingBox by: (newWidth / self width) smoothing: 2. ! !
!Form class methodsFor: '*MorphicExtras-examples' stamp: 'mt 8/14/2023 16:21'! gridFormExample "Original was in Morph >> #setStandardTexture and #textureParameters and #makeGraphPaperGrid:... Morph new color: Form gridFormExample; extent: 500@500; openInHand "
^ self gridFormOrigin: 0@0 grid: 16 px background: Color black line: Color lightGreen lighter lighter ! !
!Form class methodsFor: '*MorphicExtras-sprites' stamp: 'mt 8/14/2023 16:20'! gridFormOrigin: origin grid: smallGrid background: backColor line: lineColor
| bigGrid gridForm gridOrigin | gridOrigin := origin \ smallGrid. bigGrid := (smallGrid asPoint x) @ (smallGrid asPoint y). gridForm := Form extent: bigGrid depth: Display depth. backColor ifNotNil: [gridForm fillWithColor: backColor]. gridOrigin x to: gridForm width by: smallGrid asPoint x do: [:x | gridForm fill: (x@0 extent: 1@gridForm height) fillColor: lineColor]. gridOrigin y to: gridForm height by: smallGrid asPoint y do: [:y | gridForm fill: (0@y extent: gridForm width@1) fillColor: lineColor]. ^ InfiniteForm with: gridForm! !
!GetTextExporter class methodsFor: 'utilities' stamp: 'mt 8/4/2023 13:49'! listAllHelp "self listAllHelp" | spec specs oCatalog flap flapSelectors allKeys oCatalogHelp flapHelp | oCatalog := Dictionary new. Morph withAllSubclasses do: [:aClass | (aClass class includesSelector: #descriptionForPartsBin) ifTrue: [spec := aClass descriptionForPartsBin. oCatalog at: spec formalName put: spec documentation]]. Morph withAllSubclasses do: [:aClass | (aClass class includesSelector: #supplementaryPartsDescriptions) ifTrue: [specs := aClass supplementaryPartsDescriptions. specs do: [:each | oCatalog at: each formalName put: each documentation]]]. flap := Dictionary new. flapSelectors := #( #defaultsQuadsDefiningStackToolsFlap #defaultsQuadsDefiningSuppliesFlap #defaultsQuadsDefiningToolsFlap #defaultsQuadsDefiningWidgetsFlap ). flapSelectors do: [:selector | specs := Flaps perform: selector. specs do: [:each | flap at: each third put: each fourth]]. allKeys := oCatalog keys intersection: flap keys. allKeys asArray sort do: [:each | oCatalogHelp := oCatalog at: each ifAbsent: ['']. flapHelp := flap at: each ifAbsent: ['']. oCatalogHelp = flapHelp ifFalse: [Transcript cr; show: 'Name: ' , each. Transcript cr; show: 'O: ' , oCatalogHelp. Transcript cr; show: 'F: ' , flapHelp. Transcript cr.
]]! !
!ImageSegment methodsFor: 'fileIn' stamp: 'mt 8/16/2023 16:51'! declareAndPossiblyRename: classThatIsARoot | existing catInstaller | "The class just arrived in this segment. How fit it into the Smalltalk dictionary? If it had an association, that was installed with associationDeclareAt:."
catInstaller := [ classThatIsARoot category: Object categoryForUniclasses. ]. classThatIsARoot superclass addSubclass: classThatIsARoot. (Smalltalk includesKey: classThatIsARoot name) ifFalse: [ "Class entry in Smalltalk not referred to in Segment, install anyway." catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. existing := Smalltalk at: classThatIsARoot name. existing xxxClass == ImageSegmentRootStub ifTrue: [ "We are that segment!! Must ask it carefully!!" catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. existing == false | (existing == nil) ifTrue: [ "association is in outPointers, just installed" catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. "Conflict with existing global or copy of the class" (existing isKindOf: Class) ifTrue: [ classThatIsARoot isSystemDefined not ifTrue: [ "UniClass. give it a new name" classThatIsARoot setName: MorphicModel chooseUniqueClassName. catInstaller value. "must be after new name" ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. "Take the incoming one" self inform: 'Using newly arrived version of ', classThatIsARoot name. classThatIsARoot superclass removeSubclass: classThatIsARoot. "just in case" (Smalltalk at: classThatIsARoot name) becomeForward: classThatIsARoot. catInstaller value. ^ classThatIsARoot superclass addSubclass: classThatIsARoot]. self error: 'Name already in use by a non-class: ', classThatIsARoot name. ! !
!ImageSegment class methodsFor: 'fileIn/Out' stamp: 'mt 8/28/2023 15:10'! copyFromRootsLocalFileFor: rootArray sizeHint: segSize
^ NativeImageSegment new copyFromRootsLocalFileFor: rootArray sizeHint: segSize! !
!Inspector methodsFor: 'menu' stamp: 'mt 8/28/2023 14:33'! inspectorKey: aChar from: view "Respond to a Command key issued while the cursor is over my field list"
^ aChar caseOf: { [$x] -> [self removeSelection]. [$i] -> [self inspectSelection]. [$I] -> [self exploreSelection]. [$b] -> [self browseClass]. [$h] -> [self browseClassHierarchy]. [$p] -> [self browseFullProtocol]. [$r] -> [self browseVariableReferences]. [$a] -> [self browseVariableAssignments]. [$N] -> [self browseClassRefs]. [$c] -> [self copyName] } otherwise: [self arrowKey: aChar from: view]! !
!Inspector methodsFor: 'menu' stamp: 'mt 3/10/2023 15:12'! mainFieldListMenu: aMenu "Arm the supplied menu with items for the field-list of the receiver" <fieldListMenu> aMenu addStayUpItemSpecial. self addObjectItemsTo: aMenu. (#(self ellipsis element nil) includes: self typeOfSelection) ifTrue: [self addCollectionItemsTo: aMenu].
self typeOfSelection = #instVar ifTrue: [self addInstVarItemsTo: aMenu].
self addFieldItemsTo: aMenu. self addClassItemsTo: aMenu.
^ aMenu! !
!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 7/31/2023 10:45'! formAtKey: aString "Answer the form saved under the given key"
^(Symbol lookup: aString) ifNotNil: [ :aKey | ScriptingIcons at: aKey ifAbsent: [ self blankIcon ] ] ifNil: [ self blankIcon ]! !
!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:08'! formPressedAtKey: aSymbol "Answer the form for pressed button. It is automatically generated if unavailable." "(ScriptingSystem formPressedAtKey: #TryIt) asMorph openInHand" | pressedName pressedImage | pressedName := (aSymbol , 'Pressed') asSymbol. ((ScriptingIcons includesKey: aSymbol) and: [(ScriptingIcons includesKey: pressedName) not]) ifTrue: [pressedImage := ((self formAtKey: aSymbol) blendColor: (Color black alpha: 0.3)) colorReduced. ScriptingIcons at: pressedName put: pressedImage]. ^ self formAtKey: pressedName! !
!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:11'! saveForm: aForm atKey: aKey ScriptingIcons at: aKey asSymbol put: aForm! !
!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:05'! scriptingIcons
^ ScriptingIcons ifNil: [ScriptingIcons := IdentityDictionary new]! !
!MessageSet methodsFor: 'filtering' stamp: 'mt 8/28/2023 15:11'! filterMessageList "Allow the user to refine the list of messages." | builder menuSpec | builder := ToolBuilder default. menuSpec := builder pluggableMenuSpec new model: self; yourself. menuSpec addList: #( ('unsent messages' filterToUnsentMessages 'filter to show only messages that have no senders') - ('messages that send...' filterToSendersOf 'filter to show only messages that send a selector I specify') ('messages that do not send...' filterToNotSendersOf 'filter to show only messages that do not send a selector I specify') - ('messages whose selector is...' filterToImplementorsOf 'filter to show only messages with a given selector I specify') ('messages whose selector is NOT...' filterToNotImplementorsOf 'filter to show only messages whose selector is NOT a seletor I specify') - ('messages in current change set' filterToCurrentChangeSet 'filter to show only messages that are in the current change set') ('messages not in current change set' filterToNotCurrentChangeSet 'filter to show only messages that are not in the current change set') - ('messages in any change set' filterToAnyChangeSet 'filter to show only messages that occur in at least one change set') ('messages not in any change set' filterToNotAnyChangeSet 'filter to show only messages that do not occur in any change set in the system') - ('messages authored by me' filterToCurrentAuthor 'filter to show only messages whose authoring stamp has my initials') ('messages not authored by me' filterToNotCurrentAuthor 'filter to show only messages whose authoring stamp does not have my initials') - ('messages logged in .changes file' filterToMessagesInChangesFile 'filter to show only messages whose latest source code is logged in the .changes file') ('messages only in .sources file' filterToMessagesInSourcesFile 'filter to show only messages whose latest source code is logged in the .sources file') - ('messages with prior versions' filterToMessagesWithPriorVersions 'filter to show only messages that have at least one prior version') ('messages without prior versions' filterToMessagesWithoutPriorVersions 'filter to show only messages that have no prior versions') - ('uncommented messages' filterToUncommentedMethods 'filter to show only messages that do not have comments at the beginning') ('commented messages' filterToCommentedMethods 'filter to show only messages that have comments at the beginning') - ('messages in hardened classes' filterToMessagesWithHardenedClasses 'filter to show only messages of established classes (as opposed to Uniclasses such as MorphicModel23)') - ('methods in classes with matching names' filterToMatchingClassesNames 'filter to show only methods of classes with names that match the given criteria (wildcards are allowed)') ('methods in package...' filterToPackage 'filter to show only methods of a given package') ('methods not in package...' filterToNotPackage 'filter to show only methods not of a given package') - ('messages that...' filterToMessagesThat 'let me type in a block taking a class and a selector, which will specify yea or nay concerning which elements should remain in the list')). builder runModal: (builder open: menuSpec).! !
!Lexicon methodsFor: 'toolbuilder' stamp: 'mt 7/31/2023 11:13'! addSpecialButtonsTo: buttonPanelSpec with: builder
| homeCatBtnSpec menuBtnSpec mostGenericBtnSpec | homeCatBtnSpec := builder pluggableButtonSpec new model: self; action: #showHomeCategory; label: MenuIcons smallHomeIcon scaleIconToDisplay; help: 'show this method''s home category'; yourself. menuBtnSpec := builder pluggableButtonSpec new model: self; action: #offerMenu; label: (MenuIcons formAtKey: #TinyMenu) asMorph; help: 'click here to get a menu with further options'; yourself. mostGenericBtnSpec :=builder pluggableButtonSpec new model: self; action: #chooseLimitClass; label: #limitClassString; help: 'Governs which classes'' methods should be shown. If this is the same as the viewed class, then only methods implemented in that class will be shown. If it is ProtoObject, then methods of all classes in the vocabulary will be shown.'. buttonPanelSpec children add: homeCatBtnSpec; addFirst: mostGenericBtnSpec; addFirst: menuBtnSpec.! !
!InstanceBrowser methodsFor: 'menu commands' stamp: 'mt 8/16/2023 16:52'! offerMenu "Offer a menu to the user, in response to the hitting of the menu button on the tool pane"
| aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu title: ('Messages of {1}' translated format: {objectViewed nameForViewer}). aMenu addStayUpItem. aMenu addTranslatedList: #( ('vocabulary...' chooseVocabulary) ('what to show...' offerWhatToShowMenu) - ('inst var refs (here)' setLocalInstVarRefs) ('inst var defs (here)' setLocalInstVarDefs) ('class var refs (here)' setLocalClassVarRefs) -
('navigate to a sender...' navigateToASender) ('recent...' navigateToRecentMethod) ('show methods in current change set' showMethodsInCurrentChangeSet) ('show methods with initials...' showMethodsWithInitials) - "('toggle search pane' toggleSearch)"
- - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' browseClassHierarchy) ('browse protocol (p)' browseFullProtocol) - ('fileOut' fileOutMessage) ('printOut' printOutMessage) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('versions (v)' browseVersions) ('inheritance (i)' methodHierarchy) - ('references... (r)' browseVariableReferences) ('assignments... (a)' browseVariableAssignments) - ('inspector on me' inspectViewee) - ('more...' shiftedYellowButtonActivity)). ^ aMenu popUpInWorld: self currentWorld! !
!MethodCall methodsFor: 'initialization' stamp: 'mt 8/28/2023 14:54'! receiver: aReceiver methodInterface: aMethodInterface "Initialize me to have the given receiver and methodInterface"
receiver := aReceiver. selector := aMethodInterface selector. methodInterface := aMethodInterface. arguments := aMethodInterface defaultArguments. lastValue := nil.! !
!MethodFinder methodsFor: 'initialize' stamp: 'mt 3/10/2023 15:58'! initialize "The methods we are allowed to use. (MethodFinder new initialize) "
Approved := Set new. AddAndRemove := Set new. Blocks := Set new. "These modify an argument and are not used by the MethodFinder: longPrintOn: printOn: storeOn: sentTo: storeOn:base: printOn:base: absPrintExactlyOn:base: absPrintOn:base: absPrintOn:base:digitCount: writeOn: writeScanOn: possibleVariablesFor:continuedFrom: printOn:format:"
"Object" #("in class, instance creation" categoryForUniclasses chooseUniqueClassName initialInstance isSystemDefined newFrom: officialClass readCarefullyFrom: "accessing" at: basicAt: basicSize bindWithTemp: in: size yourself "testing" basicType ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: isColor isFloat isFraction isInMemory isInteger isMorph isNil isNumber isPoint isText isTransparent isWebBrowser knownName notNil pointsTo: wantsSteps "comparing" = == closeTo: hash identityHash identityHashPrintString ~= ~~ "copying" copy shallowCopy "dependents access" canDiscardEdits dependents hasUnacceptedEdits "updating" changed changed: okToChange update: windowIsClosing "printing" fullPrintString isLiteral longPrintString printString storeString stringForReadout stringRepresentation "class membership" class isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass "error handling" "user interface" addModelMenuItemsTo:forMorph:hand: defaultLabelForInspector fullScreenSize initialExtent modelWakeUp mouseUpBalk: newTileMorphRepresentative windowActiveOnFirstClick windowReqNewLabel: "system primitives" asOop instVarAt: instVarNamed: "private" "associating" -> "converting" as: asOrderedCollection asString "casing" caseOf: caseOf:otherwise: "binding" bindingOf: "macpal" contentsChanged currentEvent currentHand currentWorld flash instanceVariableValues "flagging" flag: "translation support" "objects from disk" "finalization" ) do: [:sel | Approved add: sel]. #(at:add: at:modify: at:put: basicAt:put: "NOT instVar:at:" "message handling" perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: ) do: [:sel | AddAndRemove add: sel].
"Boolean, True, False, UndefinedObject" #("logical operations" & eqv: not xor: | "controlling" and: ifFalse: ifFalse:ifTrue: ifTrue: ifTrue:ifFalse: or: "copying" "testing" isEmptyOrNil) do: [:sel | Approved add: sel].
"Behavior" #("initialize-release" "accessing" compilerClass decompilerClass evaluatorClass format methodDict parserClass sourceCodeTemplate subclassDefinerClass "testing" instSize instSpec isBits isBytes isFixed isPointers isVariable isWeak isWords "copying" "printing" printHierarchy "creating class hierarchy" "creating method dictionary" "instance creation" basicNew basicNew: new new: "accessing class hierarchy" allSubclasses allSubclassesWithLevelDo:startingLevel: allSuperclasses subclasses superclass withAllSubclasses withAllSuperclasses "accessing method dictionary" allSelectors changeRecordsAt: compiledMethodAt: compiledMethodAt:ifAbsent: firstCommentAt: lookupSelector: selectors selectorsDo: selectorsWithArgs: "slow but useful ->" sourceCodeAt: sourceCodeAt:ifAbsent: sourceMethodAt: sourceMethodAt:ifAbsent: "accessing instances and variables" allClassVarNames allInstVarNames allSharedPools classVarNames instVarNames instanceCount sharedPools someInstance subclassInstVarNames "testing class hierarchy" inheritsFrom: kindOfSubclass "testing method dictionary" canUnderstand: classThatUnderstands: hasMethods includesSelector: whichClassIncludesSelector: whichSelectorsAccess: whichSelectorsReferTo: whichSelectorsReferTo:special:byte: whichMethodsStoreInto: "enumerating" "user interface") do: [:sel | Approved add: sel].
"ClassDescription" #("initialize-release" "accessing" classVersion isMeta name theNonMetaClass "copying" "printing" classVariablesString instanceVariablesString sharedPoolsString "instance variables" checkForInstVarsOK: "method dictionary" "organization" category organization whichCategoryIncludesSelector: "compiling" acceptsLoggingOfCompilation wantsChangeSetLogging "fileIn/Out" definition "private" ) do: [:sel | Approved add: sel].
"Class" #("initialize-release" "accessing" classPool "testing" "copying" "class name" "instance variables" "class variables" classVarAt: classVariableAssociationAt: "pool variables" "compiling" "subclass creation" "fileIn/Out" ) do: [:sel | Approved add: sel].
"Metaclass" #("initialize-release" "accessing" isSystemDefined soleInstance "copying" "instance creation" "instance variables" "pool variables" "class hierarchy" "compiling" "fileIn/Out" nonTrivial ) do: [:sel | Approved add: sel].
"Context, BlockContext" #(receiver client method receiver tempAt: "debugger access" pc selector sender shortStack sourceCode tempNames tempsAndValues "controlling" "printing" "system simulation" "initialize-release" "accessing" hasMethodReturn home numArgs "evaluating" value value:ifError: value:value: value:value:value: value:value:value:value: valueWithArguments: "controlling" "scheduling" "instruction decoding" "printing" "private" "system simulation" ) do: [:sel | Approved add: sel]. #(value: "<- Association has it as a store" ) do: [:sel | AddAndRemove add: sel].
"Message" #("inclass, instance creation" selector: selector:argument: selector:arguments: "accessing" argument argument: arguments sends: "printing" "sending" ) do: [:sel | Approved add: sel]. #("private" setSelector:arguments:) do: [:sel | AddAndRemove add: sel].
"Magnitude" #("comparing" < <= > >= between:and: "testing" max: min: min:max: ) do: [:sel | Approved add: sel].
"Date, Time" #("in class, instance creation" fromDays: fromSeconds: fromString: newDay:month:year: newDay:year: today "in class, general inquiries" dateAndTimeNow dayOfWeek: daysInMonth:forYear: daysInYear: firstWeekdayOfMonth:year: indexOfMonth: leapYear: nameOfDay: nameOfMonth: "accessing" day leap monthIndex monthName weekday year "arithmetic" addDays: subtractDate: subtractDays: "comparing" "inquiries" dayOfMonth daysInMonth daysInYear daysLeftInYear firstDayOfMonth previous: "converting" asSeconds "printing" mmddyyyy printFormat: "private" weekdayIndex "in class, instance creation" fromSeconds: now "in class, general inquiries" dateAndTimeFromSeconds: dateAndTimeNow millisecondClockValue millisecondsToRun: totalSeconds "accessing" hours minutes seconds "arithmetic" addTime: subtractTime: "comparing" "printing" intervalString print24 "converting") do: [:sel | Approved add: sel]. #("private" ) do: [:sel | AddAndRemove add: sel].
"Number" #("in class" readFrom:base: "arithmetic" * + - / // \ abs negated quo: reciprocal rem: "mathematical functions" arcCos arcSin arcTan arcTan: cos exp floorLog: ln log log: raisedTo: raisedToInteger: sin sqrt squared tan "truncation and round off" ceiling detentBy:atMultiplesOf:snap: floor roundTo: roundUpTo: rounded truncateTo: truncated "comparing" "testing" even isDivisibleBy: isInfinite isNaN isZero negative odd positive sign strictlyPositive "converting" @ asInteger asNumber asPoint asSmallAngleDegrees degreesToRadians radiansToDegrees "intervals" to: to:by: "printing" printStringBase: storeStringBase: ) do: [:sel | Approved add: sel].
"Integer" #("in class" primesUpTo: "testing" isPowerOfTwo "arithmetic" alignedTo: "comparing" "truncation and round off" atRandom normalize "enumerating" timesRepeat: "mathematical functions" degreeCos degreeSin factorial gcd: lcm: take: "bit manipulation" << >> allMask: anyMask: bitAnd: bitClear: bitInvert bitInvert32 bitOr: bitShift: bitXor: lowBit noMask: "converting" asCharacter asColorOfDepth: asFloat asFraction asHexDigit "printing" asStringWithCommas hex hex8 radix: "system primitives" lastDigit replaceFrom:to:with:startingAt: "private" "benchmarks" ) do: [:sel | Approved add: sel].
"SmallInteger, LargeNegativeInteger, LargePositiveInteger" #("arithmetic" "bit manipulation" highBit "testing" "comparing" "copying" "converting" "printing" "system primitives" digitAt: digitLength "private" fromString:radix: ) do: [:sel | Approved add: sel]. #(digitAt:put: ) do: [:sel | AddAndRemove add: sel].
"Float" #("arithmetic" "mathematical functions" reciprocalLogBase2 timesTwoPower: "comparing" "testing" "truncation and round off" exponent fractionPart integerPart significand significandAsInteger "converting" asApproximateFraction asIEEE32BitWord asTrueFraction "copying") do: [:sel | Approved add: sel].
"Fraction, Random" #(denominator numerator reduced next nextValue) do: [:sel | Approved add: sel]. #(setNumerator:denominator:) do: [:sel | AddAndRemove add: sel].
"Collection" #("accessing" anyOne "testing" includes: includesAllOf: includesAnyOf: includesSubstringAnywhere: isEmpty isSequenceable occurrencesOf: "enumerating" collect: collect:thenSelect: count: detect: detect:ifNone: detectMax: detectMin: detectSum: inject:into: reject: select: select:thenCollect: intersection: "converting" asBag asCharacterSet asSet asSortedArray asSortedCollection asSortedCollection: "printing" "private" maxSize "arithmetic" "math functions" average max median min range sum) do: [:sel | Approved add: sel]. #("adding" add: addAll: addIfNotPresent: "removing" remove: remove:ifAbsent: removeAll: removeAllFoundIn: removeAllSuchThat: remove:ifAbsent:) do: [:sel | AddAndRemove add: sel].
"SequenceableCollection" #("comparing" hasEqualElements: "accessing" allButFirst allButLast at:ifAbsent: atAll: atPin: atRandom: atWrap: fifth first fourth identityIndexOf: identityIndexOf:ifAbsent: indexOf: indexOf:ifAbsent: indexOf:startingAt:ifAbsent: indexOfSubCollection:startingAt: indexOfSubCollection:startingAt:ifAbsent: last second sixth third "removing" "copying" , copyAfterLast: copyAt:put: copyFrom:to: copyReplaceAll:with: copyReplaceFrom:to:with: copyUpTo: copyUpToLast: copyWith: copyWithout: copyWithoutAll: forceTo:paddingWith: shuffled sorted: "enumerating" withIndexCollect: findFirst: findLast: pairsCollect: with:collect: withIndexCollect: polynomialEval: "converting" asArray asDictionary asFloat32Array asFloat64Array asIntegerArray asStringWithCr asWordArray reversed "private" copyReplaceAll:with:asTokens: ) do: [:sel | Approved add: sel]. #( swap:with:) do: [:sel | AddAndRemove add: sel].
"ArrayedCollection, Bag" #("private" defaultElement "sorting" isSorted "accessing" cumulativeCounts sortedCounts sortedElements "testing" "adding" add:withOccurrences: "removing" "enumerating" ) do: [:sel | Approved add: sel]. #( mergeSortFrom:to:by: sort sort: add: add:withOccurrences: "private" setDictionary ) do: [:sel | AddAndRemove add: sel].
"Other messages that modify the receiver" #(atAll:put: atAll:putAll: atAllPut: atWrap:put: replaceAll:with: replaceFrom:to:with: removeFirst removeLast) do: [:sel | AddAndRemove add: sel].
self initialize2.
" MethodFinder new initialize. MethodFinder new organizationFiltered: Set "
! !
!MissingFont methodsFor: 'handling' stamp: 'mt 3/7/2023 15:07'! defaultAction familyName ifNil: [ familyName := 'NoName' ]. pixelSize ifNil: [ pixelSize := 12 ].
^((familyName beginsWith: 'Comic') ifTrue: [ TextStyle named: (Preferences standardButtonFont familyName) ] ifFalse: [ TextStyle default ]) fontOfSize: pixelSize.! !
!Morph methodsFor: 'accessing' stamp: 'mt 8/11/2023 16:29'! balloonText "Answer balloon help text or nil, if no help is available." "NB: subclasses may override such that they programatically construct the text, for economy's sake, such as model phrases in a Viewer."
| balloonSelector | extension ifNil: [^ nil]. extension balloonText ifNotNil: [:balloonText | ^ balloonText]. balloonSelector := extension balloonTextSelector ifNil: [^ nil]. balloonSelector isUnary ifTrue: [ (self respondsTo: balloonSelector) ifTrue: [^ self perform: balloonSelector]. (self model respondsTo: balloonSelector) ifTrue: [^ self model perform: balloonSelector]]. ^ nil! !
!Morph methodsFor: 'copying' stamp: 'mt 3/10/2023 14:51'! duplicate "Make and return a duplicate of the receiver"
| newMorph aName w topRend | ((topRend := self topRendererOrSelf) ~~ self) ifTrue: [^ topRend duplicate].
self okayToDuplicate ifFalse: [^ self]. aName := (w := self world) ifNotNil: [w nameForCopyIfAlreadyNamed: self]. newMorph := self veryDeepCopy. aName ifNotNil: [newMorph setNameTo: aName].
newMorph arrangeToStartStepping. newMorph privateOwner: nil. "no longer in world" newMorph isPartsDonor: false. "no longer parts donor" ^ newMorph! !
!Morph methodsFor: 'debug and other' stamp: 'mt 3/10/2023 15:09'! buildDebugMenu: aHand "Answer a debugging menu for the receiver. The hand argument is seemingly historical and plays no role presently"
| aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu addStayUpItem. (self hasProperty: #errorOnDraw) ifTrue: [aMenu add: 'start drawing again' translated action: #resumeAfterDrawError. aMenu addLine]. (self hasProperty: #errorOnStep) ifTrue: [aMenu add: 'start stepping again' translated action: #resumeAfterStepError. aMenu addLine]. (self hasProperty: #errorOnLayout) ifTrue: [aMenu add: 'start layouting again' translated action: #resumeAfterLayoutError. aMenu addLine].
aMenu add: 'inspect morph' translated action: #inspectInMorphic:. aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain. Smalltalk isMorphic ifFalse: [aMenu add: 'inspect morph (in MVC)' translated action: #inspect].
self isMorphicModel ifTrue: [aMenu add: 'inspect model' translated target: self model action: #inspect; add: 'explore model' translated target: self model action: #explore].
aMenu add: 'explore morph' translated target: self selector: #exploreInMorphic:.
aMenu addLine.
aMenu add: 'browse morph class' translated target: self selector: #browseHierarchy. (self isMorphicModel) ifTrue: [aMenu add: 'browse model class' target: self model selector: #browseHierarchy]. aMenu addLine.
self addViewingItemsTo: aMenu. aMenu add: 'make own subclass' translated action: #subclassMorph; add: 'save morph in file' translated action: #saveOnFile; addLine; add: 'call #tempCommand' translated action: #tempCommand; add: 'define #tempCommand' translated action: #defineTempCommand; addLine;
add: 'control-menu...' translated target: self selector: #invokeMetaMenu:; add: 'edit balloon help' translated action: #editBalloonHelpText.
^ aMenu! !
!Morph methodsFor: 'debug and other' stamp: 'mt 8/16/2023 17:11'! deleteAnyMouseActionIndicators
self changed. (self valueOfProperty: #mouseActionIndicatorMorphs ifAbsent: [#()]) do: [ :each | each delete "one is probably enough, but be safe" ]. self removeProperty: #mouseActionIndicatorMorphs. self hasRolloverBorder: false. self removeProperty: #rolloverWidth. self removeProperty: #rolloverColor. self layoutChanged. self changed.
! !
!Morph methodsFor: 'dropping/grabbing' stamp: 'mt 8/4/2023 14:49'! justDroppedInto: aMorph event: anEvent "This message is sent to a dropped morph after it has been dropped on -- and been accepted by -- a drop-sensitive morph"
| partsBinCase cmd | (self formerOwner notNil and: [self formerOwner ~~ aMorph]) ifTrue: [self removeHalo]. self formerOwner: nil. self formerPosition: nil. cmd := self valueOfProperty: #undoGrabCommand. cmd ifNotNil:[aMorph rememberCommand: cmd. self removeProperty: #undoGrabCommand]. (partsBinCase := aMorph isPartsBin) ifFalse: [self isPartsDonor: false]. (self isInWorld and: [partsBinCase not]) ifTrue: [self world startSteppingSubmorphsOf: self]. "Note an unhappy inefficiency here: the startStepping... call will often have already been called in the sequence leading up to entry to this method, but unfortunately the isPartsDonor: call often will not have already happened, with the result that the startStepping... call will not have resulted in the startage of the steppage."! !
!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:54'! handleMouseDown: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseDown: and #mouseDown: in your custom morphs. See #handlerForMouseDown: and #mouseDownPriority." anEvent wasHandled ifTrue:[^self]. "not interested" anEvent hand removePendingBalloonFor: self. anEvent wasHandled: true.
"Make me modal during mouse transitions" anEvent hand newMouseFocus: self event: anEvent. "this mouse down could be the start of a gesture, or the end of a gesture focus" (self isGestureStart: anEvent) ifTrue: [^ self gestureStart: anEvent].
self mouseDown: anEvent.
(self handlesMouseStillDown: anEvent) ifTrue:[ self startStepping: #handleMouseStillDown: at: Time millisecondClockValue + self mouseStillDownThreshold arguments: {anEvent copy resetHandlerFields} stepTime: self mouseStillDownStepRate ]. ! !
!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:54'! handleMouseEnter: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseOver: and #mouseEnter: in your custom morphs. Also see/use #handlesMouseOverDragging: and #mouseEnterDragging:."
(anEvent isDraggingEvent) ifTrue:[ (self handlesMouseOverDragging: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseEnterDragging: anEvent]. ^self]. self wantsBalloon ifTrue:[anEvent hand triggerBalloonFor: self after: self balloonHelpDelayTime]. (self handlesMouseOver: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseEnter: anEvent. ].! !
!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:55'! handleMouseLeave: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseOver: and #mouseLeave: in your custom morphs. Also see/use #handlesMouseOverDragging: and #mouseLeaveDragging:."
anEvent hand removePendingBalloonFor: self. anEvent isDraggingEvent ifTrue:[ (self handlesMouseOverDragging: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseLeaveDragging: anEvent]. ^self]. (self handlesMouseOver: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseLeave: anEvent. ]. ! !
!Morph methodsFor: 'halos and balloon help' stamp: 'mt 8/14/2023 15:59'! addHandlesTo: aHaloMorph box: box "Add halo handles to the halo. Apply the halo filter if appropriate." aHaloMorph haloBox: box. Preferences haloSpecifications do: [:aSpec | (self wantsHaloHandleWithSelector: aSpec addHandleSelector inHalo: aHaloMorph) ifTrue: [aHaloMorph perform: aSpec addHandleSelector with: aSpec]].
aHaloMorph innerTarget addOptionalHandlesTo: aHaloMorph box: box! !
!Morph methodsFor: 'halos and balloon help' stamp: 'mt 8/11/2023 16:50'! balloonHelpTextForHandle: aHandle "Answer a string providing balloon help for the given halo handle" | itsSelector | itsSelector := aHandle eventHandler firstMouseSelector. itsSelector == #doRecolor:with: ifTrue: [^ 'Change color']. itsSelector == #mouseDownInDimissHandle:with: ifTrue: [^ TrashCanMorph preserveTrash ifTrue: ['Move to trash'] ifFalse: ['Remove from screen']]. #(#(#addFullHandles 'More halo handles') #(#addSimpleHandles 'Fewer halo handles') #(#chooseEmphasisOrAlignment 'Emphasis & alignment') #(#chooseFont 'Change font') #(#chooseStyle 'Change style') #(#dismiss 'Remove') #(#doDebug:with: 'Debug') #(#doDirection:with: 'Choose forward direction') #(#doDup:with: 'Duplicate') #(#doMenu:with: 'Menu') #(#doGrab:with: 'Pick up') #(#editButtonsScript 'See the script for this button') #(#editDrawing 'Repaint') #(#mouseDownInCollapseHandle:with: 'Collapse') #(#mouseDownOnHelpHandle: 'Help') #(#paintBackground 'Paint background') #(#prepareToTrackCenterOfRotation:with: 'Move object or set center of rotation') #(#presentViewMenu 'Present the Viewing menu') #(#startDrag:with: 'Move') #(#startGrow:with: 'Change size (Ctrl + drag blue button)') #(#startRot:with: 'Rotate') #(#startScale:with: 'Change scale') #(#tearOffTile 'Make a tile representing this object') #(#trackCenterOfRotation:with: 'Set center of rotation') ) do: [:pair | itsSelector == pair first ifTrue: [^ pair last]]. ^ 'unknown halo handle'translated! !
!Morph methodsFor: 'menu' stamp: 'mt 8/11/2023 14:44'! addYellowButtonMenuItemsTo: aMenu event: evt "Populate aMenu with appropriate menu items for a yellow-button (context menu) click." aMenu defaultTarget: self. "" aMenu addStayUpItem. "" self addModelYellowButtonItemsTo: aMenu event: evt. "" Preferences generalizedYellowButtonMenu ifFalse: [^ self]. "" aMenu addLine. aMenu add: 'inspect' translated action: #inspect. "" aMenu addLine. self world selectedObject == self ifTrue: [aMenu add: 'deselect' translated action: #removeHalo] ifFalse: [aMenu add: 'select' translated action: #addHalo]. "" self isWorldMorph ifFalse: ["" aMenu addLine. aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: evt hand]. "" self isWorldMorph ifFalse: ["" Smalltalk at: #NCAAConnectorMorph ifPresent: [:connectorClass | aMenu addLine. aMenu add: 'connect to' translated action: #startWiring. aMenu addLine]. ""
self isFullOnScreen ifFalse: [aMenu add: 'move onscreen' translated action: #goHome]]. "" self addLayoutMenuItems: aMenu hand: evt hand. (owner notNil and: [owner isTextMorph]) ifTrue: [self addTextAnchorMenuItems: aMenu hand: evt hand]. "" self isWorldMorph ifFalse: ["" aMenu addLine. self addToggleItemsToHaloMenu: aMenu]. "" aMenu addLine. self isWorldMorph ifFalse: [aMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:]. self hasStrings ifTrue: [ aMenu add: 'copy text' translated action: #clipText]. "" self addExportMenuItems: aMenu hand: evt hand. "" self isWorldMorph not ifTrue: ["" aMenu addLine. aMenu add: 'adhere to edge...' translated action: #adhereToEdge]. "" self addCustomMenuItems: aMenu hand: evt hand! !
!Morph methodsFor: 'menu' stamp: 'mt 3/10/2023 16:07'! wantsYellowButtonMenu "Answer true if the receiver wants a yellow button menu" self valueOfProperty: #wantsYellowButtonMenu ifPresentDo: [:value | ^ value]. "" self isInSystemWindow ifTrue: [^ false]."" ^ Preferences generalizedYellowButtonMenu! !
!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:59'! absorbStateFromRenderer: aRenderer "Transfer knownName, actorState, visible over from aRenderer, which was formerly imposed above me as a transformation shell but is now going away."
| current | (current := aRenderer actorStateOrNil) ifNotNil: [self actorState: current. aRenderer actorState: nil].
(current := aRenderer knownName) ifNotNil: [self setNameTo: current. aRenderer setNameTo: nil].
self visible: aRenderer visible! !
!Morph methodsFor: 'menus' stamp: 'mt 3/10/2023 14:25'! addHaloActionsTo: aMenu "Add items to aMenu representing actions requestable via halo"
| subMenu | subMenu := MenuMorph new defaultTarget: self. subMenu addTitle: self externalName. subMenu addStayUpItemSpecial. subMenu addLine. subMenu add: 'delete' translated action: #dismissViaHalo. subMenu balloonTextForLastItem: 'Delete this object -- warning -- can be destructive!!' translated.
self maybeAddCollapseItemTo: subMenu. subMenu add: 'grab' translated action: #openInHand. subMenu balloonTextForLastItem: 'Pick this object up -- warning, since this removes it from its container, it can have adverse effects.' translated.
subMenu addLine.
subMenu add: 'resize' translated action: #resizeFromMenu. subMenu balloonTextForLastItem: 'Change the size of this object' translated.
subMenu add: 'duplicate' translated action: #maybeDuplicateMorph. subMenu balloonTextForLastItem: 'Hand me a copy of this object' translated. "Note that this allows access to the non-instancing duplicate even when this is a uniclass instance"
subMenu addLine.
subMenu add: 'set color' translated target: self renderedMorph action: #changeColor. subMenu balloonTextForLastItem: 'Change the color of this object' translated.
subMenu addLine.
subMenu add: 'inspect' translated target: self action: #inspect. subMenu balloonTextForLastItem: 'Open an Inspector on this object' translated.
aMenu add: 'halo actions...' translated subMenu: subMenu ! !
!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:47'! addMiscExtrasTo: aMenu "Add a submenu of miscellaneous extra items to the menu."
| realOwner realMorph subMenu | subMenu := MenuMorph new defaultTarget: self. self isWorldMorph ifFalse: [subMenu add: 'adhere to edge...' translated action: #adhereToEdge. subMenu addLine]. realOwner := (realMorph := self topRendererOrSelf) owner. (realOwner isKindOf: TextPlusPasteUpMorph) ifTrue: [subMenu add: 'GeeMail stuff...' translated subMenu: (realOwner textPlusMenuFor: realMorph)]. subMenu add: 'add mouse up action' translated action: #addMouseUpAction; add: 'remove mouse up action' translated action: #removeMouseUpAction; add: 'hand me tiles to fire this button' translated action: #handMeTilesToFire. subMenu addLine. subMenu add: 'arrowheads on pen trails...' translated action: #setArrowheads. subMenu addLine. subMenu defaultTarget: self topRendererOrSelf. subMenu add: 'draw new path' translated action: #definePath. subMenu add: 'follow existing path' translated action: #followPath. subMenu add: 'delete existing path' translated action: #deletePath. subMenu addLine. self addGestureMenuItems: subMenu hand: self currentHand. aMenu add: 'extras...' translated subMenu: subMenu! !
!Morph methodsFor: 'menus' stamp: 'mt 8/16/2023 15:58'! addStandardHaloMenuItemsTo: aMenu hand: aHandMorph "Add standard halo items to the menu"
| unlockables |
self isWorldMorph ifTrue: [^ self addWorldHaloMenuItemsTo: aMenu hand: aHandMorph].
aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: aHandMorph. aMenu addLine.
self addFillStyleMenuItems: aMenu hand: aHandMorph. self addBorderStyleMenuItems: aMenu hand: aHandMorph. self addDropShadowMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph. self addHaloActionsTo: aMenu. owner isTextMorph ifTrue:[self addTextAnchorMenuItems: aMenu hand: aHandMorph]. aMenu addLine. self addToggleItemsToHaloMenu: aMenu. aMenu addLine. self addCopyItemsTo: aMenu. self addExportMenuItems: aMenu hand: aHandMorph. self addMiscExtrasTo: aMenu. self addDebuggingItemsTo: aMenu hand: aHandMorph.
aMenu addLine. aMenu defaultTarget: self.
aMenu addLine.
unlockables := self submorphs select: [:m | m isLocked]. unlockables size = 1 ifTrue: [aMenu add: ('unlock "{1}"' translated format: unlockables first externalName) action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' translated action: #unlockContents].
aMenu defaultTarget: aHandMorph. ! !
!Morph methodsFor: 'menus' stamp: 'mt 3/10/2023 16:06'! addToggleItemsToHaloMenu: aMenu "Add standard true/false-checkbox items to the memu"
#( (resistsRemovalString toggleResistsRemoval 'whether I should be reistant to easy deletion via the pink X handle') (stickinessString toggleStickiness 'whether I should be resistant to a drag done by mousing down on me') (lockedString lockUnlockMorph 'when "locked", I am inert to all user interactions') (hasClipSubmorphsString changeClipSubmorphs 'whether the parts of objects within me that are outside my bounds should be masked.') (hasDirectionHandlesString changeDirectionHandles 'whether direction handles are shown with the halo') (hasDragEnabledString changeDrag 'whether I am open to having objects dragged out of me') (hasDropEnabledString changeDrop 'whether I am open to having objects dropped into me') ) do: [:each | aMenu addUpdating: each first action: each second. aMenu balloonTextForLastItem: each third translated].
self couldHaveRoundedCorners ifTrue: [aMenu addUpdating: #roundedCornersString action: #toggleCornerRounding. aMenu balloonTextForLastItem: 'whether my corners should be rounded' translated]! !
!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:59'! transferStateToRenderer: aRenderer "Transfer knownName, actorState, visible over to aRenderer, which is being imposed above me as a transformation shell"
| current | (current := self actorStateOrNil) ifNotNil: [aRenderer actorState: current. self actorState: nil].
(current := self knownName) ifNotNil: [aRenderer setNameTo: current. self setNameTo: nil].
aRenderer simplySetVisible: self visible
! !
!Morph methodsFor: 'meta-actions' stamp: 'mt 3/10/2023 16:06'! buildHandleMenu: aHand "Build the morph menu for the given morph's halo's menu handle. This menu has two sections. The first section contains commands that are interpreted by the hand; the second contains commands provided by the target morph. This method allows the morph to decide which items should be included in the hand's section of the menu."
| menu | menu := MenuMorph new defaultTarget: self. menu addStayUpItem. menu addLine. self addStandardHaloMenuItemsTo: menu hand: aHand. menu defaultTarget: aHand. self addAddHandMenuItemsForHalo: menu hand: aHand. menu defaultTarget: self. self addCustomHaloMenuItems: menu hand: aHand. menu defaultTarget: aHand. ^ menu ! !
!Morph methodsFor: 'naming' stamp: 'mt 3/8/2023 10:49'! renameTo: aName self knownName = aName ifTrue: [^ aName]. self topRendererOrSelf setNameTo: aName. ^ aName! !
!Morph methodsFor: 'stepping' stamp: 'mt 8/28/2023 15:14'! step "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message." ! !
!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:53'! stepAt: millisecondClockValue "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message. The millisecondClockValue parameter gives the value of the millisecond clock at the moment of dispatch. Default is to dispatch to the parameterless step method for the morph, but this protocol makes it possible for some morphs to do differing things depending on the clock value" self step ! !
!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:53'! stepTime "Answer the desired time between steps in milliseconds. This default implementation requests that the 'step' method be called once every second."
^ 1000! !
!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:57'! wantsSteps "Return true if the receiver overrides the default Morph step method." "Details: Find first class in superclass chain that implements #step and return true if it isn't class Morph."
| c | self isPartsDonor ifTrue: [^ false]. c := self class. [c includesSelector: #step] whileFalse: [c := c superclass]. ^ c ~= Morph! !
!Morph methodsFor: 'thumbnail' stamp: 'mt 8/14/2023 17:40'! representativeNoTallerThan: maxHeight norWiderThan: maxWidth thumbnailHeight: thumbnailHeight "Return a morph representing the receiver but which is no taller than aHeight. If the receiver is already small enough, just return it, else return a MorphThumbnail companioned to the receiver, enforcing the maxWidth. If the receiver personally *demands* thumbnailing, do it even if there is no size-related reason to do it."
self permitsThumbnailing ifFalse: [^ self]. (self fullBounds height <= maxHeight and: [self fullBounds width <= maxWidth]) ifTrue: [^ self].
^ MorphThumbnail new extent: maxWidth @ (thumbnailHeight min: self fullBounds height); morphRepresented: self! !
!Morph methodsFor: 'WiW support' stamp: 'mt 3/7/2023 15:07'! eToyRejectDropMorph: morphToDrop event: evt
| tm am |
tm := TextMorph new beAllFont: ((TextStyle named: Preferences standardButtonFont familyName) fontOfSize: 24); contents: 'GOT IT!!'. (am := AlignmentMorph new) color: Color yellow; layoutInset: 10; useRoundedCorners; vResizing: #shrinkWrap; hResizing: #shrinkWrap; addMorph: tm; fullBounds; position: (self bounds center - (am extent // 2)); openInWorld: self world. SoundService default playSoundNamed: 'yum' ifAbsentReadFrom: 'yum.aif'. morphToDrop rejectDropMorphEvent: evt. "send it back where it came from" am delete ! !
!Morph methodsFor: 'private' stamp: 'mt 3/10/2023 14:53'! privateMoveBy: delta "Private!! Use 'position:' instead." | fill | bounds := bounds translateBy: delta. fullBounds ifNotNil: [fullBounds := fullBounds translateBy: delta]. fill := self fillStyle. fill isOrientedFill ifTrue: [fill origin: fill origin + delta]! !
!Morph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/10/2023 14:50'! delete "Remove the receiver as a submorph of its owner and make its new owner be nil." | oldWorld | self removeHalo. (oldWorld := self world) ifNotNil: [ self disableSubmorphFocusForHand: self activeHand. self activeHand releaseKeyboardFocus: self; releaseMouseFocus: self]. owner ifNotNil: [ self privateDelete. "remove from world"].! !
!Morph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/10/2023 14:27'! goBehind "Move the receiver to bottom z-order."
| topRend | topRend := self topRendererOrSelf. topRend owner ifNotNil: [:own | own addMorphBack: topRend] ! !
!Morph methodsFor: 'submorphs - layers' stamp: 'dgd 8/31/2004 16:21'! wantsToBeTopmost "Answer if the receiver want to be one of the topmost objects in its owner" ^ self isFlapOrTab! !
!BorderedMorph methodsFor: 'menu' stamp: 'mt 4/11/2018 08:30'! changeBorderWidth: evt | handle origin aHand newWidth oldWidth | aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand]. origin := aHand position. oldWidth := self borderWidth. (handle := HandleMorph new) forEachPointDo: [:newPoint | handle removeAllMorphs. handle addMorph: (LineMorph from: origin to: newPoint color: Color black width: 1). newWidth := (newPoint - origin) r asInteger // 5. self borderWidth: newWidth] lastPointDo: [:newPoint | handle deleteBalloon. self halo ifNotNil: [:halo | halo addHandles]. self rememberCommand: (Command new cmdWording: 'border change' translated; undoTarget: self selector: #borderWidth: argument: oldWidth; redoTarget: self selector: #borderWidth: argument: newWidth)]. aHand attachMorph: handle. handle setProperty: #helpAtCenter toValue: true. handle showBalloon: 'Move cursor farther from this point to increase border width. Click when done.' translated hand: evt hand. handle startStepping! !
!AlignmentMorph methodsFor: 'geometry' stamp: 'mt 3/7/2023 14:37'! addTransparentSpacerOfSize: aPoint "Required for several MorphicExtras and other non-Etoys stuff."
self addMorphBack: ((Morph new extent: aPoint asPoint) color: Color transparent)! !
!BookPageSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'! addControls "Add the control bar at the top of the tool."
| bb r str aCheckbox aWrapper | r := AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0. r wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. bb := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort)). bb setBalloonText: 'Accept the changes made here as the new page-order for this book' translated. r addTransparentSpacerOfSize: 12. bb := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #delete)). bb setBalloonText: 'Forgot any changes made here, and dismiss this sorter' translated.
"eliminate the parts-bin button on the book-page sorters... r addTransparentSpacerOfSize: 24 @ 0.
aCheckbox := UpdatingThreePhaseButtonMorph checkBox. aCheckbox target: self; actionSelector: #togglePartsBinStatus; arguments: #(); getSelector: #getPartsBinStatus. str := StringMorph contents: 'Parts bin' translated font: Preferences standardButtonFont. aWrapper := AlignmentMorph newRow beTransparent. aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0. aWrapper addMorphBack: (self wrapperFor: aCheckbox); addMorphBack: (self wrapperFor: str lock). r addMorphBack: aWrapper."
self addMorphFront: r ! !
!BookPageSorterMorph methodsFor: 'initialization' stamp: 'mt 8/16/2023 13:52'! initialize "initialize the state of the receiver" super initialize. "" self extent: Display extent - 100; listDirection: #topToBottom; wrapCentering: #topLeft; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 3. pageHolder := PasteUpMorph new. pageHolder vResizeToFit: true; autoLineLayout: true. pageHolder extent: self extent - self borderWidth. pageHolder hResizing: #shrinkWrap. "pageHolder cursor: 0." "causes a walkback as of 5/25/2000" self addControls. self addMorphBack: pageHolder! !
!BooklikeMorph methodsFor: 'misc' stamp: 'mt 8/4/2023 13:41'! playPageFlipSound: soundName PageFlipSoundOn "mechanism to suppress sounds at init time" ifTrue: [self playSoundNamed: soundName]. ! !
!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:39'! addBookMenuItemsTo: aMenu hand: aHandMorph | controlsShowing subMenu | subMenu := MenuMorph new defaultTarget: self. subMenu add: 'previous page' translated action: #previousPage. subMenu add: 'next page' translated action: #nextPage. subMenu add: 'goto page' translated action: #goToPage. subMenu add: 'insert a page' translated action: #insertPage. subMenu add: 'delete this page' translated action: #deletePage.
controlsShowing := self hasSubmorphWithProperty: #pageControl. controlsShowing ifTrue: [subMenu add: 'hide page controls' translated action: #hidePageControls. subMenu add: 'fewer page controls' translated action: #fewerPageControls] ifFalse: [subMenu add: 'show page controls' translated action: #showPageControls]. self isInFullScreenMode ifTrue: [ subMenu add: 'exit full screen' translated action: #exitFullScreen. ] ifFalse: [ subMenu add: 'show full screen' translated action: #goFullScreen. ]. subMenu addLine. subMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:. subMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:. subMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:. subMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:.
subMenu addLine. subMenu add: 'sort pages' translated action: #sortPages:. subMenu add: 'uncache page sorter' translated action: #uncachePageSorter. (self hasProperty: #dontWrapAtEnd) ifTrue: [subMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true] ifFalse: [subMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false].
subMenu addLine. subMenu add: 'search for text' translated action: #textSearch. (aHandMorph pasteBuffer class isKindOf: PasteUpMorph class) ifTrue: [subMenu add: 'paste book page' translated action: #pasteBookPage].
subMenu add: 'send all pages to server' translated action: #savePagesOnURL. subMenu add: 'send this page to server' translated action: #saveOneOnURL. subMenu add: 'reload all from server' translated action: #reload. subMenu add: 'copy page url to clipboard' translated action: #copyUrl. subMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype. newPagePrototype ifNotNil: [subMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype].
aMenu add: 'book...' translated subMenu: subMenu ! !
!BookMorph methodsFor: 'menu' stamp: 'mt 8/11/2023 14:44'! invokeBookMenu "Invoke the book's control panel menu." | aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'Book' translated. aMenu addStayUpItem. aMenu add: 'find...' translated action: #textSearch. aMenu add: 'go to page...' translated action: #goToPage. aMenu addLine.
aMenu addList: { {'sort pages' translated. #sortPages}. {'uncache page sorter' translated. #uncachePageSorter}}. (self hasProperty: #dontWrapAtEnd) ifTrue: [aMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true] ifFalse: [aMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false]. aMenu addList: { {'make bookmark' translated. #bookmarkForThisPage}. {'make thumbnail' translated. #thumbnailForThisPage}}. aMenu addUpdating: #showingPageControlsString action: #toggleShowingOfPageControls. aMenu addUpdating: #showingFullScreenString action: #toggleFullScreen.
aMenu addLine. aMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:. aMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:. aMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:. aMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:.
aMenu addLine. (self primaryHand pasteBuffer class isKindOf: PasteUpMorph class) ifTrue: [aMenu add: 'paste book page' translated action: #pasteBookPage].
aMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype. newPagePrototype ifNotNil: [ aMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype].
aMenu add: (self dragNDropEnabled ifTrue: ['close dragNdrop'] ifFalse: ['open dragNdrop']) translated action: #changeDragAndDrop. aMenu add: 'make all pages this size' translated action: #makeUniformPageSize. aMenu addUpdating: #keepingUniformPageSizeString target: self action: #toggleMaintainUniformPageSize. aMenu addLine.
aMenu add: 'send all pages to server' translated action: #savePagesOnURL. aMenu add: 'send this page to server' translated action: #saveOneOnURL. aMenu add: 'reload all from server' translated action: #reload. aMenu add: 'copy page url to clipboard' translated action: #copyUrl.
aMenu addLine. aMenu add: 'load PPT images from slide #1' translated action: #loadImagesIntoBook. aMenu add: 'background color for all pages...' translated action: #setPageColor. aMenu add: 'make a thread of projects in this book' translated action: #buildThreadOfProjects.
aMenu popUpEvent: self world activeHand lastEvent in: self world ! !
!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:38'! saveAsNumberedURLs "Write out all pages in this book that are not showing, onto a server. The local disk could be the server. For any page that does not have a SqueakPage and a url already, name that page file by its page number. Any pages that are already totally out will stay that way."
| stem list firstTime | firstTime := (self valueOfProperty: #url) isNil. stem := self getStemUrl. "user must approve" stem isEmpty ifTrue: [^self]. firstTime ifTrue: [self setProperty: #futureUrl toValue: stem , '.bo']. self reserveUrlsIfNeeded. pages withIndexDo: [:aPage :ind | "does write the current page too"
aPage isInMemory ifTrue: ["not out now" aPage saveOnURL: stem , ind printString , '.sp']]. list := pages collect: [:aPage | aPage sqkPage prePurge]. "knows not to purge the current page" list := (list select: [:each | each notNil]) asArray. "do bulk become:" (list collect: [:each | each contentsMorph]) elementsExchangeIdentityWith: (list collect: [:spg | MorphObjectOut new xxxSetUrl: spg url page: spg]). self saveIndexOnURL. firstTime ifTrue: ["Put a thumbnail into the hand"
URLMorph grabForBook: self. self setProperty: #futureUrl toValue: nil "clean up"]! !
!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:39'! saveOnUrlPage: pageMorph "Write out this single page in this book onto a server. See savePagesOnURL. (Don't compute the texts, only this page's is written.)" | stem ind response rand newPlace dir | "Don't give the chance to put in a different place. Assume named by number" ((self valueOfProperty: #url) isNil and: [pages first url notNil]) ifTrue: [response := Project uiManager chooseOptionFrom: {'Old book' translated. 'New book sharing old pages' translated} title: 'Modify the old book, or make a new book sharing its pages?' translated. response = 2 ifTrue: ["Make up new url for .bo file and confirm with user." "Mark as shared" [rand := String new: 4. 1 to: rand size do: [:ii | rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)]. (newPlace := self getStemUrl) ifEmpty: [^ self]. newPlace := (newPlace copyUpToLast: $/), '/BK', rand, '.bo'. dir := ServerFile new fullPath: newPlace. (dir includesKey: dir fileName)] whileTrue. "keep doing until a new file" self setProperty: #url toValue: newPlace]. response = 0 ifTrue: [^ self]].
stem := self getStemUrl. "user must approve" stem ifEmpty: [^ self]. ind := pages identityIndexOf: pageMorph ifAbsent: [self error: 'where is the page?' translated]. pageMorph isInMemory ifTrue: "not out now" [pageMorph saveOnURL: stem,(ind printString),'.sp']. self saveIndexOfOnly: pageMorph.! !
!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:40'! savePagesOnURL "Write out all pages in this book onto a server. For any page that does not have a SqueakPage and a url already, ask the user for one. Give the option of naming all page files by page number. Any pages that are not in memory will stay that way. The local disk could be the server."
| response list firstTime newPlace rand dir bookUrl | self getAllText. "stored with index later" response := Project uiManager chooseOptionFrom: {'Use page numbers' translated. 'Type in file names' translated. 'Save in a new place (using page numbers)' translated. 'Save in a new place (typing names)' translated. 'Save new book sharing old pages' translated. } title: 'Each page will be a file on the server. Do you want to page numbers be the names of the files? or name each one yourself?' translated. response = 1 ifTrue: [self saveAsNumberedURLs. ^ self]. response = 3 ifTrue: [self forgetURLs; saveAsNumberedURLs. ^ self]. response = 4 ifTrue: [self forgetURLs]. response = 5 ifTrue: ["Make up new url for .bo file and confirm with user." "Mark as shared" [rand := String new: 4. 1 to: rand size do: [:ii | rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)]. (newPlace := self getStemUrl) isEmpty ifTrue: [^ self]. newPlace := (newPlace copyUpToLast: $/), '/BK', rand, '.bo'. dir := ServerFile new fullPath: newPlace. (dir includesKey: dir fileName)] whileTrue. "keep doing until a new file"
self setProperty: #url toValue: newPlace. self saveAsNumberedURLs. bookUrl := self valueOfProperty: #url. (SqueakPage stemUrl: bookUrl) = (SqueakPage stemUrl: currentPage url) ifTrue: [bookUrl := true]. "not a shared book" (URLMorph grabURL: currentPage url) book: bookUrl. ^ self]. response = 0 ifTrue: [^ self].
"self reserveUrlsIfNeeded. Need two passes here -- name on one, write on second" pages do: [:aPage | "does write the current page too" aPage isInMemory ifTrue: "not out now" [aPage saveOnURLbasic]]. "ask user if no url"
list := pages collect: [:aPage | aPage sqkPage prePurge]. "knows not to purge the current page" list := (list select: [:each | each notNil]) asArray. "do bulk become:" (list collect: [:each | each contentsMorph]) elementsExchangeIdentityWith: (list collect: [:spg | MorphObjectOut new xxxSetUrl: spg url page: spg]).
firstTime := (self valueOfProperty: #url) isNil. self saveIndexOnURL. firstTime ifTrue: "Put a thumbnail into the hand" [URLMorph grabForBook: self. self setProperty: #futureUrl toValue: nil]. "clean up" ! !
!BookMorph methodsFor: 'navigation' stamp: 'mt 8/4/2023 13:34'! goToPageMorph: aMorph "Set the given morph as the current page; run closing and opening scripts as appropriate"
self goToPage: (pages identityIndexOf: aMorph ifAbsent: [^ self "abort"]) transitionSpec: nil! !
!BookMorph methodsFor: 'navigation' stamp: 'mt 8/4/2023 13:30'! goToPageMorph: newPage transitionSpec: transitionSpec "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly. Apply the transitionSpec provided."
| pageIndex aWorld oldPageIndex ascending tSpec readIn | pages isEmpty ifTrue: [^self]. self setProperty: #searchContainer toValue: nil. "forget previous search" self setProperty: #searchOffset toValue: nil. self setProperty: #searchKey toValue: nil. pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"]. readIn := newPage isInMemory not. oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil]. ascending := (oldPageIndex isNil or: [newPage == currentPage]) ifTrue: [nil] ifFalse: [oldPageIndex < pageIndex]. tSpec := transitionSpec ifNil: ["If transition not specified by requestor..."
newPage valueOfProperty: #transitionSpec ifAbsent: [" ... then consult new page"
self transitionSpecFor: self " ... otherwise this is the default"]]. self flag: #arNote. "Probably unnecessary" (aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus]. currentPage ifNotNil: [currentPage updateCachedThumbnail]. self currentPage notNil ifTrue: [(((pages at: pageIndex) owner isKindOf: TransitionMorph) and: [(pages at: pageIndex) isInWorld]) ifTrue: [^self "In the process of a prior pageTurn"]. ascending ifNotNil: ["Show appropriate page transition and start new page when done"
currentPage stopStepping. (pages at: pageIndex) position: currentPage position. ^(TransitionMorph effect: tSpec second direction: tSpec third inverse: (ascending or: [transitionSpec notNil]) not) showTransitionFrom: currentPage to: (pages at: pageIndex) in: self whenStart: [self playPageFlipSound: tSpec first] whenDone: [currentPage delete; fullReleaseCachedState. self insertPageMorphInCorrectSpot: (pages at: pageIndex). self adjustCurrentPageForFullScreen. self snapToEdgeIfAppropriate. aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. aWorld := self world. readIn ifTrue: [currentPage updateThumbnailUrlInBook: self url. currentPage sqkPage computeThumbnail "just store it"]]].
"No transition, but at least decommission current page" currentPage delete; fullReleaseCachedState]. self insertPageMorphInCorrectSpot: (pages at: pageIndex). "sets currentPage" self adjustCurrentPageForFullScreen. self snapToEdgeIfAppropriate. aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. aWorld := self world. readIn ifTrue: [currentPage updateThumbnailUrl. currentPage sqkPage computeThumbnail "just store it"].! !
!DockingBarMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 16:05'! wantsYellowButtonMenu "Answer true if the receiver wants a yellow button menu" ^ true! !
!EventRecorderMorph methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:52'! makeStatusLightIn: aPoint
^statusLight := EllipseMorph new extent: aPoint; color: Color green; borderWidth: 0! !
!GraphMorph methodsFor: 'accessing'! valueAtCursor: aPointOrNumber
data isEmpty ifTrue: [^ 0]. data at: ((cursor truncated max: 1) min: data size) put: (self asNumber: aPointOrNumber). self flushCachedForm. ! !
!GraphMorph methodsFor: 'commands'! appendValue: aPointOrNumber
| newVal | (data isKindOf: OrderedCollection) ifFalse: [data := data asOrderedCollection]. newVal := self asNumber: aPointOrNumber. data addLast: newVal. newVal < minVal ifTrue: [minVal := newVal]. newVal > maxVal ifTrue: [maxVal := newVal]. self cursor: data size. self flushCachedForm. ! !
!GraphMorph methodsFor: 'private' stamp: 'mt 8/14/2023 16:25'! asNumber: aPointOrNumber
^ aPointOrNumber isPoint ifTrue: [aPointOrNumber r] ifFalse: [aPointOrNumber]! !
!GraphicalDictionaryMenu methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'! initializeFor: aTarget fromDictionary: aDictionary "Initialize me for a target and a dictionary."
| anIndex aButton | self baseDictionary: aDictionary. target := aTarget. coexistWithOriginal := true. self extent: 210 @ 210. self clipSubmorphs: true. self layoutPolicy: ProportionalLayout new. aButton := (IconicButton new) borderWidth: 0; labelGraphic: (MenuIcons formAtKey: 'TinyMenu'); color: Color transparent; actWhen: #buttonDown; actionSelector: #showMenu; target: self; setBalloonText: 'menu'. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (-50 @ 6 extent: aButton extent)). aButton := (SimpleButtonMorph new) target: self; borderColor: Color black; label: 'Prev'; actionSelector: #downArrowHit; actWhen: #whilePressed; setBalloonText: 'show previous picture'; yourself. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (-24 @ 4 extent: aButton extent)). aButton := (SimpleButtonMorph new) target: self; borderColor: Color black; label: 'Next'; actionSelector: #upArrowHit; actWhen: #whilePressed; setBalloonText: 'show next pictutre'. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (24 @ 4 extent: aButton extent)). self addMorph: ((UpdatingStringMorph new) contents: ' '; target: self; putSelector: #renameGraphicTo:; getSelector: #truncatedNameOfGraphic; useStringFormat; setBalloonText: 'The name of the current graphic'; yourself) fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ 0) offsets: (10 @ 40 corner: -10 @ 60)). self addMorph: ((Morph new) extent: 100 @ 4; color: Color black) fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ 0) offsets: (0 @ 60 corner: 0 @ 64)). formDisplayMorph := (Thumbnail new) extent: 100 @ 100; useInterpolation: true; maxWidth: 300 minHeight: 100; yourself. formDisplayMorph layoutFrame: (LayoutFrame fractions: (0 @ 0 extent: 0@0) offsets: (8 @ 72 corner: 108 @ 172)). self addMorph: formDisplayMorph. self minimumExtent: 116@180. target ifNotNil: [(anIndex := formChoices indexOf: target form ifAbsent: []) ifNotNil: [currentIndex := anIndex]]. self updateThumbnail! !
!GraphicalDictionaryMenu methodsFor: 'menu commands' stamp: 'mt 8/16/2023 13:50'! repaintEntry "Let the user enter into painting mode to repaint the item and save it back."
| aWorld bnds sketchEditor aPaintBox formToEdit | (aWorld := self world) assureNotPaintingElse: [^ self].
formToEdit := formChoices at: currentIndex. bnds := (submorphs second boundsInWorld origin extent: formToEdit extent) intersect: aWorld bounds. bnds := bnds expandBy: 60@60. sketchEditor := SketchEditorMorph new. aWorld addMorphFront: sketchEditor. sketchEditor initializeFor: ((aWorld drawingClass withForm: formToEdit) position: submorphs second positionInWorld) inBounds: bnds pasteUpMorph: aWorld paintBoxPosition: bnds topRight. sketchEditor afterNewPicDo: [:aForm :aRect | formChoices at: currentIndex put: aForm. baseDictionary at: (entryNames at: currentIndex) put: aForm. self updateThumbnail. (aPaintBox := aWorld paintBoxOrNil) ifNotNil: [aPaintBox delete]] ifNoBits: [(aPaintBox := aWorld paintBoxOrNil) ifNotNil: [aPaintBox delete]]. ! !
!HandMorph methodsFor: 'paste buffer' stamp: 'mt 3/10/2023 14:49'! pasteMorph
| aPastee | PasteBuffer ifNil: [^ self inform: 'Nothing to paste.' translated]. self attachMorph: (aPastee := self objectToPaste). aPastee align: aPastee center with: self position.! !
!HandMorphForReplay methodsFor: 'event handling' stamp: 'mt 8/28/2023 14:05'! processEvents "Play back the next event"
| evt hadMouse hadAny tracker | suspended == true ifTrue: [^ self]. hadMouse := hadAny := false. tracker := recorder objectTrackingEvents. [(evt := recorder nextEventToPlay) isNil] whileFalse: [ ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self]. tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp]. evt type == #EOF ifTrue: [recorder pauseIn: self currentWorld. ^ self]. evt type == #startSound ifTrue: [evt argument play. recorder synchronize. ^ self].
evt isMouse ifTrue: [hadMouse := true]. (evt isMouse or: [evt isKeyboard]) ifTrue: [self handleEvent: (evt setHand: self) resetHandlerFields. hadAny := true]]. (mouseClickState notNil and: [hadMouse not]) ifTrue: ["No mouse events during this cycle. Make sure click states time out accordingly"
mouseClickState handleEvent: lastMouseEvent asMouseMove from: self]. hadAny ifFalse: ["No pending events. Make sure z-order is up to date"
self mouseOverHandler processMouseOver: lastMouseEvent]! !
!ImageMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:15'! setNewImageFrom: formOrNil "Change the receiver's image to be one derived from the supplied form. If nil is supplied, clobber any existing image in the receiver, and in its place put a default graphic, either the one known to the receiver as its default value"
formOrNil ifNotNil: [^ self image: formOrNil]. self image: (Form extent: 16@16 depth: 32) ! !
!GrabPatchMorph methodsFor: 'dropping' stamp: 'mt 8/14/2023 17:31'! wantsToBeDroppedInto: aMorph "Only into PasteUps that are not part bins"
^ aMorph isWorldMorph! !
!GrabPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:11'! initialize "Initialize the receiver. Emblazon the GrabPatch icon on its face"
super initialize. self image: (MenuIcons formAtKey: 'GrabPatch'). self setProperty: #ignorePartsBinDrop toValue: true! !
!GrabPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:11'! initializeToStandAlone "Initialize the receiver. Emblazon the GrabPatch icon on its face"
super initializeToStandAlone. self image: (MenuIcons formAtKey: 'GrabPatch')! !
!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'mt 8/23/2023 13:48'! insertNewProject
[MorphicProject openViewOn: nil] on: ProjectViewOpenNotification do: [ :ex | ex resume: false].! !
!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'mt 8/11/2023 14:44'! moreCommands "Put up a menu of options"
| allThreads aMenu others target | allThreads := self class knownThreads. aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'navigation' translated.
self flag: #deferred. "Probably don't want that stay-up item, not least because the navigation-keystroke stuff is not dynamically handled" aMenu addStayUpItem. others := (allThreads keys reject: [ :each | each = threadName]) asArray sort. others do: [ :each | aMenu add: ('switch to <{1}>' translated format:{each}) selector: #switchToThread: argument: each ].
aMenu addList: { {'switch to recent projects' translated. #getRecentThread}. #-. {'create a new thread' translated. #threadOfNoProjects}. {'edit this thread' translated. #editThisThread}. {'create thread of all projects' translated. #threadOfAllProjects}. #-. {'First project in thread' translated. #firstPage}. {'Last project in thread' translated. #lastPage} }.
(target := self currentIndex + 2) > listOfPages size ifFalse: [ aMenu add: ('skip over next project ({1})' translated format:{(listOfPages at: target - 1) first}) action: #skipOverNext ].
aMenu addList: { {'jump within this thread' translated. #jumpWithinThread}. {'insert new project' translated. #insertNewProject}. #-. {'simply close this navigator' translated. #delete}. {'destroy this thread' translated. #destroyThread}. #- }.
(self currentWorld keyboardNavigationHandler == self) ifFalse:[ aMenu add: 'start keyboard navigation with this thread' translated action: #startKeyboardNavigation ] ifTrue: [ aMenu add: 'stop keyboard navigation with this thread' translated action: #stopKeyboardNavigation ].
aMenu popUpInWorld.! !
!LassoPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'! initialize "Initialize the receiver. Sets its image to the lasso picture"
super initialize. self image: (MenuIcons formAtKey: 'Lasso')! !
!LassoPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'! initializeToStandAlone "Initialize the receiver such that it can live on its own. Sets its image to the lasso picture"
super initializeToStandAlone. self image: (MenuIcons formAtKey: 'Lasso')! !
!Morph class methodsFor: 'fileIn/Out' stamp: 'mt 3/8/2023 09:07'! fromFileName: fullName "Reconstitute a Morph from the file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world"
| aFileStream morphOrList | aFileStream := (MultiByteBinaryOrTextStream with: ((FileStream readOnlyFileNamed: fullName) binary contentsOfEntireFile)) binary reset. morphOrList := aFileStream fileInObjectAndCode. Project current world addMorphsAndModel: morphOrList.! !
!Morph class methodsFor: '*MorphicExtras-parts bin' stamp: 'mt 8/4/2023 14:43'! supplementaryPartsDescriptions "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
^ {DescriptionForPartsBin formalName: 'NextPage' translatedNoop categoryList: {'Multimedia' translatedNoop} documentation: 'A button which, when clicked, takes the reader to the next page of a book' translatedNoop globalReceiverSymbol: #BookMorph nativitySelector: #nextPageButton. DescriptionForPartsBin formalName: 'PreviousPage' translatedNoop categoryList: {'Multimedia'} documentation: 'A button which, when clicked, takes the reader to the previous page of a book' translatedNoop globalReceiverSymbol: #BookMorph nativitySelector: #previousPageButton.}! !
!GraphicalDictionaryMenu class methodsFor: 'example' stamp: 'mt 7/31/2023 11:13'! example "GraphicalDictionaryMenu example" | aDict | aDict := Dictionary new. #('ColorTilesOff' 'ColorTilesOn' 'Controls') do: [:aString | aDict at: aString put: (MenuIcons formAtKey: aString)]. self openOn: aDict withLabel: 'Testing One Two Three'! !
!ImageMorph class methodsFor: 'scripting' stamp: 'mt 3/15/2023 14:10'! authoringPrototype | aMorph aForm | aMorph := super authoringPrototype. aForm := MenuIcons formAtKey: 'Image'. aForm ifNil: [aForm := aMorph image rotateBy: 90]. aMorph image: aForm. ^ aMorph! !
!GrabPatchMorph class methodsFor: 'instance creation' stamp: 'mt 7/31/2023 11:11'! authoringPrototype "Answer a prototype for use in a parts bin"
^ self new image: (MenuIcons formAtKey: 'GrabPatch'); markAsPartsDonor; setBalloonText: 'Use this to grab a rectangular patch from the screen'; yourself! !
!LassoPatchMorph class methodsFor: 'instance creation' stamp: 'mt 7/31/2023 11:13'! authoringPrototype "Answer a prototype for use in a parts bin"
^ self new image: (MenuIcons formAtKey: 'Lasso'); markAsPartsDonor; setBalloonText: 'Drop this on the desktop and you can then grab a patch from the screen with a lasso.'; yourself! !
!MorphExtension methodsFor: 'accessing - other properties' stamp: 'mt 3/10/2023 14:57'! sortedPropertyNames "answer the receiver's property names in a sorted way"
| props | props := WriteStream on: (Array new: 10). locked == true ifTrue: [props nextPut: #locked]. visible == false ifTrue: [props nextPut: #visible]. sticky == true ifTrue: [props nextPut: #sticky]. balloonText isNil ifFalse: [props nextPut: #balloonText]. balloonTextSelector isNil ifFalse: [props nextPut: #balloonTextSelector]. externalName isNil ifFalse: [props nextPut: #externalName]. isPartsDonor == true ifTrue: [props nextPut: #isPartsDonor]. actorState isNil ifFalse: [props nextPut: #actorState]. eventHandler isNil ifFalse: [props nextPut: #eventHandler]. otherProperties ifNotNil: [otherProperties associationsDo: [:a | props nextPut: a key]]. ^props contents sort: [:s1 :s2 | s1 <= s2]! !
!MorphExtension methodsFor: 'connectors-copying' stamp: 'mt 3/10/2023 16:11'! veryDeepInner: deepCopier "Copy all of my instance variables. Some otherProperties need to be not copied at all, but shared. Their names are given by copyWeakly. Some otherProperties should not be copied or shared. Their names are given by propertyNamesNotCopied. This is special code for the dictionary. See DeepCopier, and veryDeepFixupWith:."
| namesOfWeaklyCopiedProperties weaklyCopiedValues | super veryDeepInner: deepCopier. locked := locked veryDeepCopyWith: deepCopier. visible := visible veryDeepCopyWith: deepCopier. sticky := sticky veryDeepCopyWith: deepCopier. balloonText := balloonText veryDeepCopyWith: deepCopier. balloonTextSelector := balloonTextSelector veryDeepCopyWith: deepCopier. externalName := externalName veryDeepCopyWith: deepCopier. isPartsDonor := isPartsDonor veryDeepCopyWith: deepCopier. actorState := actorState veryDeepCopyWith: deepCopier. eventHandler := eventHandler veryDeepCopyWith: deepCopier. "has its own restrictions"
otherProperties ifNil: [ ^self ].
otherProperties := otherProperties copy. self propertyNamesNotCopied do: [ :propName | otherProperties removeKey: propName ifAbsent: [] ].
namesOfWeaklyCopiedProperties := self copyWeakly. weaklyCopiedValues := namesOfWeaklyCopiedProperties collect: [ :propName | otherProperties removeKey: propName ifAbsent: [] ].
"Now copy all the others." otherProperties := otherProperties veryDeepCopyWith: deepCopier.
"And replace the weak ones." namesOfWeaklyCopiedProperties with: weaklyCopiedValues do: [ :name :value | value ifNotNil: [ otherProperties at: name put: value ]]. ! !
!MorphExtension methodsFor: 'other' stamp: 'mt 3/10/2023 16:11'! isDefault "Return true if the receiver is a default and can be omitted" locked == true ifTrue: [^ false]. visible == false ifTrue: [^ false]. sticky == true ifTrue: [^ false]. balloonText isNil ifFalse: [^ false]. balloonTextSelector isNil ifFalse: [^ false]. externalName isNil ifFalse: [^ false]. isPartsDonor == true ifTrue: [^ false]. actorState isNil ifFalse: [^ false]. eventHandler isNil ifFalse: [^ false]. otherProperties ifNotNil: [otherProperties isEmpty ifFalse: [^ false]]. ^ true! !
!MorphExtension methodsFor: 'printing' stamp: 'mt 3/10/2023 16:11'! printOn: aStream "Append to the argument, aStream, a sequence of characters that identifies the receiver." super printOn: aStream. aStream nextPutAll: ' ' , self identityHashPrintString. locked == true ifTrue: [aStream nextPutAll: ' [locked] ']. visible == false ifTrue: [aStream nextPutAll: '[not visible] ']. sticky == true ifTrue: [aStream nextPutAll: ' [sticky] ']. balloonText ifNotNil: [aStream nextPutAll: ' [balloonText] ']. balloonTextSelector ifNotNil: [aStream nextPutAll: ' [balloonTextSelector: ' , balloonTextSelector printString , '] ']. externalName ifNotNil: [aStream nextPutAll: ' [externalName = ' , externalName , ' ] ']. isPartsDonor == true ifTrue: [aStream nextPutAll: ' [isPartsDonor] ']. eventHandler ifNotNil: [aStream nextPutAll: ' [eventHandler = ' , eventHandler printString , '] ']. (otherProperties isNil or: [otherProperties isEmpty ]) ifTrue: [^ self]. aStream nextPutAll: ' [other: '. self otherProperties keysDo: [:aKey | aStream nextPutAll: ' (' , aKey , ' -> ' , (self otherProperties at: aKey) printString , ')']. aStream nextPut: $]! !
!MorphHierarchy class methodsFor: 'opening' stamp: 'mt 8/4/2023 14:46'! openOrDelete | oldMorph | oldMorph := Project current world submorphs detect: [:each | each hasProperty: #morphHierarchy] ifNone: [| newMorph | newMorph := self new asMorph. newMorph bottomLeft: self currentHand position. newMorph openInWorld. ^ self]. "" oldMorph delete! !
!MorphListItemWrapper methodsFor: 'accessing' stamp: 'mt 3/10/2023 16:07'! contents "Answer the receiver's contents"
| tentative submorphs | tentative := item submorphs collect: [:each | each renderedMorph].
submorphs := tentative reject: [:each | each isKindOf: HaloMorph].
^ submorphs collect: [:each | self class with: each]! !
!MorphicModel methodsFor: 'submorphs - accessing' stamp: 'mt 3/10/2023 14:52'! allKnownNames "Return a list of all known names based on the scope of the receiver. If the receiver is a member of a uniclass, incorporate the original 1997 logic that queries the known names of the values of all the instance variables."
| superNames | superNames := super allKnownNames. "gather them from submorph tree" ^self class isUniClass ifTrue: [superNames , (self instanceVariableValues select: [:e | e notNil and: [e knownName notNil]] thenCollect: [:e | e knownName])] ifFalse: [superNames]! !
!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 3/8/2023 11:01'! copyFromRootsForExport: rootArray "When possible, use copySmartRootsExport:. This way may not copy a complete tree of objects. Add to roots: all of the methods pointed to from the outside by blocks." | newRoots segSize symbolHolder | arrayOfRoots := rootArray. "self halt." symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers, so they will be in outPointers" "Creation of the segment happens here" self copyFromRoots: arrayOfRoots sizeHint: 0. segSize := segment size. [(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize]. "with methods pointed at from outside" [(newRoots := self rootsIncludingBlocks) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize]. "with methods, blocks from outPointers" "Zap sender of a homeContext. Can't send live stacks out." "Why not? eem 7/3/2017 15:31" 1 to: outPointers size do: [:ii | | outPointer | outPointer := outPointers at: ii. (outPointer isBlock or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil]]. symbolHolder size "Keep reference to symbolHolder until the last"! !
!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/28/2023 15:10'! copyFromRootsLocalFileFor: rootArray sizeHint: segSize
arrayOfRoots := rootArray. self copyFromRoots: arrayOfRoots sizeHint: segSize.! !
!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/28/2023 15:40'! copySmartRootsExport: rootArray "Use SmartRefStream to find the object. Make them all roots. Create the segment in memory. Project should be in first five objects in rootArray." | newRoots segSize symbolHolder replacements naughtyBlocks allClasses sizeHint proj dummy world |
world := Project current world. symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers, so they will be in outPointers"
dummy := ReferenceStream on: (DummyStream on: nil). "Write to a fake Stream, not a file" "Collect all objects" dummy insideASegment: true. "So Uniclasses will be traced" dummy rootObject: rootArray. "inform him about the root" dummy nextPut: rootArray. (proj :=dummy project) ifNotNil: [self dependentsSave: dummy]. allClasses := SmartRefStream new uniClassInstVarsRefs: dummy. "catalog the extra objects in UniClass inst vars. Put into dummy" allClasses do: [:cls | dummy references at: cls class put: false. "put MorphicModel5 class in roots" dummy blockers removeKey: cls class ifAbsent: []]. "refs := dummy references." arrayOfRoots := self smartFillRoots: dummy. "guaranteed none repeat" replacements := dummy blockers. dummy project "recompute it" ifNil: [self error: 'lost the project!!']. dummy project class == DiskProxy ifTrue: [self error: 'saving the wrong project']. dummy := nil. "Allow dummy to be GC'ed below (bytesLeft)." naughtyBlocks := arrayOfRoots select: [ :each | each isContext and: [each hasInstVarRef]].
"since the caller switched ActiveWorld, put the real one back temporarily" naughtyBlocks isEmpty ifFalse: [world becomeActiveDuring: [world firstHand becomeActiveDuring: [ | goodToGo | goodToGo := (Project uiManager chooseOptionFrom: #('keep going' 'stop and take a look') title: 'Some block(s) which reference instance variables are included in this segment. These may fail when the segment is loaded if the class has been reshaped. What would you like to do?') = 1. goodToGo ifFalse: [naughtyBlocks inspect. self error: 'Here are the bad blocks']]]]. "Creation of the segment happens here"
"try using one-quarter of memory min: four megs to publish (will get bumped up later if needed)" sizeHint := (Smalltalk bytesLeft // 4 // 4) min: 1024*1024. self copyFromRoots: arrayOfRoots sizeHint: sizeHint areUnique: true. segSize := segment size. [(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true]. "with methods pointed at from outside" [(newRoots := self rootsIncludingBlocks) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true]. "with methods, blocks from outPointers" 1 to: outPointers size do: [:ii | | outPointer | outPointer := outPointers at: ii. (outPointer isBlock or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil]. "substitute new object in outPointers" (replacements includesKey: outPointer) ifTrue: [outPointers at: ii put: (replacements at: outPointer)]]. proj ifNotNil: [self dependentsCancel: proj]. symbolHolder. "hold onto symbolHolder until the last."! !
!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/16/2023 16:58'! smartFillRoots: dummy | refs known ours ww blockers | "Put all traced objects into my arrayOfRoots. Remove some that want to be in outPointers. Return blockers, an IdentityDictionary of objects to replace in outPointers."
blockers := dummy blockers. known := (refs := dummy references) size. refs keys do: [:obj | "copy keys to be OK with removing items" (obj isSymbol) ifTrue: [refs removeKey: obj. known := known-1]. (obj class == PasteUpMorph) ifTrue: [ obj isWorldMorph & (obj owner == nil) ifTrue: [ (dummy project ~~ nil and: [obj == dummy project world]) ifFalse: [ refs removeKey: obj. known := known-1. blockers at: obj put: (StringMorph contents: 'The worldMorph of a different world')]]]. "Make a ProjectViewMorph here" "obj class == Project ifTrue: [Transcript show: obj; cr]." (blockers includesKey: obj) ifTrue: [ refs removeKey: obj ifAbsent: [known := known+1]. known := known-1]. ]. ours := (dummy project ifNil: [Project current]) world. refs keysDo: [:obj | obj isMorph ifTrue: [ ww := obj world. (ww == ours) | (ww == nil) ifFalse: [ refs removeKey: obj. known := known-1. blockers at: obj put: (StringMorph contents: obj printString, ' from another world')]]]. "keep original roots on the front of the list" dummy rootObject do: [:rr | refs removeKey: rr ifAbsent: []]. ^dummy rootObject, refs keys asArray! !
!NativeImageSegment methodsFor: 'testing' stamp: 'mt 3/8/2023 11:01'! findRogueRootsImSeg: rootArray "This is a tool to track down unwanted pointers into the segment. If we don't deal with these pointers, the segment turns out much smaller than it should. These pointers keep a subtree of objects out of the segment. 1) Break all owner pointers in submorphs and all scripts. 2) Create the segment and look at outPointers. 3) Remove those we expect. 4) Remember to quit without saving -- the owner pointers are smashed."
| suspects bag1 bag2 | arrayOfRoots := rootArray. self findRogueRootsPrep. "and free that context!!" Smalltalk garbageCollect. self copyFromRoots: arrayOfRoots sizeHint: 0.
suspects := outPointers select: [:oo | oo isMorph]. suspects size > 0 ifTrue: [suspects inspect]. bag1 := Bag new. bag2 := Bag new. outPointers do: [:key | (key isKindOf: Class) ifTrue: [bag2 add: key class name] ifFalse: [(#(Symbol Point Rectangle True False String Float Color Form ColorForm StrikeFont Metaclass UndefinedObject TranslucentColor) includes: key class name) ifTrue: [bag2 add: key class name] ifFalse: [bag1 add: key class name]]]. "(bag sortedCounts) is the SortedCollection" (StringHolder new contents: bag1 sortedCounts printString, '
', bag2 sortedCounts printString) openLabel: 'Objects pointed at by the outside'. self halt: 'Examine local variables pointIn and inSeg'.
"Use this in inspectors: outPointers select: [:oo | oo class == <a Class>]. " ! !
!NativeImageSegment methodsFor: 'testing' stamp: 'mt 3/10/2023 15:12'! findRogueRootsPrep "Part of the tool to track down unwanted pointers into the segment. Break all owner pointers in submorphs, scripts, and viewers in flaps."
| wld morphs | wld := arrayOfRoots detect: [:obj | obj isMorph ifTrue: [obj isWorldMorph] ifFalse: [false]] ifNone: [nil]. wld ifNil: [wld := arrayOfRoots detect: [:obj | obj isMorph] ifNone: [^ self error: 'can''t find a root morph']]. morphs := IdentitySet new: 400. wld allMorphsDo: [:m | morphs add: m]. morphs do: [:mm | "break the back pointers" mm isInMemory ifTrue: [ (mm respondsTo: #target) ifTrue: [ mm nearestOwnerThat: [:ow | ow == mm target ifTrue: [mm target: nil. true] ifFalse: [false]]]. (mm respondsTo: #arguments) ifTrue: [ mm arguments do: [:arg | arg ifNotNil: [ mm nearestOwnerThat: [:ow | ow == arg ifTrue: [mm arguments at: (mm arguments indexOf: arg) put: nil. true] ifFalse: [false]]]]]. mm eventHandler ifNotNil: ["recipients point back up" (morphs includesAllOf: (mm eventHandler allRecipients)) ifTrue: [ mm eventHandler: nil]]. "temporary, until using Model for PartsBin" (mm isMorphicModel) ifTrue: [ (mm model isMorphicModel) ifTrue: [ mm model breakDependents]]. (mm isTextMorph) ifTrue: [mm setContainer: nil]]]. (Smalltalk includesKey: #Owners) ifTrue: [Smalltalk at: #Owners put: nil]. "in case findOwnerMap: is commented out" "self findOwnerMap: morphs." morphs do: [:mm | "break the back pointers" mm isInMemory ifTrue: [mm privateOwner: nil]]. "more in extensions?" ! !
!NebraskaCommunicatorMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/11/2023 13:59'! textEntryFieldNamed: aSymbol with: aString help: helpString
| f col | f := (StringMorph new contents: aString; font: Preferences standardDefaultTextFont; yourself) setBalloonText: helpString; on: #mouseUp send: #editEvent:for: to: self. self field: aSymbol is: f. col := (self inAColumn: {f}) color: Color white; hResizing: #shrinkWrap. ^col! !
!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:52'! acceptTo: someText forMorph: aMorph
| betterText |
betterText := self improveText: someText forMorph: aMorph. self transmitStreamedObject: (SmartRefStream streamedRepresentationOf: betterText) to: self ipAddress. aMorph setText: '' asText. self appendMessage: self startOfMessageFromMe, ' - ', betterText, String cr.
^true! !
!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:56'! appendMessage: aText
receivingPane setText: (receivingPane text append: aText).! !
!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:54'! improveText: someText forMorph: aMorph
| betterText conversions fontForAll |
fontForAll := TextStyle default. betterText := someText veryDeepCopy. conversions := OrderedCollection new. betterText runs withStartStopAndValueDo: [:start :stop :attributes | attributes do: [:att | (att isMemberOf: TextFontChange) ifTrue: [ conversions add: {att. start. stop} ] ] ]. conversions do: [ :old | | newAttr | betterText removeAttribute: old first from: old second to: old third. newAttr := TextFontReference toFont: (fontForAll fontAt: old first fontNumber). newAttr fontNumber: old first fontNumber. betterText addAttribute: newAttr from: old second to: old third. ]. ^betterText! !
!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:57'! reportError: aString
receivingPane setText: (receivingPane text append: (aString asText addAttribute: TextColor red), String cr).! !
!NebraskaFridgeMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:52'! acceptDroppingMorph: morphToDrop event: evt
| outData |
(morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt ]. self eToyRejectDropMorph: morphToDrop event: evt. "we will keep a copy" (morphToDrop isKindOf: NebraskaSenderMorph) ifTrue: [ self class addRecipient: morphToDrop. ^self rebuild ]. self stopFlashing. "7 mar 2001 - remove #veryDeepCopy" outData := SmartRefStream streamedRepresentationOf: morphToDrop. self resetIndicator: #working. self class fridgeRecipients do: [ :each | self transmitStreamedObject: outData to: each ipAddress ].
! !
!NebraskaMorphsWelcomeMorph methodsFor: 'initialization' stamp: 'mt 8/11/2023 13:59'! initialize "initialize the state of the receiver" | earMorph | super initialize. "" self layoutInset: 8 @ 8. "earMorph := (EToyListenerMorph makeListeningToggle: true) asMorph." earMorph := TextMorph new contents: 'Morphs welcome here'; fontName: Preferences standardDefaultTextFont familyName size: 18; centered; lock. self addARow: {earMorph}. self setBalloonText: 'My presence in this world means received morphs may appear automatically' translated! !
!NebraskaMultiChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:52'! acceptTo: someText forMorph: aMorph
| streamedMessage betterText |
betterText := self improveText: someText forMorph: aMorph. streamedMessage := SmartRefStream streamedRepresentationOf: {targetIPAddresses. betterText}. targetIPAddresses do: [ :each | self transmitStreamedObject: streamedMessage to: each. ]. aMorph setText: '' asText. self appendMessage: self startOfMessageFromMe, ' - ', betterText, String cr.
^true! !
!NebraskaSenderMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:53'! acceptDroppingMorph: morphToDrop event: evt
| myCopy outData |
(morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it"
"7 mar 2001 - remove #veryDeepCopy" myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position. self stopFlashing.
outData := SmartRefStream streamedRepresentationOf: myCopy. self resetIndicator: #working. self transmitStreamedObject: outData to: self ipAddress.
! !
!NebraskaSenderMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:53'! sendStatusReply
| null | null := String with: 0 asCharacter. NebraskaPeerToPeer new sendSomeData: { NebraskaIncomingMessage typeStatusReply,null. Preferences defaultAuthorName,null. (SmartRefStream streamedRepresentationOf: (NebraskaGateKeeperMorph acceptableTypesFor: self ipAddress)). } to: self ipAddress for: self. ! !
!NebraskaServerMorph methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:54'! rebuild
| myServer toggle closeBox font |
font := StrikeFont familyName: #Palatino size: 14. self removeAllMorphs. self setColorsAndBorder. self updateCurrentStatusString. toggle := SimpleHierarchicalListMorph new perform: ( fullDisplay ifTrue: [#expandedForm] ifFalse: [#notExpandedForm] ). closeBox := SimpleButtonMorph new borderWidth: 0; label: 'X' font: Preferences standardButtonFont; color: Color transparent; actionSelector: #delete; target: self; extent: 14@14; setBalloonText: 'End Nebraska session' translated.
self addARow: { self inAColumn: {closeBox}. self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentStatusString; contents: self currentStatusString; stepTime: 2000; lock. }. self inAColumn: { toggle asMorph on: #mouseUp send: #toggleFull to: self; setBalloonText: 'Show more or less of Nebraska Status' translated }. }. myServer := self server. (myServer isNil or: [fullDisplay not]) ifTrue: [ ^self world startSteppingSubmorphsOf: self ]. "--- the expanded display ---" self addARow: { self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentBacklogString; contents: self currentBacklogString; stepTime: 2000; lock. }. }.
self addARow: { self inAColumn: { (StringMorph contents: '--clients--' translated) lock; font: font. }. }.
myServer clients do: [ :each | self addARow: { UpdatingStringMorph new useStringFormat; target: each; font: font; getSelector: #currentStatusString; contents: each currentStatusString; stepTime: 2000; lock. } ]. self world startSteppingSubmorphsOf: self.! !
!NebraskaServerMorph methodsFor: 'initialization' stamp: 'mt 8/23/2023 13:26'! setColorsAndBorder
self color: (Color r: 0.9 g: 0.9 b: 0.9). self borderStyle: (BorderStyle raised width: 1). self useRoundedCorners! !
!NetworkTerminalMorph methodsFor: 'events-processing' stamp: 'mt 8/14/2023 11:29'! handleMouseDown: anEvent anEvent wasHandled ifTrue:[^self]. anEvent hand removePendingBalloonFor: self. anEvent wasHandled: true. anEvent hand newMouseFocus: self event: anEvent. anEvent hand removeHaloFromClick: anEvent on: self. self sendEventAsIs: anEvent.! !
!NetworkTerminalMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:53'! acceptDroppingMorph: morphToDrop event: evt
| myCopy outData null |
(morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it"
"7 mar 2001 - remove #veryDeepCopy" myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position.
outData := SmartRefStream streamedRepresentationOf: myCopy. null := String with: 0 asCharacter. NebraskaPeerToPeer new sendSomeData: { NebraskaIncomingMessage typeMorph,null. Preferences defaultAuthorName,null. outData } to: connection remoteSocketAddress hostNumber for: self. ! !
!NewHandleMorph methodsFor: 'initialization' stamp: 'mt 3/10/2023 16:07'! initialize "initialize the state of the receiver"
super initialize. "" waitingForClickInside := true.! !
!ObjectExplorer methodsFor: 'menus' stamp: 'mt 8/28/2023 14:40'! explorerKey: aChar from: view event: event
event anyModifierKeyPressed ifFalse: [^ false].
self object ifNotNil: [ aChar == $i ifTrue: [self inspectSelection. ^ true]. aChar == $I ifTrue: [self exploreSelection. ^ true].
aChar == $b ifTrue: [self browseFull. ^ true]. aChar == $h ifTrue: [self browseClassHierarchy. ^ true]. aChar == $c ifTrue: [self copyName. ^ true]. aChar == $p ifTrue: [self browseFullProtocol. ^ true]. aChar == $N ifTrue: [self browseClassRefs. ^ true]].
^ false! !
!ObjectlandMorph methodsFor: 'projects' stamp: 'mt 8/11/2023 15:16'! fillObjectlandProject
^ self fillObjectlandProjectWith: { self createGamesProject. self createGraphicsProject. self createToolsProject. self createSoundsProject }! !
!ObjectsTool methodsFor: 'search' stamp: 'mt 8/11/2023 13:59'! newSearchPane "Answer a type-in pane for searches"
| aTextMorph | aTextMorph := TextMorph new setProperty: #defaultContents toValue: ('' asText allBold addAttribute: (TextFontChange font3)); setTextStyle: (TextStyle fontArray: { Preferences standardDefaultTextFont }); setDefaultContentsIfNil; on: #keyStroke send: #searchPaneCharacter: to: self; setNameTo: 'SearchPane'; setBalloonText: 'Type here and all entries that match will be shown.' translated; vResizing: #shrinkWrap; hResizing: #spaceFill; margins: 4 px @ 6 px; backgroundColor: Color white. ^ aTextMorph! !
!PackageDependencyTest methodsFor: 'tests' stamp: 'mt 3/15/2023 14:59'! testMorphic self testPackage: #Morphic dependsExactlyOn: #( Balloon #'Chronology-Core' Collections Compiler Compression Files Graphics 'Installer-Core' "Because of TheWorldMainDockingBar's install feature ..." Kernel MonticelloConfigurations MorphicExtras Multilingual Network Sound System SystemReporter #'ToolBuilder-Kernel' #'ToolBuilder-Morphic' Tools TrueType ).! !
!PackageDependencyTest methodsFor: 'failures' stamp: 'mt 3/15/2023 14:58'! expectedFailures
^ #(testSystem testTools)! !
!PaintBoxMorph methodsFor: 'actions' stamp: 'mt 8/10/2023 15:31'! currentColor: aColor
currentColor := aColor.! !
!PaintBoxMorph methodsFor: 'initialization' stamp: 'mt 8/28/2023 14:39'! addLabels
self addGraphicLabels ifFalse: [self addTextualLabels].! !
!PaintBoxMorph methodsFor: 'initialization' stamp: 'mt 8/10/2023 15:30'! beSupersized "Not supported."! !
!PaintBoxMorph methodsFor: 'other' stamp: 'mt 8/28/2023 14:39'! offsetFromMaxBounds "location of normal PaintBox within maxBounds." | left | left := self left. self flag: #useBiggerPaintingBox. left := left - (( self width * 1.5)- self width). ^ left - colorMemory left @ 0! !
!PaintBoxMorph class methodsFor: 'instance creation' stamp: 'mt 8/28/2023 15:42'! new
| pb | pb := self prototype veryDeepCopy. pb stampHolder normalize. "Get the stamps to show" "Get my own copies of the brushes so I can modify them" #(brush1: brush2: brush3: brush4: brush5: brush6:) do: [:sel | | dualUse button | button := pb submorphNamed: sel. button offImage: button offImage deepCopy. dualUse := button onImage == button pressedImage. "sometimes shared" button onImage: button onImage deepCopy. dualUse ifTrue: [button pressedImage: button onImage] ifFalse: [button pressedImage: button pressedImage deepCopy]. ]. pb showColor. pb fixUpRecentColors. pb addLabels. ^ pb! !
!ParagraphEditor methodsFor: 'editing keys' stamp: 'mt 8/11/2023 14:44'! changeEmphasis: characterStream "Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change. Keeps typeahead." | keyCode attribute oldAttributes index thisSel colors extras |
"control 0..9 -> 0..9" keyCode := ('0123456789' indexOf: sensor keyboard ifAbsent: [1]) - 1.
oldAttributes := paragraph text attributesAt: self pointIndex forStyle: paragraph textStyle. thisSel := self selection.
"Decipher keyCodes for Command 0-9..." "(keyCode between: 1 and: 5) ifTrue: [ attribute := TextFontChange fontNumber: keyCode ]."
keyCode = 5 ifTrue: [ | labels lines | colors := #(#black #magenta #red #yellow #green #blue #cyan #white ). extras := #('Link to comment of class' 'Link to definition of class' 'Link to hierarchy of class' 'Link to method' ).
labels := colors , #('choose color...' 'Do it' 'Print it' ) , extras , #('be a web URL link' 'Edit hidden info' 'Copy hidden info' ). lines := Array with: colors size + 1.
"index := (PopUpMenu labelArray: labels lines: lines) startUp. " index := UIManager default chooseFrom: labels lines: lines. index = 0 ifTrue: [ ^ true]. index <= colors size ifTrue: [ attribute := TextColor color: (Color perform: (colors at: index)) ] ifFalse: [ index := index - colors size - 1. "Re-number!!!!!!"
index = 0 ifTrue: [ attribute := self chooseColor ].
index = 1 ifTrue: [ attribute := TextDoIt new. thisSel := attribute analyze: self selection asString ].
index = 2 ifTrue: [ attribute := TextPrintIt new. thisSel := attribute analyze: self selection asString ].
extras size = 0 & (index > 2) ifTrue: [ index := index + 4 "skip those" ].
index = 3 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Comment' ].
index = 4 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Definition' ].
index = 5 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Hierarchy' ].
index = 6 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString ]. index = 7 ifTrue: [ attribute := TextURL new. thisSel := attribute analyze: self selection asString ]. index = 8 ifTrue: [ "Edit hidden info" thisSel := self hiddenInfo. "includes selection" attribute := TextEmphasis normal ].
index = 9 ifTrue: [ "Copy hidden info" self copyHiddenInfo. ^ true ]. "no other action" thisSel ifNil: [ ^ true ] ] ].
(keyCode between: 6 and: 9) ifTrue: [ sensor leftShiftDown ifTrue: [ keyCode = 6 ifTrue: [ attribute := TextKern kern: -1 ]. keyCode = 7 ifTrue: [ attribute := TextKern kern: 1 ] ] ifFalse: [ "And remember this: nine is fine for underline, obliter-eight it as you see fit, seven has been bold for ever'n, which leaves six as the obivous fix to emphasize your poetics." attribute := TextEmphasis perform: (#(italic bold struckOut underlined) at: keyCode - 5). oldAttributes do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]] ] ].
keyCode = 0 ifTrue: [attribute := TextEmphasis normal].
attribute ifNil: [^ true].
beginTypeInBlock ~~ nil ifTrue: [ "only change emphasisHere while typing" self insertTypeAhead: characterStream. emphasisHere := Text addAttribute: attribute toArray: oldAttributes. ^ true ].
self replaceSelectionWith: (thisSel asText addAttribute: attribute). ^ true ! !
!ParagraphEditor class methodsFor: 'class initialization' stamp: 'mt 8/11/2023 14:47'! yellowButtonMenu
^ SelectionMenu fromArray: StringHolder yellowButtonMenuItems! !
!ParagraphEditor class methodsFor: 'keyboard shortcut tables' stamp: 'mt 8/11/2023 14:45'! initializeCmdKeyShortcuts "Initialize the (unshifted) command-key (or alt-key) shortcut table."
"NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"
"ParagraphEditor initialize"
| cmdMap |
cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash"
cmdMap at: 1 + 1 put: #cursorHome:. "home key" cmdMap at: 4 + 1 put: #cursorEnd:. "end key" cmdMap at: 8 + 1 put: #backspace:. "ctrl-H or delete key" cmdMap at: 11 + 1 put: #cursorPageUp:. "page up key" cmdMap at: 12 + 1 put: #cursorPageDown:. "page down key" cmdMap at: 13 + 1 put: #crWithIndent:. "cmd-Return" cmdMap at: 27 + 1 put: #offerMenuFromEsc:. "escape key" cmdMap at: 28 + 1 put: #cursorLeft:. "left arrow key" cmdMap at: 29 + 1 put: #cursorRight:. "right arrow key" cmdMap at: 30 + 1 put: #cursorUp:. "up arrow key" cmdMap at: 31 + 1 put: #cursorDown:. "down arrow key" cmdMap at: 32 + 1 put: #selectWord:. "space bar key" cmdMap at: 127 + 1 put: #forwardDelete:. "del key"
'0123456789' do: [:char | cmdMap at: char asciiValue + 1 put: #changeEmphasis:].
"triplet = {character. comment selector. novice appropiated}" #( ($a #selectAll: ) ($b #browseIt: ) ($c #copySelection: ) ($d #doIt: ) ($e #exchange: ) ($f #find: ) ($g #findAgain: ) ($h #setSearchString: ) ($i #inspectIt: ) ($j #doAgainOnce: ) ($k #offerFontMenu: ) ($l #cancel: ) ($m #implementorsOfIt: ) ($n #sendersOfIt: ) ($o #spawnIt: ) ($p #printIt: ) ($q #querySymbol: ) ($s #save: ) ($t #tempCommand: ) ($u #align: ) ($v #paste: ) ($w #backWord: ) ($x #cut: ) ($y #swapChars: ) ($z #undo: ) ) do:[:triplet | cmdMap at: triplet first asciiValue + 1 put: triplet second].
CmdActions := cmdMap. ! !
!ParagraphEditor class methodsFor: 'keyboard shortcut tables' stamp: 'mt 8/11/2023 14:46'! initializeShiftCmdKeyShortcuts "Initialize the shift-command-key (or control-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the capitalized versions of the letters. TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values."
| cmdMap |
"shift-command and control shortcuts" cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash"
cmdMap at: ( 1 + 1) put: #cursorHome:. "home key" cmdMap at: ( 4 + 1) put: #cursorEnd:. "end key" cmdMap at: ( 8 + 1) put: #forwardDelete:. "ctrl-H or delete key" cmdMap at: (11 + 1) put: #cursorPageUp:. "page up key" cmdMap at: (12 + 1) put: #cursorPageDown:. "page down key" cmdMap at: (13 + 1) put: #crWithIndent:. "ctrl-Return" cmdMap at: (27 + 1) put: #offerMenuFromEsc:. "escape key" cmdMap at: (28 + 1) put: #cursorLeft:. "left arrow key" cmdMap at: (29 + 1) put: #cursorRight:. "right arrow key" cmdMap at: (30 + 1) put: #cursorUp:. "up arrow key" cmdMap at: (31 + 1) put: #cursorDown:. "down arrow key" cmdMap at: (32 + 1) put: #selectWord:. "space bar key" cmdMap at: (45 + 1) put: #changeEmphasis:. "cmd-sh-minus" cmdMap at: (61 + 1) put: #changeEmphasis:. "cmd-sh-plus" cmdMap at: (127 + 1) put: #forwardDelete:. "del key"
"triplet = {character. comment selector. novice appropiated}" #( ($a argAdvance: ) ($b browseItHere: ) ($c compareToClipboard: ) ($d debugIt: ) ($e methodStringsContainingIt:) ($f displayIfFalse: ) ($g fileItIn: ) ($h cursorTopHome: ) ($i exploreIt: ) ($j doAgainMany: ) ($k changeStyle: ) ($m selectCurrentTypeIn: ) ($n referencesToIt: ) ($p makeProjectLink: ) ($s search: ) ($t displayIfTrue: ) ($u changeLfToCr: ) ($v pasteInitials: ) ($w methodNamesContainingIt:) ($x makeLowercase: ) ($y makeUppercase: ) ($z makeCapitalized: ) ) do:[:triplet | cmdMap at: (triplet first asciiValue + 1) put: triplet second. "plain keys" cmdMap at: (triplet first asciiValue - 32 + 1) put: triplet second. "shifted keys" cmdMap at: (triplet first asciiValue - 96 + 1) put: triplet second. "ctrl keys" ].
ShiftCmdActions := cmdMap! !
!PasteUpMorph methodsFor: 'accessing' stamp: 'mt 8/11/2023 16:19'! flapTab "Answer the tab affilitated with the receiver. Normally every flap tab is expected to have a PasteUpMorph which serves as its 'referent.'"
self isFlap ifFalse: [^ nil]. ^ self flapTabs detect: [:any| any referent == self] ifNone: [nil]! !
!PasteUpMorph methodsFor: 'caching' stamp: 'mt 3/10/2023 15:07'! releaseCachedState super releaseCachedState. self isWorldMorph ifTrue:[self cleanseStepList].! !
!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'mt 8/14/2023 17:42'! acceptDroppingMorph: dropped event: evt "The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied"
| aMorph | (self isWorldMorph and: [dropped isTransferMorph] and: [self hasTransferMorphConverter not]) ifTrue: [ dropped dragTransferType = #filesAndDirectories ifTrue: [^ self dropFiles: dropped passenger event: evt]. dropped dragTransferType = #sourceCode ifTrue: [^ self dropSourceCode: dropped passenger event: evt]. dropped dragTransferType = #inspectorField "See Tools-Inspector" ifTrue: [^ self dropInspectorField: dropped passenger event: evt]. dropped dragTransferType = #explorerField "See Tools-Explorer" ifTrue: [^ self dropExplorerField: dropped passenger from: dropped source model event: evt]]. aMorph := self morphToDropFrom: dropped. self isWorldMorph ifFalse: [super acceptDroppingMorph: aMorph event: evt] ifTrue: ["Add the given morph to this world and start stepping it if it wants to be." aMorph isInWorld ifFalse: [aMorph position: evt position]. self addMorphFront: aMorph. (aMorph fullBounds intersects: self viewBox) ifFalse: [Beeper beep. aMorph position: self bounds center]]. aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]]. self isPartsBin ifTrue: [aMorph isPartsDonor: true. aMorph stopSteppingSelfAndSubmorphs. aMorph suspendEventHandler] ifFalse: [self world startSteppingSubmorphsOf: aMorph]. self bringTopmostsToFront.! !
!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'mt 8/14/2023 17:41'! morphToDropFrom: aMorph "Given a morph being carried by the hand which the hand is about to drop, answer the actual morph to be deposited. Normally this would be just the morph itself, but several unusual cases arise, which this method is designed to service."
| aNail representee handy posBlock | handy := self isWorldMorph ifTrue: [self primaryHand] ifFalse: [self currentHand]. posBlock := [:z | | tempPos | tempPos := handy position - ((handy targetOffset - aMorph formerPosition) * (z extent / aMorph extent)) rounded. self pointFromWorld: tempPos]. self alwaysShowThumbnail ifTrue: [aNail := aMorph representativeNoTallerThan: self maxHeightToAvoidThumbnailing norWiderThan: self maximumThumbnailWidth thumbnailHeight: self heightForThumbnails. aNail == aMorph ifFalse: [aMorph formerPosition: aMorph position. aNail position: (posBlock value: aNail)]. ^aNail]. ((aMorph isKindOf: MorphThumbnail) and: [(representee := aMorph morphRepresented) owner isNil]) ifTrue: [representee position: (posBlock value: representee). ^representee].
^aMorph morphToDropInPasteUp: self! !
!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/15/2023 13:45'! handlesKeyboard: evt ^self isWorldMorph! !
!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/15/2023 13:45'! keyStroke: anEvent "A keystroke has been made. Service event handlers and, if it's a keystroke presented to the world, dispatch it to #unfocusedKeystroke:"
| selected | super keyStroke: anEvent. "Give event handlers a chance"
selected := self selectedObject. selected isNil ifFalse:[ selected moveOrResizeFromKeystroke: anEvent ].
self isWorldMorph ifTrue: [self keystrokeInWorld: anEvent]! !
!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 16:08'! mouseDown: evt "Handle a mouse down event." | grabbedMorph handHadHalos |
(Preferences generalizedYellowButtonMenu and: [evt yellowButtonPressed]) ifTrue: [^ self yellowButtonActivity: evt shiftPressed].
grabbedMorph := self morphToGrab: evt. grabbedMorph ifNotNil:[ grabbedMorph isSticky ifTrue:[^self]. self isPartsBin ifFalse:[^evt hand grabMorph: grabbedMorph]. grabbedMorph := grabbedMorph partRepresented duplicate. grabbedMorph restoreSuspendedEventHandler. (grabbedMorph fullBounds containsPoint: evt position) ifFalse:[grabbedMorph position: evt position]. "Note: grabbedMorph is ownerless after duplicate so use #grabMorph:from: instead" ^ evt hand grabMorph: grabbedMorph from: self].
(super handlesMouseDown: evt) ifTrue:[^super mouseDown: evt].
handHadHalos := evt hand halo notNil.
evt hand removeHalo. "shake off halos" evt hand releaseKeyboardFocus. "shake of keyboard foci"
self submorphs select:[:each | each hasProperty: #morphHierarchy] thenDo:[:each | each delete].
(evt shiftPressed not and:[ self isWorldMorph not and:[ self wantsEasySelection not ]]) ifTrue:[ "explicitly ignore the event if we're not the world and we'll not select, so that we could be picked up if need be" evt wasHandled: false. ^ self. ].
( evt shiftPressed or: [ self wantsEasySelection ] ) ifTrue:[ "We'll select on drag, let's decide what to do on click" | clickSelector |
clickSelector := nil.
evt shiftPressed ifTrue:[ clickSelector := #findWindow:. ] ifFalse:[ self isWorldMorph ifTrue:[ clickSelector := handHadHalos ifTrue: [ #delayedInvokeWorldMenu: ] ifFalse: [ #invokeWorldMenu: ] ] ].
evt hand waitForClicksOrDrag: self event: evt selectors: { clickSelector. nil. nil. #dragThroughOnDesktop: } threshold: HandMorph dragThreshold. ] ifFalse:[ "We wont select, just bring world menu if I'm the world" self isWorldMorph ifTrue:[ handHadHalos ifTrue: [ self delayedInvokeWorldMenu: evt ] ifFalse: [ self invokeWorldMenu: evt ] ] ]. ! !
!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/7/2023 18:18'! windowEvent: anEvent
self windowEventHandler ifNotNil: [^self windowEventHandler windowEvent: anEvent]. anEvent type caseOf: { [#windowClose] -> [TheWorldMenu basicNew quitSession]. [#windowDeactivated] -> [ "The host window has been deactivated. Until it regains the focus, honor the fact that we will not receive keyboard events again by changing the current keyboard focus morph. windowHostFocusMorph represents the host system which now holds the keyboard focus instead of the previousFocus." (self valueOfProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | "There is currently no exact-once guarantee for this event type from the VM. Mark any older host focus morph as inactive, it will be held as the previousFocus of the next host focus morph." hostFocus active: false]. self setProperty: #windowHostFocusMorph toValue: (WindowHostFocusMorph new in: [:hostFocus | hostFocus previousFocus: anEvent hand keyboardFocus. anEvent hand newKeyboardFocus: hostFocus.]; yourself)]. [#windowActivated] -> [ "Alright, the spook is over!! We have back control over the keyboard focus, delete the windowHostFocusMorph and restore the previous focus holder." (self removeProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | hostFocus active: false. (anEvent hand keyboardFocus == hostFocus and: [hostFocus previousFocus notNil]) ifTrue: [anEvent hand newKeyboardFocus: hostFocus previousFocus]]]. } otherwise: []! !
!PasteUpMorph methodsFor: 'events-processing' stamp: 'mt 3/10/2023 16:09'! tryInvokeHalo: aUserInputEvent
Morph haloForAll ifFalse: [ ^ self ].
(self transferHalo: aUserInputEvent) ifTrue: "The event was handled, don't let it cause any further side-effects." [ aUserInputEvent ignore ].! !
!PasteUpMorph methodsFor: 'events-processing' stamp: 'mt 3/10/2023 11:27'! tryInvokeMetaMenu: anEvent
| innerMost target | Morph metaMenuForAll ifFalse: [^ self]. innerMost := (self morphsAt: anEvent position unlocked: true) first. "Traverse the owner chain if some morph does not want to show its meta menu." target := innerMost. [target isNil or: [target wantsMetaMenu]] whileFalse: [target := target owner]. target ifNil: [^ self]. target invokeMetaMenu: anEvent. anEvent ignore.! !
!PasteUpMorph methodsFor: 'halos and balloon help' stamp: 'mt 3/7/2023 17:39'! wantsHaloFromClick (owner isSystemWindow) ifTrue: [^ false]. ^ true. ! !
!PasteUpMorph methodsFor: 'initialization' stamp: 'mt 3/10/2023 15:29'! initialize "initialize the state of the receiver" super initialize. "" padding := 3. self enableDragNDrop. self clipSubmorphs: true. self initializeKeyboardShortcuts. self initializeMouseShortcuts.! !
!PasteUpMorph methodsFor: 'menu & halo' stamp: 'mt 8/11/2023 16:18'! addCustomMenuItems: menu hand: aHandMorph "Add morph-specific menu itemns to the menu for the hand" super addCustomMenuItems: menu hand: aHandMorph.
self isWorldMorph ifTrue: [ | twm | menu addLine. menu addUpdating: #showWorldMainDockingBarString action: #toggleShowWorldMainDockingBar. menu addLine. Flaps sharedFlapsAllowed ifTrue: [ menu addUpdating: #suppressFlapsString target: Project current action: #toggleFlapsSuppressed. ].
twm := TheWorldMenu new. twm world: self project: Project current hand: aHandMorph.
menu add: 'old desktop menu... (W)' translated subMenu: twm buildWorldMenu. ]. ! !
!PasteUpMorph methodsFor: 'menu & halo' stamp: 'mt 8/16/2023 16:02'! addWorldHaloMenuItemsTo: aMenu hand: aHandMorph "Add standard halo items to the menu, given that the receiver is a World"
| unlockables | self addFillStyleMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph.
aMenu addLine. self addWorldToggleItemsToHaloMenu: aMenu. aMenu addLine. self addCopyItemsTo: aMenu. self addExportMenuItems: aMenu hand: aHandMorph. self addMiscExtrasTo: aMenu.
self addDebuggingItemsTo: aMenu hand: aHandMorph.
aMenu addLine. aMenu defaultTarget: self.
aMenu addLine.
unlockables := self submorphs select: [:m | m isLocked]. unlockables size = 1 ifTrue: [aMenu add: ('unlock "{1}"' translated format:{unlockables first externalName})action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' translated action: #unlockContents].
aMenu defaultTarget: aHandMorph. ! !
!PasteUpMorph methodsFor: 'options' stamp: 'mt 8/4/2023 14:08'! autoLineLayout: aBoolean "Make the receiver be viewed with auto-line-layout, which means that its submorphs will be laid out left-to-right and then top-to-bottom in the manner of a word processor, or (if aBoolean is false,) cease applying auto-line-layout"
aBoolean ifTrue:[ self layoutPolicy: TableLayout new. self layoutInset: 8; cellGap: 4. self listDirection: #leftToRight; wrapDirection: #topToBottom. ] ifFalse:[ self layoutPolicy: nil. self layoutInset: 0; cellGap: 0. ]. ! !
!PasteUpMorph methodsFor: 'undo' stamp: 'fbs 12/31/2013 12:08'! onceAgainDismiss: aMorph "Occasioned by a redo of a dismiss-via-halo"
aMorph dismissMorph. TrashCanMorph preserveTrash ifTrue: [TrashCanMorph slideDismissalsToTrash ifTrue:[aMorph slideToTrash: nil] ifFalse:[TrashCanMorph moveToTrash: aMorph]]! !
!PasteUpMorph methodsFor: 'undo' stamp: 'mt 8/4/2023 14:45'! reintroduceIntoWorld: aMorph "The given morph is being raised from the dead. Bring it back to life."
(aMorph valueOfProperty: #lastPosition) ifNotNil: [:pos | aMorph position: pos]. aMorph openInWorld
! !
!PasteUpMorph methodsFor: 'WiW support' stamp: 'raa 11/14/2017 07:47'! installAsActiveSubprojectIn: enclosingWorld at: newBounds titled: aString | window howToOpen tm boundsForWorld | howToOpen := self embeddedProjectDisplayMode. "#scaled may be the only one that works at the moment" submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." boundsForWorld := howToOpen == #naked ifTrue: [newBounds] ifFalse: [bounds]. worldState canvas: nil. worldState viewBox: boundsForWorld. self bounds: boundsForWorld.
"self viewBox: Display boundingBox." "worldState handsDo: [:h | h initForEvents]." self installFlaps.
"SystemWindow noteTopWindowIn: self." "self displayWorldSafely." howToOpen == #naked ifTrue: [enclosingWorld addMorphFront: self]. howToOpen == #window ifTrue: [window := (SystemWindow labelled: aString) model: self. window addMorph: self frame: (0 @ 0 extent: 1.0 @ 1.0). window openInWorld: enclosingWorld]. howToOpen == #frame ifTrue: [window := (AlignmentMorphBob1 new) minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color green; bounds: newBounds. window addMorph: self. window openInWorld: enclosingWorld]. howToOpen == #scaled ifTrue: [self position: 0 @ 0. window := (EmbeddedWorldBorderMorph new) minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color green; bounds: newBounds. tm := BOBTransformationMorph new. window addMorph: tm. tm addMorph: self. window openInWorld: enclosingWorld. tm changeWorldBoundsToShow: bounds. self arrangeToStartSteppingIn: enclosingWorld "tm scale: (tm width / self width min: tm height / self height) asFloat."]! !
!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 8/14/2023 17:32'! findWindow: evt "Present a menu names of windows and naked morphs, and activate the one that gets chosen. Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo." | menu expanded collapsed nakedMorphs | menu := MenuMorph new. expanded := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed not]. collapsed := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed]. nakedMorphs := self submorphsSatisfying: [:m | m isSystemWindow not and: [(m isFlapTab) not]]. (expanded isEmpty & (collapsed isEmpty & nakedMorphs isEmpty)) ifTrue: [^ Beeper beep]. (expanded sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: (w label contractTo: 80) target: w action: #beKeyWindow. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. (expanded isEmpty | (collapsed isEmpty & nakedMorphs isEmpty)) ifFalse: [menu addLine]. (collapsed sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: (w label contractTo: 80) target: w action: #collapseOrExpand. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. nakedMorphs isEmpty ifFalse: [menu addLine]. (nakedMorphs sort: [:w1 :w2 | w1 nameForFindWindowFeature caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) do: [:w | menu add: (w nameForFindWindowFeature contractTo: 80) target: w action: #comeToFrontAndAddHalo]. menu addTitle: 'find window' translated. menu popUpEvent: evt in: self.! !
!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 11:27'! invokeWorldMenu: evt "Put up the world menu, triggered by the passed-in event."
self putUpWorldMenu: evt.! !
!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 11:27'! keystrokeInWorld: evt "A keystroke was hit when no keyboard focus was set, so it is sent here to the world instead."
| aChar isCmd ascii | aChar := evt keyCharacter. (ascii := aChar asciiValue) = Character escape asciiValue ifTrue: [evt commandKeyPressed ifFalse: [^ self putUpWorldMenuFromEscapeKey]]. (evt controlKeyPressed not and: [(#(1 4 8 28 29 30 31 32) includes: ascii) "home, end, backspace, arrow keys, space" and: [self keyboardNavigationHandler notNil]]) ifTrue: [self keyboardNavigationHandler navigateFromKeystroke: aChar].
isCmd := evt commandKeyPressed and: [Preferences cmdKeysInText]. (isCmd and: [Preferences honorDesktopCmdKeys]) ifTrue: [^ self dispatchCommandKeyInWorld: aChar event: evt].
"It was unhandled. Remember the keystroke." self lastKeystroke: evt keyString. self triggerEvent: #keyStroke! !
!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/8/2023 10:36'! putUpNewMorphMenu "Put up the New Morph menu in the world"
TheWorldMenu new world: self project: Project current hand: self currentHand; newMorph! !
!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 16:08'! putUpWorldMenuFromEscapeKey self putUpWorldMenu: self currentEvent.! !
!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/10/2023 13:57'! allNonWindows "Answer all non-window submorphs"
^submorphs select: [:m | (m isSystemWindow) not and: [m wantsToBeTopmost not]]! !
!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/10/2023 15:29'! beWorldForProject: aProject
self privateOwner: nil. worldState := WorldState new. self addHand: HandMorph new. self setProperty: #optimumExtentFromAuthor toValue: Display extent. self startSteppingSubmorphsOf: self! !
!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/15/2023 13:18'! initForProject: aWorldState
worldState := aWorldState. self viewBox: Display boundingBox. self color: Preferences defaultWorldColor. self addHand: HandMorph new. self setProperty: #optimumExtentFromAuthor toValue: Display extent. self borderWidth: 0. model := nil. ! !
!PasteUpMorph methodsFor: 'world state' stamp: 'mt 8/11/2023 16:20'! install
owner := nil. "since we may have been inside another world previously" submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." self viewBox: Display boundingBox. EventSensor default flushEvents. worldState handsDo: [:h | h initForEvents]. self installFlaps. self borderWidth: 0. "default" (Preferences showSecurityStatus and: [SecurityManager default isInRestrictedMode]) ifTrue: [self borderWidth: 2; borderColor: Color red]. SystemWindow noteTopWindowIn: self.! !
!PasteUpMorph methodsFor: 'world state' stamp: 'mt 8/10/2023 15:27'! paintBox "Return the painting controls widget (PaintBoxMorph) to be used for painting in this world. If there is not already a PaintBox morph, or if it has been deleted from this world, create a new one."
| newPaintBox refPoint | self allMorphsDo: [:m | (m isKindOf: PaintBoxMorph) ifTrue: [^ m]]. refPoint := self topRight. newPaintBox := PaintBoxMorph new. newPaintBox position: (refPoint - (newPaintBox width @ 0)). self addMorph: newPaintBox. ^ newPaintBox ! !
!PasteUpMorph methodsFor: 'world state' stamp: 'sw 9/2/1999 12:01'! paintBoxOrNil "Return the painting controls widget (PaintBoxMorph) to be used for painting in this world. If there is not already a PaintBox morph return nil"
self allMorphsDo: [:m | (m isKindOf: PaintBoxMorph) ifTrue: [^ m]]. ^ nil ! !
!PasteUpMorph methodsFor: '*Tools' stamp: 'mt 3/10/2023 16:08'! defaultDesktopCommandKeyTriplets "Answer a list of triplets of the form <key> <receiver> <selector> [+ optional fourth element, a <description> for use in desktop-command-key-help] that will provide the default desktop command key handlers. If the selector takes an argument, that argument will be the command-key event" "World initializeDesktopCommandKeySelectors"
| noviceKeys expertKeys |
noviceKeys := { {$r. self. #restoreMorphicDisplay. 'Redraw the screen' translated}. {$M. self. #toggleShowWorldMainDockingBar. 'Show/Hide the Main Docking Bar' translated}. {$]. Smalltalk. #saveSession. 'Save the image.' translated}. }. expertKeys := { {$b. SystemBrowser. #defaultOpenBrowser. 'Open a new System Browser' translated}. {$k. Workspace. #open. 'Open a new Workspace' translated}. {$m. self. #putUpNewMorphMenu. 'Put up the "New Morph" menu' translated}. {$O. self. #findAMonticelloBrowser. 'Bring a Monticello window into focus.' translated}. {$t. self. #findATranscript:. 'Make a System Transcript visible' translated}. {$w. SystemWindow. #closeTopWindow. 'Close the topmost window' translated}. {Character escape. SystemWindow. #closeTopWindow. 'Close the topmost window' translated}. {$C. self. #findAChangeSorter:. 'Make a Change Sorter visible' translated}. {$L. self. #findAFileList:. 'Make a File List visible' translated}. {$P. self. #findAPreferencesPanel:. 'Activate the Preferences tool' translated}. {$R. Utilities. #browseRecentSubmissions. 'Make a Recent Submissions browser visible' translated}. {$W. self. #findAMessageNamesWindow:. 'Make a MessageNames tool visible' translated}. {$Z. ChangeList. #browseRecentLog. 'Browse recently-logged changes' translated}. {$. SystemWindow. #sendTopWindowToBack. 'Send the top window to the back' translated}. {$_. Smalltalk. #quitPrimitive. 'Quit the image immediately.' translated}. {$-. Preferences. #decreaseFontSize. 'Decrease all font sizes' translated}. {$+. Preferences. #increaseFontSize. 'Increase all font sizes' translated}. }. ^ noviceKeys, expertKeys! !
!PasteUpMorph methodsFor: 'flaps' stamp: 'mt 8/4/2023 14:02'! addGlobalFlaps "Must make global flaps adapt to world. Do this even if not shown, so the old world will not be pointed at by the flaps."
| use thisWorld | use := Flaps sharedFlapsAllowed. Project current flapsSuppressed ifTrue: [use := false]. "Smalltalk isMorphic ifFalse: [use := false]." thisWorld := use ifTrue: [self] ifFalse: [PasteUpMorph new initForProject: "fake to be flap owner" WorldState new; bounds: (0@0 extent: 4000@4000); viewBox: (0@0 extent: 4000@4000)]. Flaps globalFlapTabsIfAny do: [:aFlapTab | (Project current isFlapEnabled: aFlapTab) ifTrue: [(aFlapTab world == thisWorld) ifFalse: [thisWorld addMorphFront: aFlapTab]. "always do" use ifTrue: [aFlapTab spanWorld. aFlapTab adjustPositionAfterHidingFlap. aFlapTab flapShowing ifTrue: [aFlapTab showFlap]]]]! !
!PasteUpMorph methodsFor: 'flaps' stamp: 'nice 12/27/2009 20:14'! localFlapTabs "Answer a list of local flap tabs in the current project"
| globalList aList | globalList := Flaps globalFlapTabsIfAny. aList := OrderedCollection new. submorphs do: [:m | | aFlapTab | ((m isFlapTab) and: [(globalList includes: m) not]) ifTrue: [aList add: m] ifFalse: [((m isFlap) and: [(aFlapTab := m submorphs detect: [:n | n isFlapTab] ifNone: [nil]) notNil]) ifTrue: [aList add: aFlapTab]]]. ^ aList! !
!PasteUpMorph methodsFor: '*services-base' stamp: 'mt 8/4/2023 14:03'! openWorldMenu | menu | menu := (TheWorldMenu new world: self project: nil hand: self primaryHand) buildWorldMenu. menu addTitle: Preferences desktopMenuTitle translated. menu openInHand! !
!PasteUpMorph methodsFor: '*services-base' stamp: 'mt 8/28/2023 14:42'! worldMenu ^ TheWorldMenu new world: self project: nil hand: self primaryHand! !
!PasteUpMorph class methodsFor: 'scripting' stamp: 'mt 3/15/2023 13:30'! authoringPrototype "Answer an instance of the receiver suitable for placing in a parts bin for authors" | proto | proto := self new markAsPartsDonor. proto color: Color green muchLighter; extent: 100 @ 80; borderColor: (Color r: 0.645 g: 0.935 b: 0.161). proto extent: 300 @ 240. proto beSticky. ^ proto! !
!PasteUpMorph class methodsFor: '*MorphicExtras-class initialization' stamp: 'mt 7/31/2023 11:14'! initialize "Initialize the class"
self registerInFlapsRegistry.! !
!PolygonMorph methodsFor: 'stepping' stamp: 'mt 3/10/2023 15:01'! stepTime "Answer the desired time between steps in milliseconds."
^ 100! !
!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:59'! printStandardSystemFonts "self printStandardSystemFonts"
| string | string := String streamContents: [ :s |
#(standardDefaultTextFont standardListFont standardFlapFont standardMenuFont windowTitleFont standardBalloonHelpFont standardCodeFont standardButtonFont) do: [:selector | | font | font := Preferences perform: selector. s nextPutAll: selector; space; nextPutAll: font familyName; space; nextPutAll: (AbstractFont emphasisStringFor: font emphasis); nextPutAll: ' points: '; print: font pointSize; nextPutAll: ' height: '; print: font height; cr ]].
(StringHolder new) contents: string; openLabel: 'Current system font settings' translated. ! !
!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:58'! refreshFontSettings "Try to update all the current font settings to make things consistent."
UserInterfaceTheme current applyAfter: [ self setFlapsFontTo: (self standardFlapFont); setWindowTitleFontTo: (self windowTitleFont); setListFontTo: (self standardListFont); setMenuFontTo: (self standardMenuFont); setSystemFontTo: (TextStyle defaultFont); setCodeFontTo: (self standardCodeFont); setBalloonHelpFontTo: (BalloonMorph balloonFont)].
SystemWindow allSubInstancesDo: [ :s | | rawLabel | rawLabel := s getRawLabel. rawLabel owner vResizing: #spaceFill. rawLabel font: rawLabel font. s setLabel: s label. s replaceBoxes ].! !
!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:59'! restoreFontsAfter: aBlock
"Restore the currently chosen set of standard fonts after evaluating aBlock. Used for tests that modify the default fonts."
| standardDefaultTextFont standardListFont standardMenuFont windowTitleFont standardBalloonHelpFont standardCodeFont standardButtonFont |
standardDefaultTextFont := Preferences standardDefaultTextFont. standardListFont := Preferences standardListFont. standardMenuFont := Preferences standardMenuFont. windowTitleFont := Preferences windowTitleFont. standardBalloonHelpFont := Preferences standardBalloonHelpFont. standardCodeFont := Preferences standardCodeFont. standardButtonFont := Preferences standardButtonFont. ^ UserInterfaceTheme current applyAfter: [ aBlock ensure: [ Preferences setSystemFontTo: standardDefaultTextFont. Preferences setListFontTo: standardListFont. Preferences setMenuFontTo: standardMenuFont. Preferences setWindowTitleFontTo: windowTitleFont. Preferences setBalloonHelpFontTo: standardBalloonHelpFont. Preferences setCodeFontTo: standardCodeFont. Preferences setButtonFontTo: standardButtonFont]]. ! !
!Preferences class methodsFor: 'support - misc' stamp: 'mt 3/7/2023 15:42'! personalizeUserMenu: aMenu "The user has clicked on the morphic desktop with the yellow mouse button (option+click on the Mac); a menu is being constructed to present to the user in response; its default target is the current world. In this method, you are invited to add items to the menu as per personal preferences. The default implementation, for illustrative purposes, sets the menu title to 'personal', and adds items for go-to-previous-project, show/hide flaps, and load code updates" aMenu addTitle: 'personal' translated. "Remove or modify this as per personal choice"
aMenu addStayUpItem. aMenu add: 'previous project' translated action: #goBack. aMenu add: 'load latest code updates' translated target: MCMcmUpdater action: #updateFromServer. aMenu add: 'about this system...' translated target: Smalltalk action: #aboutThisSystem.! !
!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'! classicHaloSpecs "Non-iconic halos with traditional placements"
"Preferences installClassicHaloSpecs" "Preferences resetHaloSpecifications" " <- will result in the standard default halos being reinstalled" "NB: listed below in clockwise order"
^ #( " selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addMenuHandle: left top (red) none) (addDismissHandle: leftCenter top (red muchLighter) 'Halo-Dismiss') (addGrabHandle: center top (black) none) (addDragHandle: rightCenter top (brown) none) (addDupHandle: right top (green) none) (addDebugHandle: right topCenter (blue veryMuchLighter) none) (addGrowHandle: right bottom (yellow) none) (addScaleHandle: right bottom (lightOrange) none) (addFontEmphHandle: rightCenter bottom (lightBrown darker) none) (addFontStyleHandle: center bottom (lightRed) none) (addFontSizeHandle: leftCenter bottom (lightGreen) none)
(addRecolorHandle: right bottomCenter (magenta darker) none)
(addRotateHandle: left bottom (blue) none))
! !
!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/8/2023 11:41'! customHaloSpecs "Intended for you to modify to suit your personal preference. What is implemented in the default here is just a skeleton; in comment at the bottom of this method are some useful lines you may wish to paste in to the main body here, possibly modifying positions, colors, etc.. Note that in this example, we include: Dismiss handle, at top-left Menu handle, at top-right Resize handle, at bottom-right Rotate handle, at bottom-left Drag handle, at top-center Recolor handle, at left-center. (this one is NOT part of the standard formulary -- it is included here to illustrate how to add non-standard halos) Note that the optional handles for specialized morphs, such as Sketch, Text, PasteUp, are also included"
^ #( (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addMenuHandle: right top (red) 'Halo-Menu') (addDragHandle: center top (brown) 'Halo-Drag') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale')
(addRecolorHandle: left center (green muchLighter lighter) 'Halo-Recolor')
(addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRotateHandle: left bottom (blue) 'Halo-Rot')
(addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug')
)
" Other useful handles...
selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------
(addTileHandle: left bottomCenter (lightBrown) 'Halo-Tile') (addViewHandle: left center (cyan) 'Halo-View') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addFewerHandlesHandle: left topCenter (paleBuff) 'Halo-FewerHandles') (addPaintBgdHandle: right center (lightGray) 'Halo-Paint') (addRepaintHandle: right center (lightGray) 'Halo-Paint') " ! !
!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/8/2023 11:30'! haloSpecificationsForWorld | desired | "Answer a list of HaloSpecs that describe which halos are to be used on a world halo, what they should look like, and where they should be situated" "Preferences resetHaloSpecifications"
desired := #(addDebugHandle: addMenuHandle: addHelpHandle: addRecolorHandle:). ^ self haloSpecifications select: [:spec | desired includes: spec addHandleSelector]! !
!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'! iconicHaloSpecifications "Answer an array that characterizes the locations, colors, icons, and selectors of the halo handles that may be used in the iconic halo scheme"
"Preferences resetHaloSpecifications"
^ #( " selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addCollapseHandle: left topCenter (tan) 'Halo-Collapse') (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addMenuHandle: leftCenter top (red) 'Halo-Menu') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor') ) ! !
!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'! simpleFullHaloSpecifications "This method gives the specs for the 'full' handles variant when simple halos are in effect"
"Preferences resetHaloSpecifications"
^ #( " selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addMenuHandle: leftCenter top (red) 'Halo-Menu') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale') (addFewerHandlesHandle: left topCenter (paleBuff) 'Halo-FewerHandles') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor')
) ! !
!Preferences class methodsFor: 'defaults' stamp: 'mt 8/29/2023 15:25'! defaultValueTableForCurrentRelease "Answer a table defining default values for all the preferences in the release. Returns a list of (pref-symbol, boolean-symbol) pairs"
^ #( (alternativeBrowseIt false) (annotationPanes false) (areaFillsAreTolerant false) (areaFillsAreVeryTolerant false) (automaticKeyGeneration false) (balloonHelpEnabled true) (balloonHelpInMessageLists false) (caseSensitiveFinds false) (changeSetVersionNumbers true) (checkForSlips true) (checkForUnsavedProjects true) (cmdDotEnabled true) (collapseWindowsInPlace false) (confirmFirstUseOfStyle true) (conversionMethodsAtFileOut false) (debugHaloHandle true) (debugPrintSpaceLog false) (debugShowDamage false) (decorateBrowserButtons true) (diffsInChangeList true) (diffsWithPrettyPrint false) (dismissAllOnOptionClose false) (fastDragWindowForMorphic true) (fullScreenLeavesDeskMargins true) (higherPerformance false) (honorDesktopCmdKeys true) (logDebuggerStackToFile true) (menuKeyboardControl false) (modalColorPickers true) (mouseOverForKeyboardFocus false) (navigatorOnLeftEdge true) (optionalButtons true) (passwordsOnPublish false) (personalizedWorldMenu true) (postscriptStoredAsEPS false) (projectViewsInWindows true) (projectZoom true) (projectsSentToDisk false) (readDocumentAtStartup true) (restartAlsoProceeds false) (reverseWindowStagger true) (roundedMenuCorners true) (scrollBarsNarrow false) (scrollBarsOnRight true) (securityChecksEnabled false) (showBoundsInHalo false) (showDirectionForSketches false) (showDirectionHandles false) (showProjectNavigator false) (showSecurityStatus true) (signProjectFiles true) (smartUpdating true) (startInUntrustedDirectory false) (systemWindowEmbedOK false) (timeStampsInMenuTitles true) (turnOffPowerManager false) (twentyFourHourFileStamps true) (uniqueNamesInHalos false) (useButtonPropertiesToFire false) (warnAboutInsecureContent true) (warnIfNoChangesFile true) (warnIfNoSourcesFile true))
" Preferences defaultValueTableForCurrentRelease do: [:pair | (Preferences preferenceAt: pair first ifAbsent: [nil]) ifNotNilDo: [:pref | pref defaultValue: (pair last == true)]]. Preferences chooseInitialSettings. "! !
!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/10/2023 16:09'! disableProgrammerFacilities "Warning: do not call this lightly!! It disables all access to menus, debuggers, halos. There is no guaranteed return from this, which is to say, you cannot necessarily reenable these things once they are disabled -- you can only use whatever the UI of the current project affords, and you cannot even snapshot -- you can only quit.
You can completely reverse the work of this method by calling the dual Preferences method enableProgrammerFacilities, provided you have left yourself leeway to bring about a call to that method.
To set up a system that will come up in such a state, you have to request the snapshot in the same breath as you disable the programmer facilities. To do this, put the following line into the 'do' menu and then evaluate it from that 'do' menu:
Preferences disableProgrammerFacilities.
You will be prompted for a new image name under which to save the resulting image."
Beeper beep. (self confirm: 'CAUTION!!!! This is a drastic step!! Do you really want to do this?') ifFalse: [Beeper beep. ^self inform: 'whew!!']. self disable: #cmdDotEnabled. "No user-interrupt-into-debugger" self compileAccessorForPreferenceNamed: #cmdGesturesEnabled value: false. "No halos, etc." self compileAccessorForPreferenceNamed: #cmdKeysInText value: false. "No user commands invokable via cmd-key combos in text editor" self disable: #warnIfNoSourcesFile. self disable: #warnIfNoChangesFile. Smalltalk saveAs! !
!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/10/2023 16:09'! enableProgrammerFacilities "Meant as a one-touch recovery from a #disableProgrammerFacilities call." "Preferences enableProgrammerFacilities"
self enable: #cmdDotEnabled. self compileAccessorForPreferenceNamed: #cmdGesturesEnabled value: true. self compileAccessorForPreferenceNamed: #cmdKeysInText value: true. self enable: #warnIfNoSourcesFile. self enable: #warnIfNoChangesFile.! !
!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/15/2023 13:50'! setNotificationParametersForStandardPreferences "Set up the notification parameters for the standard preferences that require need them. When adding new Preferences that require use of the notification mechanism, users declare the notifcation info as part of the call that adds the preference, or afterwards -- the two relevant methods for doing that are: Preferences.addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: and Preference changeInformee:changeSelector:"
"Preferences setNotificationParametersForStandardPreferences"
#( (annotationPanes annotationPanesChanged) (optionalButtons optionalButtonsChanged) (smartUpdating smartUpdatingChanged) ) do:
[:pair | | aPreference | aPreference := self preferenceAt: pair first. aPreference changeInformee: self changeSelector: pair second]! !
!Preferences class methodsFor: 'initialization - save/load' stamp: 'mt 3/7/2023 13:27'! loadPreferencesFrom: aFile
| stream params dict desktopColor patternsToIgnore | patternsToIgnore := #('*updateMapName' '*defaultUpdateURL'). stream := ReferenceStream fileNamed: aFile. params := stream next. self assert: (params isKindOf: IdentityDictionary). params removeKey: #PersonalDictionaryOfPreferences. dict := stream next. self assert: (dict isKindOf: IdentityDictionary). desktopColor := stream next. stream close. dict rehash. "See http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217817.html" dict keys reject: [:key | patternsToIgnore anySatisfy: [:pattern | pattern match: key]] thenDo: [:key | | value | value := dict at: key. (self preferenceAt: key ifAbsent: [nil]) ifNotNil: [:pref | [pref preferenceValue: value preferenceValue] on: Deprecation do: [ : err | "Ignore preferences which may not be supported anymore."]]]. params keysAndValuesDo: [ :key :value | self setParameter: key to: value ]. Project current world fillStyle: desktopColor.! !
!ProgressMorph methodsFor: 'private' stamp: 'mt 8/11/2023 14:00'! fontOfPointSize: size ^ (TextConstants at: Preferences standardDefaultTextFont familyName ifAbsent: [TextStyle default]) fontOfPointSize: size! !
!Project methodsFor: 'displaying' stamp: 'mt 8/28/2023 14:08'! displayZoom: entering "Show the project transition when entering a new project" | newDisplay vanishingPoint | "Show animated zoom to new display" newDisplay := self imageForm. entering ifTrue: [vanishingPoint := Sensor cursorPoint] ifFalse: [vanishingPoint := self viewLocFor: CurrentProject]. Display zoomIn: entering orOutTo: newDisplay at: 0@0 vanishingPoint: vanishingPoint.! !
!Project methodsFor: 'file in/out' stamp: 'mt 8/16/2023 15:46'! exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: noInteraction
| exportChangeSet |
"An experimental version to fileout a changeSet first so that a project can contain its own classes"
"Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target image. Name it <project name>.extSeg. Player classes are included automatically." exportChangeSet := nil. (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [ (noInteraction or: [self confirm: 'Would you like to include all the changes in the change set as part of this publishing operation?' translated]) ifTrue: [ exportChangeSet := changeSet ]. ].
^ self exportSegmentWithChangeSet: exportChangeSet fileName: aFileName directory: aDirectory withoutInteraction: noInteraction! !
!Project methodsFor: 'menu messages' stamp: 'mt 8/23/2023 13:50'! validateProjectNameIfOK: aBlock
| details |
details := world valueOfProperty: #ProjectDetails. details ifNotNil: ["ensure project info matches real project name" details at: 'projectname' put: self name. ]. self doWeWantToRename ifTrue: [self notify: 'Please choose another name!!'] ifFalse: [aBlock value: details]! !
!MorphicProject methodsFor: 'initialize' stamp: 'mt 3/8/2023 09:42'! initialize "Initialize a new Morphic Project"
super initialize. world := PasteUpMorph newWorldForProject: self. self setWorldBackground: true. Locale switchToID: CurrentProject localeID. Project current isMorphic ifTrue: [ "Only trigger tool builders etc. if we are already in the same kind of project because there is global state that cannot yet be configured in a dynamic scope such as 'ToolBuilder default'." self assureMainDockingBarPresenceMatchesPreference].! !
!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/16/2023 17:02'! exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory withoutInteraction: noInteraction "Store my project out on the disk as an *exported* ImageSegment. All outPointers will be in a form that can be resolved in the target image. Name it <project name>.extSeg. Whatdo we do about subProjects, especially if they are out as local image segments? Force them to come in? Player classes are included automatically."
| is str ans revertSeg roots holder collector fd mgr stacks |
"Files out a changeSet first, so that a project can contain its own classes" world ifNil: [^ false].
ScrapBook default emptyScrapBook. world currentHand pasteBuffer: nil. "don't write the paste buffer." world currentHand mouseOverHandler initialize. "forget about any references here" "Display checkCurrentHandForObjectToPaste." Command initialize. world clearCommandHistory. world fullReleaseCachedState. world cleanseStepList. world localFlapTabs size = world flapTabs size ifFalse: [noInteraction ifTrue: [^ false]. self error: 'Still holding onto Global flaps']. world releaseSqueakPages. holder := Project allProjects. "force them in to outPointers, where DiskProxys are made"
"Just export me, not my previous version" revertSeg := self parameterAt: #revertToMe. self removeParameter: #revertToMe.
roots := OrderedCollection new. roots add: self; add: world; add: transcript; add: aChangeSetOrNil; add: thumbnail; add: world activeHand.
roots := roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail"
fd := aDirectory directoryNamed: self resourceDirectoryName. fd assureExistence. "Clean up resource references before writing out" mgr := self resourceManager. self resourceManager: nil. ResourceCollector current: ResourceCollector new. ResourceCollector current localDirectory: fd. ResourceCollector current baseUrl: self resourceUrl. ResourceCollector current initializeFrom: mgr. ProgressNotification signal: '2:findingResources' extra: '(collecting resources...)' translated. "Must activate old world because this is run at #armsLength. Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent will not be captured correctly if referenced from blocks or user code." world becomeActiveDuring: [is := ImageSegment copySmartRootsExport: roots asArray. "old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)"]. self resourceManager: mgr. collector := ResourceCollector current. ResourceCollector current: nil. ProgressNotification signal: '2:foundResources' extra: ''. is state = #tooBig ifTrue: [collector replaceAll. ^ false].
str := ''. "considered legal to save a project that has never been entered" (is outPointers includes: world) ifTrue: [str := str, '\Project''s own world is not in the segment.' translated withCRs]. str isEmpty ifFalse: [ans := Project uiManager chooseOptionFrom: {'Do not write file' translated. 'Write file anyway' translated. 'Debug' translated} title: str. ans = 1 ifTrue: [revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. ^ false]. ans = 3 ifTrue: [collector replaceAll. self halt: 'Segment not written' translated]]. stacks := is findStacks.
is writeForExportWithSources: aFileName inDirectory: fd changeSet: aChangeSetOrNil. SecurityManager default signFile: aFileName directory: fd. "Compress all files and update check sums" collector forgetObsolete. self storeResourceList: collector in: fd. self storeHtmlPageIn: fd. self storeManifestFileIn: fd. self writeStackText: stacks in: fd registerIn: collector. "local proj.005.myStack.t" self compressFilesIn: fd to: aFileName in: aDirectory resources: collector. "also deletes the resource directory" "Now update everything that we know about" mgr updateResourcesFrom: collector.
revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. world flapTabs do: [:ft | (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. ^ true ! !
!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/11/2023 16:06'! storeSegment "Store my project out on the disk as an ImageSegment. Keep the outPointers in memory. Name it <project name>.seg. *** Caller must be holding (Project alInstances) to keep subprojects from going out. ***"
| currentWorld is sizeHint | currentWorld := Project current world. (currentWorld == world) ifTrue: [^ false]. "self inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ false]. "already done" world ifNil: [^ false].
ScrapBook default emptyScrapBook. currentWorld checkCurrentHandForObjectToPaste. world releaseSqueakPages. sizeHint := self projectParameters at: #segmentSize ifAbsent: [0].
is := ImageSegment copyFromRootsLocalFileFor: {world} sizeHint: sizeHint.
is state = #tooBig ifTrue: [^ false]. is segment size < 2000 ifTrue: ["debugging" Transcript show: self name, ' only ', is segment size printString, 'bytes in Segment.'; cr]. self projectParameters at: #segmentSize put: is segment size. is extract; writeToFile: self name. ^ true! !
!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/11/2023 16:08'! storeSegmentNoFile "For testing. Make an ImageSegment. Keep the outPointers in memory. Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)"
| is currentWorld | currentWorld := Project current world. (currentWorld == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ self]. "already done" world ifNil: [^ self].
"Do this on project enter" ScrapBook default emptyScrapBook. currentWorld checkCurrentHandForObjectToPaste2.
is := ImageSegment copyFromRootsLocalFileFor: {world} sizeHint: 0.
is segment size < 800 ifTrue: ["debugging" Transcript show: self name, ' did not get enough objects'; cr. ^ Beeper beep].
is extract. "is instVarAt: 2 put: is segment clone." "different memory"! !
!MorphicProject methodsFor: 'enter' stamp: 'mt 3/10/2023 15:01'! enterAsActiveSubprojectWithin: enclosingWorld
"Install my ChangeSet, Transcript, and scheduled views as current globals.
If returningFlag is true, we will return to the project from whence the current project was entered; don't change its previousProject link in this case. If saveForRevert is true, save the ImageSegment of the project being left. If revertFlag is true, make stubs for the world of the project being left. If revertWithoutAsking is true in the project being left, then always revert."
"Experimental mods for initial multi-project work: 1. assume in morphic (this eliminated need for <showZoom>) 2. assume <saveForRevert> is false (usual case) - removed <old> 3. assume <revertFlag> is false 4. assume <revertWithoutAsking> is false - <forceRevert> now auto false <seg> n.u. 5. no zooming 6. assume <projectsSentToDisk> false - could be dangerous here 7. assume no isolation problems (isolationHead ==) 8. no closing scripts "
self isCurrentProject ifTrue: [^ self].
"guards ifNotNil: [ guards := guards reject: [:obj | obj isNil]. guards do: [:obj | obj okayToEnterProject ifFalse: [^ self]] ]."
"CurrentProject makeThumbnail." "--> Display bestGuessOfCurrentWorld triggerClosingScripts." CurrentProject displayDepth: Display depth.
displayDepth == nil ifTrue: [displayDepth := Display depth]. "Display newDepthNoRestore: displayDepth."
"(world hasProperty: #letTheMusicPlay) ifTrue: [world removeProperty: #letTheMusicPlay] ifFalse: [Smalltalk at: #ScorePlayer ifPresent: [:playerClass | playerClass allSubInstancesDo: [:player | player pause]]]."
"returningFlag ifTrue: [nextProject := CurrentProject] ifFalse: [previousProject := CurrentProject]."
"CurrentProject saveState." "CurrentProject := self." "Smalltalk newChanges: changeSet." "TranscriptStream newTranscript: transcript." "Sensor flushKeyboard." "recorderOrNil := Display pauseMorphicEventRecorder."
"Display changeMorphicWorldTo: world." "Signifies Morphic" world installAsActiveSubprojectIn: enclosingWorld titled: self name.
"recorderOrNil ifNotNil: [recorderOrNil resumeIn: world]." self removeParameter: #exportState. "self spawnNewProcessAndTerminateOld: true"! !
!MorphicProject methodsFor: 'enter' stamp: 'mt 8/28/2023 14:28'! finalEnterActions: leavingProject "Perform the final actions necessary as the receiver project is entered"
| navigator armsLengthCmd navType thingsToUnhibernate | "If this image has a global World variable, update it now" Smalltalk globals at: #World ifPresent: [ :w | Smalltalk globals at: #World put: world ]. world install. world transferRemoteServerFrom: leavingProject world. "(revertFlag | saveForRevert | forceRevert) ifFalse: [ (Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [ self storeSomeSegment]]." "Transfer event recorder to me." leavingProject isMorphic ifTrue: [ leavingProject world pauseEventRecorder ifNotNil: [:rec | rec resumeIn: world]].
self initializeMenus. self projectParameters at: #projectsToBeDeleted ifPresent: [ :projectsToBeDeleted | self removeParameter: #projectsToBeDeleted. projectsToBeDeleted do: [:each | each delete]].
Locale switchToID: self localeID.
thingsToUnhibernate := world valueOfProperty: #thingsToUnhibernate ifAbsent: [#()]. thingsToUnhibernate do: [:each | each unhibernate]. world removeProperty: #thingsToUnhibernate.
navType := ProjectNavigationMorph preferredNavigator. armsLengthCmd := self parameterAt: #armsLengthCmd ifAbsent: [nil]. navigator := world findA: navType. (Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator and: [navigator isNil]]) ifTrue: [(navigator := navType new) bottomLeft: world bottomLeft; openInWorld: world]. navigator notNil & armsLengthCmd notNil ifTrue: [navigator color: Color lightBlue]. armsLengthCmd notNil ifTrue: [self flapsSuppressed: true. navigator ifNotNil: [navigator visible: false]. armsLengthCmd openInWorld: world]. world reformulateUpdatingMenus. self assureMainDockingBarPresenceMatchesPreference.
world repairEmbeddedWorlds.! !
!MorphicProject methodsFor: 'enter' stamp: 'mt 8/11/2023 16:05'! finalExitActions: enteringProject
"Pause sound players, subject to preference settings" (world hasProperty: #letTheMusicPlay) ifTrue: [world removeProperty: #letTheMusicPlay] ifFalse: [SoundService stop].
world sleep. (world findA: ProjectNavigationMorph) ifNotNil: [:navigator | navigator retractIfAppropriate].
self clearGlobalState. EventSensor default flushEvents. self world submorphsDo: [:ea | ea removeProperty: #dropShadow].! !
!MorphicProject methodsFor: 'release' stamp: 'mt 3/10/2023 15:10'! prepareForDelete "The window in which the project is housed is about to deleted. Perform any necessary actions to prepare for deletion."
Smalltalk at: #WonderlandCameraMorph ifPresent:[:aClass | world submorphs do: "special release for wonderlands" [:m | (m isKindOf: aClass) and: [m getWonderland release]]]. ! !
!MorphicProject methodsFor: 'language' stamp: 'mt 3/10/2023 16:07'! chooseNaturalLanguage "Put up a menu allowing the user to choose the natural language for the project"
| aMenu availableLanguages | aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'choose language' translated. aMenu lastItem setBalloonText: 'This controls the human language in which tiles should be viewed. It is potentially extensible to be a true localization mechanism, but initially it only works in the classic tile scripting system. Each project has its own private language choice' translated. aMenu addStayUpItem.
availableLanguages := NaturalLanguageTranslator availableLanguageLocaleIDs sorted:[:x :y | x displayName < y displayName].
availableLanguages do: [:localeID | aMenu addUpdating: #stringForLanguageNameIs: target: Locale selector: #switchToID: argumentList: {localeID}]. aMenu popUpInWorld
"Project current chooseNaturalLanguage"! !
!MorphicProject methodsFor: 'language' stamp: 'mt 8/4/2023 15:20'! updateLocaleDependents "Set the project's natural language as indicated"
Flaps disableGlobalFlaps: false. Flaps enableGlobalFlaps.
(self isFlapIDEnabled: 'Navigator' translated) ifFalse: [Flaps enableDisableGlobalFlapWithID: 'Navigator' translated]. ScrapBook default emptyScrapBook. MenuIcons initializeTranslations. super updateLocaleDependents. "self setFlaps. self setPaletteFor: aLanguageSymbol."! !
!MorphicProject methodsFor: 'scheduling & debugging' stamp: 'mt 3/10/2023 11:26'! interruptCleanUpFor: interruptedProcess "Clean up things in case of a process interrupt."
super interruptCleanUpFor: interruptedProcess.
self uiProcess == interruptedProcess ifTrue: [ self currentHand ifNotNil: [:hand | hand interrupted]. world removeProperty: #shouldDisplayWorld].! !
!Project class methodsFor: 'utilities' stamp: 'mt 3/15/2023 14:01'! removeAll: projects "Project removeAll: (Project allSubInstances copyWithout: Project current)"
AllProjects := nil. Smalltalk garbageCollect.
ProjectHistory currentHistory initialize. projects do: [:project | Project deletingProject: project].
Smalltalk garbageCollect. Smalltalk garbageCollect. ! !
!ProjectLauncher methodsFor: 'initialization' stamp: 'mt 8/4/2023 13:21'! setupFlaps "Only called when the image has been launched in a browser. If I am requested to show all flaps, then if flaps already exist, use them as is, else set up to show the default set of standard flaps."
whichFlaps = 'all' ifTrue: [Flaps sharedFlapsAllowed ifFalse: [Flaps enableGlobalFlaps]]! !
!ProjectLauncher methodsFor: 'running' stamp: 'mt 8/4/2023 13:23'! startUp | scriptName loader isUrl | self setupFlaps. Smalltalk firstArgMightBeDocument ifTrue: [scriptName := Smalltalk documentPath. scriptName := scriptName convertFromSystemString. scriptName isEmpty ifFalse: ["figure out if script name is a URL by itself" isUrl := (scriptName asLowercase beginsWith: 'http://') or: [(scriptName asLowercase beginsWith: 'file://') or: [scriptName asLowercase beginsWith: 'ftp://']]. isUrl ifFalse: [| encodedPath pathTokens | "Allow for ../dir/scriptName arguments" pathTokens := scriptName splitBy: FileDirectory slash. pathTokens := pathTokens collect: [:s | s encodeForHTTP]. encodedPath := pathTokens reduce: [:acc :each | acc , FileDirectory slash , each]. scriptName := (FileDirectory default uri resolveRelativeURI: encodedPath) asString]]] ifFalse: [scriptName := '']. scriptName isEmptyOrNil ifTrue: [^ self]. loader := CodeLoader new. loader loadSourceFiles: (Array with: scriptName). (scriptName asLowercase endsWith: '.pr') ifTrue: [self installProjectFrom: loader] ifFalse: [loader installSourceFiles]! !
!ProjectLoading class methodsFor: 'accessing' stamp: 'mt 8/28/2023 13:46'! projectStreamFromArchive: archive | ext prFiles entry unzipped | ext := FileDirectory dot, Project projectExtension. prFiles := archive members select:[:any| any fileName endsWith: ext]. prFiles isEmpty ifTrue: ['']. entry := prFiles first. unzipped := MultiByteBinaryOrTextStream on: (ByteArray new: entry uncompressedSize). entry extractTo: unzipped. ^unzipped reset! !
!ProjectLoading class methodsFor: 'loading' stamp: 'mt 8/28/2023 13:51'! openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView clearOriginFlag: clearOriginFlag "Reconstitute a Morph from the selected file, presumed to represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world."
| morphOrList archive mgr substituteFont numberOfFontSubstitutes resultArray anObject project manifests dict | ProgressNotification signal: '0.2'. archive := preStream isZipArchive ifTrue:[ZipArchive new readFrom: preStream] ifFalse:[nil]. archive ifNotNil:[ manifests := (archive membersMatching: '*manifest'). (manifests size = 1 and: [((dict := self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression']) ifTrue: [^ self notify: 'S-Expression format projects not supported. Use Squeak 6.0 or older.']].
morphOrList := self morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive. morphOrList ifNil: [^ self]. ProgressNotification signal: '0.4'. resultArray := self fileInName: aFileName archive: archive morphOrList: morphOrList. anObject := resultArray first. numberOfFontSubstitutes := resultArray second. substituteFont := resultArray third. mgr := resultArray fourth. preStream close. ProgressNotification signal: '0.7'. "the hard part is over" (anObject isKindOf: ImageSegment) ifTrue: [ project := self loadImageSegment: anObject fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr. project noteManifestDetailsIn: dict. clearOriginFlag ifTrue: [project forgetExistingURL]. ProgressNotification signal: '0.8'. ^ project ifNil: [self inform: 'No project found in this file' translated] ifNotNil: [ProjectEntryNotification signal: project]]. Project current openViewAndEnter: anObject! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'tak 9/3/2006 11:00'! checkSecurity: aFileName preStream: preStream projStream: projStream "Answer true if passed" | trusted enterRestricted | trusted := SecurityManager default positionToSecureContentsOf: projStream. trusted ifFalse: [enterRestricted := (preStream isTypeHTTP or: [aFileName isNil]) ifTrue: [Preferences securityChecksEnabled] ifFalse: [Preferences standaloneSecurityChecksEnabled]. enterRestricted ifTrue: [SecurityManager default enterRestrictedMode ifFalse: [preStream close. ^ false]]]. ^ true ! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'mt 8/28/2023 13:49'! fileInName: aFileName archive: archive morphOrList: morphOrList | baseChangeSet substituteFont numberOfFontSubstitutes exceptions anObject mgr | ResourceCollector current: ResourceCollector new. baseChangeSet := ChangeSet current. self useTempChangeSet. "named zzTemp" "The actual reading happens here" substituteFont := Preferences standardDefaultTextFont copy. numberOfFontSubstitutes := 0. exceptions := Set new. [[anObject := morphOrList fileInObjectAndCodeForProject] on: MissingFont do: [ :ex | exceptions add: ex. numberOfFontSubstitutes := numberOfFontSubstitutes + 1. ex resume: substituteFont ]] ensure: [ ChangeSet newChanges: baseChangeSet]. mgr := ResourceManager new initializeFrom: ResourceCollector current. mgr fixJISX0208Resource. mgr registerUnloadedResources. archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName]. ResourceCollector current: nil. ^ {anObject. numberOfFontSubstitutes. substituteFont. mgr}! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'mt 8/28/2023 14:00'! loadImageSegment: morphOrList fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr
| proj projectsToBeDeleted f | (f := (Flaps globalFlapTabWithID: 'Navigator' translated)) ifNotNil: [f hideFlap]. proj := morphOrList arrayOfRoots detect: [:mm | mm isKindOf: Project] ifNone: [^ nil]. proj projectParameterAt: #substitutedFont put: substituteFont. proj projectParameters at: #MultiSymbolInWrongPlace put: false. "Yoshiki did not put MultiSymbols into outPointers in older images!!" morphOrList arrayOfRoots do: [:obj | obj fixUponLoad: proj seg: morphOrList "imageSegment"]. (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [ morphOrList arrayOfRoots do: [:obj | (obj isKindOf: HashedCollection ) ifTrue: [obj rehash]]].
proj resourceManager: mgr. "proj versionFrom: preStream." proj lastDirectory: aDirectoryOrNil. proj setParent: Project current. projectsToBeDeleted := OrderedCollection new. existingView == #none ifFalse: [ self makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted]. ChangeSet allChangeSets add: proj changeSet. Project current projectParameters at: #deleteWhenEnteringNewProject ifPresent: [ :ignored | projectsToBeDeleted add: Project current. Project current removeParameter: #deleteWhenEnteringNewProject. ]. projectsToBeDeleted isEmpty ifFalse: [ proj projectParameters at: #projectsToBeDeleted put: projectsToBeDeleted. ]. ^ proj! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'pre 8/22/2019 15:03'! makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted existingView ifNil: [ Smalltalk isMorphic ifTrue: [ proj createViewIfAppropriate. ] ifFalse: [ ChangeSet allChangeSets add: proj changeSet. Project current openProject: proj. "Note: in MVC we get no further than the above" ]. ] ifNotNil: [ (existingView project isKindOf: DiskProxy) ifFalse: [ existingView project changeSet name: ChangeSet defaultName. projectsToBeDeleted add: existingView project. ]. (existingView owner isSystemWindow) ifTrue: [ existingView owner model: proj ]. existingView project: proj. ]. ! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'cmm 10/23/2013 16:24'! morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive "Answer morphOrList or nil if problem happened" | projStream localDir morphOrList | projStream := archive ifNil: [preStream] ifNotNil: [self projectStreamFromArchive: archive]. (self checkSecurity: aFileName preStream: preStream projStream: projStream) ifFalse: [^nil]. localDir := Project squeakletDirectory. aFileName ifNotNil: [ (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName ~= localDir pathName]) ifTrue: [ localDir deleteFileNamed: aFileName. (localDir fileNamed: aFileName) binary nextPutAll: preStream remainingContents; close. ]. ]. morphOrList := projStream asUnZippedStream. preStream sleep. "if ftp, let the connection close" ^ morphOrList ! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'yo 2/5/2008 17:15'! parseManifest: aString
| dict line index key value aStream | aStream := aString readStream. dict := Dictionary new. [(line := aStream nextLine) notNil] whileTrue: [ index := line indexOf: $:. index > 0 ifTrue: [ key := line copyFrom: 1 to: index - 1. value := (line copyFrom: index + 1 to: line size) withBlanksTrimmed. dict at: key put: value. ]. ]. ^ dict.! !
!ProjectNavigationMorph methodsFor: 'buttons' stamp: 'mt 8/10/2023 11:32'! makeTheAdvancedButtons
^{ self buttonNewProject. self buttonShare. self buttonPrev. self buttonNext. self buttonPublish. self buttonNewer. self buttonTell. self buttonFind. self buttonFullScreen. "self buttonFlaps." }, ( Preferences includeSoundControlInNavigator ifTrue: [{self buttonSound}] ifFalse: [#()] ), { self buttonLanguage. self buttonUndo. self buttonQuit. } ! !
!ProjectNavigationMorph methodsFor: 'buttons' stamp: 'mt 8/28/2023 14:27'! makeTheButtons ^ self makeTheAdvancedButtons! !
!ProjectNavigationMorph methodsFor: 'the actions' stamp: 'mt 8/23/2023 13:51'! doPublishButtonMenuEvent: evt
| selection | selection := UIManager default chooseFrom: { 'Publish' translated. 'Publish As...' translated. 'Publish to Different Server' translated. } values: { [self publishProject]. [self publishProjectAs]. [self publishDifferent]. } title: 'Publish options' translated. selection ifNil: [^self]. selection value.
! !
!ProjectSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'! addControls "Add the control bar at the top of the tool."
| b r partsBinButton newButton aWrapper | newButton := ImageMorph new image: (Project current makeThumbnail scaledToSize: 48@36). newButton on: #mouseDown send: #insertNewProject: to: self. newButton setBalloonText: 'Make a new Project' translated. (partsBinButton := UpdatingThreePhaseButtonMorph checkBox) target: self; actionSelector: #togglePartsBinStatus; arguments: #(); getSelector: #getPartsBinStatus. (r := AlignmentMorph newRow) color: Color transparent; borderWidth: 0; layoutInset: 0; cellInset: 10@0; wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. b := SimpleButtonMorph new target: self; color: self defaultColor darker; borderColor: Color black. r addMorphBack: (self wrapperFor: (b label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort)). b := SimpleButtonMorph new target: self; color: self defaultColor darker; borderColor: Color black. r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #delete)); addTransparentSpacerOfSize: 8 @ 0; addMorphBack: (self wrapperFor: (newButton)); addTransparentSpacerOfSize: 8 @ 0.
aWrapper := AlignmentMorph newRow beTransparent. aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0. aWrapper addMorphBack: (self wrapperFor: partsBinButton); addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated font: Preferences standardButtonFont) lock). r addMorphBack: aWrapper.
self addMorphFront: r. ! !
!ProjectSorterMorph methodsFor: 'initialization' stamp: 'mt 8/14/2023 16:22'! initialize "initialize the state of the receiver"
super initialize. self useRoundedCorners. pageHolder useRoundedCorners; borderWidth: 0; color: (Form gridFormOrigin: 0 @ 0 grid: 32 @ 32 background: Color white line: Color blue muchLighter)! !
!ProjectSorterMorph methodsFor: 'controls' stamp: 'mt 8/23/2023 13:50'! insertNewProject: evt
[MorphicProject openViewOn: nil] on: ProjectViewOpenNotification do: [ :ex | ex resume: false].! !
!RecordingControlsMorph methodsFor: 'button commands' stamp: 'mt 8/22/2023 15:53'! makeTile "Make a tile representing my sound. Get a sound-name from the user by which the sound is to be known."
| tile | recorder verifyExistenceOfRecordedSound ifFalse: [^ self]. recorder pause. tile := InterimSoundMorph new sound: (SampledSound samples: recorder condensedSamples samplingRate: recorder samplingRate). tile bounds: tile fullBounds. tile openInHand! !
!ReferenceMorph methodsFor: 'menu' stamp: 'mt 8/14/2023 17:24'! changeTabGraphic | aGraphicalMenu | aGraphicalMenu := GraphicalMenu new initializeFor: submorphs first withForms: submorphs first reasonableForms coexist: true. self primaryHand attachMorph: aGraphicalMenu.! !
!ReferenceMorph methodsFor: 'menu' stamp: 'mt 7/31/2023 11:15'! graphicalMorphForTab | formToUse | formToUse := self valueOfProperty: #priorGraphic ifAbsent: [MenuIcons formAtKey: 'squeakyMouse']. ^ SketchMorph withForm: formToUse! !
!FlapTab methodsFor: 'show & hide' stamp: 'mt 8/4/2023 14:02'! showFlap "Open the flap up"
| thicknessToUse flapOwner |
"19 sept 2000 - going for all paste ups <- raa note" flapOwner := self pasteUpMorph. self referentThickness <= 0 ifTrue: [thicknessToUse := lastReferentThickness ifNil: [100]. self orientation == #horizontal ifTrue: [referent height: thicknessToUse] ifFalse: [referent width: thicknessToUse]]. inboard ifTrue: [self stickOntoReferent]. "makes referent my owner, and positions me accordingly" referent pasteUpMorph == flapOwner ifFalse: [flapOwner accommodateFlap: self. "Make room if needed" flapOwner addMorphFront: referent. flapOwner startSteppingSubmorphsOf: referent. self positionReferent]. inboard ifFalse: [self adjustPositionVisAVisFlap]. flapShowing := true. self pasteUpMorph hideFlapsOtherThan: self ifClingingTo: edgeToAdhereTo.
flapOwner bringTopmostsToFront! !
!ReferenceStream class methodsFor: 'accessing' stamp: 'mt 8/28/2023 15:43'! versionCode "Answer a number representing the 'version' of the ReferenceStream facility; this is stashed at the beginning of ReferenceStreams, as a secondary versioning mechanism (the primary one is the fileTypeCode). At present, it serves for information only, and is not checked for compatibility at reload time, but could in future be used to branch to variant code. "
" 1 = original version 1992" " 2 = HyperSqueak. PathFromHome used for Objs outside the tree. SqueakSupport SysLibrary for shared globals like Display and StrikeFonts. File has version number, class structure, then an IncomingObjects manager. 8/16/96 tk. Extended to SmartRefStream. class structure also keeps superclasse chain. Does analysis on structure to see when translation methods are needed. Embedable in file-ins. (factored out HyperSqueak support) Feb-May 97 tk" " 3 = Reference objects are byte offsets relative to the start of the object portion of the file. Rectangles with values -2048 to 2047 are encoded compactly." " 4 = If UniClasses have class instance variables, append their values in the form (#Class43 (val1 val2 vla3)). An array of those. Can still read version 3." ^ 4! !
!ReleaseBuilder class methodsFor: 'scripts' stamp: 'mt 8/16/2023 15:43'! configureTools "Initialize well-known tools and other resources."
FileList initialize. FileServices initialize. "register file reader services" RealEstateAgent standardSize: 650@425. SMLoaderPlus setDefaultFilters: #(filterSafelyAvailable).
"Default applications and tools." SystemBrowser default: TreeBrowser. MailSender default: nil. SoundService default: BaseSoundSystem. ToolSet default: StandardToolSet. WebBrowser default: nil. ! !
!ReleaseBuilder class methodsFor: 'scripts - support' stamp: 'mt 3/7/2023 14:05'! discardUserObjects
"Remove the classes." MorphicModel removeUninstantiatedSubclassesSilently.
"Clean-up environment hick-ups." Environment default allClassesDo: [:cls | (cls isUniClass and: [cls environment ~~ Environment default]) ifTrue: [Environment default forgetClass: cls logged: false]]. Environment default declarations select: [:binding | (binding value isBehavior and: [binding value isUniClass]) and: [binding value isObsolete]] thenDo: [:binding | SystemOrganization removeElement: binding key. Environment default removeKey: binding key].
"Remove auto-generated accessors. See Preferences." (MCPackage named: 'Autogenerated') unload.
"Remove empty categories for user objects. See Object class >> #categoryForUniclasses." SystemOrganizer cleanUp: true.! !
!RemoteHandMorph methodsFor: 'event handling' stamp: 'mt 8/28/2023 14:35'! transmitEvent: aMorphicEvent "Transmit the given event to all remote connections." | firstEvt | self readyToTransmit ifFalse: [^ self]. self lastEventTransmitted = aMorphicEvent ifTrue: [^ self]. sendBuffer ifNil: [sendBuffer := WriteStream on: (String new: 10000)]. sendBuffer nextPutAll: aMorphicEvent storeString; cr. self lastEventTransmitted: aMorphicEvent.
sendSocket isConnected ifTrue:[ sendState = #opening ifTrue: [ "connection established; disable TCP delays on sends" sendSocket setOption: 'TCP_NODELAY' value: true. "send worldExtent as first event" firstEvt := MorphicUnknownEvent new setType: #worldBounds argument: self worldBounds extent. sendSocket sendData: firstEvt storeString, (String with: Character cr). Transcript show: 'Connection established with remote WorldMorph at '; show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. sendState := #connected]. sendSocket sendData: sendBuffer contents. ] ifFalse: [ owner primaryHand removeEventListener: self. sendState = #connected ifTrue: [ "other end has closed; close our end" Transcript show: 'Closing connection with remote WorldMorph at '; show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. sendSocket close. sendState := #closing]].
sendBuffer reset. ! !
!ResourceCollector methodsFor: 'initialize' stamp: 'mt 3/15/2023 14:07'! initialize originalMap := IdentityDictionary new. stubMap := IdentityDictionary new. locatorMap := IdentityDictionary new. internalStubs := IdentityDictionary new.! !
!ScreenController methodsFor: 'nested menus' stamp: 'mt 7/31/2023 11:19'! helpMenu "Answer the help menu to be put up as a screen submenu"
^ SelectionMenu labelList: #( 'about this system...' 'update code from server' 'preferences...'
'command-key help' 'font size summary' 'useful expressions' 'view graphical imports' 'standard graphics library'),
(Array with: (SoundService soundEnablingString)) ,
#( 'set author initials...' 'vm statistics' 'space left') lines: #(1 4 6 11) selections: #( aboutThisSystem absorbUpdatesFromServer editPreferences openCommandKeyHelp fontSizeSummary openStandardWorkspace viewImageImports soundOnOrOff setAuthorInitials vmStatistics garbageCollect) " ScreenController new helpMenu startUp "! !
!ScrollableField methodsFor: 'menu' stamp: 'mt 8/11/2023 14:47'! getMenu: shiftKeyState ^ shiftKeyState not ifTrue: [TextEditor yellowButtonMenu] ifFalse: [TextEditor shiftedYellowButtonMenu]! !
!SelectionMorph methodsFor: 'halo commands' stamp: 'mt 3/10/2023 15:26'! duplicate "Make a duplicate of the receiver and havbe the hand grab it"
selectedItems := self duplicateMorphCollection: selectedItems. selectedItems reverseDo: [:m | (owner ifNil: [self currentWorld]) addMorph: m]. dupLoc := self position. self currentHand grabMorph: self.! !
!ServerDirectory class methodsFor: 'school support' stamp: 'mt 3/10/2023 11:45'! projectDefaultDirectory ^ FileDirectory default! !
!ServerDirectory class methodsFor: 'server prefs' stamp: 'mt 8/16/2023 15:50'! parseServerEntryFrom: stream | server type directory entries serverName |
entries := ExternalSettings parseServerEntryArgsFrom: stream.
serverName := entries at: 'name' ifAbsent: [^nil]. directory := entries at: 'directory' ifAbsent: [^nil]. type := entries at: 'type' ifAbsent: [^nil]. type = 'file' ifTrue: [ server := self determineLocalServerDirectory: directory. entries at: 'userListUrl' ifPresent:[:value | "Ignore" ]. entries at: 'baseFolderSpec' ifPresent:[:value | "Ignore" ]. ^self addLocalProjectDirectory: server]. type = 'bss' ifTrue: [server := SuperSwikiServer new type: #http]. type = 'http' ifTrue: [server := HTTPServerDirectory new type: #ftp]. type = 'ftp' ifTrue: [server := ServerDirectory new type: #ftp].
server directory: directory. entries at: 'server' ifPresent: [:value | server server: value]. entries at: 'user' ifPresent: [:value | server user: value]. entries at: 'group' ifPresent: [:value | server groupName: value]. entries at: 'passwdseq' ifPresent: [:value | server passwordSequence: value asNumber]. entries at: 'url' ifPresent: [:value | server altUrl: value]. entries at: 'loaderUrl' ifPresent: [:value | server loaderUrl: value]. entries at: 'acceptsUploads' ifPresent: [:value | server acceptsUploads: value asLowercase = 'true']. entries at: 'userListUrl' ifPresent:[:value | "Ignore" ]. entries at: 'encodingName' ifPresent:[:value | server encodingName: value]. ServerDirectory addServer: server named: serverName. ! !
!IconicButton methodsFor: 'initialization' stamp: 'mt 3/7/2023 15:06'! initializeWithThumbnail: aThumbnail withLabel: aLabel andColor: aColor andSend: aSelector to: aReceiver "Initialize the receiver to show aThumbnail on its face, giving it the label supplied and arranging for it, when the button goes down on it, to obtain a new morph by sending the supplied selector to the supplied receiver"
| labeledItem nonTranslucent | nonTranslucent := aColor asNontranslucentColor. labeledItem := AlignmentMorph newColumn. labeledItem color: nonTranslucent. labeledItem borderWidth: 0. labeledItem layoutInset: 4@0; cellPositioning: #center. labeledItem addMorph: aThumbnail. labeledItem addMorphBack: (Morph new extent: (4@4)) beTransparent. labeledItem addMorphBack: (TextMorph new backgroundColor: nonTranslucent; contentsAsIs: aLabel; beAllFont: Preferences standardButtonFont; centered).
self beTransparent; labelGraphic: ((labeledItem imageForm: 32 backgroundColor: nonTranslucent forRectangle: labeledItem fullBounds) replaceColor: nonTranslucent withColor: Color transparent); borderWidth: 0; target: aReceiver; actionSelector: #launchPartVia:label:; arguments: {aSelector. aLabel}; actWhen: #buttonDown.
self stationarySetup.! !
!IconicButton methodsFor: 'initialization' stamp: 'mt 3/15/2023 14:10'! setDefaultLabel self labelGraphic: (MenuIcons formAtKey: 'squeakyMouse')! !
!HaloMorph methodsFor: 'handles' stamp: 'mt 3/15/2023 13:34'! addDismissHandle: handleSpec "Add the dismiss handle according to the spec, unless my target resists dismissal"
| dismissHandle | target okayToAddDismissHandle ifTrue: [dismissHandle := self addHandle: handleSpec on: #mouseDown send: #mouseDownInDimissHandle:with: to: self. dismissHandle on: #mouseUp send: #maybeDismiss:with: to: self. dismissHandle on: #mouseDown send: #setDismissColor:with: to: self. dismissHandle on: #mouseMove send: #setDismissColor:with: to: self] ! !
!HaloMorph methodsFor: 'handles' stamp: 'mt 8/11/2023 14:24'! addDupHandle: haloSpec "Add the halo that offers duplication"
self addHandle: haloSpec on: #mouseDown send: #doDup:with: to: self
! !
!HaloMorph methodsFor: 'handles' stamp: 'sw 1/26/2000 16:16'! addHelpHandle: haloSpec target balloonText ifNotNil: [(self addHandle: haloSpec on: #mouseDown send: #mouseDownOnHelpHandle: to: innerTarget) on: #mouseUp send: #deleteBalloon to: innerTarget] ! !
!HaloMorph methodsFor: 'handles' stamp: 'RAA 3/15/2001 11:24'! addRecolorHandle: haloSpec "Add a recolor handle to the receiver, if appropriate"
| recolorHandle |
"since this halo now opens a more general properties panel, allow it in all cases" "innerTarget canSetColor ifTrue:"
recolorHandle := self addHandle: haloSpec on: #mouseUp send: #doRecolor:with: to: self. recolorHandle on: #mouseUp send: #doRecolor:with: to: self
! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/15/2023 14:10'! addGraphicalHandleFrom: formKey at: aPoint "Add the supplied form as a graphical handle centered at the given point. Return the handle." | handle aForm | aForm := (MenuIcons formAtKey: formKey) ifNil: [MenuIcons formAtKey: #SolidMenu]. handle := ImageMorph new image: aForm; bounds: (Rectangle center: aPoint extent: aForm extent). handle borderColor: Color black; borderWidth: 2. handle wantsYellowButtonMenu: false. self addMorph: handle. handle on: #mouseUp send: #endInteraction: to: self. ^ handle ! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/15/2023 14:10'! createHandleAt: aPoint color: aColor iconName: iconName | bou handle | bou := Rectangle center: aPoint extent: self handleSize asPoint. Preferences alternateHandlesLook ifTrue: [handle := RectangleMorph newBounds: bou color: aColor. handle useRoundedCorners. self setColor: aColor toHandle: handle] ifFalse: [handle := EllipseMorph newBounds: bou color: aColor]. handle borderWidth: 0; wantsYellowButtonMenu: false. "" iconName isNil ifFalse: [| form | form := MenuIcons formAtKey: iconName. form isNil ifFalse: [| image | image := ImageMorph new. image image: form scaleIconToDisplay. image color: aColor makeForegroundColor. image lock. handle addMorphCentered: image]]. "" ^ handle! !
!HaloMorph methodsFor: 'private' stamp: 'mt 2/19/2021 14:52'! doGrow: evt with: growHandle "Called while the mouse is down in the grow handle"
| newExtent extentToUse scale | evt hand obtainHalo: self. newExtent := (target pointFromWorld: evt cursorPoint - positionOffset) - target topLeft. evt shiftPressed ifTrue: [ scale := (newExtent x / (originalExtent x max: 1)) min: (newExtent y / (originalExtent y max: 1)). newExtent := (originalExtent x * scale) asInteger @ (originalExtent y * scale) asInteger ]. (newExtent x < 1 or: [newExtent y < 1 ]) ifTrue: [^ self]. target renderedMorph setExtentFromHalo: (extentToUse := newExtent). growHandle position: evt cursorPoint - (growHandle extent // 2). self layoutChanged. (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | "Update the final extent" cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: extentToUse] ! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/8/2023 11:29'! doRecolor: evt with: aHandle "The mouse went down in the 'recolor' halo handle. Allow the user to change the color of the innerTarget"
evt hand obtainHalo: self. (aHandle containsPoint: evt cursorPoint) ifFalse: "only do it if mouse still in handle on mouse up" [self delete. target addHalo: evt] ifTrue: [innerTarget changeColor. self showingDirectionHandles ifTrue: [self addHandles]]! !
!HaloMorph methodsFor: 'private' stamp: 'ul 12/12/2009 14:11'! doRot: evt with: rotHandle "Update the rotation of my target if it is rotatable. Keep the relevant command object up to date."
| degrees | evt hand obtainHalo: self. degrees := (evt cursorPoint - (target pointInWorld: target referencePosition)) degrees. degrees := degrees - angleOffset degrees. degrees := degrees detentBy: 10.0 atMultiplesOf: 90.0 snap: false. degrees = 0.0 ifTrue: [self setColor: Color lightBlue toHandle: rotHandle] ifFalse: [self setColor: Color blue toHandle: rotHandle]. rotHandle submorphsDo: [:m | m color: rotHandle color makeForegroundColor]. self removeAllHandlesBut: rotHandle. self showingDirectionHandles ifFalse: [self showDirectionHandles: true addHandles: false]. self addDirectionHandles.
target rotationDegrees: degrees.
rotHandle position: evt cursorPoint - (rotHandle extent // 2). (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | "Update the final rotation" cmd redoTarget: target renderedMorph selector: #heading: argument: degrees]. self layoutChanged! !
!HaloMorph methodsFor: 'private' stamp: 'ul 12/12/2009 14:11'! doScale: evt with: scaleHandle "Update the scale of my target if it is scalable." | newHandlePos colorToUse | evt hand obtainHalo: self. newHandlePos := evt cursorPoint - (scaleHandle extent // 2). target scaleToMatch: newHandlePos. colorToUse := target scale = 1.0 ifTrue: [Color yellow] ifFalse: [Color orange]. self setColor: colorToUse toHandle: scaleHandle. scaleHandle submorphsDo: [:m | m color: colorToUse makeForegroundColor]. scaleHandle position: newHandlePos. self layoutChanged.
(self valueOfProperty: #commandInProgress) ifNotNil:[:cmd | "Update the final extent" cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent ]. ! !
!HaloMorph methodsFor: 'private' stamp: 'mt 8/11/2023 17:00'! endInteraction: event "Clean up after a user interaction with the a halo control"
| m | (target isInWorld not or: [owner isNil]) ifTrue: [^self]. [target isFlexMorph and: [target hasNoScaleOrRotation]] whileTrue: [m := target firstSubmorph. target removeFlexShell. target := m]. self restoreTargetDropShadows. target changedViaHalo: self. self isInWorld ifTrue: ["make sure handles show in front, even if flex shell added" self flag: #tofix. "mt: Try to avoid deleting and re-creating an event handler (here: the handle) while handling the event." self comeToFront. self addHandles. event hand newMouseFocus: self]. (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | self rememberCommand: cmd. self removeProperty: #commandInProgress].! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/10/2023 15:08'! maybeDismiss: evt with: dismissHandle "Ask hand to dismiss my target if mouse comes up in it."
evt hand obtainHalo: self. (dismissHandle containsPoint: evt cursorPoint) ifFalse: [self delete. target addHalo: evt] ifTrue: [target resistsRemoval ifTrue: [(Project uiManager chooseOptionFrom: {'Yes' translated. 'Um, no, let me reconsider' translated.} title: 'Really throw this away?' translated) = 1 ifFalse: [^ self]]. evt hand removeHalo. self delete. target dismissViaHalo].! !
!HaloMorph methodsFor: 'private' stamp: 'HenrikSperreJohansen 1/21/2011 18:34'! mouseDownInDimissHandle: evt with: dismissHandle evt hand obtainHalo: self. SoundService soundEnabled ifTrue: [TrashCanMorph playMouseEnterSound]. self removeAllHandlesBut: dismissHandle. self setColor: Color darkGray toHandle: dismissHandle. ! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/10/2023 13:51'! startDrag: evt with: dragHandle "Drag my target without removing it from its owner."
self obtainHaloForEvent: evt andRemoveAllHandlesBut: dragHandle. target aboutToBeDraggedViaHalo. positionOffset := dragHandle center - (target point: target position in: owner).! !
!HaloMorph methodsFor: 'private' stamp: 'ct 2/28/2022 16:24'! startGrow: evt with: growHandle "Initialize resizing of my target. Launch a command representing it, to support Undo"
| botRt | self obtainHaloForEvent: evt andRemoveAllHandlesBut: growHandle. self backupAndHideTargetDropShadows. target aboutToBeGrownViaHalo. botRt := target point: target bottomRight in: owner. positionOffset := (self world viewBox containsPoint: botRt) ifTrue: [evt cursorPoint - botRt] ifFalse: [0@0].
self setProperty: #commandInProgress toValue: (Command new cmdWording: ('resize ' translated, target nameForUndoWording); undoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent).
originalExtent := target extent! !
!HaloMorph methodsFor: 'private' stamp: 'mt 8/11/2023 16:59'! startRot: evt with: rotHandle "Initialize rotation of my target if it is rotatable. Launch a command object to represent the action"
self obtainHaloForEvent: evt andRemoveAllHandlesBut: rotHandle. self backupAndHideTargetDropShadows. target aboutToBeRotatedViaHalo. target isFlexMorph ifFalse: [target addFlexShellIfNecessary]. growingOrRotating := true.
self removeAllHandlesBut: rotHandle. "remove all other handles" angleOffset := evt cursorPoint - (target pointInWorld: target referencePosition). angleOffset := Point r: angleOffset r degrees: angleOffset degrees - target rotationDegrees. self setProperty: #commandInProgress toValue: (Command new cmdWording: ('rotate ' translated, target nameForUndoWording); undoTarget: target renderedMorph selector: #heading: argument: target rotationDegrees)
! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/7/2023 16:46'! startScale: evt with: scaleHandle "Initialize scaling of my target."
self obtainHaloForEvent: evt andRemoveAllHandlesBut: scaleHandle. self backupAndHideTargetDropShadows. target aboutToBeScaledViaHalo. target isFlexMorph ifFalse: [target addFlexShellIfNecessary]. growingOrRotating := true. positionOffset := 0@0. originalExtent := target extent ! !
!HaloMorph methodsFor: 'pop up' stamp: 'mt 3/15/2023 13:40'! popUpFor: morph at: position hand: hand
super popUpFor: morph at: position hand: hand. self startStepping.! !
!HaloMorph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/15/2023 13:40'! delete "Delete the halo. Tell the target that it no longer has the halo; accept any pending edits to the name; and then actually delete myself"
self acceptNameEdit. super delete.! !
!SketchEditorMorph methodsFor: 'initialization' stamp: 'mt 8/10/2023 15:28'! initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph."
| paintBoxBounds worldBounds | self setProperty: #recipientPasteUp toValue: aPasteUpMorph.
paintBoxBounds := self world paintBox bounds. worldBounds := self world bounds.
self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: ((boundsToUse topRight extent: paintBoxBounds extent) translatedToBeWithin: worldBounds) topLeft. ! !
!SketchEditorMorph methodsFor: 'start & finish' stamp: 'mt 8/10/2023 15:34'! cancelOutOfPainting "The user requested to back out of a painting session without saving"
self deleteSelfAndSubordinates. emptyPicBlock ifNotNil: [emptyPicBlock value]. "note no args to block!!" hostView ifNotNil: [hostView changed]. ^ nil! !
!SketchEditorMorph methodsFor: 'start & finish' stamp: 'mt 8/10/2023 15:34'! deliverPainting: result evt: evt "Done painting. May come from resume, or from original call. Execute user's post painting instructions in the block. Always use this standard one. 4/21/97 tk"
| newBox newForm ans | palette ifNotNil: "nil happens" [palette setAction: #paint: evt: evt]. "Get out of odd modes" "rot := palette getRotations." "rotate with heading, or turn to and fro" "palette setRotation: #normal." result == #cancel ifTrue: [ ans := Project uiManager chooseOptionFrom: { 'throw it away' translated. 'keep painting it' translated} title: 'Do you really want to throw away what you just painted?' translated. ^ ans = 1 ifTrue: [self cancelOutOfPainting] ifFalse: [nil]]. "cancelled out of cancelling."
"hostView rotationStyle: rot." "rotate with heading, or turn to and fro" newBox := paintingForm rectangleEnclosingPixelsNotOfColor: Color transparent. registrationPoint ifNotNil: [registrationPoint := registrationPoint - newBox origin]. "relative to newForm origin" newForm := Form extent: newBox extent depth: paintingForm depth. newForm copyBits: newBox from: paintingForm at: 0@0 clippingBox: newForm boundingBox rule: Form over fillColor: nil. newForm isAllWhite ifTrue: [(self valueOfProperty: #background) == true ifFalse: [^ self cancelOutOfPainting]].
newForm fixAlpha. "so alpha channel stays intact for 32bpp"
self delete. "so won't find me again" dimForm ifNotNil: [dimForm delete]. newPicBlock value: newForm value: (newBox copy translateBy: bounds origin).! !
!SketchMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:15'! setNewFormFrom: formOrNil "Set the receiver's form as indicated. If nil is provided, then a default form will be used"
formOrNil ifNotNil: [^ self form: formOrNil]. self form: (Form extent: 16@16 depth: 32) ! !
!SketchMorph methodsFor: 'initialization' stamp: 'mt 3/15/2023 14:10'! initialize "initialize the state of the receiver" ^ self initializeWith: (MenuIcons formAtKey: 'Painting') deepCopy! !
!SketchMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 14:30'! addPaintingItemsTo: aMenu hand: aHandMorph | subMenu movies | subMenu := MenuMorph new defaultTarget: self. subMenu add: 'repaint' translated action: #editDrawing; add: 'set rotation center' translated action: #setRotationCenter; add: 'reset forward-direction' translated action: #resetForwardDirection; add: 'set rotation style' translated action: #setRotationStyle; add: 'erase pixels of color' translated action: #erasePixelsUsing:; add: 'recolor pixels of color' translated action: #recolorPixelsUsing:; add: 'reduce color palette' translated action: #reduceColorPalette:; add: 'detect edges' translated action: #edgeDetect; add: 'sharpen' translated action: #sharpen; add: 'blur' translated action: #blur; add: 'emboss' translated action: #emboss; add: 'add a border around this shape...' translated action: #addBorderToShape:. movies := (self world rootMorphsAt: aHandMorph targetPoint) select: [:m | (m isKindOf: MovieMorph) or: [m isSketchMorph]]. movies size > 1 ifTrue: [subMenu add: 'insert into movie' translated action: #insertIntoMovie:]. aMenu add: 'painting...' translated subMenu: subMenu! !
!SketchMorph methodsFor: 'menu' stamp: 'mt 8/10/2023 15:33'! editDrawingIn: aPasteUpMorph forBackground: forBackground "Edit an existing sketch."
| w bnds sketchEditor rotCenter aWorld aPaintBox | self world assureNotPaintingElse: [^self]. w := aPasteUpMorph world.
w displayWorld. self visible: false. bnds := forBackground ifTrue: [aPasteUpMorph boundsInWorld] ifFalse: [self boundsInWorld expandBy: 60 @ 60]. sketchEditor := SketchEditorMorph new. forBackground ifTrue: [sketchEditor setProperty: #background toValue: true]. w addMorphFront: sketchEditor. sketchEditor initializeFor: self inBounds: bnds pasteUpMorph: aPasteUpMorph. rotCenter := self rotationCenter.
sketchEditor afterNewPicDo: [:aForm :aRect | | tfx | self visible: true. self form: aForm. tfx := aPasteUpMorph transformFrom: aPasteUpMorph world. self topRendererOrSelf position: (tfx globalPointToLocal: aRect origin). self rotationStyle: sketchEditor rotationStyle. self forwardDirection: sketchEditor forwardDirection. (rotCenter notNil and: [(rotCenter = (0.5 @ 0.5)) not]) ifTrue: [self rotationCenter: rotCenter]. aWorld := self world. (aPaintBox := aWorld paintBox) ifNotNil: [aPaintBox delete].
forBackground ifTrue: [self goBehind "shouldn't be necessary"]] ifNoBits: []! !
!SketchMorph methodsFor: 'menus' stamp: 'mt 3/10/2023 16:09'! addToggleItemsToHaloMenu: aCustomMenu "Add toggle-items to the halo menu" super addToggleItemsToHaloMenu: aCustomMenu. aCustomMenu addUpdating: #useInterpolationString target: self action: #toggleInterpolation.! !
!SketchMorph methodsFor: 'menus' stamp: 'mt 8/11/2023 13:42'! chooseNewGraphic "Allow the user to choose a different form for her form-based morph"
| aGraphicalMenu | aGraphicalMenu := GraphicalMenu new initializeFor: self withForms: self reasonableForms coexist: true. self primaryHand attachMorph: aGraphicalMenu.! !
!SketchMorph methodsFor: 'parts bin' stamp: 'mt 3/15/2023 14:10'! initializeToStandAlone super initializeToStandAlone. self initializeWith: (MenuIcons formAtKey: 'Painting') deepCopy
! !
!ColorPickerMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 14:01'! mouseUp: evt
self stopStepping. sourceHand := nil. deleteOnMouseUp ifTrue: [self delete]. self updateTargetColor. ! !
!ColorPickerMorph methodsFor: 'menu' stamp: 'mt 3/15/2023 14:09'! pickUpColorFor: aMorph "Show the eyedropper cursor, and modally track the mouse through a mouse-down and mouse-up cycle"
| aHand localPt | aHand := aMorph ifNil: [self activeHand] ifNotNil: [aMorph activeHand]. aHand ifNil: [aHand := self currentHand]. self addToWorld: aHand world near: (aMorph ifNil: [aHand world]) fullBounds. self owner ifNil: [^ self].
aHand showTemporaryCursor: (MenuIcons formAtKey: #Eyedropper) hotSpotOffset: 2@14. "<<<< the form was changed a bit??"
self updateContinuously: false. [Sensor anyButtonPressed] whileFalse: [self trackColorUnderMouse]. self deleteAllBalloons.
localPt := Sensor cursorPoint - self topLeft. self inhibitDragging ifFalse: [ (DragBox containsPoint: localPt) ifTrue: ["Click or drag the drag-dot means to anchor as a modeless picker" ^ self anchorAndRunModeless: aHand]. ]. (clickedTranslucency := TransparentBox containsPoint: localPt) ifTrue: [selectedColor := originalColor].
self updateContinuously: true. [Sensor anyButtonPressed] whileTrue: [self updateTargetColorWith: self indicateColorUnderMouse]. aHand newMouseFocus: nil; showTemporaryCursor: nil; flushEvents. self delete. ! !
!ColorPickerMorph methodsFor: 'private' stamp: 'mt 3/10/2023 14:01'! pickColorAt: aGlobalPoint
| alpha selfRelativePoint pickedColor | clickedTranslucency ifNil: [clickedTranslucency := false]. selfRelativePoint := (self globalPointToLocal: aGlobalPoint) - self topLeft. (FeedbackBox containsPoint: selfRelativePoint) ifTrue: [^ self]. (RevertBox containsPoint: selfRelativePoint) ifTrue: [^ self updateColor: originalColor feedbackColor: originalColor].
"check for transparent color and update using appropriate feedback color " (TransparentBox containsPoint: selfRelativePoint) ifTrue: [clickedTranslucency ifFalse: [^ self]. "Can't wander into translucency control" alpha := (selfRelativePoint x - TransparentBox left - 10) asFloat / (TransparentBox width - 20) min: 1.0 max: 0.0. "(alpha roundTo: 0.01) printString , ' ' displayAt: 0@0." " -- debug" self updateColor: (selectedColor alpha: alpha) feedbackColor: (selectedColor alpha: alpha). ^ self].
"pick up color, either inside or outside this world" clickedTranslucency ifTrue: [^ self]. "Can't wander out of translucency control" self locationIndicator visible: false. self refreshWorld. pickedColor := Display colorAt: aGlobalPoint. self locationIndicator visible: true. self refreshWorld. self updateColor: ( (selectedColor isColor and: [selectedColor isTranslucentColor]) ifTrue: [pickedColor alpha: selectedColor alpha] ifFalse: [pickedColor] ) feedbackColor: pickedColor! !
!SmartRefStream methodsFor: 'read write' stamp: 'mt 3/10/2023 15:43'! initKnownRenames renamed at: #FlasherMorph put: #Flasher; at: #AlansTextPlusMorph put: #TextPlusMorph; at: #Project put: #MorphicProject; at: #InputSensor put: #EventSensor; yourself! !
!SmartRefStream methodsFor: 'read write' stamp: 'mt 3/10/2023 15:43'! restoreClassInstVars "Install the values of the class instance variables of UniClasses."
self flag: #todo. "mt: See EToys in Squeak 6.0 and before."! !
!SqueakToolsDebuggerHelp class methodsFor: 'pages' stamp: 'mt 3/15/2023 14:10'! showForm: aSymbol | form contents | form := MenuIcons formAtKey: aSymbol. contents := (String with: Character cr) asText, (Text string: ' ' attribute: (TextFontReference toFont: (FormSetFont new fromFormArray: (Array with: form) asciiStart: Character space asInteger ascent: form height))), (String with: Character cr) asText. ^contents! !
!SystemWindow methodsFor: 'initialization' stamp: 'mt 3/10/2023 16:09'! initializeLabelArea "Initialize the label area (titlebar) for the window." labelString ifNil: [labelString := 'Untitled Window']. label := StringMorph new contents: labelString; font: (self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont]); yourself. "Add collapse box so #labelHeight will work" collapseBox := self createCollapseBox. stripes := Array with: (RectangleMorph newBounds: bounds) with: (RectangleMorph newBounds: bounds). "see extent:" self addLabelArea. self setLabelWidgetAllowance. self addCloseBox. self class moveMenuButtonRight ifTrue: [self addLabel. self addMenuControl] ifFalse: [self addMenuControl. self addLabel]. self addExpandBox. labelArea addMorphBack: collapseBox. self setFramesForLabelArea. ! !
!SystemWindow methodsFor: 'menu' stamp: 'dao 10/1/2004 12:57'! fullScreenMaximumExtent "Zoom Window to Full World size with possible DeskMargins obey the maximum extent rules" | left right possibleBounds | left := right := 0. self paneMorphs do: [:pane | ((pane isKindOf: ScrollPane) and: [pane retractableScrollBar]) ifTrue: [pane scrollBarOnLeft ifTrue: [left := left max: pane scrollBarThickness] ifFalse: [right := right max: pane scrollBarThickness]]]. possibleBounds := self worldBounds insetBy: (left @ 0 corner: right @ 0).
self maximumExtent ifNotNil: [possibleBounds := possibleBounds origin extent: ( self maximumExtent min: ( possibleBounds extent ))]. ((Flaps sharedFlapsAllowed and: [Project current flapsSuppressed not]) or: [Preferences fullScreenLeavesDeskMargins]) ifTrue: [possibleBounds := possibleBounds insetBy: 22]. self bounds: possibleBounds! !
!SystemWindow methodsFor: 'menu' stamp: 'mt 3/10/2023 14:27'! sendToBack | aWorld nextWindow | aWorld := self world. nextWindow := aWorld submorphs detect: [:m | (m isSystemWindow) and: [m ~~ self]] ifNone: [^self]. nextWindow beKeyWindow. aWorld addMorphBack: self! !
!SystemWindow methodsFor: 'open/close' stamp: 'mt 3/7/2023 17:40'! delete | thisWorld | self mustNotClose ifTrue: [^self]. model okToClose ifFalse: [^self]. thisWorld := self world. self activeHand removeKeyboardListener: self. self isFlexed ifTrue: [owner delete] ifFalse: [super delete]. model windowIsClosing; release. model := nil. SystemWindow noteTopWindowIn: thisWorld! !
!SystemWindow methodsFor: 'stepping' stamp: 'mt 8/28/2023 15:51'! stepAt: millisecondClockValue "If the receiver is not collapsed, step it, after first stepping the model."
(isCollapsed not or: [self wantsStepsWhenCollapsed]) ifTrue: [model ifNotNil: [model stepAt: millisecondClockValue in: self]. super stepAt: millisecondClockValue]
"Since this method ends up calling step, the model-stepping logic should not be duplicated there."! !
!SystemWindow methodsFor: 'stepping' stamp: 'mt 3/10/2023 15:01'! wantsSteps "Return true if the model wants its view to be stepped. For an open system window, we give the model to offer an opinion"
self isPartsDonor ifTrue: [^ false]. ^ isCollapsed not and: [model wantsStepsIn: self]! !
!SystemWindow methodsFor: 'top window' stamp: 'mt 3/7/2023 17:40'! comeToFront
"Modal windows: Walk along the modal owner chain, the bring all to top." self modalOwner ifNotNil: [:mo | mo isSystemWindow ifTrue: [ ^ mo modalOwner ifNil: [mo comeToFrontModally] ifNotNil: [:omo | omo comeToFront]]]. self modalChild ifNotNil: [^ self comeToFrontModally]. "Now show me." super comeToFront. "Label should be visible to interact with." self assureLabelAreaVisible.! !
!TabMorph methodsFor: 'tabs' stamp: 'mt 8/4/2023 13:36'! tabSelected "Called when the receiver is hit. First, bulletproof against someone having taken the structure apart. My own action basically requires that my grand-owner be a TabbedPalette" (owner isKindOf: IndexTabs) ifFalse: [^ Beeper beep]. (owner owner isKindOf: TabbedPalette) ifFalse: [^ Beeper beep]. owner owner selectTab: self! !
!TabSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'! addControls "Add the control bar at the top of the tool."
| b r | b := SimpleButtonMorph new target: self; borderColor: Color black. r := AlignmentMorph newRow. r color: b color; borderWidth: 0; layoutInset: 0. r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. r wrapCentering: #topLeft. r addMorphBack: (b label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort). b := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (b label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #cancelSort). self addMorphFront: r. ! !
!TabSorterMorph methodsFor: 'initialization' stamp: 'mt 8/16/2023 13:52'! initialize "Initialize the receiver."
super initialize. self removeAllMorphs.
self extent: 300@100. pageHolder := PasteUpMorph new. pageHolder vResizeToFit: true; autoLineLayout: true. pageHolder extent: self extent - self borderWidth. pageHolder padding: 8. pageHolder cursor: 0. self addControls. self addMorphBack: pageHolder! !
!TabbedPalette methodsFor: 'palette menu' stamp: 'mt 8/4/2023 13:42'! addBookMenuItemsTo: aCustomMenu hand: aHandMorph aCustomMenu add: 'add palette menu' translated action: #addMenuTab.! !
!TabbedPalette methodsFor: 'palette menu' stamp: 'mt 7/31/2023 11:20'! addMenuTab "Add the menu tab. This is ancient code, not much in the spirit of anything current"
| aMenu aTab aGraphic sk | aMenu := MenuMorph new defaultTarget: self. aMenu stayUp: true. "aMenu add: 'clear' translated action: #showNoPalette." aMenu add: 'sort tabs' translated action: #sortTabs:. aMenu add: 'choose new colors for tabs' translated action: #recolorTabs. aMenu setProperty: #paletteMenu toValue: true. "aMenu add: 'make me the Standard palette' translated action: #becomeStandardPalette." aTab := self addTabForBook: aMenu withBalloonText: 'a menu of palette-related controls' translated. aTab highlightColor: tabsMorph highlightColor; regularColor: tabsMorph regularColor. tabsMorph laySubpartsOutInOneRow; layoutChanged.
aGraphic := MenuIcons formAtKey: 'TinyMenu'. aGraphic ifNotNil: [aTab removeAllMorphs. aTab addMorph: (sk := Project current world drawingClass withForm: aGraphic). sk position: aTab position. sk lock. aTab fitContents]. self layoutChanged! !
!TabbedPalette methodsFor: 'user-interface' stamp: 'mt 8/4/2023 13:36'! selectTab: aTab | currentPalette morphToInstall oldTab aSketchEditor | oldTab := tabsMorph highlightedTab. (oldTab notNil and: [(morphToInstall := oldTab morphToInstall) isKindOf: PaintBoxMorph]) ifTrue: [(aSketchEditor := self world submorphOfClass: SketchEditorMorph) ifNotNil: [aSketchEditor cancelOutOfPainting]. morphToInstall delete].
tabsMorph selectTab: aTab. morphToInstall := aTab morphToInstall.
(morphToInstall isKindOf: PaintBoxMorph) "special case, maybe generalize this need?" ifFalse: [self goToPageMorph: morphToInstall] ifTrue: [self showNoPaletteAndHighlightTab: aTab. self world addMorphFront: morphToInstall. morphToInstall position: ((self left max: 90) "room for the pop-out-to-left panel" @ (tabsMorph bottom))]. (currentPalette := self currentPalette) ifNotNil: [currentPalette layoutChanged]. self snapToEdgeIfAppropriate! !
!TabbedPalette class methodsFor: 'scripting' stamp: 'mt 7/31/2023 11:20'! authoringPrototype | aTabbedPalette aBook aTab | aTabbedPalette := self new markAsPartsDonor. aTabbedPalette pageSize: 200 @ 300. aTabbedPalette tabsMorph highlightColor: Color red regularColor: Color blue. aTabbedPalette addMenuTab.
aBook := BookMorph new setNameTo: 'one'; pageSize: aTabbedPalette pageSize. aBook color: Color blue muchLighter. aBook removeEverything; insertPage; showPageControls. aBook currentPage addMorphBack: (Project current world drawingClass withForm: (MenuIcons formAtKey: 'squeakyMouse')). aTab := aTabbedPalette addTabForBook: aBook.
aBook := BookMorph new setNameTo: 'two'; pageSize: aTabbedPalette pageSize. aBook color: Color red muchLighter. aBook removeEverything; insertPage; showPageControls. aBook currentPage addMorphBack: CurveMorph authoringPrototype. aTabbedPalette addTabForBook: aBook.
aTabbedPalette selectTab: aTab.
aTabbedPalette beSticky. aTabbedPalette tabsMorph hResizing: #spaceFill. ^ aTabbedPalette! !
!TextMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 16:10'! getMenu: shiftKeyState ^ shiftKeyState not ifTrue: [TextEditor yellowButtonMenu] ifFalse: [TextEditor shiftedYellowButtonMenu]! !
!TextMorph methodsFor: 'events-processing' stamp: 'mt 3/15/2023 13:46'! handleKeystroke: anEvent "Overwritten to support tab-among-fields preference."
anEvent wasHandled ifTrue:[^self]. (self handlesKeyboard: anEvent) ifFalse: [^ self]. (anEvent hand keyboardFocus ~~ self and: [self handlesKeyboardOnlyOnFocus]) ifTrue: [^ self]. ^ super handleKeystroke: anEvent! !
!TextMorph methodsFor: 'menu' stamp: 'mt 8/16/2023 13:54'! addCustomMenuItems: aCustomMenu hand: aHandMorph | outer | super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu add: 'text properties...' translated action: #changeTextColor. aCustomMenu addUpdating: #autoFitString target: self action: #autoFitOnOff. aCustomMenu addUpdating: #wrapString target: self action: #wrapOnOff. aCustomMenu add: 'text margins...' translated action: #changeMargins:. aCustomMenu add: 'add predecessor' translated action: #addPredecessor:. aCustomMenu add: 'add successor' translated action: #addSuccessor:. outer := self owner. outer ifNotNil: [ outer isLineMorph ifTrue: [container isNil ifTrue: [Smalltalk at: #TextOnCurveContainer ifPresent: [:ignored | aCustomMenu add: 'follow owner''s curve' translated action: #followCurve]] ifFalse: [aCustomMenu add: 'reverse direction' translated action: #reverseCurveDirection. aCustomMenu add: 'set baseline' translated action: #setCurveBaseline:]] ifFalse: [self fillsOwner ifFalse: [aCustomMenu add: 'fill owner''s shape' translated action: #fillingOnOff] ifTrue: [aCustomMenu add: 'rectangular bounds' translated action: #fillingOnOff]. self avoidsOcclusions ifFalse: [aCustomMenu add: 'avoid occlusions' translated action: #occlusionsOnOff] ifTrue: [aCustomMenu add: 'ignore occlusions' translated action: #occlusionsOnOff]]]. ! !
!TextMorph class methodsFor: 'parts bin' stamp: 'mt 3/7/2023 15:07'! fancyPrototype
| t | t := self authoringPrototype. t autoFit: false; extent: 150@75. t borderWidth: 2; margins: 4@0; useRoundedCorners. "Why not rounded?" "fancy font, shadow, rounded" t fontName: Preferences standardButtonFont familyName size: 18; textColor: Color blue; fillStyle: Color lightBrown. t addDropShadow.
"Strangeness here in order to avoid two offset copies of the default contents when operating in an mvc project before cursor enters the morphic window" t paragraph. ^ t! !
!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 8/11/2023 15:18'! extrasMenuOn: aDockingBar
aDockingBar addItem: [ :it| it contents: 'Extras' translated; addSubMenu: [:menu| menu addItem:[:item| item contents: 'Recover Changes' translated; help: 'Recover changes after a crash' translated; icon: MenuIcons smallDocumentClockIcon; target: ChangeList; selector: #browseRecentLog]. menu addItem:[:item| item contents: 'Recover Method Versions' translated; help: 'Recover versions of deleted methods' translated; target: ChangeList; selector: #browseMethodVersions]. menu addLine. menu addItem:[:item| item contents: 'Themes & Colors' translated; subMenuUpdater: self selector: #themesAndWindowColorsOn: ]. menu addItem:[:item| item contents: 'Scale Factor' translated; subMenuUpdater: self selector: #scaleFactorsOn:]. menu addItem:[:item| item contents: 'Language' translated; subMenuUpdater: self selector: #languageTranslatorsOn: ]. menu addItem:[:item| item contents: 'Set Author Initials' translated; help: 'Sets the author initials' translated; icon: MenuIcons smallUserQuestionIcon; target: Utilities; selector: #setAuthorInitials]. menu addItem:[:item| item contents: 'Restore Display (r)' translated; help: 'Redraws the entire display' translated; target: Project current; selector: #restoreDisplay]. menu addItem:[:item| item contents: 'Rebuild Menus' translated; help: 'Rebuilds the menu bar' translated; target: TheWorldMainDockingBar; selector: #updateInstances]. menu addLine. menu addItem:[:item| item contents: 'Start Profiler' translated; help: 'Starts the profiler' translated; icon: MenuIcons smallTimerIcon; target: self; selector: #startMessageTally]. menu addItem:[:item| item contents: 'Collect Garbage' translated; help: 'Run the garbage collector and report space usage' translated; target: Utilities; selector: #garbageCollectAndReport]. menu addItem:[:item| item contents: 'Purge Undo Records' translated; help: 'Save space by removing all the undo information remembered in all projects' translated; target: CommandHistory; selector: #resetAllHistory]. menu addItem:[:item| item contents: 'VM statistics' translated; help: 'Virtual Machine information' translated; target: self; selector: #vmStatistics]. menu addLine. menu addItem:[:item| item contents: 'Graphical Imports' translated; help: 'View the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList' translated; target: (Imports default); selector: #viewImages]. menu addItem:[:item| item contents: 'Browse My Changes' translated; help: 'Browse all of my changes since the last time #condenseSources was run.' translated; target: SystemNavigation new; selector: #browseMyChanges]. ] ]! !
!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 3/7/2023 13:59'! themesAndWindowColorsOn: menu | themes | menu addItem:[:item| item contents: 'Fonts' translated; subMenuUpdater: Preferences selector: #fontConfigurationMenu:; icon: MenuIcons smallFontsIcon]. menu addLine. menu addItem:[:item| item contents: (Model useColorfulWindows ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Colorful Windows' translated; target: self; selector: #toggleColorfulWindows]. menu addItem:[:item| item contents: (SystemWindow gradientWindow not ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Flat Widget Look' translated; target: self; selector: #toggleGradients]. menu addLine. menu addItem:[:item | item contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Soft Shadows' translated; target: self; selector: #toggleSoftShadows]. menu addItem:[:item | item contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow not]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Hard Shadows' translated; target: self; selector: #toggleHardShadows]. menu addLine. menu addItem:[:item | item contents: (SystemWindow roundedWindowCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Window/Dialog Look' translated; target: self; selector: #toggleRoundedWindowLook]. menu addItem:[:item | item contents: (PluggableButtonMorph roundedButtonCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Button/Scrollbar/Menu Look' translated; target: self; selector: #toggleRoundedButtonLook]. menu addLine. themes := UserInterfaceTheme allThemes asArray sort: #name ascending. themes := themes select: [ :each | each isGenuine]. themes ifEmpty: [ menu addItem: [ :item | item contents: '(No UI themes found.)' translated; isEnabled: false ] ]. themes do: [ :each | menu addItem: [ :item | item contents: (UserInterfaceTheme current name = each name ifTrue: ['<yes>'] ifFalse: ['<no>']), each name; target: each; selector: #applyScaled ] ]. menu addLine; add: 'Restore UI theme background' translated target: self selector: #restoreThemeBackground; add: 'Reset all UI themes' translated target: self selector: #resetAllThemes; add: 'Edit current UI theme...' translated target: self selector: #editCurrentTheme.! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/4/2023 13:59'! addObjectsAndTools: menu self fillIn: menu from: { nil. { 'objects (o)'. { #myWorld. #activateObjectsTool }. 'A tool for finding and obtaining many kinds of objects' }. { 'new morph...'. { self. #newMorph }. 'Offers a variety of ways to create new objects' }. nil. { 'flaps...'. { self. #flapsDo }. 'A menu relating to use of flaps. For best results, use "keep this menu up"' }. { 'projects...'. { self. #projectDo }. 'A menu of commands relating to use of projects' }. { 'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}. nil }! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:54'! addPrintAndDebug: menu self fillIn: menu from: { { 'make screenshot'. {self. #saveScreenshot}. 'makes a screenshot and saves it to disk'}. "{ 'print PS to file...'. { self. #printWorldOnFile }. 'write the world into a postscript file' }." { 'debug...'. { self. #debugDo }. 'a menu of debugging items' } }! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:58'! addUtilities: menu self fillIn: menu from: { { 'open...'. { self. #openWindow } }. { 'windows...'. { self. #windowsDo } }. { 'changes...'. { self. #changesDo } } }. self fillIn: menu from: { { 'help...'. { self. #helpDo }. 'puts up a menu of useful items for updating the system, determining what version you are running, and much else' }. { 'appearance...'. { self. #appearanceDo }. 'put up a menu offering many controls over appearance.' } }. self fillIn: menu from: { { 'do...'. { Utilities. #offerCommonRequests }. 'put up an editible list of convenient expressions, and evaluate the one selected.' } }! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:57'! appearanceMenu "Build the appearance menu for the world."
^self fillIn: (self menu: 'appearance...') from: {
{'preferences...' . { self . #openPreferencesBrowser} . 'Opens a "Preferences Browser" which allows you to alter many settings' } . {'preferences wizard...' . { self . #openPreferencesWizard} . 'Opens a "Preferences Wizard" which allows you to alter many settings in a guided fashion' } . {'choose set of preferences...' . { Preferences . #offerThemesMenu} . 'Presents you with a menu of sets or preferences; each item''s balloon-help will tell you about the particular set. If you choose one, many different preferences that come along are set at the same time; you can subsequently change any settings by using a Preferences Panel'} . nil . {'system fonts...' . { self . #standardFontDo} . 'Choose the standard fonts to use for code, lists, menus, window titles, etc.'}. nil. {'full screen on' . { DisplayScreen . #fullScreenOn} . 'puts you in full-screen mode, if not already there.'}. {'full screen off' . { DisplayScreen . #fullScreenOff} . 'if in full-screen mode, takes you out of it.'}. nil. {'set display depth...' . {self. #setDisplayDepth} . 'choose how many bits per pixel.'}. {'set desktop color...' . {self. #changeBackgroundColor} . 'choose a uniform color to use as desktop background.'}. {'set gradient color...' . {self. #setGradientColor} . 'choose second color to use as gradient for desktop background.'}.
}! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 7/31/2023 11:19'! helpMenu "Build the help menu for the world." | menu |
menu := self menu: 'help...'.
self fillIn: menu from: { {'about this system...'. {Smalltalk. #aboutThisSystem}. 'current version information.'}. {'update code from server'. {MCMcmUpdater. #updateFromServer}. 'load latest code updates via the internet'}. {'preferences...'. {self. #openPreferencesBrowser}. 'view and change various options.'}. {'set language...' . {Project. #chooseNaturalLanguage}. 'choose the language in which tiles should be displayed.'} . nil. {'command-key help'. { TheWorldMainDockingBar instance . #commandKeyHelp}. 'summary of keyboard shortcuts.'} }.
self addGestureHelpItemsTo: menu.
self fillIn: menu from: { {'world menu help'. { self . #worldMenuHelp}. 'helps find menu items buried in submenus.'}. "{'info about flaps' . { Utilities . #explainFlaps}. 'describes how to enable and use flaps.'}." {'font size summary' . { TextStyle . #fontSizeSummary}. 'summary of names and sizes of available fonts.'}. {'useful expressions' . { Utilities . #openStandardWorkspace}. 'a window full of useful expressions.'}. {'annotation setup...' . { Preferences . #editAnnotations}. 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools'}. nil. {'graphical imports' . { Imports default . #viewImages}. 'view the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList'}. nil. {'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}. {#soundEnablingString . { SoundService . #toggleSoundEnabled}. 'turning sound off will completely disable Squeak''s use of sound.'}. nil.
{'set author initials...' . { Utilities . #setAuthorInitials }. 'supply initials to be used to identify the author of code and other content.'}. {'vm statistics' . { self . #vmStatistics}. 'obtain some intriguing data about the vm.'}. nil. {'purge undo records' . { CommandHistory . #resetAllHistory }. 'save space by removing all the undo information remembered in all projects.'}. {'space left' . { self . #garbageCollect}. 'perform a full garbage-collection and report how many bytes of space remain in the image.'}. }.
^menu
! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/16/2023 11:24'! newMorph "The user requested 'new morph' from the world menu. Put up a menu that allows many ways of obtaining new morphs."
| menu |
menu := self menu: 'Add a new morph'. menu add: 'from paste buffer' translated target: myHand action: #pasteMorph; add: 'from alphabetical list' translated subMenu: self alphabeticalMorphMenu; add: 'from a file...' translated target: self action: #readMorphFromAFile. menu addLine. menu add: 'grab rectangle from screen' translated target: myWorld action: #grabDrawingFromScreen:; add: 'grab with lasso from screen' translated target: myWorld action: #grabLassoFromScreen:; add: 'grab rubber band from screen' translated target: myWorld action: #grabRubberBandFromScreen:; add: 'grab flood area from screen' translated target: myWorld action: #grabFloodFromScreen:. menu addLine. menu add: 'make link to project...' translated target: self action: #projectThumbnail.
self doPopUp: menu. ! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/11/2023 16:37'! openMenu "Build the open window menu for the world."
| menu | menu := self menu: 'open...'. menu defaultTarget: ToolSet default. menu addList: ToolSet menuItems. menu defaultTarget: self. self fillIn: menu from: { nil. {'file...' . { self . #openFileDirectly} . 'Lets you open a window on a single file'}. {'transcript (t)' . {self . #openTranscript}. 'A window used to report messages sent to Transcript' }. "{'inner world' . { WorldWindow . #test1} }." nil. }. self fillIn: menu from: self class registeredOpenCommands. menu addLine.
self fillIn: menu from: { {'morphic project' . {self. #openMorphicProject} . 'Creates a new morphic project'}. {'mvc project' . {self. #openMVCProject} . 'Creates a new project of the classic "mvc" style'} }.
^menu ! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/11/2023 16:37'! projectMenu "Build the project menu for the world." | menu |
self flag: #bob0302.
menu := self menu: 'projects...'. self fillIn: menu from: { { 'save on server (also makes a local copy)' . { #myProject . #storeOnServer } }. { 'save to a different server' . { #myProject . #saveAs } }. { 'save project on local file only' . { #myWorld . #saveOnFile } }. { 'see if server version is more recent...' . { #myProject . #loadFromServer } }. { 'load project from file...' . { self . #loadProject } }. nil. }.
self fillIn: menu from: { { 'create new morphic project' . { self . #openMorphicProject } }. { 'create new mvc project'. { self . #openMVCProject } }. }.
self fillIn: menu from: { nil. { 'go to previous project' . { Project . #returnToPreviousProject } }. { 'go to next project' . { Project . #advanceToNextProject } }. { 'jump to project...' . { #myWorld . #jumpToProject } }. }. self fillIn: menu from: { nil. { 'save for future revert' . { #myProject . #saveForRevert } }. { 'revert to saved copy' . { #myProject . #revert } }. }.
^ menu! !
!TheWorldMenu methodsFor: '*MorphicExtras-windows & flaps menu' stamp: 'mt 8/4/2023 15:18'! formulateFlapsMenu: aMenu "Fill aMenu with appropriate content"
aMenu addTitle: 'flaps' translated. aMenu addStayUpItem. Preferences classicNavigatorEnabled ifTrue: [aMenu addUpdating: #navigatorShowingString enablementSelector: #enableProjectNavigator target: Preferences selector: #toggle: argumentList: #(showProjectNavigator). aMenu balloonTextForLastItem: (Preferences preferenceAt: #showProjectNavigator) helpString translated].
Flaps sharedFlapsAllowed ifTrue: [self fillIn: aMenu from: {{#suppressFlapsString. {Project current. #toggleFlapsSuppressed}. 'Whether prevailing flaps should be shown in the project right now or not.'}}.
aMenu addUpdating: #automaticFlapLayoutString target: Preferences selector: #toggle: argumentList: #(automaticFlapLayout). aMenu balloonTextForLastItem: (Preferences preferenceAt: #automaticFlapLayout) helpString translated.
aMenu addLine. Flaps addIndividualGlobalFlapItemsTo: aMenu].
self fillIn: aMenu from: { nil.
{'make a new flap'. {Flaps. #addLocalFlap}. 'Create a new flap. You can later make it into a shared flap is you wish.'}.
nil.}. Flaps sharedFlapsAllowed ifTrue: [aMenu addWithLabel: 'put shared flaps on bottom' translated enablementSelector: #showSharedFlaps target: Flaps selector: #sharedFlapsAlongBottom argumentList: #(). aMenu balloonTextForLastItem: 'Group all the standard shared flaps along the bottom edge of the screen' translated.
self fillIn: aMenu from: { {'destroy all shared flaps'. {Flaps. #disableGlobalFlaps}. 'Destroy all the shared flaps and disable their use in all projects.'}}] ifFalse: [aMenu add: 'install default shared flaps' translated target: Flaps action: #enableGlobalFlaps. aMenu balloonTextForLastItem: 'Create the default set of shared flaps' translated. aMenu addLine].
self fillIn: aMenu from: { nil. {'about flaps...'. {Flaps . #explainFlaps}. 'Gives a window full of details about how to use flaps.'}}! !
!ThreePhaseButtonMorph class methodsFor: 'class initialization' stamp: 'mt 3/15/2023 14:11'! initialize "ThreePhaseButtonMorph initialize" | extent inset | extent := 12@12. inset := 3.
#('CheckBoxOff' 'CheckBoxOn' 'CheckBoxPressed') do: [:button | | f r | f := ColorForm extent: extent depth: 1. f colors: {Color transparent. Color black}. f borderWidth: 1. r := f boundingBox insetBy: inset. button = 'CheckBoxPressed' ifTrue: [f border: r width: 1]. button = 'CheckBoxOn' ifTrue: [f fillBlack: r]. MenuIcons saveForm: f atKey: button].
#('RadioButtonOff' 'RadioButtonOn' 'RadioButtonPressed') do: [:button | | f r c | f := ColorForm extent: extent depth: 1. f colors: {Color transparent. Color black}. r := f boundingBox. c := f getCanvas. c frameOval: r color: Color black. r := r insetBy: inset. button = 'RadioButtonPressed' ifTrue: [c frameOval: r color: Color black]. button = 'RadioButtonOn' ifTrue: [c fillOval: r color: Color black]. MenuIcons saveForm: f atKey: button]! !
!ThreePhaseButtonMorph class methodsFor: 'instance creation' stamp: 'mt 3/15/2023 14:09'! labelSymbol: aSymbol "(self labelSymbol: #TryIt) openInHand" | aButton form | aButton := ThreePhaseButtonMorph new. form := MenuIcons formAtKey: aSymbol. aButton offImage: form. aButton image: form. aButton pressedImage: (MenuIcons formPressedAtKey: aSymbol). ^ aButton! !
!ThumbnailMorph methodsFor: 'stepping' stamp: 'mt 8/28/2023 14:37'! stepTime "Adjust my step time to the time it takes drawing my referent" drawTime ifNil:[^ 250]. ^(20 * drawTime) max: 250.! !
!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'! actualViewee "Return the actual morph to be viewed, or nil if there isn't an appropriate morph to view."
| aMorph actualViewee | aMorph := self morphToView ifNil: [^ nil]. aMorph isInWorld ifFalse: [^ nil]. actualViewee := viewSelector ifNil: [aMorph] ifNotNil: [objectToView perform: viewSelector]. actualViewee == 0 ifTrue: [^ nil]. "valueAtCursor result for an empty HolderMorph" actualViewee ifNil: [actualViewee := objectToView]. (actualViewee isMorph and: [actualViewee isFlexMorph and: [actualViewee submorphs size = 1]]) ifTrue: [actualViewee := actualViewee firstSubmorph]. ^ actualViewee! !
!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'! formOrMorphToView "Answer the form to be viewed, or the morph to be viewed, or nil"
| actualViewee | (objectToView isForm) ifTrue: [^objectToView]. actualViewee := viewSelector ifNil: [objectToView] ifNotNil: [objectToView perform: viewSelector]. ^actualViewee == 0 ifTrue: [nil "valueAtCursor result for an empty HolderMorph"] ifFalse: [actualViewee]! !
!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'! morphToView "If the receiver is viewing some object, answer a morph can be thought of as being viewed; A gesture is made toward generalizing this beyond the morph/player regime, in that a plain blue rectangle is returned rather than simply failing if the referent is not itself displayable."
objectToView ifNil: [^ nil]. ^ objectToView isMorph ifTrue: [objectToView] ifFalse: [RectangleMorph new color: Color blue]! !
!TransformationMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 15:02'! removeFlexShell "Remove the shell used to make a morph rotatable and scalable."
| oldHalo unflexed myWorld refPos aPosition | self isInWorld ifFalse: [^self]. refPos := self referencePosition. myWorld := self world. oldHalo := self halo. submorphs isEmpty ifTrue: [^ self delete]. aPosition := (owner submorphIndexOf: self) ifNil: [1]. unflexed := self firstSubmorph. self submorphs do: [:m | m position: self center - (m extent // 2). owner addMorph: m asElementNumber: aPosition]. unflexed absorbStateFromRenderer: self. oldHalo ifNotNil: [oldHalo setTarget: unflexed]. myWorld ifNotNil: [myWorld startSteppingSubmorphsOf: unflexed]. self delete. unflexed referencePosition: refPos. ^ unflexed! !
!TransformationMorph methodsFor: 'private' stamp: 'mt 3/10/2023 11:18'! adjustAfter: changeBlock "Cause this morph to remain centered where it was before, and choose appropriate smoothing, after a change of scale or rotation." | oldRefPos | oldRefPos := self referencePosition. changeBlock value. self chooseSmoothing. self layoutChanged. owner ifNotNil: [owner invalidRect: bounds] ! !
!TranslucentProgessMorph methodsFor: 'drawing' stamp: 'mt 3/7/2023 15:07'! drawOn: aCanvas
| revealPercentage revealingStyle revealingColor revealingBounds revealToggle x baseColor revealTimes secondsRemaining stringToDraw where fontToUse innerBounds | innerBounds := bounds. opaqueBackgroundColor ifNotNil: [ aCanvas frameAndFillRectangle: bounds fillColor: opaqueBackgroundColor borderWidth: 8 borderColor: Color blue. innerBounds := innerBounds insetBy: 8. ]. revealTimes := (self valueOfProperty: #revealTimes) ifNil: [^self]. revealPercentage := (revealTimes first / revealTimes second) asFloat. revealingStyle := self revealingStyle. x := self valueOfProperty: #progressStageNumber ifAbsent: [1]. baseColor := Color perform: (#(red blue green magenta cyan yellow) atPin: x). revealingColor := baseColor alpha: 0.2. revealingStyle = 3 ifTrue: [ "wrap and change color" revealPercentage > 1.0 ifTrue: [ revealingColor := baseColor alpha: (0.2 + (revealingStyle / 10) min: 0.5). ]. revealPercentage := revealPercentage fractionPart. ]. revealingStyle = 2 ifTrue: [ "peg at 75 and blink" revealPercentage > 0.75 ifTrue: [ revealToggle := self valueOfProperty: #revealToggle ifAbsent: [true]. self setProperty: #revealToggle toValue: revealToggle not. revealToggle ifTrue: [revealingColor := baseColor alpha: 0.8.]. ]. revealPercentage := revealPercentage min: 0.75. ]. revealingBounds := innerBounds withLeft: innerBounds left + (innerBounds width * revealPercentage) truncated. aCanvas fillRectangle: revealingBounds color: revealingColor. secondsRemaining := (revealTimes second - revealTimes first / 1000) rounded. secondsRemaining > 0 ifTrue: [ fontToUse := StrikeFont familyName: Preferences standardButtonFont familyName size: 24. stringToDraw := secondsRemaining printString. where := innerBounds corner - ((fontToUse widthOfString: stringToDraw) @ fontToUse height). aCanvas drawString: stringToDraw in: (where corner: innerBounds corner) font: fontToUse color: Color black. aCanvas drawString: stringToDraw in: (where - (1@1) corner: innerBounds corner) font: fontToUse color: Color white. ].
! !
!TrashCanMorph methodsFor: 'event handling' stamp: 'mt 8/11/2023 13:45'! doubleClick: evt evt hand world addMorphCentered: ScrapBook default scrapBook! !
!UpdatingRectangleMorph methodsFor: 'setting' stamp: 'mt 3/10/2023 15:02'! valueProvider "Answer the object to which my get/set messages should be sent. This is inefficient and contorted in order to support grandfathered content for an earlier design"
^ target! !
!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:28'! decimalPlaces: aNumber "Set the receiver's number of decimal places to be shown."
| constrained | self setProperty: #decimalPlaces toValue: (constrained := aNumber min: 11). self pvtFloatPrecision: (Utilities floatPrecisionForDecimalPlaces: constrained).! !
!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 15:45'! target: anObject
target := anObject. floatPrecision := 1. ! !
!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:02'! valueFromContents "Return a new value from the current contents string."
format = #symbol ifTrue: [^ lastValue]. format = #string ifTrue: [^ contents]. ^ Compiler evaluate: contents ! !
!UpdatingStringMorph methodsFor: 'target access' stamp: 'mt 3/10/2023 14:13'! readFromTarget "Update my readout from my target"
| v ret | (target isNil or: [getSelector isNil]) ifTrue: [^contents]. ret := self checkTarget. ret ifFalse: [^ '0']. v := target perform: getSelector. "scriptPerformer" (v isKindOf: Text) ifTrue: [v := v asString]. ^self acceptValueFromTarget: v! !
!UserInterfaceTheme methodsFor: 'private - fonts' stamp: 'mt 7/31/2023 11:21'! installSystemFont: aFont "Establish the default text font and style. Update the #defaultFontIndex in all known text styles to reflect the system's new default point size."
| aStyle | self flag: #todo. "mt: Support derivatives such as bold and italic." aStyle := aFont textStyleOrNil. "mt: Must be installed and thus never be nil!!" aStyle defaultFontIndex: (aStyle fontIndexOfPointSize: aFont pointSize "drop emphasis").
TextStyle setDefault: aStyle. TextStyle actualTextStyles "no defaults" do: [:ea | ea isTTCStyle ifTrue: [ea defaultFont asPointSize: aFont pointSize "May generate new pointSize"]. ea defaultFontIndex: (ea fontIndexOfPointSize: aFont pointSize)]. RealEstateAgent resetScaleFactor. Flaps replaceToolsFlap.! !
!CommunityTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addDarkWindowColors: aUserInterfaceTheme "self createDark apply." aUserInterfaceTheme set: #uniformWindowColor for: #Model to: Color darkGray; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color darker] ]; set: #unfocusedLabelColor for: #SystemWindow to: Color veryLightGray; set: #focusedLabelColor for: #SystemWindow to: Color white;
set: #customWindowColor for: #Browser to: self dbBlue; set: #customWindowColor for: #ChangeList to: self dbBlue; set: #customWindowColor for: #ChangeSorter to: self dbBlue; set: #customWindowColor for: #ChatNotes to: self dbPurple twiceDarker; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self dbPurple twiceDarker; set: #customWindowColor for: #Debugger to: self dbRed; set: #customWindowColor for: #DualChangeSorter to: self dbOrange twiceDarker; set: #customWindowColor for: #FileContentsBrowser to: self dbGray; set: #customWindowColor for: #FileList to: self dbGray; set: #customWindowColor for: #Inspector to: self dbYellow duller; set: #customWindowColor for: #InstanceBrowser to: self dbYellow duller; set: #customWindowColor for: #Lexicon to: self dbGreen; set: #customWindowColor for: #MCTool to: self dbOrange twiceDarker; set: #customWindowColor for: #MessageNames to: self dbGreen; set: #customWindowColor for: #MessageSet to: self dbGreen; set: #customWindowColor for: #ObjectExplorer to: self dbYellow duller; set: #customWindowColor for: #PackagePaneBrowser to: self dbBlue; set: #customWindowColor for: #PluggableFileList to: self dbGray; set: #customWindowColor for: #PreferenceBrowser to: self dbBlue; set: #customWindowColor for: #ProcesBrowser to: self dbAqua; set: #customWindowColor for: #SMLoader to: self dbOrange twiceDarker; set: #customWindowColor for: #SMLoaderPlus to: self dbOrange twiceDarker; set: #customWindowColor for: #SMReleaseBrowser to: self dbOrange twiceDarker; set: #customWindowColor for: #SelectorBrowser to: self dbBlue; set: #customWindowColor for: #StringHolder to: self dbGray; set: #customWindowColor for: #TestRunner to: self dbPink darker; set: #customWindowColor for: #TranscriptStream to: self dbGray; set: #customWindowColor for: #VersionsBrowser to: self dbPurple twiceDarker; set: #customWindowColor for: #Workspace to: self dbPink darker.! !
!MonokaiTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addDarkWindowColors: theme "self createDark apply." theme set: #uniformWindowColor for: #Model to:( self invisibleColor adjustBrightness: 0.16) "lighter twice"; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: -0.16 "darker twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: [ Model useColorfulWindows ifTrue: [(Color r: 0.285 g: 0.282 b: 0.242) "invisible color"] ifFalse: [(Color r: 0.972 g: 0.972 b: 0.948) "foreground color"] ]; set: #focusedLabelColor for: #SystemWindow to: [ Model useColorfulWindows ifTrue: [(Color r: 0.152 g: 0.156 b: 0.133) "background color"] ifFalse: [(Color r: 0.901 g: 0.858 b: 0.455) "yellow"] ];
set: #customWindowColor for: #Browser to: self green duller; set: #customWindowColor for: #ChangeList to: self blue duller; set: #customWindowColor for: #ChangeSorter to: self blue duller; set: #customWindowColor for: #ChatNotes to: self magenta duller; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet duller; set: #customWindowColor for: #Debugger to: self red duller; set: #customWindowColor for: #DualChangeSorter to: self blue duller; set: #customWindowColor for: #FileContentsBrowser to: self yellow duller; set: #customWindowColor for: #FileList to: self yellow duller; set: #customWindowColor for: #InstanceBrowser to: self cyan duller; set: #customWindowColor for: #Lexicon to: self cyan duller; set: #customWindowColor for: #MCTool to: self violet duller; set: #customWindowColor for: #MessageNames to: self green duller; set: #customWindowColor for: #MessageSet to: self cyan duller; set: #customWindowColor for: #PackagePaneBrowser to: self green duller; set: #customWindowColor for: #PluggableFileList to: self yellow duller; set: #customWindowColor for: #PreferenceBrowser to: self cyan duller; set: #customWindowColor for: #SMLoader to: self orange duller; set: #customWindowColor for: #SMLoaderPlus to: self orange duller; set: #customWindowColor for: #SMReleaseBrowser to: self orange duller; set: #customWindowColor for: #SelectorBrowser to: self cyan duller; set: #customWindowColor for: #StringHolder to: self yellow duller; set: #customWindowColor for: #TestRunner to: self orange duller; set: #customWindowColor for: #TranscriptStream to: self orange duller; set: #customWindowColor for: #VersionsBrowser to: self violet duller.! !
!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addDarkWindowColors: theme "doIt: [self createDark apply.]"
theme set: #uniformWindowColor for: #Model to: (self darkBackgroundHighlights adjustBrightness: 0.16 "lighter twice");
set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: -0.16 "darker twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: self darkContentEmphasized; set: #focusedLabelColor for: #SystemWindow to: self darkContentEmphasizedMore;
set: #customWindowColor for: #Browser to: self green; set: #customWindowColor for: #ChangeList to: self blue; set: #customWindowColor for: #ChangeSorter to: self blue; set: #customWindowColor for: #ChatNotes to: self magenta; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet; set: #customWindowColor for: #Debugger to: self red; set: #customWindowColor for: #DualChangeSorter to: self blue; set: #customWindowColor for: #FileContentsBrowser to: self yellow; set: #customWindowColor for: #FileList to: self yellow; set: #customWindowColor for: #InstanceBrowser to: self cyan; set: #customWindowColor for: #Lexicon to: self cyan; set: #customWindowColor for: #MCTool to: self violet; set: #customWindowColor for: #MessageNames to: self green; set: #customWindowColor for: #MessageSet to: self cyan; set: #customWindowColor for: #PackagePaneBrowser to: self green; set: #customWindowColor for: #PluggableFileList to: self yellow; set: #customWindowColor for: #PreferenceBrowser to: self cyan; set: #customWindowColor for: #SMLoader to: self orange; set: #customWindowColor for: #SMLoaderPlus to: self orange; set: #customWindowColor for: #SMReleaseBrowser to: self orange; set: #customWindowColor for: #SelectorBrowser to: self cyan; set: #customWindowColor for: #StringHolder to: self yellow; set: #customWindowColor for: #TestRunner to: self orange; set: #customWindowColor for: #TranscriptStream to: self orange; set: #customWindowColor for: #VersionsBrowser to: self violet.! !
!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addLightWindowColors: theme "You have to create dark first. doIt: [self createDark. self createLight apply.]"
theme set: #uniformWindowColor for: #Model to: (self lightBackgroundHighlights adjustBrightness: -0.16 "darker twice");
set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: 0.16 "lighter twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: self lightContentEmphasized; set: #focusedLabelColor for: #SystemWindow to: self lightContentEmphasizedMore;
set: #customWindowColor for: #Browser to: self green; set: #customWindowColor for: #ChangeList to: self blue; set: #customWindowColor for: #ChangeSorter to: self blue; set: #customWindowColor for: #ChatNotes to: self magenta; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet; set: #customWindowColor for: #Debugger to: (self red adjustSaturation: -0.27 brightness: 0.27); set: #customWindowColor for: #DualChangeSorter to: self blue; set: #customWindowColor for: #FileContentsBrowser to: self yellow; set: #customWindowColor for: #FileList to: self yellow; set: #customWindowColor for: #InstanceBrowser to: self cyan; set: #customWindowColor for: #Lexicon to: self cyan; set: #customWindowColor for: #MCTool to: self violet; set: #customWindowColor for: #MessageNames to: self green; set: #customWindowColor for: #MessageSet to: self cyan; set: #customWindowColor for: #PackagePaneBrowser to: self green; set: #customWindowColor for: #PluggableFileList to: self yellow; set: #customWindowColor for: #PreferenceBrowser to: self cyan; set: #customWindowColor for: #SMLoader to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SMLoaderPlus to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SMReleaseBrowser to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SelectorBrowser to: self cyan; set: #customWindowColor for: #StringHolder to: self yellow; set: #customWindowColor for: #TestRunner to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #TranscriptStream to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #VersionsBrowser to: self violet.! !
!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addDullerWindowColors: theme
theme set: #uniformWindowColor for: #Model to: Color veryVeryLightGray duller; set: #customWindowColor for: #Browser to: (Color r: 0.764 g: 0.9 b: 0.63) duller; set: #customWindowColor for: #ChangeList to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #ChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #ChatNotes to: (Color r: 1.0 g: 0.7 b: 0.8) duller; set: #customWindowColor for: #ClassCommentVersionsBrowser to: (Color r: 0.753 g: 0.677 b: 0.9) duller; set: #customWindowColor for: #Debugger to: (Color r: 0.9 g: 0.719 b: 0.719) duller; set: #customWindowColor for: #DualChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #FileContentsBrowser to: (Color r: 0.7 g: 0.7 b: 0.508) duller; set: #customWindowColor for: #FileList to: (Color r: 0.65 g: 0.65 b: 0.65) duller; set: #customWindowColor for: #InstanceBrowser to: (Color r: 0.726 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #Lexicon to: (Color r: 0.79 g: 0.9 b: 0.79) duller; set: #customWindowColor for: #MCTool to: (Color r: 0.65 g: 0.691 b: 0.876) duller; set: #customWindowColor for: #MessageNames to: (Color r: 0.639 g: 0.9 b: 0.497) duller; set: #customWindowColor for: #MessageSet to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #PackagePaneBrowser to: (Color r: 0.9 g: 0.9 b: 0.63) duller; set: #customWindowColor for: #PluggableFileList to: Color lightYellow duller; set: #customWindowColor for: #PreferenceBrowser to: (Color r: 0.671 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #SMLoader to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SMLoaderPlus to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SMReleaseBrowser to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SelectorBrowser to: (Color r: 0.45 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #StringHolder to: (Color r: 0.9 g: 0.9 b: 0.719) duller; set: #customWindowColor for: #TestRunner to: (Color r: 0.9 g: 0.576 b: 0.09) duller; set: #customWindowColor for: #TranscriptStream to: (Color r: 0.9 g: 0.75 b: 0.45) duller; set: #customWindowColor for: #VersionsBrowser to: (Color r: 0.782 g: 0.677 b: 0.9) duller.! !
!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addWindowColors: theme
theme set: #titleFont for: #SystemWindow to: [Preferences windowTitleFont]; set: #borderColorModifier for: #SystemWindow to: [ [:c | c adjustBrightness: -0.3] ]; set: #borderColorModifier for: #ScrollPane to: [ [:c | c adjustBrightness: -0.3] ]; set: #borderWidth for: #SystemWindow to: 1; derive: #resizerColorModifier for: #AbstractResizerMorph from: #SystemWindow at: #borderColorModifier; set: #uniformWindowColor for: #Model to: Color veryVeryLightGray; derive: #uniformWindowColor for: #TranscriptStream from: #Model; derive: #color for: #SystemWindow from: #Model at: #uniformWindowColor; "Fall back for windows without models." set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color darker] ]; set: #unfocusedLabelColor for: #SystemWindow to: Color darkGray; set: #focusedLabelColor for: #SystemWindow to: Color black;
set: #customWindowColor for: #Browser to: (Color r: 0.764 g: 0.9 b: 0.63); set: #customWindowColor for: #ChangeList to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #ChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #ChatNotes to: (Color r: 1.0 g: 0.7 b: 0.8); set: #customWindowColor for: #ClassCommentVersionsBrowser to: (Color r: 0.753 g: 0.677 b: 0.9); set: #customWindowColor for: #Debugger to: (Color r: 0.9 g: 0.719 b: 0.719); set: #customWindowColor for: #DualChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #FileContentsBrowser to: (Color r: 0.7 g: 0.7 b: 0.508); set: #customWindowColor for: #FileList to: (Color r: 0.65 g: 0.65 b: 0.65); set: #customWindowColor for: #InstanceBrowser to: (Color r: 0.726 g: 0.9 b: 0.9); set: #customWindowColor for: #Lexicon to: (Color r: 0.79 g: 0.9 b: 0.79); set: #customWindowColor for: #MCTool to: (Color r: 0.65 g: 0.691 b: 0.876); set: #customWindowColor for: #MessageNames to: (Color r: 0.639 g: 0.9 b: 0.497); set: #customWindowColor for: #MessageSet to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #PackagePaneBrowser to: (Color r: 0.9 g: 0.9 b: 0.63); set: #customWindowColor for: #PluggableFileList to: Color lightYellow; set: #customWindowColor for: #PreferenceBrowser to: (Color r: 0.671 g: 0.9 b: 0.9); set: #customWindowColor for: #SMLoader to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SMLoaderPlus to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SMReleaseBrowser to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SelectorBrowser to: (Color r: 0.45 g: 0.9 b: 0.9); set: #customWindowColor for: #StringHolder to: (Color r: 0.9 g: 0.9 b: 0.719); set: #customWindowColor for: #TestRunner to: (Color r: 0.9 g: 0.576 b: 0.09); set: #customWindowColor for: #TranscriptStream to: (Color r: 0.9 g: 0.75 b: 0.45); set: #customWindowColor for: #VersionsBrowser to: (Color r: 0.782 g: 0.677 b: 0.9).! !
!TrimTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addWindowColors: theme | windowColorBrightnessAdjustment | windowColorBrightnessAdjustment := -0.35. theme set: #titleFont for: #SystemWindow to: [Preferences windowTitleFont]; set: #borderColorModifier for: #SystemWindow to: [ [:c | c adjustBrightness: -0.1] ]; set: #borderColorModifier for: #ScrollPane to: [ [:c | c adjustBrightness: 0.1] ]; set: #borderWidth for: #SystemWindow to: 1; set: #uniformWindowColor for: #Model to: self gray76; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color alphaMixed: 0.5 with: self gray40] ]; set: #unfocusedLabelColor for: #SystemWindow to: self gray168; set: #focusedLabelColor for: #SystemWindow to: Color white;
set: #customWindowColor for: #Browser to: ((Color r: 0.764 g: 0.9 b: 0.63) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChangeList to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChangeSorter to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChatNotes to: ((Color r: 1.0 g: 0.7 b: 0.8) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ClassCommentVersionsBrowser to: ((Color r: 0.753 g: 0.677 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #Debugger to: ((Color r: 0.9 g: 0.719 b: 0.719) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #DualChangeSorter to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #FileContentsBrowser to: ((Color r: 0.7 g: 0.7 b: 0.508) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #FileList to: ((Color r: 0.65 g: 0.65 b: 0.65) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #InstanceBrowser to: ((Color r: 0.726 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #Lexicon to: ((Color r: 0.79 g: 0.9 b: 0.79) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MCTool to: ((Color r: 0.65 g: 0.691 b: 0.876) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MessageNames to: ((Color r: 0.639 g: 0.9 b: 0.497) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MessageSet to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PackagePaneBrowser to: ((Color r: 0.9 g: 0.9 b: 0.63) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PluggableFileList to: (Color lightYellow adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PreferenceBrowser to: ((Color r: 0.671 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMLoader to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMLoaderPlus to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMReleaseBrowser to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SelectorBrowser to: ((Color r: 0.45 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #StringHolder to: ((Color r: 0.9 g: 0.9 b: 0.719) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #TestRunner to: ((Color r: 0.9 g: 0.576 b: 0.09) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #TranscriptStream to: ((Color r: 0.9 g: 0.75 b: 0.45) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #VersionsBrowser to: ((Color r: 0.782 g: 0.677 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment).! !
!Utilities class methodsFor: 'common requests' stamp: 'mt 8/11/2023 15:01'! initializeCommonRequestStrings "Initialize the common request strings, a directly-editable list of expressions that can be evaluated from the 'do...' menu."
CommonRequestStrings := StringHolder new contents: 'Utilities emergencyCollapse. Utilities closeAllDebuggers. RecentMessages default revertMostRecent. - MCFileBasedRepository flushAllCaches - Sensor keyboard. ParagraphEditor abandonChangeText. Cursor normal show. - CommandHistory resetAllHistory. Project allInstancesDo: [:p | p displayDepth: 16]. ScriptingSystem inspectFormDictionary. Form fromUser bitEdit. Display border: (0@0 extent: 640@480) width: 2. - Undeclared inspect. Undeclared removeUnreferencedKeys; inspect. Transcript clear. GIFReadWriter grabScreenAndSaveOnDisk. FrameRateMorph new openInHand. - Utilities reconstructTextWindowsFromFileNamed: ''TW''. Utilities storeTextWindowContentsToFileNamed: ''TW''. ChangeSet removeEmptyUnnamedChangeSets. ChangesOrganizer reorderChangeSets.'
"Utilities initializeCommonRequestStrings"! !
!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:55'! addControls | slider aWrapper m aButton | aWrapper := AlignmentMorph newRow. aWrapper color: Color transparent; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 @ 5. aWrapper wrapCentering: #topLeft. aButton := self buttonName: 'X' action: #delete. aButton setBalloonText: 'Close WaveEditor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Menu' translated action: #invokeMenu. aButton setBalloonText: 'Open a menu' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play' translated action: #play. aButton setBalloonText: 'Play sound' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play Before' translated action: #playBeforeCursor. aButton setBalloonText: 'Play before cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play After' translated action: #playAfterCursor. aButton setBalloonText: 'Play after cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play Loop' translated action: #playLoop. aButton setBalloonText: 'Play the loop' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Test' translated action: #playTestNote. aButton setBalloonText: 'Test the note' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Save' translated action: #saveInstrument. aButton setBalloonText: 'Save the sound' translated. aWrapper addMorphBack: aButton.
aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set Loop End' translated action: #setLoopEnd. aButton setBalloonText: 'Set loop end at cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set One Cycle' translated action: #setOneCycle. aButton setBalloonText: 'Set one cycle' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set Loop Start' translated action: #setLoopStart. aButton setBalloonText: 'Set the loop start at cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. self addMorphBack: aWrapper. aWrapper := AlignmentMorph newRow. aWrapper color: self color; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5 @ 20; wrapCentering: #center; cellPositioning: #leftCenter. m := StringMorph new contents: 'Index: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #cursor; putSelector: #cursor:; font: Preferences standardButtonFont; growable: false; width: 71; step. aWrapper addMorphBack: m. m := StringMorph new contents: 'Value: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #valueAtCursor; putSelector: #valueAtCursor:; font: Preferences standardButtonFont; growable: false; width: 50; step. aWrapper addMorphBack: m. slider := SimpleSliderMorph new color: color; extent: 200 @ 10; target: self; actionSelector: #scrollTime:. aWrapper addMorphBack: slider. m := Morph new color: aWrapper color; extent: 10 @ 5. "spacer" aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #startIndex; putSelector: #startIndex:; font: Preferences standardButtonFont; width: 40; step. aWrapper addMorphBack: m. self addMorphBack: aWrapper! !
!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:56'! addLoopPointControls
| m aWrapper | aWrapper := AlignmentMorph newRow. aWrapper color: self color; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
m := StringMorph new contents: 'Loop end: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopEnd; putSelector: #loopEnd:; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Loop length: ' translated ; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopLength; putSelector: #loopLength:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Loop cycles: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopCycles; putSelector: #loopCycles:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Frequency: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #perceivedFrequency; putSelector: #perceivedFrequency:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m.
self addMorphBack: aWrapper ! !
!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:53'! buttonName: aString action: aSymbol "Create a button with the given label and action selector, and answer it."
^ SimpleButtonMorph new target: self; label: aString font: Preferences standardButtonFont; actionSelector: aSymbol! !
WebCamMorph class removeSelector: #additionsToViewerCategories! SymbolListType removeSelector: #initialValueForASlotFor:! StringType removeSelector: #initialValueForASlotFor:! SoundType removeSelector: #initialValueForASlotFor:! PointType removeSelector: #initialValueForASlotFor:! NumberType removeSelector: #initialValueForASlotFor:! GraphicType removeSelector: #initialValueForASlotFor:!
!GraphicType reorganize! ('initial value') ('initialization' initialize) !
ColorType removeSelector: #initialValueForASlotFor:! BooleanType removeSelector: #initialValueForASlotFor:! DataType removeSelector: #initialValueForASlotFor:! Vocabulary removeSelector: #isEToyVocabulary! UpdatingStringMorph removeSelector: #isEtoyReadout!
!UpdatingStringMorph reorganize! ('accessing' autoAcceptOnFocusLoss autoAcceptOnFocusLoss: decimalPlaces decimalPlaces: floatPrecision format getSelector getSelector: growable growable: maximumWidth maximumWidth: minWidth minWidth: putSelector putSelector: pvtFloatPrecision: target target: valueFromContents) ('copying' veryDeepFixupWith: veryDeepInner:) ('editing' acceptContents acceptValue: addCustomMenuItems:hand: doneWithEdits lostFocusWithoutAccepting setDecimalPlaces: setFontSize setFontStyle setPrecision setToAllowTextEdit toggleGrowability userEditsAllowed) ('event handling' handlesMouseDown: mouseDown: wouldAcceptKeyboardFocus) ('events-processing' handlerForMouseDown:) ('formats' useDefaultFormat useStringFormat useSymbolFormat) ('initialization' defaultMaximumWidth defaultMinimumWidth initialize) ('stepping' step stepTime stepTime: updateContentsFrom:) ('target access' acceptValueFromTarget: checkTarget informTarget readFromTarget setDecimalPlacesFromTypeIn: stringForNumericValue:) ('layout' fitContents) ('*MorphicExtras-accessing' floatPrecision:) !
UpdatingRectangleMorph removeSelector: #isEtoyReadout!
!UpdatingRectangleMorph reorganize! ('accessing' contents contents: getSelector getSelector: putSelector putSelector: target target: userEditsAllowed) ('copying' veryDeepFixupWith: veryDeepInner:) ('event handling' handlesMouseDown: mouseUp:) ('initialization' defaultBorderColor) ('setting' setTargetColor: valueProvider) ('stepping' step stepTime) ('target access' readFromTarget) !
UpdatingMenuItemMorph removeSelector: #adaptToWorld:! ThumbnailMorph removeSelector: #isEtoyReadout!
!ThumbnailMorph reorganize! ('accessing' getSelector getSelector: putSelector target) ('caching' releaseCachedState) ('copying' veryDeepFixupWith: veryDeepInner:) ('display' drawForForm:on: drawMeOn: scaleFor:in:) ('drawing' drawOn:) ('initialization' defaultBorderWidth defaultColor initialize objectToView: objectToView:viewSelector:) ('stepping' step stepTime) ('texture support' installAsWonderlandTextureOn:) ('what to view' actualViewee formOrMorphToView morphToView) !
ThreePhaseButtonMorph initialize!
!ThreePhaseButtonMorph class reorganize! ('class initialization' initialize) ('instance creation' checkBox labelSymbol: radioButton) ('preferences' themeProperties) !
ThreePhaseButtonMorph removeSelector: #adaptToWorld:! TheWorldMenu removeSelector: #adaptToWorld:! TheWorldMenu removeSelector: #menuColorString! TheWorldMenu removeSelector: #mvcProjectsAllowed! TheWorldMenu removeSelector: #roundedCornersString! TheWorldMenu removeSelector: #toggleMenuColorPolicy!
!TheWorldMenu reorganize! ('action' commandKeyTypedIntoMenu: doMenuItem:with: projectThumbnail saveScreenshot setGradientColor soundEnablingString staggerPolicyString toggleRoundedCorners toggleWindowPolicy) ('commands' changeBackgroundColor cleanUpWorld garbageCollect loadProject lookForSlips newMorphOfClass:event: openBrowser openFileDirectly openFileList openMorphicProject openMVCProject openPreferencesBrowser openPreferencesWizard openTranscript openWorkspace projectForMyWorld quitSession readMorphFromAFile saveAndQuit saveWorldInFile setDisplayDepth splitNewMorphList:depth: startMessageTally vmStatistics worldMenuHelp) ('construction' addObjectsAndTools: addPrintAndDebug: addProjectEntries: addRestoreDisplay: addSaveAndQuit: addUtilities: alphabeticalMorphMenu appearanceMenu buildWorldMenu changesMenu colorForDebugging: debugMenu fillIn:from: helpMenu makeConvenient: newMorph openMenu projectMenu remoteMenu) ('mechanics' menu: world:project:hand:) ('menu' addGestureHelpItemsTo:) ('popups' appearanceDo changesDo debugDo doPopUp: helpDo openWindow projectDo remoteDo standardFontDo) ('windows & flaps menu' suppressFlapsString windowsDo windowsMenu) ('*MorphicExtras-action' createStandardPartsBin launchCustomPartsBin toggleFlapSuppressionInProject) ('*MorphicExtras-construction' myMenuColor) ('*MorphicExtras-mechanics') ('*MorphicExtras-windows & flaps menu' flapsDo flapsMenu formulateFlapsMenu: globalFlapsEnabled newGlobalFlapString) ('*Tools' browseRecentLog openChangeSorter1 openChangeSorter2 openMessageNames openProcessBrowser openSelectorBrowser startThenBrowseMessageTally) ('*MorphicExtras-Postscript Canvases' printWorldOnFile) !
TextMorphForEditView removeSelector: #wouldAcceptKeyboardFocusUponTab!
!TextMorph class reorganize! ('class initialization' cleanUp defaultEditorClass defaultEditorClass: initialize registerInFlapsRegistry unload) ('connectorstext-parts bin' boldAuthoringPrototype) ('new-morph participation' includeInNewMorphMenu) ('parts bin' borderedPrototype exampleBackgroundLabel fancyPrototype) ('scripting' authoringPrototype defaultNameStemForInstances) ('instance creation' string:fontName: string:fontName:size: string:fontName:size:wrap: string:size:) ('*MorphicExtras-parts bin' supplementaryPartsDescriptions) !
TextMorph removeSelector: #cursor! TextMorph removeSelector: #cursorWrapped:! TextMorph removeSelector: #getAllButFirstCharacter! TextMorph removeSelector: #holderForCharacters! TextMorph removeSelector: #insertCharacters:! TextMorph removeSelector: #insertContentsOf:! TextMorph removeSelector: #setAllButFirstCharacter:! TextMorph removeSelector: #wouldAcceptKeyboardFocusUponTab!
!TextMorph reorganize! ('accessing' autoFit: backgroundColor backgroundColor: borderWidth: caretColor caretColor: contents contentsAsIs: contentsWrapped: contents: contents:wrappedTo: crAction crAction: editor elementCount font: getFirstCharacter getLastCharacter hasTranslucentColor isAutoFit isWrapped margins margins: newContents: plainTextOnly plainTextOnly: readOnly readOnly: selectAll selectFrom:to: selectInterval: selection selectionColor selectionColor: selectionInterval selectionInterval: setCharacters: setFirstCharacter: setLastCharacter: text textAlignment textAlignmentSymbol textColor textColor: textStyle textStyle: unfocusedSelectionColor unfocusedSelectionColor: userString wrapFlag:) ('alignment' centered justified leftFlush rightFlush) ('anchors' adjustTextAnchor: anchorMorph:at:type:) ('caching' loadCachedState releaseCachedState) ('change reporting' ownerChanged) ('classification' isTextMorph) ('containment' avoidsOcclusions fillingOnOff fillsOwner fillsOwner: occlusionsOnOff recognizerArena setContainer:) ('copying' copy veryDeepFixupWith: veryDeepInner:) ('drawing' areasRemainingToFill: debugDrawLineRectsOn: drawNullTextOn: drawOn:) ('editing' acceptContents acceptOnCR cancelEdits cancelEditsSafely chooseAlignment chooseEmphasis chooseEmphasisOrAlignment chooseFont chooseStyle handleEdit: handleInteraction:fromEvent: hasUnacceptedEdits: passKeyboardFocusTo: setCompositionWindow xeqLinkText:withParameter:) ('event handling' click: getMenu: handlesKeyboard: handlesMouseDown: handlesMouseMove: handlesMouseOver: handlesMouseStillDown: hasFocus keyboardFocusChange: keyStroke: mouseDown: mouseEnter: mouseLeave: mouseMove: mouseUp: startDrag: wantsKeyboardFocus yellowButtonActivity:) ('events-processing' handleKeystroke:) ('geometry' bounds container defaultLineHeight extent: maximumContainerExtent privateMoveBy: textBounds) ('geometry testing' containsPoint:) ('initialization' beAllFont: defaultBorderWidth defaultColor fontName:pointSize: fontName:size: initialize setTextStyle: string:fontName:size: string:fontName:size:wrap:) ('layout' acceptDroppingMorph:event: averageLineLength averageLineLength: doLayoutIn: layoutChanged minCompositionHeight minCompositionWidth minHeight minWidth) ('linked frames' addPredecessor: addSuccessor: firstCharacterIndex firstInChain isLinkedTo: lastCharacterIndex predecessor recomposeChain startingIndex successor withSuccessorsDo:) ('menu' addCustomMenuItems:hand: autoFitOnOff autoFitString changeMargins: changeTextColor followCurve reverseCurveDirection setCurveBaseline: wrapOnOff wrapString) ('multi level undo' editHistory) ('objects from disk' convertToCurrentVersion:refStream: fixUponLoad:seg:) ('visual properties' fillStyle fillStyle:) ('*MorphicExtras-accessing' getCharacters) ('*MorphicExtras-copying' updateReferencesUsing:) ('private' adjustLineIndicesBy: clippingRectangle composeToBounds compositionRectangle createParagraph editorClass fit installEditorToReplace: paragraph paragraphClass predecessorChanged predecessor:successor: privateOwner: releaseEditor releaseParagraph releaseParagraphReally removedMorph: selectionChanged selectionChanged: setDefaultContentsIfNil setPredecessor: setSuccessor: text:textStyle: text:textStyle:wrap:color:predecessor:successor: updateFromParagraph) ('blinking' blinkStart blinkStart: onBlinkCursor resetBlinkCursor startBlinking stopBlinking) ('layout-properties' hResizing hResizing: vResizing vResizing: wrapDirection) ('printing' fullPrintOn:) ('Multilingual-ImmPlugin' preferredKeyboardPosition) ('submorphs - add/remove' addMorphFront:fromWorldPosition: delete goBehind) ('converting' asText withNoLineLongerThan:) !
TabbedPalette removeSelector: #becomeStandardPalette!
!TabbedPalette reorganize! ('dropping/grabbing' wantsDroppedMorph:event:) ('halos and balloon help' defersHaloOnClickTo:) ('initialization' addTabFor:font: addTabForBook: addTabForBook:withBalloonText: defaultColor defaultPageSize initialize newTabs: setInitialState) ('misc menu items' recolorTabs showNoPalette showNoPaletteAndHighlightTab: sortTabs:) ('miscellaneous' currentPalette tabsMorph) ('navigation' transitionSpecFor:) ('other' setExtentFromHalo:) ('palette menu' addBookMenuItemsTo:hand: addMenuTab) ('scraps tab' hasScrapsTab scrapsBook showScrapsTab) ('user-interface' selectTab: selectTabNamed: selectTabOfBook: tabMorphs tabNamed:) ('submorphs - add/remove' replaceSubmorph:by:) !
SystemWindow removeSelector: #extantSketchEditor! SystemWindow removeSelector: #wantsExpandBox! SystemWindow removeSelector: #wantsHalo!
!SystemWindow reorganize! ('drawing' areasRemainingToFill: colorForInsets makeMeVisible wantsRoundedCorners) ('events' doFastFrameDrag: filterEvent:for: handleListenEvent: handleMouseDown: handleMouseUp: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: paneTransition: secondaryPaneTransition:divider: startDragFromLabel: wantsToBeDroppedInto:) ('geometry' extent: justDroppedInto:event: labelRect paneMorphs panelRect position: removeMenuBox setPaneRectsFromBounds) ('initialization' addCloseBox addExpandBox addGrips addKeyboardShortcuts addLabelArea addMenuControl applyModelExtent boxExtent createBox: createCloseBox createCollapseBox createExpandBox createMenuBox defaultBounds defaultColor initialize initializeKeyboardShortcuts initializeLabelArea initializeWithLabel: maximumExtent maximumExtent: model: removeKeyboardShortcuts replaceBoxes setDefaultParameters setFramesForLabelArea) ('label' addLabel getRawLabel knownName label labelArea labelHeight labelWidgetAllowance relabel relabelEvent: setLabel: setLabelWidgetAllowance tryToRenameTo: update: widthOfFullLabelText) ('layout' assureLabelAreaVisible changeCellGapOfLayoutFrames: convertAlignment displayScaleChangedBy: layoutBounds putLabelItemsInLabelArea) ('menu' addCustomMenuItems:hand: buildWindowMenu changeColor deleteCloseBox fullScreen fullScreenMaximumExtent makeClosable makeSecondTopmost makeUnclosable offerWindowMenu sendToBack setWindowColor takeOutOfWindow wantsYellowButtonMenu) ('object fileIn' convertToCurrentVersion:refStream:) ('open/close' anyOpenWindowLikeMeIn: closeBoxHit delete initialExtent mustNotClose openAsIs openAsIsIn: openInWorld: openInWorld:extent: openInWorldExtent: postAcceptBrowseFor:) ('panes' addMorph:frame: addMorph:fullFrame: holdsTranscript paneMorphSatisfying: replacePane:with: setUpdatablePanesFrom: titleAndPaneText updatablePanes updateBox:color: updateBoxesColor:) ('resize/collapse' allowReframeHandles allowReframeHandles: collapse collapseOrExpand collapsedFrame contractToOriginalSize dragToEdgeDistance dragToEdgesSelectorFor:in: expand expandBoxHit expandToFullScreen fastFramingOn fullFrame getBoundsWithFlex getCollapsedFrame isCollapsed isPoint:nearBottomLeftOf: isPoint:nearBottomOf: isPoint:nearBottomRightOf: isPoint:nearLeftOf: isPoint:nearRightOf: isPoint:nearTopLeftOf: isPoint:nearTopOf: isPoint:nearTopRightOf: mouseLeaveEvent:fromPane: paneWithLongestSide:near: reframePanesAdjoining:along:to: setBoundsWithFlex: unexpandedFrame unexpandedFrame:) ('stepping' amendSteppingStatus stepAt: stepTime wantsSteps wantsStepsWhenCollapsed) ('testing' isSystemWindow isWindowForModel: shouldDropOnMouseUp wantsToBeCachedByHand) ('top window' beKeyWindow beKeyWindowIfNeeded: comeToFront comeToFrontModally dimWindowButtons isKeyWindow undimWindowButtons updatePanesFromSubmorphs) ('thumbnail' icon) ('polymorph' modalChild modalLockTo: modalOwner modalUnlockFrom: rememberedKeyboardFocus) ('focus' activate defaultFocusMorph defaultFocusMorph: isActive isActive: isLookingFocused isLookingFocused: lockWindowDecorations lockWindowTitle lookFocused lookUnfocused passivate passivateIfNeeded unlockWindowDecorations unlockWindowTitle updateFocusLookAtHand updateFocusLookForKeyboardFocus windowDecorations) ('colors' existingPaneColor gradientWithColor: paneColor paneColor: paneColorToUse paneColorToUseWhenNotActive raisedColor refreshWindowColor restoreDefaultPaneColor setStripeColorsFrom: setWindowColor: updatePaneColors) ('user interface' applyUserInterfaceTheme) ('*ToolBuilder-Morphic-opening' openAsTool) ('*services-base' requestor topWindow) ('*60Deprecated-open/close' anyOpenWindowLikeMe) !
SuperSwikiServer removeSelector: #matchingEntries:! StringButtonMorph removeSelector: #adaptToWorld:!
!StringButtonMorph reorganize! ('accessing' actionSelector actionSelector: arguments arguments: target target:) ('button' doButtonAction) ('copying' updateReferencesUsing: veryDeepFixupWith: veryDeepInner:) ('event handling' handlesMouseDown: handlesMouseStillDown: mouseDown: mouseMove: mouseStillDown: mouseUp:) ('initialization' initialize) ('menu' addCustomMenuItems:hand: addTargetingMenuItems:hand: clearTarget setActWhen setActionSelector setArguments setLabel setTarget:) ('submorphs - add/remove' actWhen:) ('classification' isButton) !
SqueakFurtherCorePackagesHelp class removeSelector: #etoys!
!SmartRefStream reorganize! ('accessing' structures: superclasses:) ('class changed shape' catalogValues:size: conversionMethodsFor: storeInstVarsIn:from: writeClassRename:was: writeClassRenameMethod:was:fromInstVars: writeConversionMethod:class:was:fromInstVars:to: writeConversionMethodIn:fromInstVars:to:renamedFrom:) ('conversion' inputSensorx0 worldMorphbosfcebbfgccpmcpbttloiairfidcuwhavcdsll0) ('import image segment' applyConversionMethodsTo:className:varMap: checkFatalReshape: convert1:to:allVarMaps: convert2:allVarMaps: mapClass:origName: reshapedClassesIn:) ('read write' appendClassDefns checkCrLf initKnownRenames initShapeDicts instVarInfo: mapClass: moreObjects next nextAndClose nextPut: nextPutObjOnly: noHeader readInstance readInstanceSize:clsname:refPosn: readShortInst readWordLike recordImageSegment: renamed renamedConv restoreClassInstVars saveClassInstVars scanFrom: scanFrom:environment: setStream: setStream:reading: structures superclasses uniClasesDo: uniClassInstVarsRefs: verifyStructure versionSymbol:) ('*Morphic-conversion' bookPageMorphbosfcepcbbfgcc0 clippingMorphbosfcep0 clippingMorphbosfcepc0 dropShadowMorphbosfces0 layoutMorphbosfcepbbochvimol0 layoutMorphbosfcepcbbochvimol0 morphicEventtcbks0 morphicSoundEventtcbkss0 multiNewParagraphttfclpomsswfpp0 myMorphbosfce0 newMorphicEventts0) ('*ST80-conversion' scrollControllermvslrrsmsms0) ('*Graphics-conversion' transparentColorrcc0) ('strings-conversion' abstractStringx0 multiStringx0 multiSymbolx0) !
ColorPickerMorph removeSelector: #delete! ColorPickerMorph removeSelector: #getColorFromKedamaWorldIfPossible:!
!ColorPickerMorph reorganize! ('accessing' argument argument: deleteOnMouseUp deleteOnMouseUp: locationIndicator originalColor: selectedColor selector selector: sourceHand sourceHand: target target: updateContinuously updateContinuously:) ('drawing' drawOn:) ('event handling' handlesMouseDown: inhibitDragging mouseDown: mouseUp:) ('geometry testing' containsPoint:) ('halos and balloon help' isLikelyRecipientForMouseOverHalos) ('initialization' buildChartForm choseModalityFromPreference initialize initializeForPropertiesPanel initializeModal: updateSelectorDisplay) ('menu' addCustomMenuItems:hand: pickUpColorFor: toggleDeleteOnMouseUp toggleUpdateContinuously) ('other' addToWorld:near: bestPositionNear:inWorld: indicateColorUnderMouse putUpFor:near: trackColorUnderMouse) ('stepping' step stepTime) ('private' anchorAndRunModeless: argumentsWith: deleteAllBalloons modalBalloonHelpAtPoint: pickColorAt: positionOfColor: trackColorAt: updateAlpha: updateColor:feedbackColor: updateTargetColor updateTargetColorWith:) ('submorphs - add/remove' delete) !
SketchMorph removeSelector: #firstIntersectionWithLineFrom:to:!
!SketchMorph reorganize! ('accessing' form form: framesToDwell framesToDwell: keepAspectRatio keepAspectRatio: nominalForm: originalForm: rotatedForm scaleFactor scalePoint scalePoint: setNewFormFrom: useInterpolation useInterpolation: wantsSimpleSketchMorphHandles) ('caching' releaseCachedState) ('drawing' canBeEnlargedWithB3D drawHighResolutionOn:in: drawInterpolatedImage:on: drawOn: generateInterpolatedForm generateRotatedForm) ('support' baseGraphic baseGraphic: flipHorizontal flipVertical rotationStyle rotationStyle: wantsRecolorHandle) ('geometry' extent:) ('geometry testing' containsPoint:) ('halos and balloon help' isLikelyRecipientForMouseOverHalos wantsDirectionHandles wantsDirectionHandles:) ('initialization' initialize initializeWith:) ('layout' layoutChanged) ('menu' addBorderToShape: addCustomMenuItems:hand: addPaintingItemsTo:hand: blur callThisBaseGraphic edgeDetect editDrawing editDrawingIn:forBackground: emboss erasePixelsOfColor: erasePixelsUsing: insertIntoMovie: recolorPixelsOfColor:with: recolorPixelsUsing: reduceColorPalette: restoreBaseGraphic restoreBaseGraphicFromMenu setRotationStyle sharpen toggleInterpolation useInterpolationString) ('menus' addFillStyleMenuItems:hand: addToggleItemsToHaloMenu: changePixelsOfColor:toColor: chooseNewGraphic collapse) ('objects from disk' convertToCurrentVersion:refStream:) ('other' newForm: replaceSelfWithMovie) ('parts bin' initializeToStandAlone) ('pen support' clearExtent:fillColor: penOnMyForm revealPenStrokes) ('rotate scale and flex' forwardDirection: heading:) ('*MorphicExtras-testing' canDrawAtHigherResolution) !
SketchEditorMorph removeSelector: #wantsHaloFromClick! SimpleSliderMorph removeSelector: #isLikelyRecipientForMouseOverHalos!
!SimpleSliderMorph reorganize! ('accessing' actionSelector actionSelector: arguments arguments: maxVal maxVal: minVal minVal: target target:) ('copying' updateReferencesUsing: veryDeepFixupWith: veryDeepInner:) ('initialization' initialize) ('menu' addCustomMenuItems:hand: addSliderMenuItems:hand: addTargetingMenuItems:hand: clearTarget descendingString setActionSelector setArguments setLabel setMaxVal setMinVal setMinVal: setTarget: toggleDescending toggleTruncate truncateString) ('model access' setValue:) ('parts bin' initializeToStandAlone) ('private' adjustToValue: getScaledValue setMaxVal: setScaledValue: truncate truncate:) !
SimpleHierarchicalListMorph class removeSelector: #submorphsExample!
!SimpleHierarchicalListMorph class reorganize! ('instance creation' expandedForm notExpandedForm on:list:selected:changeSelected: on:list:selected:changeSelected:menu: on:list:selected:changeSelected:menu:keystroke:) ('preferences' applyUserInterfaceTheme expandAllLimit expandAllLimit: themeProperties wrappedNavigation wrappedNavigation:) !
HaloMorph removeSelector: #addChooseGraphicHandle:! HaloMorph removeSelector: #addMakeSiblingHandle:! HaloMorph removeSelector: #addPaintBgdHandle:! HaloMorph removeSelector: #addPoohHandle:! HaloMorph removeSelector: #addRepaintHandle:! HaloMorph removeSelector: #addScriptHandle:! HaloMorph removeSelector: #addTileHandle:! HaloMorph removeSelector: #addViewHandle:! HaloMorph removeSelector: #addViewingHandle:! HaloMorph removeSelector: #doDupOrMakeSibling:with:! HaloMorph removeSelector: #doMakeSibling:with:! HaloMorph removeSelector: #doMakeSiblingOrDup:with:! HaloMorph removeSelector: #fadeIn! HaloMorph removeSelector: #fadeInInitially! HaloMorph removeSelector: #fadeOut! HaloMorph removeSelector: #fadeOutFinally! HaloMorph removeSelector: #handleEntered! HaloMorph removeSelector: #handleLeft! HaloMorph removeSelector: #isMagicHalo! HaloMorph removeSelector: #isMagicHalo:! HaloMorph removeSelector: #mouseDown:! HaloMorph removeSelector: #openViewerForTarget:with:! HaloMorph removeSelector: #popUpMagicallyFor:hand:! HaloMorph removeSelector: #tearOffTileForTarget:with:! SimpleHaloMorph removeSelector: #isMagicHalo! SimpleHaloMorph removeSelector: #popUpMagicallyFor:hand:!
!IconicButton reorganize! ('events' mouseEnter: mouseLeave:) ('initialization' borderNormal borderThick buttonSetup defaultBorderWidth initialize initializeWithThumbnail:withLabel:andColor:andSend:to: initializeWithThumbnail:withLabel:andSend:to: setDefaultLabel stationarySetup) ('menu' addLabelItemsTo:hand:) ('button' doButtonAction) ('compatibility' dim undim) ('ui' darken darkenedForm restoreImage shedSelvedge) ('label' labelFromString: labelGraphic: labelMorph) ('*MorphicExtras-initialization' initializeToShow:withLabel:andSend:to:) !
SimpleButtonMorph removeSelector: #adaptToWorld:!
!ServerDirectory class reorganize! ('available servers' addLocalProjectDirectory: addServer:named: localProjectDirectories nameForServer: projectServers removeServerNamed: removeServerNamed:ifAbsent: resetLocalProjectDirectories resetServers serverForURL: serverNamed: serverNamed:ifAbsent: serverNames servers) ('class initialization' cleanUp: initialize) ('misc' defaultStemUrl newFrom: on: parseFTPEntry: secondsForDay:month:yearOrTime:thisMonth:thisYear:) ('school support' projectDefaultDirectory) ('server prefs' determineLocalServerDirectory: fetchExternalSettingsIn: parseServerEntryFrom: releaseExternalSettings serverConfDirectoryName storeCurrentServersIn: transferServerDefinitionsToExternal) ('*UpdateStream-server groups' convertGroupNames groupNames serverInGroupNamed: serversInGroupNamed:) !
Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl keepAlive encodingName' classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers' poolDictionaries: '' category: 'Network-RemoteDirectory'! SelectionMorph removeSelector: #couldMakeSibling! SelectionMorph removeSelector: #preferredDuplicationHandleSelector! ScrollableField removeSelector: #cursorWrapped:! ScrollableField removeSelector: #getAllButFirstCharacter! ScrollableField removeSelector: #getNumericValue! ScrollableField removeSelector: #insertCharacters:! ScrollableField removeSelector: #insertContentsOf:! ScrollableField removeSelector: #setNumericValue:!
!ScreeningMorph reorganize! ('accessing' passElseBlock: passingColor:) ('drawing' fullDrawOn:) ('halos and balloon help' wantsRecolorHandle) ('geometry testing' containsPoint:) ('initialization' initialize) ('layout' layoutChanged) ('menu' addCustomMenuItems:hand: chooseBlockingColor choosePassingColor exchange showScreenOnly showScreenOverSource showScreened showSourceOnly) ('private' removedMorph: screenForm screenMorph sourceMorph) ('submorphs - add/remove' addMorph:) !
ScreenController removeSelector: #standardGraphicsLibrary! ReleaseBuilder class removeSelector: #beautifyEtoys! FlapTab removeSelector: #makeNewDrawing:! FlapTab removeSelector: #startOrFinishDrawing:! FlapTab removeSelector: #thicknessString! Quadrangle class removeSelector: #exampleInViewer!
!ProjectSorterMorph reorganize! ('initialization' addControls defaultBorderWidth defaultColor initialize navigator:listOfPages:) ('event handling' clickFromSorterEvent:morph:) ('controls' insertNewProject:) ('private' morphsForMyContentsFrom:sizedTo: sorterMorphForProjectNamed:) !
ProjectNavigationMorph removeSelector: #buttonPaint! ProjectNavigationMorph removeSelector: #doNewPainting! ProjectNavigationMorph removeSelector: #editProjectInfo! ProjectNavigationMorph removeSelector: #makeTheSimpleButtons!
!ProjectLoading class reorganize! ('accessing' projectStreamFromArchive: thumbnailFromUrl:) ('loading' installRemoteNamed:from:named:in: openFromDirectory:andFileName: openFromFile:fromDirectory:withProjectView: openName:stream:fromDirectory:withProjectView: openName:stream:fromDirectory:withProjectView:clearOriginFlag: openOn:) ('utilities' bestAccessToFileName:andDirectory: useTempChangeSet) ('loading - support' checkSecurity:preStream:projStream: fileInName:archive:morphOrList: loadImageSegment:fromDirectory:withProjectView:numberOfFontSubstitutes:substituteFont:mgr: makeExistingView:project:projectsToBeDeleted: morphOrList:stream:fromDirectory:archive: parseManifest:) !
ProjectLauncher removeSelector: #cancelLogin! ProjectLauncher removeSelector: #doEtoyLogin! ProjectLauncher removeSelector: #loginAs:! ProjectLauncher removeSelector: #prepareForLogin! ProjectLauncher removeSelector: #proceedWithLogin! ProjectLauncher removeSelector: #startUpAfterLogin! AbstractLauncher subclass: #ProjectLauncher instanceVariableNames: 'showSplash splashURL whichFlaps' classVariableNames: 'SplashMorph' poolDictionaries: '' category: 'System-Download'!
!ProjectLauncher reorganize! ('initialization' initialize setupFlaps setupFromParameters) ('running' hideSplashMorph installProjectFrom: showSplashMorph startUp) ('private' showSplash) !
Project class removeSelector: #publishInSexp!
!Project class reorganize! ('class initialization' cleanUp: cleanUpProjectPreferences initialize localeChanged rebuildAllProjects) ('constants' current uiManager uiProcess) ('squeaklet on server' enterIfThereOrFind: fromUrl: isBadNameForStoring: loaderUrl mostRecent:onServer: namedUrl: parseProjectFileName: projectExtension serverDirectoryFromURL: serverFileFromURL: squeakletDirectory sweep:) ('utilities' addingProject: advanceToNextProject allNames allNamesAndProjects allProjects allProjectsOrdered canWeLoadAProjectNow chooseNaturalLanguage deletingProject: enter: flattenProjectHierarchy forget: hierarchyOfNamesAndProjects jumpToProject jumpToSelection: maybeForkInterrupt named: named:in: namedWithDepth: ofWorld: projectHierarchy releaseProjectReferences: removeAll: removeAllButCurrent returnToParentProject returnToPreviousProject storeAllInSegments topProject versionForFileName:) ('*Morphic-Support' allMorphicProjects) ('error recovery' tryEmergencyEvaluatorForRecovery: tryOtherProjectForRecovery:) ('shrinking' removeProjectsFromSystem) ('snapshots' shutDown: startUp:) ('*ST80-Support' allMVCProjects) ('preferences') ('*60Deprecated-error recovery' handlePrimitiveError:) ('*61Deprecated-utilities' resumeProcess:) !
MorphicProject removeSelector: #exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction:! MorphicProject removeSelector: #initMorphic! MorphicProject removeSelector: #myPlayerClasses! MorphicProject removeSelector: #setFlaps!
!MorphicProject reorganize! ('display' displayScaleChangedFrom:to: invalidate noDisplayDuring: previewImageForm restore viewLocFor:) ('initialize' initialize installPasteUpAsWorld: openProject: setWorldBackground:) ('testing' isMorphic) ('menu messages' assureNavigatorPresenceMatchesPreference makeThumbnail) ('utilities' addItem:toMenu:selection:color:thumbnail: composeDisplayTextIntoForm: createViewIfAppropriate do:withProgressInfoOn:label: findAFolderForProject:label: findProjectView: jumpToProject launchSystemFiles:event: offerMenu:from:shifted: pointerMoved setAsBackground: showImage:named: textWindows) ('docking bars support' assureMainDockingBarPresenceMatchesPreference createOrUpdateMainDockingBar dockingBar dockingBar: removeMainDockingBar showWorldMainDockingBar showWorldMainDockingBar: showWorldMainDockingBarString toggleShowWorldMainDockingBar) ('file in/out' acceptProjectDetails: armsLengthCommand:withDescription: compressFilesIn:to:in: compressFilesIn:to:in:resources: exportSegmentWithChangeSet:fileName:directory: exportSegmentWithChangeSet:fileName:directory:withoutInteraction: loadFromServer: noteManifestDetailsIn: storeSegment storeSegmentNoFile) ('enter' clearGlobalState enterAsActiveSubprojectWithin: finalEnterActions: finalExitActions: initializeMenus isIncompletelyLoaded resumeEventRecorder: scheduleProcessForEnter startUpActions suspendProcessForDebug terminateProcessForLeave wakeUpTopWindow) ('squeaklet on server' enterIfThereOrFind: openBlankProjectNamed:) ('release' deletingProject: prepareForDelete) ('language' chooseNaturalLanguage updateLocaleDependents) ('editors' bitEdit: bitEdit:at:scale: editCharacter:ofFont: formEdit: formViewClass openImage:name:saveResource:) ('futures' future:do:at:args: future:send:at:args:) ('active process' spawnNewProcess spawnNewProcessAndTerminateOld: spawnNewProcessIfThisIsUI: uiProcess uiProcess:) ('transcripter' displayTranscripter: initializeParagraphForTranscripter:) ('subprojects' addProject: subProjects) ('accessing' color topMorphicProject) ('updating' applyUserInterfaceTheme canApplyUserInterfaceTheme) ('scheduling & debugging' addDeferredUIMessage: fatalDrawingError: interruptCleanUpFor: lastDeferredUIMessage openDebuggerWindow: recursiveError: restoreDisplay resumeProcessSafely: suspendProcessSafely:) ('flaps support' assureFlapIntegrity cleanseDisabledGlobalFlapIDsList enableDisableGlobalFlap: flapsSuppressed: globalFlapEnabledString: globalFlapWithIDEnabledString: isFlapEnabled: isFlapIDEnabled: suppressFlapsString toggleFlapsSuppressed) ('protocols' currentVocabulary) !
Project removeSelector: #restoreReferences!
!Project reorganize! ('accessing' changeSet color displayDepth displayDepth: explicitName explicitName: findProjectView: forgetExistingURL labelString lastDirectory: lastSavedAtSeconds name nameAdjustedForDepth nextProject nilParentError previousProject projectChangeSet renameTo: storeNewPrimaryURL: thumbnail thumbnail: topProject transcript uiManager urlList viewSize viewSize: world) ('active process' depth spawnNewProcessIfThisIsUI: uiProcess) ('displaying' displayDepthChanged displayScaleChangedFrom:to: displaySizeChanged displayZoom: imageForm imageFormOfSize:depth: invalidate noDisplayDuring: previewImageForm restore restoreDisplay showZoom shrinkDisplay viewLocFor:) ('file in/out' armsLengthCommand:withDescription: assureIntegerVersion bumpVersion: couldBeSwappedOut currentVersionNumber decideAboutCreatingBlank: doArmsLengthCommand: downloadUrl ensureChangeSetNameUnique exportSegmentFileName:directory: exportSegmentFileName:directory:withoutInteraction: exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction: exportSegmentWithCatagories:classes:fileName:directory: exportSegmentWithChangeSet:fileName:directory: findAFolderToLoadProjectFrom findAFolderToStoreProjectIn fromMyServerLoad: hasBadNameForStoring htmlPagePrototype loadFromServer loadFromServer: objectForDataStream: primaryServer primaryServerIfNil: projectExtension revert saveAs saveForRevert serverList squeakletDirectory storeAttributeKey:value:on: storeAttributesOn: storeDataOn: storeHtmlPageIn: storeManifestFileIn: storeOnServer storeOnServerAssumingNameValid storeOnServerInnards storeOnServerShowProgressOn:forgetURL: storeOnServerWithProgressInfo storeOnServerWithProgressInfoOn: storeSegment storeSegmentNoFile storeSomeSegment storeToMakeRoom tryToFindAServerWithMe url urlForLoading versionForFileName versionFrom: versionedFileName writeFileNamed:fromDirectory:toServer: writeStackText:in:registerIn:) ('flaps support' flapsSuppressed flapsSuppressed: showSharedFlaps) ('initialization' initialExtent initialProject initialize installNewDisplay:depth: openProject: resetTranscript setChangeSet: setServer windowActiveOnFirstClick windowReqNewLabel:) ('language' chooseNaturalLanguage localeChanged localeID naturalLanguage updateLocaleDependents) ('menu messages' assureNavigatorPresenceMatchesPreference doWeWantToRename exit fileOut installProjectPreferences makeThumbnail saveProjectPreferences validateProjectNameIfOK:) ('printing' addSubProjectNamesTo:indentation: printOn:) ('project parameters' initializeProjectParameters initializeProjectPreferences noteThatParameter:justChangedTo: parameterAt: parameterAt:ifAbsent: projectParameterAt: projectParameterAt:ifAbsent: projectParameterAt:ifAbsentPut: projectParameterAt:put: projectParameters projectPreferenceAt: projectPreferenceAt:ifAbsent: projectPreferenceFlagDictionary rawParameters removeParameter:) ('release' addDependent: canDiscardEdits close delete deletingProject: forget okToChange prepareForDelete release removeChangeSetIfPossible windowIsClosing) ('resources' abortResourceLoading resourceDirectoryName resourceManager resourceManager: resourceUrl startResourceLoading storeResourceList:in:) ('SuperSwiki' tellAFriend tellAFriend:) ('*sound' beep) ('enter' enter enter: enter:revert:saveForRevert: finalEnterActions: finalExitActions: loadState saveState scheduleProcessForEnter shutDownActions startUpActions terminateProcessForLeave wakeUpTopWindow) ('utilities' addItem:toMenu:selection:color:thumbnail: buildJumpToMenu: composeDisplayTextIntoForm: do:withProgressInfoOn:label: findAFolderForProject:label: jumpToProject jumpToSelection: offerMenu:from:shifted: pointerMoved setAsBackground: showImage:named: textWindows) ('squeaklet on server' enterIfThereOrFind: openBlankProjectNamed:) ('futures' future:do:at:args: future:send:at:args:) ('editors' bitEdit: bitEdit:at:scale: editCharacter:ofFont: formEdit: formViewClass openImage:name:saveResource:) ('transcripter' displayTranscripter: initializeParagraphForTranscripter:) ('sub-projects & hierarchy' addProject: beTopProject children isTopProject liftSubProjects parent setParent: subProjects withChildrenDo:) ('enter - recovery' enterForEmergencyRecovery suspendProcessForDebug) ('testing' isCurrentProject isIncompletelyLoaded isMorphic) ('shrinking' removeAllOtherProjects) ('*ST80-Testing' isMVC) ('*60Deprecated-accessing' setThumbnail: setViewSize:) ('scheduling & debugging' addDeferredUIMessage: debugProcess:inDialog: debugProcess:inWindow: guardRecursiveError:during: interruptCleanUpFor: interruptName: interruptName:message: interruptName:message:preemptedProcess: interruptName:preemptedProcess: lastDeferredUIMessage openDebuggerWindow: prepareProcessForDebugger: primitiveError: recursiveError: resumeProcessSafely: suspendProcessSafely:) ('*MorphicExtras-accessing' useOwnChangeSetWithCurrentName useParentChangeSetButSetProjectName:) ('protocols' currentVocabulary) !
Preferences class removeSelector: #annotationEditingWindow! Preferences class removeSelector: #automaticViewerPlacement! Preferences class removeSelector: #batchPenTrails! Preferences class removeSelector: #capitalizedReferences! Preferences class removeSelector: #cautionBeforeClosing! Preferences class removeSelector: #chooseEToysFont! Preferences class removeSelector: #chooseEToysTitleFont! Preferences class removeSelector: #classicTilesSettingToggled! Preferences class removeSelector: #compactViewerFlaps! Preferences class removeSelector: #debugMenuItemsInvokableFromScripts! Preferences class removeSelector: #defaultPaintingExtent! Preferences class removeSelector: #dropProducesWatcher! Preferences class removeSelector: #eToyFriendly! Preferences class removeSelector: #eToyFriendlyChanged! Preferences class removeSelector: #eToyLoginEnabled! Preferences class removeSelector: #editAnnotations! Preferences class removeSelector: #enableLocalSave! Preferences class removeSelector: #expandedPublishing! Preferences class removeSelector: #fenceEnabled! Preferences class removeSelector: #fenceSoundEnabled! Preferences class removeSelector: #fenceSoundEnabled:! Preferences class removeSelector: #haloTransitions! Preferences class removeSelector: #includeSoundControlInNavigator! Preferences class removeSelector: #keepTickingWhilePainting! Preferences class removeSelector: #largeTilesSettingToggled! Preferences class removeSelector: #magicHalos! Preferences class removeSelector: #menuColorFromWorld! Preferences class removeSelector: #menuColorString! Preferences class removeSelector: #messengersInViewers! Preferences class removeSelector: #mouseOverHalos! Preferences class removeSelector: #mouseOverHalosChanged! Preferences class removeSelector: #mvcProjectsAllowed! Preferences class removeSelector: #navigatorOnLeftEdge! Preferences class removeSelector: #noviceMode! Preferences class removeSelector: #noviceModeSettingChanged! Preferences class removeSelector: #okToReinitializeFlaps! Preferences class removeSelector: #oliveHandleForScriptedObjects! Preferences class removeSelector: #propertySheetFromHalo! Preferences class removeSelector: #selectiveHalos! Preferences class removeSelector: #setEToysFontTo:! Preferences class removeSelector: #setEToysTitleFontTo:! Preferences class removeSelector: #showAdvancedNavigatorButtons! Preferences class removeSelector: #showFlapsWhenPublishing! Preferences class removeSelector: #simpleMenus! Preferences class removeSelector: #standardEToysFont! Preferences class removeSelector: #standardEToysTitleFont! Preferences class removeSelector: #tabAmongFields! Preferences class removeSelector: #tileTranslucentDrag! Preferences class removeSelector: #typeCheckingInTileScripting! Preferences class removeSelector: #uniTilesClassic! Preferences class removeSelector: #universalTiles! Preferences class removeSelector: #universalTilesSettingToggled! Preferences class removeSelector: #unlimitedPaintArea! Preferences class removeSelector: #useCategoryListsInViewers! Preferences class removeSelector: #useVectorVocabulary! Preferences class removeSelector: #vectorVocabularySettingChanged! Preferences class removeSelector: #viewersInFlaps!
!Preferences class reorganize! ('accessing' allPreferences atomicUpdatePreferences: dictionaryOfPreferences pragmaIdFor:getter: pragmaPreferenceFor:getter: preferenceAt: preferenceAt:ifAbsent:) ('class initialization' initialize unload) ('get/set' doesNotUnderstand: setPreference:toValue: setPreference:toValue:during: valueOfPreference: valueOfPreference:ifAbsent:) ('initialization' chooseInitialSettings cleanUp: cleanUpPragmaPreferences initializeDictionaryOfPreferences registerForEvents removeObsolete resetDefaultValues setPreferencesFrom:) ('parameters' expungeParameter: initializeParameters inspectParameters parameterAt: parameterAt:ifAbsentPut: parameterAt:ifAbsent: parameters setParameter:to:) ('reacting to change' isChangeSelector:) ('standard queries' alphabeticalProjectMenu alternateHandlesLook alternativeBrowseIt alternativeWindowBoxesLook alwaysHideHScrollbar alwaysShowHScrollbar alwaysShowVScrollbar annotationPanes areaFillsAreTolerant areaFillsAreVeryTolerant autoIndent automaticFlapLayout automaticKeyGeneration balloonHelpEnabled balloonHelpInMessageLists biggerHandles caseSensitiveFinds changeSetVersionNumbers checkForSlips checkForUnsavedProjects classicNavigatorEnabled cmdDotEnabled cmdGesturesEnabled collapseWindowsInPlace confirmFirstUseOfStyle conversionMethodsAtFileOut debugHaloHandle debugLogTimestamp debugPrintSpaceLog debugShowDamage decorateBrowserButtons diffsInChangeList diffsWithPrettyPrint dismissAllOnOptionClose easySelection extraDebuggerButtons fastDragWindowForMorphic fullScreenLeavesDeskMargins generalizedYellowButtonMenu haloEnclosesFullBounds higherPerformance honorDesktopCmdKeys infiniteUndo logDebuggerStackToFile maintainHalos menuAppearance3d menuKeyboardControl menuWithIcons modalColorPickers mouseOverForKeyboardFocus optionalButtons passwordsOnPublish personalizedWorldMenu postscriptStoredAsEPS projectsSentToDisk projectViewsInWindows projectZoom purgeUndoOnQuit readDocumentAtStartup readDocumentAtStartup: restartAlsoProceeds reverseWindowStagger scrollBarsNarrow scrollBarsOnRight securityChecksEnabled serverMode showBoundsInHalo showDirectionForSketches showDirectionHandles showProjectNavigator showSecurityStatus showSharedFlaps showSplitterHandles signProjectFiles smartUpdating standaloneSecurityChecksEnabled startInUntrustedDirectory swapMouseButtons systemWindowEmbedOK timeStampsInMenuTitles tinyDisplay traceMessages turnOffPowerManager twentyFourHourFileStamps uniqueNamesInHalos useButtonPropertiesToFire useUndo visualExplorer warnAboutInsecureContent warnIfNoChangesFile warnIfNoSourcesFile wordStyleCursorMovement) ('themes' outOfTheBox personal) ('*PreferenceBrowser' addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:viewRegistry:) ('private' compileAccessorForPreference: compileAccessorForPreferenceNamed:value: preference:category:description:type: preference:categoryList:description:type:) ('prefs - fonts' aaFontsColormapDepth chooseBalloonHelpFont chooseCodeFont chooseFixedFont chooseFlapsFont chooseFontWithPrompt:andSendTo:withSelector:highlightSelector: chooseHaloLabelFont chooseListFont chooseMenuFont chooseStandardButtonFont chooseSystemFont chooseWindowTitleFont decreaseFontSize fontConfigurationMenu fontConfigurationMenu: increaseFontSize printStandardSystemFonts refreshFontSettings restoreDefaultFonts restoreDefaultFontsForJapanese restoreFontsAfter: setBalloonHelpFontTo: setButtonFontTo: setCodeFontTo: setDemoFonts setFixedFontTo: setFlapFontTo: setFlapsFontTo: setHaloLabelFontTo: setListFontTo: setMenuFontTo: setPaintBoxButtonFontTo: setSystemFontTo: setWindowTitleFontTo: standardBalloonHelpFont standardButtonFont standardCodeFont standardDefaultTextFont standardFixedFont standardFlapFont standardHaloLabelFont standardListFont standardMenuFont standardPaintBoxButtonFont standardSystemFont standardWindowTitleFont subPixelRenderColorFonts subPixelRenderFonts windowTitleFont windowTitleStyle) ('support - misc' acceptAnnotationsFrom: addModelItemsToWindowMenu: automaticFlapLayoutString initialExtent inspectPreferences letUserPersonalizeMenu navigatorShowingString personalizeUserMenu: setArrowheads staggerPolicyString wantsChangeSetLogging) ('add/remove - specific' addBooleanPreference:categories:default:balloonHelp: addBooleanPreference:category:default:balloonHelp: addColorPreference:categories:default:balloonHelp: addColorPreference:category:default:balloonHelp: addFontPreference:categories:default:balloonHelp: addFontPreference:category:default:balloonHelp: addNumericPreference:categories:default:balloonHelp: addNumericPreference:category:default:balloonHelp: addTextPreference:categories:default:balloonHelp: addTextPreference:category:default:balloonHelp:) ('add/remove' addPragmaPreference: addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:type: removeAllPreferencesSuchThat: removePreference:) ('add/remove - convenience' addPreference:categories:default:balloonHelp: addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: addPreference:category:default: addPreference:category:default:balloonHelp: addPreference:default:) ('prefs - annotations' annotationInfo defaultAnnotationInfo defaultAnnotationRequests defaultAnnotationRequests:) ('updating - system' annotationPanesChanged displaySizeChanged infiniteUndoChanged optionalButtonsChanged roundedWindowCornersChanged sharedFlapsSettingChanged showProjectNavigatorChanged smartUpdatingChanged) ('prefs - misc' balloonHelpDelayTime borderColorWhenRunning cmdKeysInText defaultAuthorName defaultWorldColor desktopColor desktopColor: desktopMenuTitle enableProjectNavigator maxBalloonHelpLineLength maxBalloonHelpLineLength: metaMenuDisabled preserveCommandExcursions scrollBarColor scrollBarWidth suppressWindowTitlesInInstanceBrowsers useFormsInPaintBox:) ('themes - tools' browseThemes installTheme: offerThemesMenu themeChoiceButtonOfColor:font:) ('support' categoryList categoryListOfPreference: giveHelpWithPreferences okayToChangeProjectLocalnessOf: preferencesInCategory: typeForValue:) ('prefs - halos' classicHaloSpecs classicHalosInForce customHaloSpecs customHalosInForce editCustomHalos haloSpecifications haloSpecificationsForWorld haloTheme iconicHaloSpecifications iconicHalosInForce installClassicHaloSpecs installCustomHaloSpecs installHaloSpecsFromArray: installHaloTheme: installIconicHaloSpecs installSimpleHaloSpecs resetHaloSpecifications showChooseGraphicHaloHandle simpleFullHaloSpecifications simpleHalosInForce) ('defaults' defaultValueTableForCurrentRelease unclassifiedCategory) ('get/set - flags' disable: enable: setFlag:toValue: setFlag:toValue:during: toggle: valueOfFlag: valueOfFlag:ifAbsent:) ('initialization - misc' disableProgrammerFacilities enableProgrammerFacilities setDefaultAnnotationInfo setNotificationParametersForStandardPreferences) ('support - file list services' fileReaderServicesForFile:suffix: serviceLoadPreferencesFromDisk services) ('initialization - save/load' loadPreferencesFrom: restorePersonalPreferences restorePreferencesFromDisk restorePreferencesFromDisk: savePersonalPreferences storePreferencesIn: storePreferencesToDisk) ('updating' localeChanged prefEvent:) ('*60Deprecated-menu colors' menuBorderColor menuBorderWidth menuColor menuLineColor menuSelectionColor menuTitleBorderColor menuTitleBorderWidth menuTitleColor) ('*morphicextras' rotationAndScaleHandlesInPaintBox) ('*60Deprecated-prefs-text' chooseInsertionPointColor chooseKeyboardFocusColor chooseTextHighlightColor initializeTextHighlightingParameters insertionPointColor insertionPointColor: keyboardFocusColor keyboardFocusColor: textHighlightColor textHighlightColor:) ('*60Deprecated-Etoys-Squeakland-window colors' windowColorHelp windowSpecificationPanel) ('*60Deprecated-parameters' parameterAt:default:) !
!PolygonMorph reorganize! ('access' isClosed isCurve isOpen makeOpenOrClosed midVertices openOrClosePhrase smoothOrSegmentedPhrase vertices) ('accessing' borderColor: borderDashSpec borderStyle: borderWidth: couldHaveRoundedCorners) ('caching' loadCachedState releaseCachedState) ('dashes' borderDashOffset dashedBorder dashedBorder: removeVertex: vertexAt:) ('debug and other' installModelIn: rotateTestFlip:) ('drawing' areasRemainingToFill: drawArrowOn:at:from: drawArrowsOn: drawBorderOn: drawBorderOn:usingEnds: drawClippedBorderOn:usingEnds: drawDashedBorderOn: drawDashedBorderOn:usingEnds: drawOnFormCanvas: drawOn:) ('editing' addHandles clickVertex:event:fromHandle: deleteVertexAt: dragVertex:event:fromHandle: dragVertex:fromHandle:vertIndex: dropVertex:event:fromHandle: dropVertex:fromHandle:vertIndex: handleColorAt: insertVertexAt:put: newVertex:event:fromHandle: newVertex:fromHandle:afterVert: updateHandles verticesAt:put:) ('event handling' handlesMouseDown: mouseDown:) ('geometry' arrowsContainPoint: bounds: closestPointTo: closestSegmentTo: extent: flipHAroundX: flipVAroundY: intersectionsWith: intersectionWithLineSegmentFromCenterTo: intersects: isBordered lineBorderColor lineBorderColor: lineBorderWidth lineBorderWidth: lineColor lineColor: lineWidth lineWidth: mergeDropThird:in:from: merge: nextDuplicateVertexIndex reduceVertices straighten transformedBy:) ('geometry testing' containsPoint:) ('initialization' beSmoothCurve beStraightSegments defaultBorderColor defaultColor initialize vertices:color:borderWidth:borderColor:) ('menu' addCustomMenuItems:hand: addPolyArrowMenuItems:hand: addPolyLIneCurveMenuItems:hand: addPolyShapingMenuItems:hand: arrowLength: arrowSpec: arrows customizeArrows: handlesShowingPhrase makeBackArrow makeBothArrows makeClosed makeForwardArrow makeNoArrows makeOpen quickFill: removeHandles setRotationCenterFrom: showingHandles showOrHideHandles specifyDashedLine standardArrows toggleHandles toggleSmoothing unrotatedLength unrotatedLength: unrotatedWidth unrotatedWidth:) ('objects from disk' convertToCurrentVersion:refStream:) ('rotate scale and flex' addFlexShellIfNecessary heading heading: referencePosition rotationCenter rotationCenter: rotationDegrees rotationDegrees:) ('smoothing' coefficients computeNextToEndPoints derivs:first:second:third: lineSegmentsDo: nextToFirstPoint nextToLastPoint slopes: straightLineSegmentsDo:) ('stepping' step stepTime wantsSteps) ('testing' hasArrows isCurvier isCurvy isLineMorph) ('visual properties' canHaveFillStyles fillStyle fillStyle:) ('*MorphicExtras-geometry eToy' scale:) ('private' arrowBoundsAt:from: arrowForms borderForm computeArrowFormAt:from: computeBounds curveBounds filledForm getVertices includesHandle: lineSegments privateMoveBy: setVertices: transformVerticesFrom:to:) ('shaping' diamondOval rectOval) ('attachments' defaultAttachmentPointSpecs endShapeColor: endShapeWidth: firstVertex lastVertex midpoint nudgeForLabel: totalLength) ('rounding' cornerStyle:) ('*MorphicExtras-Postscript Canvases' drawPostscriptOn:) !
PluggableTextMorph removeSelector: #tileForIt! PasteUpMorphTest removeSelector: #testCursorWrapped! PasteUpMorphTest removeSelector: #testCursorWrappedWithFraction! PasteUpMorphTest removeSelector: #testGridToGradient! PasteUpMorph initialize! PasteUpMorph class removeSelector: #supplementaryPartsDescriptions!
!PasteUpMorph class reorganize! ('printing' defaultNameStemForInstances) ('project' newWorldForProject:) ('scripting' authoringPrototype) ('preferences' globalCommandKeysEnabled globalCommandKeysEnabled:) ('recompilation' postRecompileAction) ('*MorphicExtras-class initialization' initialize registerInFlapsRegistry unload) ('*MorphicExtras-project' newWorldTesting) ('*MorphicExtras-parts bin') ('parts bin' descriptionForPartsBin) !
PartsBin removeSelector: #morphToDropFrom:! PasteUpMorph removeSelector: #abandonCostumeHistory! PasteUpMorph removeSelector: #abandonVocabularyPreference! PasteUpMorph removeSelector: #adaptedToWorld:! PasteUpMorph removeSelector: #addPenMenuItems:hand:! PasteUpMorph removeSelector: #addPenTrailsMenuItemsTo:! PasteUpMorph removeSelector: #addPlayfieldMenuItems:hand:! PasteUpMorph removeSelector: #addStackMenuItems:hand:! PasteUpMorph removeSelector: #allScriptEditors! PasteUpMorph removeSelector: #allScriptors! PasteUpMorph removeSelector: #allTileScriptingElements! PasteUpMorph removeSelector: #assureNotPaintingEvent:! PasteUpMorph removeSelector: #automaticPhraseExpansion! PasteUpMorph removeSelector: #automaticViewing! PasteUpMorph removeSelector: #behaveLikeHolder! PasteUpMorph removeSelector: #behaveLikeHolder:! PasteUpMorph removeSelector: #behavingLikeAHolder! PasteUpMorph removeSelector: #browseAllScriptsTextually! PasteUpMorph removeSelector: #buildDebugMenu:! PasteUpMorph removeSelector: #closedViewerFlapTabs! PasteUpMorph removeSelector: #couldMakeSibling! PasteUpMorph removeSelector: #cursor! PasteUpMorph removeSelector: #cursor:! PasteUpMorph removeSelector: #cursorWrapped:! PasteUpMorph removeSelector: #detachableScriptingSpace! PasteUpMorph removeSelector: #drawOn:! PasteUpMorph removeSelector: #dumpPresenter! PasteUpMorph removeSelector: #hideViewerFlaps! PasteUpMorph removeSelector: #hideViewerFlapsOtherThanFor:! PasteUpMorph removeSelector: #indicateCursor! PasteUpMorph removeSelector: #indicateCursor:! PasteUpMorph removeSelector: #indicateCursorString! PasteUpMorph removeSelector: #installVectorVocabulary! PasteUpMorph removeSelector: #isPlayfieldLike! PasteUpMorph removeSelector: #makeNewDrawing:! PasteUpMorph removeSelector: #makeNewDrawing:at:! PasteUpMorph removeSelector: #makeNewDrawingWithin! PasteUpMorph removeSelector: #makeVectorUseConformToPreference! PasteUpMorph removeSelector: #mouseOverHalosString! PasteUpMorph removeSelector: #newDrawingFromMenu:! PasteUpMorph removeSelector: #numberAtCursor! PasteUpMorph removeSelector: #openScrapsBook:! PasteUpMorph removeSelector: #paintArea! PasteUpMorph removeSelector: #paintAreaFor:! PasteUpMorph removeSelector: #paintingBoundsAround:! PasteUpMorph removeSelector: #paintingFlapTab! PasteUpMorph removeSelector: #prepareToBeSaved! PasteUpMorph removeSelector: #prepareToPaint! PasteUpMorph removeSelector: #prepareToPaint:! PasteUpMorph removeSelector: #presentCardAndStackMenu! PasteUpMorph removeSelector: #presentPlayfieldMenu! PasteUpMorph removeSelector: #presenter! PasteUpMorph removeSelector: #printScriptSummary! PasteUpMorph removeSelector: #putUpPenTrailsSubmenu! PasteUpMorph removeSelector: #reasonablePaintingExtent! PasteUpMorph removeSelector: #rectifyCursor! PasteUpMorph removeSelector: #referencePlayfield! PasteUpMorph removeSelector: #referencePool! PasteUpMorph removeSelector: #releaseViewers! PasteUpMorph removeSelector: #removeAllViewers! PasteUpMorph removeSelector: #restoreBoundsOfSubmorphs! PasteUpMorph removeSelector: #resumeScriptsPausedByPainting! PasteUpMorph removeSelector: #roundUpStrays! PasteUpMorph removeSelector: #saveBoundsOfSubmorphs! PasteUpMorph removeSelector: #selectedRect! PasteUpMorph removeSelector: #sendTextContentsBackToDonor! PasteUpMorph removeSelector: #showStatusOfAllScripts! PasteUpMorph removeSelector: #showingListView! PasteUpMorph removeSelector: #sortSubmorphsBy:! PasteUpMorph removeSelector: #standardPlayerHit! PasteUpMorph removeSelector: #startRunningAll! PasteUpMorph removeSelector: #stepAll! PasteUpMorph removeSelector: #stopRunningAll! PasteUpMorph removeSelector: #toggleAutoLineLayout! PasteUpMorph removeSelector: #toggleClassicNavigatorIfAppropriate! PasteUpMorph removeSelector: #toggleMouseOverHalos! PasteUpMorph removeSelector: #triggerClosingScripts! PasteUpMorph removeSelector: #triggerOpeningScripts! PasteUpMorph removeSelector: #updateStatusForAllScriptEditors! PasteUpMorph removeSelector: #valueAtCursor! PasteUpMorph removeSelector: #valueAtCursor:! PasteUpMorph removeSelector: #viewingNormally! PasteUpMorph removeSelector: #wantsHaloFor:! PasteUpMorph removeSelector: #wantsMouseOverHalos! PasteUpMorph removeSelector: #wantsMouseOverHalos:! BorderedMorph subclass: #PasteUpMorph instanceVariableNames: 'model padding isPartsBin worldState' classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler' poolDictionaries: '' category: 'Morphic-Worlds'!
!PasteUpMorph reorganize! ('accessing' assureFlapWidth: flapTab lastKeystroke lastKeystroke: modelOrNil useRoundedCorners) ('alarms-scheduler' addAlarm:withArguments:for:at: removeAlarm:for:) ('caching' releaseCachedState) ('change reporting' invalidRect:from:) ('classification' isWorldMorph) ('copying' veryDeepCopyWith:) ('display' gradientFillColor: setGradientColor:) ('dropping/grabbing' acceptDroppingMorph:event: dropEnabled hasTransferMorphConverter justDroppedInto:event: morphToDropForTransferMorph: morphToDropFrom: originAtCenter positionNear:forExtent:adjustmentSuggestion: repelsMorph:event: resetTransferMorphConverter transferMorphConverter transferMorphConverter: wantsDroppedMorph:event: wantsDroppedTransferMorph:) ('event handling' dropExplorerField:from:event: dropFiles:event: dropInspectorField:event: dropSourceCode:event: handleDroppedItem:event: handlesKeyboard: handlesMouseDown: keyStroke: morphToGrab: mouseDown: mouseUp: wantsEasySelection wantsKeyboardFocusFor: wantsWindowEvent: windowEvent: windowEventHandler windowEventHandler:) ('events-processing' filterEvent:for: processEvent:using: tryInvokeHalo: tryInvokeKeyboardShortcut: tryInvokeMetaMenu:) ('geometry' bringTopmostsToFront extent: position:) ('geometry testing' fullContainsPoint:) ('halos and balloon help' defersHaloOnClickTo: wantsDirectionHandles wantsHaloFromClick) ('initialization' addKeyboardShortcuts addMouseShortcuts becomeActiveDuring: defaultBorderColor defaultBorderWidth defaultColor initialize initializeKeyboardShortcuts initializeMouseShortcuts newResourceLoaded removeKeyboardShortcuts) ('interaction loop' doOneCycleNow) ('layout' addCenteredAtBottom:offset: convertAlignment laySubpartsOutInOneRow layoutChanged) ('menu & halo' addCustomMenuItems:hand: addScalingMenuItems:hand: addWorldHaloMenuItemsTo:hand: addWorldToggleItemsToHaloMenu: autoLineLayoutString currentlyUsingVectorVocabulary defineApplicationView defineFactoryView deleteBalloonTarget: isPartsBinString originAtCenterString reformulateUpdatingMenus showApplicationView showExpandedView showFactoryView showFullView showReducedView showThumbnailString showWorldMainDockingBarString toggleShowWorldMainDockingBar transformToShow:) ('misc' alwaysShowThumbnail cachedOrNewThumbnailFrom: cartesianOrigin heightForThumbnails hideFlapsOtherThan:ifClingingTo: innocuousName maxHeightToAvoidThumbnailing maximumThumbnailWidth mouseX mouseY nameForCopyIfAlreadyNamed: padding: smallThumbnailForPageSorter thumbnailForPageSorter unhideHiddenObjects) ('model' createCustomModel model setModel:) ('name' unusedMorphNameLike:) ('objects from disk' convertToCurrentVersion:refStream: fixUponLoad:seg: saveOnFile) ('options' autoLineLayout autoLineLayout: isPartsBin: replaceTallSubmorphsByThumbnails resizeToFit resizeToFitString setPartsBinStatusTo: toggleIsPartsBin toggleResizeToFit) ('parts bin' initializeToStandAlone isPartsBin residesInPartsBin) ('printing' printOn:) ('project' project releaseSqueakPages storeProjectsAsSegments) ('project state' canvas canvas: firstHand hands handsDo: handsReverseDo: isStepping: isStepping:selector: listOfSteppingMorphs stepListSize stepListSummary steppingMorphsNotInWorld viewBox viewBox:) ('stepping' cleanseStepList runLocalStepMethods runStepMethods startStepping: startStepping:at:selector:arguments:stepTime: step stepTime stopStepping: stopStepping:selector:) ('structure' primaryHand world) ('testing' isEasySelecting) ('undo' clearCommandHistory commandHistory onceAgainDismiss: reintroduceIntoWorld:) ('update cycle' startBackgroundProcess) ('user interface' modelWakeUp) ('naming' defaultNameStemForInstances) ('visual properties' canHaveFillStyles fillStyle: setAsBackground:) ('WiW support' addMorphInLayer: installAsActiveSubprojectIn:at:titled: installAsActiveSubprojectIn:titled: restartWorldCycleWithEvent: shouldGetStepsFrom: validateMouseEvent:) ('world menu' activateObjectsTool addUndoItemsTo: bringWindowsFullOnscreen buildWorldMenu: closeUnchangedWindows collapseAll collapseNonWindows commandKeySelectors connectRemoteUser connectRemoteUserWithName:picture:andIPAddress: delayedInvokeWorldMenu: deleteNonWindows disconnectAllRemoteUsers disconnectRemoteUser dispatchCommandKeyInWorld:event: drawingClass expandAll extractScreenRegion:andPutSketchInHand: findAChangeSorter: findAFileList: findAMessageNamesWindow: findAPreferencesPanel: findATranscript: findAWindowSatisfying:orMakeOneUsing: findDirtyBrowsers: findDirtyWindows: findWindow: getWorldMenu: grabDrawingFromScreen: grabFloodFromScreen: grabLassoFromScreen: grabRubberBandFromScreen: initializeDesktopCommandKeySelectors invokeWorldMenu: keyboardNavigationHandler keyboardNavigationHandler: keystrokeInWorld: putUpNewMorphMenu putUpWorldMenu: putUpWorldMenuFromEscapeKey reportLocalAddress respondToCommand:bySending:to: undoOrRedoCommand yellowButtonClickOnDesktopWithEvent:) ('world state' abandonAllHalos addHand: addMorph:centeredNear: addMorphsAndModel: allNonFlapRelatedSubmorphs allNonWindows assureNotPaintingElse: assuredCanvas beWorldForProject: checkCurrentHandForObjectToPaste checkCurrentHandForObjectToPaste2 chooseClickTarget colorAt:belowMorph: deEmphasizeViewMVC: deleteAllHalos displayWorld displayWorldAsTwoTone displayWorldNonIncrementally displayWorldSafely doOneCycle doOneCycleInBackground doOneSubCycle dragThroughOnDesktop: embeddedProjectDisplayMode endDrawing: exit flashRects:color: fullRepaintNeeded goBack haloMorphs initForProject: install installFlaps jumpToProject nextPage noDisplayDuring: optimumExtentFromAuthor paintBox paintBoxOrNil patchAt:without:andNothingAbove: pauseEventRecorder previousPage privateOuterDisplayWorld removeHand: repairEmbeddedWorlds repositionFlapsAfterScreenSizeChange restoreFlapsDisplay restoreMainDockingBarDisplay restoreMorphicDisplay saveAsWorld sketchEditorOrNil sleep someHalo specialNameInModelFor: startSteppingSubmorphsOf:) ('*Tools' defaultDesktopCommandKeyTriplets findAMonticelloBrowser) ('private' privateFullMoveBy: privateMoveBy:) ('thumbnail' icon) ('polymorph' modalLockTo: modalUnlockFrom:) ('recompilation' updateStatePostRecompile) ('submorphs - add/remove' addAllMorphs: addMorphFront:) ('submorphs - accessing' allMorphsDo: morphsInFrontOf:overlapping:do:) ('flaps' accommodateFlap: addGlobalFlaps assureFlapTabsFitOnScreen correspondingFlapTab deleteGlobalFlapArtifacts enableGlobalFlaps flapTabs localFlapTabs offsetForAccommodating:onEdge: removeAccommodationForFlap:) ('Nebraska' addRemoteClient: convertRemoteClientToBuffered: hasRemoteServer releaseRemoteServer remoteServer remoteServer: removeRemoteClient: transferRemoteServerFrom:) ('*60Deprecated-menu & halo' isOpenForDragNDropString) ('*services-base' focusedRequestor openWorldMenu requestor worldMenu) ('*60Deprecated-accessing' modalWindow: removeModalWindow) ('*MorphicExtras-flaps' deleteAllFlapArtifacts) ('*ST80-Support' standardSystemController) ('*Protocols' currentVocabulary) !
ParagraphEditor class removeSelector: #yellowButtonExpertMenu! ParagraphEditor class removeSelector: #yellowButtonNoviceMenu! PackageDependencyTest removeSelector: #testEtoys! ObjectlandMorph removeSelector: #createEtoysProject! ObjectExplorer removeSelector: #viewerForValue! NativeImageSegment removeSelector: #findRogueRootsAllMorphs:! NativeImageSegment removeSelector: #rootsIncludingPlayers! NativeImageSegment removeSelector: #savePlayerReferences:! MorphicModel removeSelector: #addModelYellowButtonMenuItemsTo:forMorph:hand:!
!MorphicModel reorganize! ('accessing' model modelOrNil slotName wantsSlot) ('caching' releaseCachedState) ('classification' isMorphicModel) ('compilation' addPartNameLike:withValue: compileAccessForSlot: compilePropagationMethods nameFor: propagate:as: removeAll slotSelectorFor: use:orMakeModelSelectorFor:in:) ('debug and other' installModelIn:) ('drag and drop' allowSubmorphExtraction isOpen) ('geometry' charactersOccluded newBounds: recomputeBounds) ('initialization' defaultBorderColor defaultBounds defaultColor duplicate:from: initialize model: model:slotName:) ('menu' addCustomMenuItems:hand: closeToEdits openToEdits) ('naming' choosePartName) ('printing' initString) ('submorphs - accessing' allKnownNames) ('submorphs - add/remove' delete) ('*MorphicExtras-compilation' compileInitMethods) !
MorphExtension removeSelector: #player! MorphExtension removeSelector: #player:! Object subclass: #MorphExtension instanceVariableNames: 'locked visible sticky balloonText balloonTextSelector externalName isPartsDonor actorState eventHandler otherProperties' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Kernel'!
!MorphExtension reorganize! ('accessing' actorState actorState: balloonText balloonTextSelector balloonTextSelector: balloonText: eventHandler eventHandler: externalName: locked locked: sticky sticky: visible visible:) ('accessing - layout properties' layoutFrame layoutFrame: layoutPolicy layoutPolicy: layoutProperties layoutProperties:) ('accessing - other properties' assureOtherProperties hasOtherProperties hasProperty: initializeOtherProperties otherProperties privateOtherProperties: removeOtherProperties removeProperty: setProperty:toValue: sortedPropertyNames valueOfProperty: valueOfProperty:ifAbsentPut: valueOfProperty:ifAbsent:) ('connectors-copying' copyWeakly propertyNamesNotCopied veryDeepFixupWith: veryDeepInner:) ('initialization' initialize) ('objects from disk' comeFullyUpOnReload:) ('other' isDefault) ('printing' printOn:) ('viewer' externalName) ('*MorphicExtras-copying' updateReferencesUsing:) ('*MorphicExtras-Undo' removeUndoCommands) ('parts bin' isPartsDonor isPartsDonor:) ('*60Deprecated-other' inspectElement) !
ImageMorph class removeSelector: #descriptionForPartsBin!
!ImageMorph class reorganize! ('accessing' defaultForm) ('class initialization' initialize registerInFlapsRegistry unload) ('instance creation' fromString: fromString:font:) ('scripting' authoringPrototype) !
Morph class removeSelector: #selectionBackground!
!Morph class reorganize! ('class initialization' initialize) ('fileIn/Out' fileReaderServicesForFile:suffix: fromFileName: serviceLoadMorphFromFile services) ('initialize-release' unload) ('instance creation' initializedInstance newBounds: newBounds:color: newSticky) ('misc' morphsUnknownToTheirOwners) ('new-morph participation' includeInNewMorphMenu newStandAlone partName:categories:documentation: partName:categories:documentation:sampleImageForm:) ('scripting' authoringPrototype) ('testing' allSketchMorphClasses allSketchMorphForms isSketchMorphClass) ('preferences' haloForAll haloForAll: indicateKeyboardFocus indicateKeyboardFocus: metaMenuForAll metaMenuForAll: preferredCornerRadius preferredCornerRadius: themeProperties useSoftDropShadow useSoftDropShadow:) ('*Tools-icons' toolIcon) ('defaults') ('layer names' backmostLayer balloonLayer defaultLayer dialogLayer frontmostLayer haloLayer menuLayer navigatorLayer progressLayer windowLayer) ('*MorphicExtras-arrow head size' defaultArrowheadSize obtainArrowheadFor:defaultValue:) ('*MorphicExtras-parts bin' supplementaryPartsDescriptions) ('*MorphicExtras-new-morph participation' addPartsDescriptorQuadsTo:if:) !
MenuMorph removeSelector: #allWordings! MenuMorph removeSelector: #allWordingsNotInSubMenus:! MenuMorph removeSelector: #undoGrabCommand!
!MenuMorph reorganize! ('accessing' addBlankIconsIfNecessary: commandKeyHandler commandKeyHandler: defaultTarget hasItems hasSubMenu: itemWithWording: items lastItem lastSelection matchString matchString: popUpOwner popUpOwner: rootMenu stayUp stayUp:) ('construction' add:action: add:help:action: add:icon:help:subMenu: add:icon:subMenu: add:selector:argument: add:subMenu: add:subMenu:target:selector:argumentList: add:target:action: add:target:selector: add:target:selector:argument: add:target:selector:argumentList: addAllFrom: addItem: addLine addList: addMenuItem: addService:for: addServices2:for:extraLines: addServices:for:extraLines: addStayUpIcons addStayUpItem addStayUpItemSpecial addTitle: addTitle:icon: addTitle:icon:updatingSelector:updateTarget: addTitle:updatingSelector:updateTarget: addTranslatedList: addUpdating:action: addUpdating:enablement:action: addUpdating:enablementSelector:target:selector:argumentList: addUpdating:target:action: addUpdating:target:selector:argumentList: addUpdatingItem: addWithLabel:enablement:action: addWithLabel:enablementSelector:target:selector:argumentList: balloonTextForLastItem: defaultTarget: labels:lines:selections: title:) ('control' activeSubmenu: deleteIfPopUp deleteIfPopUp: popUpAdjacentTo:forHand:from: popUpAt:forHand:in: popUpAt:forHand:in:allowKeyboard: popUpEvent:in: popUpForHand:in: popUpInWorld popUpInWorld: popUpNoKeyboard selectItem:event: updateColor wantsToBeDroppedInto:) ('copying' veryDeepFixupWith: veryDeepInner:) ('dropping/grabbing' justDroppedInto:event:) ('events' activate: deactivate: handlesMouseDown: handlesMouseOver: mouseDown: mouseLeave: mouseMove: mouseUp: processFocusEvent:using: wantsEveryMouseMove) ('initialization' delete initialize setDefaultParameters setTitleParameters setTitleParametersFor:) ('keyboard control' displayFiltered: handlesKeyboard: keyStroke: matchString:event: moveSelectionDown:event: removeMatchString removeMatchString: selectCurrentItem: selectMoreItem:) ('menu' addCustomMenuItems:hand: addItem addTitle detachSubMenu: doButtonAction removeStayUpBox removeStayUpItems setInvokingView: setTarget: target: toggleStayUp: toggleStayUpIgnore:evt: updateItemsWithTarget:orWithHand:) ('modal control' informUserAt:during: invokeAt:in:allowKeyboard: invokeModal invokeModal: invokeModalAt:in: invokeModalAt:in:allowKeyboard: isModalInvokationDone isModalInvokationDone: modalSelection modalSelection:) ('private' invokeMetaMenu: positionAt:relativeTo:inWorld: selectedItem) ('update' applyUserInterfaceTheme updateMenu) ('keystroke helpers' handleCRStroke: handleCommandKeyPress: handleDelStroke: handleDownStroke: handleEscStroke: handleFiltering: handleLeftStroke: handlePageDownStroke: handlePageUpStroke: handleRightStroke: handleUpStroke: hideKeyboardHelp keyStrokeHandlers noteRootMenuHasUsedKeyboard showKeyboardHelp stepIntoSubmenu:) ('rounding' wantsRoundedCorners) ('testing' indicateKeyboardFocus) ('*ToolBuilder-Morphic-opening' openAsTool) ('*MorphicExtras-accessing') ('*60Deprecated-keyboard control' filterListWith: unfilterOrEscape:) !
MenuItemMorph removeSelector: #adaptToWorld:! MenuItemMorph removeSelector: #allWordingsNotInSubMenus:!
!MenuItemMorph reorganize! ('accessing' action: addSubMenu: addUpdatingSubMenu: arguments arguments: colorToUse contentString contentString: contents: contents:withMarkers: contents:withMarkers:inverse: hasIcon hasIconOrMarker hasMarker hasSubMenu hasSubMenu: help: icon icon: isEnabled isEnabled: isStayUpItem itemWithWording: selector selector: subMenu subMenu: subMenuUpdater:selector: subMenuUpdater:selector:arguments: target target:) ('copying' veryDeepFixupWith: veryDeepInner:) ('drawing' drawBackgroundOn: drawIconOn: drawLabelOn: drawOn: drawSubMenuMarkerOn:) ('events' activateOwnerMenu: activateSubmenu: doButtonAction handleMouseUp: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: invokeWithEvent: mouseDown: mouseEnter: mouseEnterDragging: mouseUp:) ('grabbing' aboutToBeGrabbedBy: duplicateMorph:) ('initialization' defaultBounds deleteIfPopUp: initialize) ('layout' doLayoutIn: minHeight minWidth stringMargin) ('selecting' adjacentTo deselect: isSelected isSelected: select:) ('private' bottomArrow createSubmenu createUpdatingSubmenu deselectItem iconForm leftArrow offImage onImage rightArrow selectionFillStyle subMenuMarker upArrow updateLayoutInDockingBar) ('browse' browseImplementationOfActionSelector buildDebugMenu: debugAction effectiveActionSelector effectiveActionTarget) ('testing' isMenuItemMorph) ('updating' applyUserInterfaceTheme) !
!LassoPatchMorph reorganize! ('dropping' justDroppedInto:event: wantsToBeDroppedInto:) ('initialization' initialize initializeToStandAlone) !
!GrabPatchMorph reorganize! ('dropping' justDroppedInto:event: wantsToBeDroppedInto:) ('initialization' initialize initializeToStandAlone) !
!ImageMorph reorganize! ('accessing' borderStyle: borderWidth: color: form image image: isOpaque isOpaque: preferredExtent setNewImageFrom: wantsRecolorHandle withSnapshotBorder) ('caching' releaseCachedState) ('drawing' drawOn:) ('geometry' extent:) ('initialization' initialize) ('menu' changeOpacity opacityString) ('menu commands' grabFromScreen readFromFile) ('menus' addCustomMenuItems:hand:) ('other' newForm:) ('parts bin' initializeToStandAlone) ('testing' isImageMorph) ('*MorphicExtras-Postscript Canvases' drawPostscriptOn:) !
HandMorph removeSelector: #removePendingHaloFor:! HandMorph removeSelector: #spawnMagicHaloFor:! HandMorph removeSelector: #triggerHaloFor:after:!
!HandMorph reorganize! ('accessing' anyButtonPressed colorForInsets lastEvent mouseOverHandler noButtonPressed targetOffset targetPoint userInitials userPicture userPicture:) ('balloon help' addBalloonHelp: balloonHelpList deleteBalloonTarget: removePendingBalloonFor: resetBalloonHelp: spawnBalloonFor: triggerBalloonFor:after:) ('caching' releaseCachedState) ('change reporting' invalidRect:from:) ('classification' isHandMorph) ('copying' veryDeepCopyWith:) ('cursor' cursorBounds showTemporaryCursor: showTemporaryCursor:hotSpotOffset: temporaryCursor) ('double click support' resetClickState waitForClicksOrDrag:event: waitForClicksOrDrag:event:selectors:threshold:) ('drawing' drawOn: fullDrawOn: hasChanged hasUserInformation needsToBeDrawn nonCachingFullDrawOn: restoreSavedPatchOn: savePatchFrom: shadowForm showHardwareCursor: updateCacheCanvas: visible:) ('drop shadows' shadowOffset) ('event handling' cursorPoint flushEvents noticeMouseOver:event: processEvents) ('events-processing' handleEvent: isCapturingGesturePoints sendFilterEventCaptureAgain:for:) ('focus handling' keyboardFocus keyboardFocus: mouseFocus mouseFocus: newKeyboardFocus: newMouseFocus: newMouseFocus:event: releaseAllFoci releaseKeyboardFocus releaseKeyboardFocus: releaseMouseFocus releaseMouseFocus:) ('genie-stubs' autoFocusRectangleBoundsFor: disableGenieFocus enableGenie focusStartEvent genieGestureProcessor isGenieAvailable isGenieEnabled isGenieFocused) ('geometry' position position: userInitials:andPicture:) ('grabbing/dropping' attachMorph: dropMorphs dropMorphs: dropMorph:event: grabMorph:from: targetOffset:) ('halo handling' halo: obtainHalo: releaseHalo: removeHalo removeHaloFromClick:on:) ('halos and balloon help' halo) ('initialization' becomeActiveDuring: initForEvents initialize interrupted resourceJustLoaded) ('layout' fullBounds) ('meta-actions' copyToPasteBuffer: grabMorph:) ('multilingual' clearKeyboardInterpreter keyboardInterpreter) ('objects from disk' objectForDataStream:) ('paste buffer' objectToPaste pasteBuffer pasteBuffer: pasteMorph) ('updating' applyUserInterfaceTheme changed) ('private events' generateDropFilesEvent: generateKeyboardEvent: generateMouseEvent: generateMouseWheelEvent: generateMouseWheelEvent:direction: generateWindowEvent: mouseDragTrailFrom: mouseTrailFrom: moveToEvent: sendEvent:focus: sendEvent:focus:clear: sendFocusEvent:to:clear: sendKeyboardEvent: sendListenEvent:to: sendListenEvents: sendMouseEvent:) ('selected object' selectedObject) ('*MorphicExtras-event handling' pauseEventRecorderIn:) ('gridded cursor' gridPointRaw gridTo:origin: griddedPoint: griddingOn turnOffGridding turnOnGridding) ('events-listening' addEventListener: addKeyboardListener: addListener:to: addMouseListener: eventListeners eventListeners: keyboardListeners keyboardListeners: mouseListeners mouseListeners: removeEventListener: removeKeyboardListener: removeListener:from: removeMouseListener:) ('events-filtering-bubbling' eventBubbleFilters keyboardBubbleFilters mouseBubbleFilters) ('events-filtering-capturing' eventCaptureFilters eventCaptureFilters: keyboardCaptureFilters keyboardCaptureFilters: mouseCaptureFilters mouseCaptureFilters:) ('events-debugging' logEvent: showEvent:) ('events-filtering' filterEvent:for: ignoreEvent:) ('Multilingual-ImmPlugin' compositionWindowManager) ('initialize-release' cleanUp:) !
!GraphMorph reorganize! ('accessing' color: cursor cursor: cursorAtEnd cursorColor cursorColor: cursorColorAtZeroCrossing cursorColorAtZeroCrossings: cursorWrapped: data data: dataColor dataColor: interpolatedValueAtCursor lastValue lastValue: startIndex startIndex: valueAtCursor valueAtCursor:) ('commands' appendValue: centerCursor clear loadSineWave loadSound: loadSoundData: playOnce reverse) ('drawing' drawOn:) ('event handling' handlesMouseDown: mouseMove:) ('initialization' defaultColor initialize) ('layout' layoutChanged) ('objects from disk' convertToCurrentVersion:refStream:) ('stepping' step) ('private' asNumber: drawCursorOn: drawDataOn: flushCachedForm keepIndexInView:) ('sound' addCustomMenuItems:hand: openWaveEditor readDataFromFile) !
DockingBarMorph removeSelector: #isSticky! DockingBarMorph removeSelector: #resistsRemoval! BookMorph removeSelector: #goToPage:transitionSpec:runTransitionScripts:! BookMorph removeSelector: #goToPageMorph:runTransitionScripts:! BookMorph removeSelector: #goToPageMorph:transitionSpec:runTransitionScripts:! BookMorph removeSelector: #goto:! BookMorph removeSelector: #keepTogether! BooklikeMorph removeSelector: #currentPlayerDo:!
!BooklikeMorph reorganize! ('menu commands' clearNewPagePrototype firstPage insertPage sortPages) ('menus' addCustomMenuItems:hand:) ('misc' addBookMenuItemsTo:hand: move pageSize pageSize: playPageFlipSound: showingFullScreenString showingPageControlsString) ('page controls' addPageControlMorph: fewerPageControls fullControlSpecs hidePageControls indexForPageControls makeDescriptionViewer makePageControlsFrom: makePageNumberItem setEventHandlerForPageControls: shortControlSpecs showPageControls showPageControls:) !
!BookPageSorterMorph reorganize! ('copying' veryDeepFixupWith: veryDeepInner:) ('dropping/grabbing' wantsToBeDroppedInto:) ('initialization' addControls book:morphsToSort: defaultBorderWidth defaultColor initialize) ('buttons' acceptSort getPartsBinStatus togglePartsBinStatus) ('private' changeExtent: closeButtonOnly columnWith: rowWith: wrapperFor:) ('accessing' pageHolder) !
!AlignmentMorph reorganize! ('classification' isAlignmentMorph) ('event handling' wantsKeyboardFocusFor:) ('geometry' addTransparentSpacerOfSize:) ('initialization' defaultBorderWidth defaultColor initialize openInWindowLabeled:inWorld:) ('object fileIn' convertOldAlignmentsNov2000:using:) ('objects from disk' convertToCurrentVersion:refStream:) ('visual properties' canHaveFillStyles) ('*MorphicExtras-initialization' basicInitialize) !
!BorderedMorph reorganize! ('accessing' borderColor: borderStyle: borderWidth: hasTranslucentColor useRoundedCorners useSquareCorners) ('drawing' areasRemainingToFill:) ('geometry' acquireBorderWidth: closestPointTo: intersectionWithLineSegmentFromCenterTo:) ('initialization' borderInitialize borderInset borderRaised borderSimple defaultBorderColor defaultBorderStyle defaultBorderWidth initialize) ('menu' addBorderStyleMenuItems:hand: changeBorderColor: changeBorderWidth:) ('resize handling' addCellGapToLayoutFrames addCornerGrips addEdgeGrips addGrips addMorph:fullFrame: addPaneHSplitterAtBottomOfRow: addPaneHSplitters addPaneSplitters addPaneVSplitterAtRightOfColumn: addPaneVSplitters changeCellGapOfLayoutFrames: cornerGrips doFastWindowReframe: edgeGrips fastFramingOn grips linkSubmorphsToSplitters paneMorphs removeCellGapFromLayoutFrames removeCornerGrips removeEdgeGrips removeGrips removePaneSplitters splitters wantsGrips wantsGrips: wantsPaneSplitters wantsPaneSplitters:) ('printing' fullPrintOn:) ('layout properties' cellGap:) ('display scale' displayScaleChangedBy: handlesDisplayScaleChangedBy:) ('*MorphicExtras-initialization' basicInitialize) ('*60Deprecated-private' setBorderWidth:borderColor: setColor:borderWidth:borderColor:) ('*60Deprecated-accessing' doesBevels) !
Morph removeSelector: #adaptToWorld:! Morph removeSelector: #addMagicHaloFor:! Morph removeSelector: #addMorphNearBack:! Morph removeSelector: #addPaintingItemsTo:hand:! Morph removeSelector: #allMenuWordings! Morph removeSelector: #allMorphsAndBookPagesInto:! Morph removeSelector: #allMorphsWithPlayersDo:! Morph removeSelector: #applyStatusToAllSiblings:! Morph removeSelector: #asNumber:! Morph removeSelector: #automaticViewing! Morph removeSelector: #bringAllSiblingsToMe:! Morph removeSelector: #chooseNewGraphic! Morph removeSelector: #chooseNewGraphicCoexisting:! Morph removeSelector: #chooseNewGraphicFromHalo! Morph removeSelector: #couldMakeSibling! Morph removeSelector: #currentPlayerDo:! Morph removeSelector: #cursor! Morph removeSelector: #cursor:! Morph removeSelector: #decimalPlacesForGetter:! Morph removeSelector: #defaultValueOrNil! Morph removeSelector: #demandsBoolean! Morph removeSelector: #demandsThumbnailing! Morph removeSelector: #doMenuItem:! Morph removeSelector: #embedInWindow! Morph removeSelector: #embeddedInMorphicWindowLabeled:! Morph removeSelector: #getNumericValue! Morph removeSelector: #gridFormOrigin:grid:background:line:! Morph removeSelector: #handUserASibling! Morph removeSelector: #indicateAllSiblings! Morph removeSelector: #inspectArgumentsPlayerInMorphic:! Morph removeSelector: #isAViewer! Morph removeSelector: #isCompoundTileMorph! Morph removeSelector: #isKedamaMorph! Morph removeSelector: #isLikelyRecipientForMouseOverHalos! Morph removeSelector: #isModalShell! Morph removeSelector: #isNumericReadoutTile! Morph removeSelector: #isPhraseTileMorph! Morph removeSelector: #isPlayfieldLike! Morph removeSelector: #isSoundTile! Morph removeSelector: #isStandardViewer! Morph removeSelector: #isStickySketchMorph! Morph removeSelector: #isSyntaxMorph! Morph removeSelector: #isTileEditor! Morph removeSelector: #isTileMorph! Morph removeSelector: #isTilePadMorph! Morph removeSelector: #isViewer! Morph removeSelector: #makeGraphPaper! Morph removeSelector: #makeGraphPaperGrid:background:line:! Morph removeSelector: #makeMultipleSiblings:! Morph removeSelector: #makeNascentScript! Morph removeSelector: #makeNewPlayerInstance:! Morph removeSelector: #makeSiblings:! Morph removeSelector: #makeSiblingsLookLikeMe:! Morph removeSelector: #menuItemAfter:! Morph removeSelector: #menuItemBefore:! Morph removeSelector: #methodCommentAsBalloonHelp! Morph removeSelector: #mustBeBackmost! Morph removeSelector: #noteDecimalPlaces:forGetter:! Morph removeSelector: #objectViewed! Morph removeSelector: #offerCostumeViewerMenu:! Morph removeSelector: #openAPropertySheet! Morph removeSelector: #openViewerForArgument! Morph removeSelector: #overlapsShadowForm:bounds:! Morph removeSelector: #pasteUpMorphHandlingTabAmongFields! Morph removeSelector: #player! Morph removeSelector: #player:! Morph removeSelector: #playerRepresented! Morph removeSelector: #preferredDuplicationHandleSelector! Morph removeSelector: #presenter! Morph removeSelector: #readoutForField:! Morph removeSelector: #referencePlayfield! Morph removeSelector: #renameInternal:! Morph removeSelector: #rotationStyle! Morph removeSelector: #rotationStyle:! Morph removeSelector: #roundUpStrays! Morph removeSelector: #saveDocPane! Morph removeSelector: #screenLocation! Morph removeSelector: #screenRectangle! Morph removeSelector: #setAsActionInButtonProperties:! Morph removeSelector: #setNumericValue:! Morph removeSelector: #setStandardTexture! Morph removeSelector: #shouldRememberCostumes! Morph removeSelector: #shuffleSubmorphs! Morph removeSelector: #standardPalette! Morph removeSelector: #tabAmongFields! Morph removeSelector: #textureParameters! Morph removeSelector: #unlockOneSubpart! Morph removeSelector: #updateAllScriptingElements! Morph removeSelector: #usableSiblingInstance! Morph removeSelector: #viewMorphDirectly! Morph removeSelector: #wantsHalo! Morph removeSelector: #wantsHaloFor:! Morph removeSelector: #wantsScriptorHaloHandle! Morph removeSelector: #wouldAcceptKeyboardFocusUponTab! Morph removeSelector: #wrappedInWindow:! Morph removeSelector: #wrappedInWindowWithTitle:!
!Morph reorganize! ('accessing' actorState: actorStateOrNil adoptPaneColor: balloonText balloonText: balloonTextSelector balloonTextSelector: beFlap: beSticky beTransparent beUnsticky borderColor borderColor: borderStyle borderStyle: borderStyleForSymbol: borderWidth borderWidth: borderWidthForRounding clearArea color color: colorForInsets couldHaveRoundedCorners defaultNameStemForInstances eventHandler eventHandler: hasTranslucentColor highlight highlightColor highlightColor: insetColor isFlap isLocked isShared isSticky lock lock: modelOrNil raisedColor regularColor regularColor: rememberedColor rememberedColor: resistsRemoval resistsRemoval: scaleFactor setBorderStyle: sqkPage sticky: toggleLocked toggleResistsRemoval toggleStickiness unHighlight unlock unlockContents url userString viewBox visibleClearArea wantsToBeCachedByHand) ('accessing - extension' assureExtension extension hasExtension initializeExtension privateExtension: resetExtension) ('accessing - properties' hasProperty: otherProperties removeProperty: setProperties: setProperty:toValue: valueOfProperty: valueOfProperty:ifAbsent: valueOfProperty:ifAbsentPut: valueOfProperty:ifPresentDo:) ('caching' fullLoadCachedState fullReleaseCachedState loadCachedState releaseCachedState) ('change reporting' addedMorph: colorChangedForSubmorph: invalidRect: invalidRect:from: privateInvalidateMorph: userSelectedColor:) ('classification' isAlignmentMorph isBalloonHelp isButton isFlapOrTab isFlapTab isFlexMorph isHandMorph isRenderer isTextMorph isWorldMorph isWorldOrHandMorph) ('connectors-scripting' wantsConnectorVocabulary) ('converting' asSnapshotThumbnail) ('copying' copy deepCopy duplicate duplicateMorphCollection: okayToDuplicate updateReferencesUsing: veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:) ('creation' asMorph) ('debug and other' addDebuggingItemsTo:hand: addMouseActionIndicatorsWidth:color: addMouseUpAction addMouseUpActionWith: addViewingItemsTo: allStringsAfter: allStringsAfter:do: altSpecialCursor0 altSpecialCursor1 altSpecialCursor2 altSpecialCursor3 altSpecialCursor3: buildDebugMenu: defineTempCommand deleteAnyMouseActionIndicators hasStrings inspectOwnerChain installModelIn: mouseUpCodeOrNil ownerChain programmedMouseDown:for: programmedMouseEnter:for: programmedMouseLeave:for: programmedMouseUp:for: removeMouseUpAction resumeAfterDrawError resumeAfterLayoutError resumeAfterStepError tempCommand) ('dispatching' disableSubmorphFocusForHand:) ('drawing' areasRemainingToFill: boundingBoxOfSubmorphs boundsWithinCorners changeClipSubmorphs clipLayoutCells clipLayoutCells: clipSubmorphs clipSubmorphs: clippingBounds doesOwnRotation drawDropHighlightOn: drawDropShadowOn: drawErrorOn: drawKeyboardFocusIndicationOn: drawMouseDownHighlightOn: drawOn: drawOverlayOn: drawRolloverBorderOn: drawSubmorphsOn: expandFullBoundsForDropShadow: expandFullBoundsForRolloverBorder: flashBounds fullDrawOn: hasClipSubmorphsString hide highlightedForMouseDown highlightedForMouseDown: imageForm imageForm:backgroundColor:forRectangle: imageForm:forRectangle: imageFormDepth: imageFormForRectangle: imageFormWithout:andStopThere: keyboardFocusColor keyboardFocusWidth refreshWorld shadowForm show updateDropShadowCache visible visible:) ('drop shadows' addDropShadow addDropShadowMenuItems:hand: changeShadowColor hasDropShadow hasDropShadow: hasDropShadowString hasRolloverBorder hasRolloverBorder: removeDropShadow setShadowOffset: shadowColor shadowColor: shadowOffset shadowOffset: shadowPoint: toggleDropShadow useSoftDropShadow useSoftDropShadow:) ('dropping/grabbing' aboutToBeGrabbedBy: acceptDroppingMorph:event: disableDragNDrop dragEnabled dragEnabled: dragNDropEnabled dragSelectionColor dropEnabled dropEnabled: dropHighlightColor dropSuccessColor enableDrag: enableDragNDrop enableDragNDrop: enableDrop: formerOwner formerOwner: formerPosition formerPosition: grabTransform handledOwnDraggingBy:on: highlightForDrop highlightForDrop: highlightedForDrop justDroppedInto:event: justGrabbedFrom: morphToDropInPasteUp: nameForUndoWording rejectDropMorphEvent: repelsMorph:event: resetHighlightForDrop separateDragAndDrop slideBackToFormerSituation: slideToTrash: startDrag:with: transportedMorph undoGrabCommand vanishAfterSlidingTo:event: wantsDroppedMorph:event: wantsToBeDroppedInto: wantsToBeOpenedInWorld willingToBeDiscarded) ('event handling' click click: cursorPoint doubleClick: doubleClickTimeout: firstClickTimedOut: handlerForMouseDown: handlerForYellowButtonDown: handlesKeyboard: handlesKeyboardOnlyOnFocus handlesKeyboardOnlyOnFocus: handlesMouseDown: handlesMouseMove: handlesMouseOver: handlesMouseOverDragging: handlesMouseStillDown: handlesMouseWheel: hasFocus hasKeyboardFocus hasKeyboardFocus: hasMouseFocus hasMouseFocus: keyDown: keyStroke: keyUp: keyboardFocusChange: keyboardFocusDelegate mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: mouseMove: mouseStillDown: mouseStillDownThreshold mouseUp: mouseWheel: moveOrResizeFromKeystroke: on:send:to: on:send:to:withValue: removeLink: restoreSuspendedEventHandler startDrag: suspendEventHandler transformFrom: transformFromOutermostWorld transformFromWorld wantsEveryMouseMove wantsKeyboardFocus wantsKeyboardFocusFor: wantsWindowEvents: windowEvent: wouldAcceptKeyboardFocus yellowButtonActivity:) ('events-accessing' actionMap updateableActionMap) ('events-alarms' addAlarm:after: addAlarm:at: addAlarm:with:after: addAlarm:with:at: addAlarm:with:with:after: addAlarm:with:with:at: addAlarm:withArguments:after: addAlarm:withArguments:at: alarmScheduler removeAlarm: removeAlarm:at:) ('events-processing' containsPoint:event: defaultEventDispatcher handleDropMorph: handleEvent: handleFocusEvent: handleKeyDown: handleKeyUp: handleKeystroke: handleListenEvent: handleMouseDown: handleMouseEnter: handleMouseLeave: handleMouseMove: handleMouseOver: handleMouseStillDown: handleMouseUp: handleMouseWheel: handleUnknownEvent: handleWindowEvent: mouseDownPriority mouseDownPriority: processEvent: processEvent:using: processFocusEvent: processFocusEvent:using: rejectDropEvent: rejectsEvent: sendFilterEvent:for:to: sendFilterEventBubble:for: sendFilterEventBubbleAgain:for: sendFilterEventCapture:for: sendFilterEventCaptureAgain:for: transformedFrom:) ('events-removing' releaseActionMap) ('fileIn/out' attachToResource prepareToBeSaved reserveUrl: saveAsResource saveOnFile saveOnURL saveOnURL: saveOnURLbasic updateAllFromResources updateFromResource) ('filter streaming' drawOnCanvas:) ('geometry' bottom bottom: bottomCenter bottomLeft bottomLeft: bottomRight bottomRight: bounds bounds: center center: extent extent: height height: left left: leftCenter pointAtFraction: position position: right right: rightCenter top top: topCenter topLeft topLeft: topRight topRight: width width:) ('geometry testing' containsPoint: fullContainsPoint: obtrudesBeyondContainer) ('halos and balloon help' addHalo addHalo: addHandlesTo:box: addOptionalHandlesTo:box: addSimpleHandlesTo:box: addWorldHandlesTo:box: balloonColor balloonColor: balloonFont balloonFont: balloonHelpAligner balloonHelpDelayTime balloonHelpTextForHandle: balloonMorphClass boundsForBalloon comeToFrontAndAddHalo createHalo defaultBalloonColor defaultBalloonFont defaultHaloDispatcher defersHaloOnClickTo: deleteBalloon editBalloonHelpContent: editBalloonHelpText halo haloClass haloDelayTime hasHalo hasHalo: mouseDownOnHelpHandle: noHelpString okayToAddDismissHandle okayToAddGrabHandle okayToBrownDragEasily okayToExtractEasily okayToResizeEasily okayToRotateEasily removeHalo setBalloonText: setBalloonText:maxLineLength: setCenteredBalloonText: showBalloon showBalloon: showBalloon:at: showBalloon:hand: transferHalo: transferHalo:using: wantsBalloon wantsDirectionHandles wantsDirectionHandles: wantsHaloFromClick wantsHaloFromClick: wantsHaloHandleWithSelector:inHalo: wantsRecolorHandle wantsSimpleSketchMorphHandles) ('initialization' basicInitialize defaultBounds defaultColor inAScrollPane initialize openCenteredInWorld openInHand openInWindow openInWindowLabeled: openInWindowLabeled:inWorld: openInWorld openInWorld: openNear: openNear:in: openNearMorph: resourceJustLoaded) ('layout' adjustLayoutBounds checkCellSpacingProperty: checkListSpacingProperty: checkResizingProperty: doLayout doLayoutIn: doLayoutSafely fullBounds layoutChanged layoutComputed layoutInBounds: layoutInBounds:positioning: layoutProportionallyIn: layoutProportionallyInBounds:positioning: minExtent minExtent: minHeight minHeight: minWidth minWidth: ownerChanged ownerChangedHandler ownerChangedHandler: privateFullBounds privateFullBoundsForRedraw setExtentFromLayout: setLayoutBoundsFromLayout: setPositionFromLayout: submorphBounds submorphBoundsForShrinkWrap) ('layout-menu' addCellLayoutMenuItems:hand: addLayoutMenuItems:hand: addTableLayoutMenuItems:hand: cellPositioningString: cellSpacingString: changeCellGap: changeCellInset: changeClipLayoutCells changeDisableTableLayout changeHeightForWidth changeLayoutInset: changeListDirection: changeMaxCellSize: changeMinCellSize: changeNoLayout changeProportionalLayout changeReverseCells changeRubberBandCells changeTableLayout changeWidthForHeight changesHeightForWidth changesWidthForHeight hResizingString: hasClipLayoutCellsString hasDisableTableLayoutString hasNoLayoutString hasProportionalLayoutString hasReverseCellsString hasRubberBandCellsString hasTableLayoutString layoutMenuPropertyString:from: listCenteringString: listDirectionString: listSpacingString: vResizingString: wrapCenteringString: wrapDirectionString:) ('macpal' flash) ('menu' addBorderStyleMenuItems:hand: addGestureMenuItems:hand: addGraphModelYellowButtonItemsTo:event: addModelYellowButtonItemsTo:event: addMyYellowButtonMenuItemsToSubmorphMenus addNestedYellowButtonItemsTo:event: addTitleForHaloMenu: addYellowButtonMenuItemsTo:event: buildYellowButtonMenu: hasYellowButtonMenu outermostOwnerWithYellowButtonMenu startWiring wantsMetaMenu wantsMetaMenu: wantsYellowButtonMenu wantsYellowButtonMenu:) ('menus' absorbStateFromRenderer: addAddHandMenuItemsForHalo:hand: addCopyItemsTo: addCustomHaloMenuItems:hand: addCustomMenuItems:hand: addExportMenuItems:hand: addFillStyleMenuItems:hand: addHaloActionsTo: addMiscExtrasTo: addStandardHaloMenuItemsTo:hand: addToggleItemsToHaloMenu: addWorldTargetSightingItems:hand: adhereToEdge adhereToEdge: adjustedCenter adjustedCenter: changeColor changeDirectionHandles changeDrag changeDragAndDrop changeDrop collapse defaultArrowheadSize exploreInMorphic exploreInMorphic: exportAsBMP exportAsBMPNamed: exportAsGIF exportAsGIFNamed: exportAsJPEG exportAsJPEGNamed: exportAsPNG exportAsPNGNamed: hasDirectionHandlesString hasDragAndDropEnabledString hasDragEnabledString hasDropEnabledString helpButton inspectInMorphic inspectInMorphic: lockUnlockMorph lockedString maybeAddCollapseItemTo: model presentHelp reasonableBitmapFillForms reasonableForms resetForwardDirection resistsRemovalString setArrowheads setRotationCenter setRotationCenterFrom: setToAdhereToEdge: snapToEdgeIfAppropriate stickinessString transferStateToRenderer: uncollapseSketch) ('meta-actions' addEmbeddingMenuItemsTo:hand: beThisWorldsModel buildHandleMenu: buildMetaMenu: changeColorTarget:selector:originalColor:hand: copyToPasteBuffer: dismissMorph dismissMorph: duplicateMorph: duplicateMorphImage: embedInto: grabMorph: inspectAt:event: invokeMetaMenu: invokeMetaMenuAt:event: maybeDuplicateMorph maybeDuplicateMorph: openATextPropertySheet potentialEmbeddingTargets potentialTargets potentialTargetsAt: resizeFromMenu resizeMorph: saveAsPrototype showActions showHiders sightTargets: sightWorldTargets: subclassMorph targetFromMenu: targetWith:) ('miscellaneous' setExtentFromHalo: setFlexExtentFromHalo:) ('naming' assureExternalName downshiftedNameOfObjectRepresented externalName innocuousName knownName name: nameForFindWindowFeature nameInModel nameOfObjectRepresented renameTo: setNamePropertyTo: setNameTo: specialNameInModel tryToRenameTo:) ('objects from disk' objectForDataStream: storeDataOn:) ('other events' menuButtonMouseEnter: menuButtonMouseLeave:) ('parts bin' inPartsBin initializeToStandAlone isPartsBin isPartsDonor isPartsDonor: markAsPartsDonor partRepresented residesInPartsBin) ('printing' clipText colorString: constructorString fullPrintOn: initString morphReport morphReportFor: morphReportFor:on:indent: pagesHandledAutomatically printConstructorOn:indent: printConstructorOn:indent:nodeDict: printOn: printSpecs printSpecs: printStructureOn:indent: reportableSize structureString textToPaste) ('rotate scale and flex' addFlexShell addFlexShellIfNecessary assureFlexShell forwardDirection forwardDirection: heading heading: keepsTransform newTransformationMorph referencePosition referencePosition: referencePositionInWorld referencePositionInWorld: removeFlexShell rotationCenter rotationCenter: rotationDegrees rotationDegrees: setDirectionFrom:) ('rounding' cornerRadius cornerRadius: cornerStyle cornerStyle: roundedCorners roundedCornersString toggleCornerRounding wantsRoundedCorners) ('stepping' arrangeToStartStepping arrangeToStartSteppingIn: isStepping isSteppingSelector: start startStepping startStepping:at:arguments:stepTime: startSteppingIn: startSteppingSelector: step stepAt: stepTime stop stopStepping stopSteppingSelector: stopSteppingSelfAndSubmorphs wantsSteps) ('structure' activeHand allOwners allOwnersDo: containingWindow firstOwnerSuchThat: hasOwner: isInDockingBar isInSystemWindow isInWorld morphPreceding: nearestOwnerThat: orOwnerSuchThat: outermostMorphThat: outermostWorldMorph owner ownerThatIsA: ownerThatIsA:orA: pasteUpMorph primaryHand renderedMorph root rootAt: topPasteUp topRendererOrSelf withAllOwners withAllOwnersDo: world) ('testing' canDrawAtHigherResolution canDrawBorder: completeModificationHash indicateKeyboardFocus isDockingBar isFlexed isFullOnScreen isImageMorph isLineMorph isMenuItemMorph isMorph isSafeToServe isSelectionMorph isSketchMorph isTransferMorph modificationHash shouldDropOnMouseUp) ('text-anchor' addTextAnchorMenuItems:hand: asTextAnchor textAnchorProperties) ('thumbnail' icon iconOrThumbnail iconOrThumbnailOfSize: morphRepresented permitsThumbnailing representativeNoTallerThan:norWiderThan:thumbnailHeight: thumbnail updateThumbnailUrl updateThumbnailUrlInBook:) ('undo' commandHistory undoMove:redo:owner:bounds:predecessor:) ('updating' applyUserInterfaceTheme changed) ('user interface' defaultLabelForInspector doCancel initialExtent playSoundNamed:) ('visual properties' canApplyUserInterfaceTheme canHaveFillStyles defaultBitmapFillForm fillStyle fillStyle: fillWithRamp:oriented: useBitmapFill useDefaultFill useGradientFill useSolidFill) ('WiW support' eToyRejectDropMorph:event: randomBoundsFor: shouldGetStepsFrom:) ('private' canBeEncroached privateAddAllMorphs:atIndex: privateAddMorph:atIndex: privateBounds: privateColor: privateDeleteWithAbsolutelyNoSideEffects privateFullBounds: privateFullMoveBy: privateMoveBy: privateOwner: privateRemove: privateRemoveMorphWithAbsolutelyNoSideEffects: privateSubmorphs privateSubmorphs:) ('accessing-backstop' target:) ('geniestubs' allowsGestureStart: isGestureStart: mouseStillDownStepRate redButtonGestureDictionaryOrName: yellowButtonGestureDictionaryOrName:) ('*morphic-Postscript Canvases' asPostscript clipPostscript drawPostscriptOn: fullDrawPostscriptOn: printPSToFile) ('button' doButtonAction) ('model access' models) ('other' removeAllButFirstSubmorph) ('selected object' selectedObject) ('polymorph' modalLockTo: modalUnlockFrom: openModal:) ('*Morphic-Sound-piano rolls' addMorphsTo:pianoRoll:eventTime:betweenTime:and: encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: justDroppedIntoPianoRoll:event: pauseFrom: resetFrom: resumeFrom: triggerActionFromPianoRoll) ('events-filtering-bubbling' addEventBubbleFilter: addKeyboardBubbleFilter: addMouseBubbleFilter: eventBubbleFilters eventBubbleFilters: keyboardBubbleFilters keyboardBubbleFilters: mouseBubbleFilters mouseBubbleFilters: removeEventBubbleFilter: removeKeyboardBubbleFilter: removeMouseBubbleFilter:) ('events-filtering-capturing' addEventCaptureFilter: addKeyboardCaptureFilter: addMouseCaptureFilter: eventCaptureFilters eventCaptureFilters: keyboardCaptureFilters keyboardCaptureFilters: mouseCaptureFilters mouseCaptureFilters: removeEventCaptureFilter: removeKeyboardCaptureFilter: removeMouseCaptureFilter:) ('events-filtering' addFilter:to: eventFilterDocumentation removeFilter:from:) ('*ToolBuilder-Morphic-opening' buildWith: openAsTool) ('geometry - misc' align:with: positionSubmorphs setConstrainedPosition:hangOut: shiftSubmorphsOtherThan:by: transformedBy: worldBounds worldBoundsForHalo) ('geometry - local/global' bounds:from: bounds:in: boundsIn: boundsInWorld fullBoundsInWorld globalPointToLocal: intersects: localPointToGlobal: point:from: point:in: pointFromWorld: pointInWorld: positionInWorld) ('geometry - layout' innerBounds innerBounds: innerExtent innerExtent: innerPosition innerPosition: layoutBounds layoutBounds: layoutExtent layoutExtent: layoutPosition layoutPosition: minimumExtent minimumExtent: minimumHeight minimumHeight: minimumWidth minimumWidth: outerBounds outerBounds: outerExtent outerExtent: outerPosition outerPosition:) ('Multilingual-ImmPlugin' preferredKeyboardBounds preferredKeyboardPosition) ('*ToolBuilder-Morphic' inspectorClass) ('submorphs - add/remove' abandon addAllMorphs: addAllMorphs:after: addAllMorphs:behind: addAllMorphs:inFrontOf: addAllMorphsBack: addAllMorphsFront: addMorph: addMorph:after: addMorph:asElementNumber: addMorph:atIndex: addMorph:behind: addMorph:inFrontOf: addMorphBack: addMorphFront: comeToFront delete goBehind privateDelete removeAllMorphs removeAllMorphsIn: removeMorph:) ('submorphs - misc' actWhen actWhen: addMorph:fullFrame: addMorphCentered: addMorphFront:fromWorldPosition: addMorphFrontFromWorldPosition: allNonSubmorphMorphs copyWithoutSubmorph: deleteDockingBars deleteSubmorphsWithProperty: deleteUnlessHasFocus dismissViaHalo dockingBars findA: findDeepSubmorphThat:ifAbsent: findDeeplyA: findSubmorphBinary: hasSubmorphWithProperty: indexOfMorphAbove: mainDockingBars morphsAt:behind:unlocked: morphsInFrontOf:overlapping:do: morphsInFrontOverlapping: morphsInFrontOverlapping:do: replaceSubmorph:by: rootMorphsAt: rootMorphsAtGlobal: submorphAfter submorphBefore submorphOfClass: submorphWithProperty:) ('submorphs - layers' addAllMorphsBackInLayers: addAllMorphsFrontInLayers: addAllMorphsInLayers: addMorphBackInLayer: addMorphFrontInLayer: addMorphInLayer: morphicLayerNumber morphicLayerNumber: reorderSubmorphsInLayers wantsToBeTopmost) ('submorphs - accessing' allKnownNames allMorphs firstSubmorph lastSubmorph morphsAt: morphsAt:unlocked: morphsAt:unlocked:useFullBounds: submorphCount submorphIndexOf: submorphNamed: submorphNamed:ifNone: submorphThat:ifNone: submorphs submorphsSatisfying:) ('submorphs - enumerating' allMorphsBreadthFirstDo: allMorphsBreadthFirstDo:sorted: allMorphsDepthFirstDo: allMorphsDo: allSubmorphNamesDo: morphsAt:unlocked:do: morphsAt:unlocked:useFullBounds:do: submorphsBehind:do: submorphsDo: submorphsInFrontOf:do: submorphsReverseDo:) ('layout properties' assureGridLayoutProperties assureLayoutProperties assureTableLayoutProperties copyLayoutProperties disableLayout disableLayout: disableTableLayout disableTableLayout: hResizing hResizing: layoutInset layoutInset: layoutPolicy layoutPolicy: layoutProperties layoutProperties: vResizeToFit: vResizing vResizing:) ('layout properties - table' cellGap cellGap: cellInset cellInset: cellPositioning cellPositioning: cellSpacing cellSpacing: listCentering listCentering: listDirection listDirection: listSpacing listSpacing: maxCellSize maxCellSize: minCellSize minCellSize: reverseTableCells reverseTableCells: rubberBandCells rubberBandCells: spaceFillWeight spaceFillWeight: wrapCentering wrapCentering: wrapDirection wrapDirection:) ('layout properties - grid' gridModulus gridModulus: gridOrigin gridOrigin:) ('submorphs - testing' hasSubmorphs) ('submorphs - callbacks' intoWorld: noteNewOwner: outOfWorld: removedMorph:) ('layout properties - proportional' layoutFrame layoutFrame:) ('halo notification' aboutToBeDraggedViaHalo aboutToBeGrownViaHalo aboutToBeRotatedViaHalo aboutToBeScaledViaHalo changedViaHalo:) ('display scale' displayScaleChangedBy: handlesDisplayScaleChangedBy:) ('*60Deprecated-events-processing' handleDropFiles:) ('*MorphicExtras-menus' dismissButton printPSToFileNamed:) ('*60Deprecated-rotate scale and flex' degreesOfFlex) ('*60Deprecated-text-anchor' changeDocumentAnchor changeInlineAnchor changeParagraphAnchor hasDocumentAnchorString hasInlineAnchorString hasParagraphAnchorString relativeTextAnchorPosition relativeTextAnchorPosition: textAnchorType textAnchorType:) ('*MorphicExtras' nextOwnerPage previousOwnerPage) ('*60Deprecated-event handling' dropFiles: wantsDropFiles:) ('*60Deprecated-geometry' gridPoint: griddedPoint:) ('*services-base' requestor) ('*60Deprecated-accessing' doesBevels) ('*60Deprecated-meta-actions' blueButtonDown: blueButtonUp: handlerForBlueButtonDown: handlerForMetaMenu:) ('*60Deprecated-user-interface' becomeModal) ('*MorphicExtras-books' updateCachedThumbnail) ('*60Deprecated-initialization' inATwoWayScrollPane) ('*MorphicExtras-geometry' shiftSubmorphsBy:) ('*60Deprecated-dropping/grabbing' toggleDragNDrop) ('*60Deprecated-copying' fullCopy) ('*MorphicExtras-postscript' asEPS asPostscriptPrintJob exportAsEPS exportAsEPSNamed:) ('*60Deprecated-WiW support' addMorphInFrontOfLayer: morphicLayerNumberWithin:) ('*60Deprecated-MorphicExtras-accessing' highlightOnlySubmorph:) ('*61Deprecated-drawing' highlightForMouseDown highlightForMouseDown:) !
InstanceBrowser removeSelector: #viewViewee!
!Lexicon reorganize! ('basic operation' annotation displaySelector: messageListIndex:) ('category list' categoriesPane categoryDefiningSelector: categoryList categoryListIndex categoryListIndex: categoryListKey:from: categoryListMenu:shifted: categoryListMenuTitle categoryWithNameSpecifiedBy: chooseCategory: mainCategoryListMenu: newCategoryPane reformulateCategoryList selectCategoryAll selectWithinCurrentCategoryIfPossible: selectedCategoryName selectorsReferringToClassVar showCategoriesPane) ('contents' contents) ('control buttons' customButtonSpecs) ('history' navigateToNextMethod navigateToPreviousMethod navigateToRecentMethod removeFromSelectorsVisited removeFromSelectorsVisited: selectorsVisited updateSelectorsVisitedfrom:to:) ('initialization' customButtonsFrame: initListFrom:highlighting: listFrame:fromLeft:width:) ('limit class' chooseLimitClass initialLimitClass limitClass limitClass: limitClassString setLimitClass:) ('menu commands' offerMenu removeMessage showCategory showHomeCategory showMainCategory) ('message category functions' canShowMultipleMessageCategories) ('message list menu' messageListKey:from:) ('model glue' doItReceiver okayToAccept targetObject) ('new-window queries' browseVariableAssignments browseVariableReferences) ('search' hasSearchPane lastSearchString lastSearchString: lastSendersSearchSelector methodListFromSearchString: obtainNewSearchString selectorsMatching setMethodListFromSearchString showSearchPane toggleSearch) ('selection' categoryOfSelector: selectImplementedMessageAndEvaluate: selectSelectorItsNaturalCategory: selectWithinCurrentCategory: selectedClassOrMetaClass selectedMessage setToShowSelector:selectCategory:) ('senders' navigateToASender selectorsSendingSelectedSelector setSendersSearch) ('transition' maybeReselectClass:selector: noteAcceptanceOfCodeFor: preserveSelectorIfPossibleSurrounding: reformulateList reformulateListNoting: retainMethodSelectionWhileSwitchingToCategory:) ('vocabulary' chooseVocabulary switchToVocabulary: useVocabulary:) ('window title' addModelItemsToWindowMenu: adjustWindowTitle startingWindowTitle) ('within-tool queries' currentQueryParameter methodsWithInitials methodsWithInitials: queryCharacterization seeAlso seeAlso: selectorsChanged selectorsDefiningInstVar selectorsReferringToInstVar selectorsRetrieved setLocalClassVarRefs setLocalInstVarDefs setLocalInstVarRefs showMethodsInCurrentChangeSet showMethodsWithInitials showMethodsWithInitials: showQueryResultsCategory) ('toolbuilder' addSpecialButtonsTo:with: buildCategoryListWith: buildCustomButtonsWith: buildWith: openOnClass:inWorld:showingSelector: openOnClass:showingSelector: wantsAnnotationPane) ('morphic' representsSameBrowseeAs: targetClass) ('message list' formattedLabel:forSelector:inClass: messageHelpAt: messageIconAt:) ('user interface' defaultWindowColor) ('private' contents:notifying: contents:oldSelector:in:classified:notifying: targetForContents:) !
Object subclass: #MenuIcons instanceVariableNames: '' classVariableNames: 'Icons ScriptingIcons TranslatedIcons TranslationLocale' poolDictionaries: '' category: 'Morphic-Menus'! Inspector removeSelector: #addEtoysItemsTo:!
!Inspector reorganize! ('accessing' context context: customFields doItContext doItReceiver fields object object: selectionIndex selectionIndex:) ('private' allInstVarsTranslated) ('toolbuilder' buildCodePaneWith: buildExploreButtonWith: buildFieldListWith: buildValuePaneWith: buildWith: replaceInspectorWithExplorer) ('*Protocols-Tools' browseFullProtocol spawnFullProtocol spawnProtocol) ('*60Deprecated-selecting' selectedSlotName) ('user interface - styling' aboutToStyle:requestor: fieldListStyler typeValue: updateStyler: updateStyler:requestor:) ('menu - construction' addClassItemsTo: addCollectionItemsTo: addFieldItemsTo: addInstVarItemsTo: addObjectItemsTo:) ('fields - custom' addCustomField addCustomField: hasCustomFields newCustomField removeCustomField: requestCustomFieldOrCancel:) ('user interface' applyUserInterfaceTheme defaultIntegerBase fieldList getContents representsSameBrowseeAs: textColorForError valuePane) ('menu - commands' browseClass browseClassHierarchy browseVariableAssignments browseVariableReferences chaseSelectionPointers copyExpression copyName exploreSelection exploreSelectionPointers inspectOne inspectOneOf: inspectOneOfFrom:to: inspectSelection inspectSelectionBasic objectReferencesToSelection removeSelection) ('selection - convenience' classOfSelection selectedClass selectedInstVarName selectionIsReadOnly selectionOrObject typeOfSelection) ('accessing - contents' contents:notifying: contentsTyped contentsTyped: expression expression:) ('fields - error handling' contentsForErrorDoing: emphasizeError: streamError:on: streamErrorDoing:on:) ('fields - truncation' contentsForTruncationOf: streamOn:truncate:collectFields: streamOn:truncate:collectFields:ellipsisFrom: truncationLimit truncationTail) ('fields - drag and drop' dragFromFieldList: dragTypeInFieldListAt: dropOnFieldList:at:shouldCopy:) ('selection' ensureSelectedField hasSelection noteSelectionIndex:for: replaceSelectionValue: selectField: selectFieldNamed: selectFieldSuchThat: selectedField selectedFieldName selection) ('fields' expressionForField: fieldAllInstVars fieldSelf newFieldForType: newFieldForType:key:) ('initialization' fieldClass initialExtent initialize inspect: resetContents resetFields setContents: setContentsTyped: setExpression:) ('menu' fieldListMenu: fieldListMenu:shifted: inspectorKey:from: mainFieldListMenu: metaFieldListMenu:) ('user interface - window' labelString objectOkToClose okToClose okToDiscardCustomFields) ('updating - steps' modelWakeUpIn: stepAt:in: stepTimeIn: updateListsAndCodeIn: wantsStepsIn:) ('fields - streaming' streamBaseFieldsOn: streamCustomFieldsOn: streamFieldsOn: streamIndexedVariablesOn: streamInstanceVariablesOn: streamVariableFieldsOn:) ('updating' update update: update:with: updateContentsSafely updateFieldList updateFields) ('*60Deprecated-menu' classHierarchy) ('*60Deprecated-toolbuilder' exploreObject) ('copying' veryDeepInner:) ('private - collections' elementAt: elementGetterAt:) ('user edits' okToRevertChanges:) !
!ImageSegment reorganize! ('access' allObjectsDo: arrayOfRoots arrayOfRoots:) ('read/write segment' install loadSegmentFrom:outPointers: localName readFromFile) ('error checking' checkAndReportLoadError) ('fileIn' comeFullyUpOnReload: declare: declareAndPossiblyRename: dependentsCancel: dependentsRestore: fixCapitalizationOfSymbols processRoots rehashDictionaries: reshapeClasses:refStream: restoreEndianness:) ('fileIn/Out' acceptSingleMethodSource: endianness restoreEndianness scanFrom: scanFrom:environment:) ('testing' errorWrongState forFile:outPointers:) ('private' forgetDoItsInClass: segmentFormatFrom:) !
Form removeSelector: #graphicForViewerTab!
!Form reorganize! ('accessing' bits bitsSize bits: defaultCanvasClass depth depth: extent form getCanvas hasBeenModified hasBeenModified: nativeDepth offset offset: size) ('analyzing' cgForPixelValue:orNot: colorsUsed dominantColor innerPixelRectFor:orNot: pixelCompare:with:at: primCountBits rectangleEnclosingPixelsNotOfColor: tallyPixelValues tallyPixelValuesInRect:into: xTallyPixelValue:orNot: yTallyPixelValue:orNot:) ('bordering' borderFormOfWidth:sharpCorners: borderWidth: borderWidth:color: borderWidth:fillColor: border:width:rule:fillColor: shapeBorder:width: shapeBorder:width:interiorPoint:sharpCorners:internal:) ('color mapping' balancedPatternFor: bitPatternFor: colormapFromARGB colormapIfNeededForDepth: colormapIfNeededFor: colormapToARGB makeBWForm: mapColors:to: mapColor:to: maskingMap newColorMap pixelValueFor: pixelWordFor: reducedPaletteOfSize: rgbaBitMasks) ('converting' adjustBrightness: adjustSaturation: as8BitColorForm asCursorForm asFormOfDepth: asGrayScale asSourceForm asTextAnchor blendColor: collectColors: collectPixels: colorReduced copyWithColorsReducedTo: darker dimmed dyed: flipVertically lighter orderedDither32To16) ('copying' blankCopyOf:scaledBy: contentsOfArea: contentsOfArea:into: copyBits:at:translucent: copyBits:from:at:clippingBox:rule:fillColor: copyBits:from:at:clippingBox:rule:fillColor:map: copyBits:from:at:colorMap: copy: copy:from:in:rule: copy:from:to:rule: deepCopy postCopy veryDeepCopyWith:) ('display box access' boundingBox center computeBoundingBox height width) ('displaying' displayInterpolatedIn:on: displayInterpolatedOn: displayOnPort:at: displayOn:at:clippingBox:rule:fillColor: displayOn:transformation:clippingBox:align:with:rule:fillColor: displayResourceFormOn: displayScaledOn: drawLine:from:to:clippingBox:rule:fillColor: paintBits:at:translucent:) ('editing' bitEdit bitEditAt:scale: edit) ('fileIn/Out' comeFullyUpOnReload: hibernate objectForDataStream: printOn: readAttributesFrom: readBitsFrom: readFromOldFormat: readFrom: replaceByResource: storeBitsOn:base: storeOn: storeOn:base: unhibernate writeAttributesOn: writeBitsOn: writeBMPfileNamed: writeJPEGfileNamed: writeJPEGfileNamed:progressive: writeOnMovie: writeOn: writePNGfileNamed: writeUncompressedOn:) ('filling' anyShapeFill bitPatternForDepth: convexShapeFill: eraseShape: fillFromXColorBlock: fillFromXYColorBlock: fillFromYColorBlock: fill:rule:fillColor: findShapeAroundSeedBlock: floodFill2:at: floodFillMapFrom:to:mappingColorsWithin:to: floodFill:at: floodFill:at:tolerance: shapeFill:interiorPoint: shapeFill:seedBlock:) ('image manipulation' replaceColor:withColor: smear:distance: trimBordersOfColor:) ('initialize-release' allocateForm: finish flush fromDisplay: shutDown swapEndianness) ('other' fillAlpha: fixAlpha formForColorCount: preMultiplyAlpha primPrintHScale:vScale:landscape: relativeTextAnchorPosition setAsBackground) ('pixel access' colorAt: colorAt:put: isTransparentAt: pixelValueAt: pixelValueAt:put: primPixelValueAtX:y: primPixelValueAtX:y:put:) ('postscript generation' bitsPerComponent bytesPerRow decodeArray numComponents paddedWidth printPostscript:operator: rowPadding setColorspaceOn: store15To24HexBitsOn: store32To24HexBitsOn: storeBits:to:on: storeHexBitsOn: storePostscriptHexOn:) ('resources' readNativeResourceFrom: readResourceFrom: resourceTag storeResourceOn:) ('scaling, rotation' clippedToSize: flipBy:centerAt: magnifyBy: magnify:by: magnify:by:smoothing: rotateBy: rotateBy:centerAt: rotateBy:magnify:smoothing: rotateBy:smoothing: scaledToHeight: scaledToSize: scaledToSize:smoothing: scaledToWidth: shrink:by:) ('testing' hasNonStandardPalette isAllWhite isBigEndian isDisplayScreen isForm isGrayScale isLittleEndian isStatic isTranslucent isVirtualScreen shouldPreserveContents) ('transitions' fadeImageCoarse:at: fadeImageFine:at: fadeImageHorFine:at: fadeImageHor:at: fadeImageSquares:at: fadeImageVert:at: fadeImage:at:indexAndMaskDo: pageImage:at:corner: pageWarp:at:forward: slideImage:at:delta: wipeImage:at:clippingBox:rectForIndex: wipeImage:at:delta: wipeImage:at:delta:clippingBox: zoomInTo:at: zoomIn:orOutTo:at:vanishingPoint: zoomOutTo:at:) ('*MorphicExtras-postscript generation' encodePostscriptOn:) ('*nebraska-encoding' addDeltasFrom: deltaFrom: deltaFrom:at: encodeForRemoteCanvas) ('private' hackBits: initFromArray: privateFloodFillValue: setExtent:depth: setExtent:depth:bits: setResourceBits:) ('*Morphic' asMorph blankCopyOf: iconOrThumbnailOfSize: scaledIntoFormOfSize: scaledIntoFormOfSize:smoothing:) ('*Morphic-Support-image manipulation' stencil) ('processing' approxGaussianBlur at:bias: dither: edgeDetect emboss processUsingKernel: processUsingKernel:factor:bias: sharpen) ('*System-icon scaling' scaleIconToDisplay) ('*Morphic-Text Support' textAnchorProperties) ('*Tools-Inspector' inspectorClass) ('*TrueType-displaying' advanceWidth) !
Flaps class removeSelector: #addAndEnableEToyFlaps! Flaps class removeSelector: #defaultsQuadsDefiningPlugInSuppliesFlap! Flaps class removeSelector: #defaultsQuadsDefiningScriptingFlap! Flaps class removeSelector: #enableEToyFlaps! Flaps class removeSelector: #newLoneSuppliesFlap! Flaps class removeSelector: #newPaintingFlap! Flaps class removeSelector: #paintFlapButton! Flaps class removeSelector: #possiblyReplaceEToyFlaps! Flaps class removeSelector: #setUpSuppliesFlapOnly!
!Flaps class reorganize! ('class initialization' initialize) ('construction support' addMorph:asElementNumber:inGlobalFlapSatisfying: addMorph:asElementNumber:inGlobalFlapWithID: addToSuppliesFlap:asElementNumber: deleteMorphsSatisfying:fromGlobalFlapSatisfying:) ('flap mechanics' clobberFlapTabList freshFlapsStart reinstateDefaultFlaps removeFlapTab:keepInList:) ('flaps registry' defaultsQuadsDefiningStackToolsFlap defaultsQuadsDefiningSuppliesFlap defaultsQuadsDefiningToolsFlap defaultsQuadsDefiningWidgetsFlap initializeFlapsQuads registeredFlapsQuads registeredFlapsQuadsAt: registerQuad:forFlapNamed: unregisterQuadsWithReceiver: unregisterQuadsWithReceiver:fromFlapNamed: unregisterQuad:forFlapNamed:) ('menu commands' disableGlobalFlaps disableGlobalFlaps: disableGlobalFlapWithID: enableDisableGlobalFlapWithID: enableGlobalFlapWithID: explainFlaps explainFlapsText) ('menu support' addIndividualGlobalFlapItemsTo: enableGlobalFlaps globalFlapWithIDEnabledString: showSharedFlaps suppressFlapsString) ('miscellaneous' automaticFlapLayoutChanged doAutomaticLayoutOfFlapsIfAppropriate enableClassicNavigatorChanged fileOutChanges makeNavigatorFlapResembleGoldenBar orientationForEdge: removeFromGlobalFlapTabList:) ('new flap' addLocalFlap addLocalFlap: addLocalFlap:titled:onEdge: askForEdgeOfNewFlap defaultColorForFlapBackgrounds newFlapTitled:onEdge: newFlapTitled:onEdge:inPasteUp:) ('predefined flaps' addNewDefaultSharedFlaps addStandardFlaps initializeStandardFlaps newNavigatorFlap newObjectsFlap newSqueakFlap newStackToolsFlap newSuppliesFlap newSuppliesFlapFromQuads:positioning: newToolsFlap newWidgetsFlap quadsDefiningPlugInSuppliesFlap quadsDefiningStackToolsFlap quadsDefiningSuppliesFlap quadsDefiningToolsFlap quadsDefiningWidgetsFlap quadsDeiningScriptingFlap twiddleSuppliesButtonsIn:) ('replacement' replaceGlobalFlapwithID: replacePartSatisfying:inGlobalFlapSatisfying:with: replacePartSatisfying:inGlobalFlapWithID:with: replaceToolsFlap) ('shared flaps' addGlobalFlap: enableOnlyGlobalFlapsWithIDs: globalFlapTabOrDummy: globalFlapTabs globalFlapTabsIfAny globalFlapTabsWithID: globalFlapTabWithID: globalFlapTab: positionNavigatorAndOtherFlapsAccordingToPreference positionVisibleFlapsRightToLeftOnEdge:butPlaceAtLeftFlapsWithIDs: removeDuplicateFlapTabs sharedFlapsAllowed sharedFlapsAlongBottom) ('testing' anyFlapsVisibleIn:) !
EventHandler removeSelector: #adaptToWorld:! DeepCopier removeSelector: #mapUniClasses! DeepCopier removeSelector: #newUniClasses! DeepCopier removeSelector: #newUniClasses:! DeepCopier removeSelector: #uniClasses! Object subclass: #DeepCopier instanceVariableNames: 'references' classVariableNames: '' poolDictionaries: '' category: 'System-Object Storage'!
!DeepCopier reorganize! ('like fullCopy' checkBasicClasses checkClass: checkDeep checkVariables fixDependents initialize initialize: objInMemory: references warnIverNotCopiedIn:sel:) !
ChangeList removeSelector: #buildMorphicCodePaneWith:! CodeHolder removeSelector: #installTextualCodingPane! CodeHolder removeSelector: #restoreTextualCodingPane!
!CodeHolder reorganize! ('annotation' addPriorVersionsCountForSelector:ofClass:to: annotation annotation: annotationForClassCommentFor: annotationForClassDefinitionFor: annotationForHierarchyFor: annotationForSelector:ofClass: annotationPaneMenu:shifted: annotationRequests annotationSeparator) ('categories' categoryFromUserWithPrompt:for: categoryOfCurrentMethod changeCategory letUserReclassify:in: methodCategoryChanged selectedMessageCategoryName selectedSystemCategoryName) ('categories & search pane' listPaneWithSelector: newSearchPane searchTextMorph) ('commands' adoptMessageInCurrentChangeset browseImplementors browseSenders copyUpOrCopyDown offerMenu offerShiftedClassListMenu offerUnshiftedClassListMenu shiftedYellowButtonActivity spawn: spawnToClass: spawnToCollidingClass: unshiftedYellowButtonActivity) ('construction' buildClassBrowserEditString: buildMessageBrowserEditString: buildMessageCategoryBrowserForCategory:class:selector:editString: buildMorphicCodePaneWith:) ('contents' commentContents contents contentsChanged contentsSymbol contentsSymbol: editContents editContentsWithDefault: isModeStyleable) ('controls' codePaneProvenanceString contentsSymbolQuints decorateButtons optionalButtonPairs sourceAndDiffsQuintsOnly) ('diffs' defaultDiffsSymbol diffFromPriorSourceFor: showDiffs showDiffs: showPrettyDiffs: showRegularDiffs: showingAnyKindOfDiffs showingPrettyDiffs showingPrettyDiffsString showingRegularDiffs showingRegularDiffsString toggleDiffing togglePlainSource togglePrettyDiffing togglePrettyPrint toggleRegularDiffing wantsDiffFeedback) ('message category functions' canShowMultipleMessageCategories removeMessageCategory) ('message list' decompiledSourceIntoContents decompiledSourceIntoContentsWithTempNames: formattedLabel: formattedLabel:forSelector:inClass: messageHelpForMethod: messageHelpTruncated: selectedBytecodes selectedMessage sourceStringPrettifiedAndDiffed validateMessageSource:forSelector:inClass:) ('message list menu' messageListKey:from: messageListMenuMore: shiftedMessageListMore:) ('misc' addModelItemsToWindowMenu: getSelectorAndSendQuery:to: getSelectorAndSendQuery:to:with: informPossiblyCorruptSource isThereAnOverride isThisAnOverride modelWakeUpIn: okayToAccept priorSourceOrNil refreshAnnotation refusesToAcceptCode releaseCachedState sampleInstanceOfSelectedClass sendQuery:to: sendQuery:to:with: setClassAndSelectorIn: suggestCategoryToSpawnedBrowser: useSelector:orGetSelectorAndSendQuery:to:) ('self-updating' didCodeChangeElsewhere stepIn: updateCodePaneIfNeeded updateListsAndCodeIn: wantsStepsIn:) ('toolbuilder' annotationFrame annotationPaneHeight browseButtonEnabled buildAnnotationPaneWith: buildCodePaneWith: buildCodeProvenanceButtonWith: buildOptionalButtonsWith: buttonHeight hierarchyButtonEnabled inheritanceButtonColor inheritanceButtonEnabled optionalButtonsFrame receiverClass textFrame variablesButtonEnabled versionsButtonEnabled) ('traits' makeSampleInstance showUnreferencedClassVars showUnreferencedInstVars spawnHierarchy) ('what to show' offerWhatToShowMenu prettyPrintString setContentsToForceRefetch showByteCodes: showDecompile: showDocumentation: showingByteCodes showingByteCodesString showingDecompile showingDecompileString showingDocumentation showingDocumentationString showingEditContentsOption showingPlainSource showingPlainSourceString showingPrettyPrint showingSource toggleDecompile toggleShowDocumentation toggleShowingByteCodes wantsCodeProvenanceButton) ('*services-base' messageListMenuServices: requestor) ('*Protocols-Tools' spawnFullProtocol spawnProtocol) ('multi-window support' multiWindowState multiWindowState:) ('message functions' exploreMethod inspectMethod removeMessage) ('*SUnitTools-running' testAskToCreateNewTest: testBinarySelectorNames testBrowseClassNamed:possibleMessageNamed: testFindTest testFindTested testRunSuite: testSelectorFrom:) ('*SUnitTools-message list functions' testDebugTest testRunTest) ('*SUnitTools-menus' testsMessageListMenu: testsTestFindingMenu:) ('breakpoints' isBreakOnEntry toggleBreakOnEntry) ('code pane' aboutToStyle: compileMessage:notifying:) ('accessing' contents:notifying: doItReceiver metaClassIndicated selectedClass selectedClassOrMetaClass selectedMessageName systemOrganizer) ('initialize-release' defaultBrowserTitle labelString setClass:selector:) ('*monticello-revisions' classListMenuMonticello: messageListMenuMonticello:) ('class functions' removeClass) ('system category functions' removeSystemCategory) ('*60Deprecated-annotation' defaultAnnotationPaneHeight defaultButtonPaneHeight) ('*60Deprecated-categories & search pane' searchPane) !
Object removeSelector: #adaptedToWorld:! Object removeSelector: #beViewed! Object removeSelector: #belongsToUniClass! Object removeSelector: #costumes! Object removeSelector: #defaultFloatPrecisionFor:! Object removeSelector: #evaluateUnloggedForSelf:! Object removeSelector: #isPlayer! Object removeSelector: #isPrimitiveCostume! Object removeSelector: #isScriptEditorMorph! Object removeSelector: #isUniversalTiles! Object removeSelector: #methodInterfacesForCategory:inVocabulary:limitClass:! Object removeSelector: #methodInterfacesForInstanceVariablesCategoryIn:! Object removeSelector: #methodInterfacesForScriptsCategoryIn:! Object removeSelector: #presenter! Object removeSelector: #renameInternal:! Object removeSelector: #scriptPerformer! Object removeSelector: #selfWrittenAsIll! Object removeSelector: #selfWrittenAsIm! Object removeSelector: #selfWrittenAsMe! Object removeSelector: #selfWrittenAsMy! Object removeSelector: #selfWrittenAsThis! Object removeSelector: #slotInfo! Object removeSelector: #veryDeepCopySibling!
!Object reorganize! ('accessing' at: at:modify: at:put: basicAt: basicAt:put: basicSize bindWithTemp: enclosedSetElement in: readFromString: size yourself) ('associating' ->) ('binding' bindingOf:) ('casing' caseOf: caseOf:otherwise:) ('class membership' class inheritsFromAnyIn: isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass) ('comparing' = closeTo: hash identityHashPrintString literalEqual: ~=) ('converting' adaptToFloat:andCompare: adaptToFloat:andSend: adaptToFraction:andCompare: adaptToFraction:andSend: adaptToInteger:andCompare: adaptToInteger:andSend: adaptToScaledDecimal:andCompare: adaptToScaledDecimal:andSend: as: asOrderedCollection asSetElement asString asStringOrText changeClassTo: complexContents mustBeBoolean mustBeBooleanIn: printDirectlyToDisplay withoutListWrapper) ('copying' copy copyAddedStateFrom: copyFrom: copySameFrom: copyTwoLevel deepCopy initialDeepCopierSize postCopy shallowCopy veryDeepCopy veryDeepCopyUsing: veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:) ('debugging' evaluate:wheneverChangeIn: haltIf: haltOnceIf: meetsHaltCondition: needsWork) ('debugging-haltOnce' checkHaltCountExpired clearHaltOnce decrementAndCheckHaltCount decrementHaltCount doExpiredHaltCount doExpiredHaltCount: doExpiredInspectCount halt:onCount: haltIfNil haltOnCount: haltOnce haltOnce: haltOnceEnabled hasHaltCount inspectOnCount: inspectOnce inspectUntilCount: removeHaltCount setHaltCountTo: setHaltOnce toggleHaltOnce) ('dependents access' addDependent: breakDependents canDiscardEdits dependents hasUnacceptedEdits myDependents myDependents: release removeDependent:) ('drag and drop' acceptDroppingMorph:event:inMorph: dragPassengerFor:inMorph: dragStartedFor:transferMorph: dragTransferTypeForMorph: wantsDroppedMorph:event:inMorph:) ('error handling' assert: assert:description: assert:descriptionBlock: backwardCompatibilityOnly: caseError deprecated deprecated: deprecated:block: doesNotUnderstand: dpsTrace: dpsTrace:levels: dpsTrace:levels:withContext: error error: halt halt: handles: notify: notify:at: primitiveFailed primitiveFailed: shouldBeImplemented shouldNotImplement subclassResponsibility traitConflict) ('evaluating' value valueWithArguments:) ('filter streaming' byteEncode: drawOnCanvas: elementSeparator encodePostscriptOn: flattenOnStream: fullDrawPostscriptOn: putOn: writeOnFilterStream:) ('flagging' isThisEverCalled isThisEverCalled: logEntry logExecution logExit) ('graph model' addModelYellowButtonMenuItemsTo:forMorph:hand: hasModelYellowButtonMenuItems) ('macpal' codeStrippedOut: contentsChanged flash instanceVariableValues objectRepresented refusesToAcceptCode) ('message handling' executeMethod: perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:with:with:with:with: perform:with:with:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: perform:withEnoughArguments: with:executeMethod: with:with:executeMethod: with:with:with:executeMethod: with:with:with:with:executeMethod: withArgs:executeMethod:) ('objects from disk' comeFullyUpOnReload: convertToCurrentVersion:refStream: fixUponLoad:seg: objectForDataStream: readDataFrom:size: saveOnFile saveOnFileNamed: storeDataOn:) ('printing' fullPrintString isLiteral longPrintOn: longPrintOn:limitedTo:indent: longPrintString longPrintStringLimitedTo: nominallyUnsent: printOn: printString printStringLimitedTo: printWithClosureAnalysisOn: reportableSize storeOn: storeString stringForReadout stringRepresentation) ('system primitives' asOop become: becomeForward: becomeForward:copyHash: className creationStamp instVarAt: instVarAt:put: instVarNamed: instVarNamed:put: oopString primitiveChangeClassTo: rootStubInImageSegment: someObject) ('testing' isArray isBehavior isBlock isBoolean isCharacter isClassReference isClosure isCodeReference isCollection isColor isColorForm isCompiledCode isCompiledCodeClass isCompiledMethod isComplex isContext isDictionary isFloat isForm isFraction isHeap isInteger isInterval isMessageSend isMethodContext isMethodProperties isMethodReference isMorph isMorphicEvent isMorphicModel isNumber isPoint isPromise isRectangle isScaledDecimal isSketchMorph isStream isString isSymbol isSystemWindow isText isTextView isTrait isTransparent isVariableBinding isWebBrowser isWindowForModel: knownName name nameForViewer renameTo: shouldBePrintedAsLiteral shouldBePrintedAsLiteralVisiting: showDiffs stepAt:in: stepIn: stepTime stepTimeIn: vocabularyDemanded wantsDiffFeedback wantsSteps wantsStepsIn:) ('updating' changed changed: changed:with: handledListVerification noteSelectionIndex:for: okToChange okToClose update: update:with: updateListsAndCodeIn: windowIsClosing) ('user interface' addModelItemsToWindowMenu: addModelMenuItemsTo:forMorph:hand: asExplorerString defaultLabelForInspector launchPartVia: launchPartVia:label: launchTileToRefer modelSleep modelWakeUp modelWakeUpIn: mouseUpBalk: notYetImplemented windowActiveOnFirstClick windowReqNewLabel:) ('*monticello' isConflict) ('*system-support' isPrimitiveError systemNavigation) ('*Tools-Explorer' explore exploreWithLabel:) ('*tools-browser' browseHierarchy) ('private' errorImproperStore errorNonIntegerIndex errorNotIndexable errorSubscriptBounds: setPinned: species storeAt:inTempFrame:) ('thumbnail' iconOrThumbnailOfSize:) ('*Morphic-Explorer' explorerContents hasContentsInExplorer) ('futures' future future: futureDo:at:args: futureSend:at:args:) ('*Tools-MessageSets' browseAllCallsOn: browseAllCallsOn:requestor: browseAllImplementorsOf: browseAllImplementorsOf:requestor:) ('*Tools-multi-window support' canHaveUnacceptedEdits) ('*morphic' asMorph asStringMorph asTextMorph isPluggableListMorph openAsMorph) ('tracing' inboundPointers inboundPointersExcluding: outboundPointers outboundPointersDo:) ('*Tools-Debugger' canonicalArgumentName chasePointers explorePointers shouldFollowOutboundPointers) ('*System-Object Events-accessing' actionForEvent: actionForEvent:ifAbsent: actionMap actionSequenceForEvent: actionsDo: createActionMap hasActionForEvent: setActionSequence:forEvent: updateableActionMap) ('*System-Change Notification-events' actionsWithReceiver:forEvent: renameActionsWithReceiver:forEvent:toEvent:) ('*System-Change Notification-converting' asActionSequence asActionSequenceTrappingErrors) ('*System-Tools-breakpoint' break) ('*ToolBuilder-Kernel-error handling' confirm: confirm:orCancel:) ('*ToolBuilder-Kernel-user interface' inform:) ('*System-Support-user interface' initialExtent) ('*System-Localization-locales' localeChanged localeChangedGently translatedNoop) ('*System-Object Events-accessing-removing' releaseActionMap removeAction:forEvent: removeActionsForEvent: removeActionsSatisfying: removeActionsSatisfying:forEvent: removeActionsWithReceiver: removeActionsWithReceiver:forEvent:) ('*System-Object Events-accessing-triggering' triggerEvent: triggerEvent:ifNotHandled: triggerEvent:with: triggerEvent:with:ifNotHandled: triggerEvent:withArguments: triggerEvent:withArguments:ifNotHandled:) ('*System-Object Events-accessing-registering' when:evaluate: when:send:to: when:send:to:with: when:send:to:withArguments:) ('*Traits' explicitRequirement requirement) ('*Graphics-KernelExtensions' fullScreenSize) ('*System-Finalization' actAsExecutor executor finalizationRegistry finalize hasMultipleExecutors retryWithGC:until: toFinalizeSend:to:with:) ('*collections' asLink compareSafely:) ('*Tools-Browsing' browse) ('*System-Recovery-error handling' primitiveError:) ('*SUnit-testing' isTestClass) ('*Morphic-Events-Filtering' filterEvent:for:) ('*System-Preferences' applyUserInterfaceTheme canApplyUserInterfaceTheme userInterfaceTheme) ('*Tools' environment) ('pinning' isPinned pin unpin) ('literals' allLiteralsDo: hasLiteral: hasLiteralSuchThat:) ('write barrier' attemptToAssign:withIndex: beReadOnlyObject beWritableObject isReadOnlyObject setIsReadOnlyObject:) ('*Tools-Inspector' basicInspect inspect inspectWithLabel: inspectorClass) ('*Morphic-Kernel-accessing' currentEvent currentHand currentWorld) ('*Monticello-Patching-testing' isMCPatchOperation) ('*JSON' asJsonString) ('*60Deprecated-accessing' ifNil:ifNotNilDo: ifNotNilDo: ifNotNilDo:ifNil:) ('*MorphicExtras-Undo' capturedState commandHistory purgeAllCommands redoFromCapturedState: refineRedoTarget:selector:arguments:in: refineUndoTarget:selector:arguments:in: rememberCommand: rememberUndoableAction:named: undoFromCapturedState:) ('*Protocols' currentVocabulary haveFullProtocolBrowsed haveFullProtocolBrowsedShowingSelector:) ('*services-base' requestor) ('*60Deprecated-copying' clone) ('*60Deprecated-Tools' exploreAndYourself notifyWithLabel:) ('*MorphicExtras-PartsBin' descriptionForPartsBin) !
| currentChanges | currentChanges := ChangeSet current.
Smalltalk globals removeKey: #References. Smalltalk globals removeKey: #CustomEventsRegistry. Smalltalk globals removeKey: #ScriptingSystem.
ChangeSet newChanges: (ChangeSet new name: 'unload-etoys-more'). (Smalltalk classNamed: #StandardScriptingSystem) removeFromSystem. (Smalltalk classNamed: #Presenter) removeFromSystem. (Smalltalk classNamed: #MethodHolder) removeFromSystem. (Smalltalk classNamed: #PaintInvokingMorph) removeFromSystem. (Smalltalk classNamed: #ViewerFlapTab) removeFromSystem. (Smalltalk classNamed: #AcceptableCleanTextMorph) removeFromSystem. (Smalltalk classNamed: #BrowserCommentTextMorph) removeFromSystem. (Smalltalk classNamed: #BorderedSubpaneDividerMorph) removeFromSystem. (Smalltalk classNamed: #TextFieldMorph) removeFromSystem. (Smalltalk classNamed: #KeyboardBuffer) removeFromSystem. (Smalltalk classNamed: #PluggableTabButtonMorph) removeFromSystem. (Smalltalk classNamed: #MorphWithSubmorphsWrapper) removeFromSystem. (Smalltalk classNamed: #TwoWayScrollPane) removeFromSystem. Preferences removePreference: #noviceMode. Preferences removePreference: #eToyFriendly. Preferences removePreference: #universalTiles. Preferences removePreference: #uniTilesClassic. Preferences removePreference: #tileTranslucentDrag. Preferences removePreference: #typeCheckingInTileScripting. Preferences removePreference: #compactViewerFlaps. Preferences removePreference: #viewersInFlaps. Preferences removePreference: #batchPenTrails. Preferences removePreference: #keepTickingWhilePainting. Preferences removePreference: #unlimitedPaintArea. Preferences removePreference: #mvcProjectsAllowed. Preferences removePreference: #eToyLoginEnabled. Preferences removePreference: #oliveHandleForScriptedObjects. Preferences removePreference: #dropProducesWatcher. Preferences removePreference: #automaticViewerPlacement. Preferences removePreference: #capitalizedReferences. Preferences removePreference: #fenceEnabled. Preferences removePreference: #fenceSoundEnabled. Preferences removePreference: #haloTransitions. Preferences removePreference: #selectiveHalos. Preferences removePreference: #useVectorVocabulary. Preferences removePreference: #simpleMenus. Preferences removePreference: #propertySheetFromHalo. Preferences removePreference: #menuColorFromWorld. Preferences removePreference: #enableVirtualOLPCDisplay. Preferences removePreference: #enablePortraitMode. Preferences removePreference: #magicHalos. Preferences removePreference: #tabAmongFields. Preferences removePreference: #sugarAutoSave. Preferences removePreference: #showAdvancedNavigatorButtons. FileServices removeObsolete. ChangeSet newChanges: currentChanges.
ChangeSet newChanges: (ChangeSet new name: 'clean-up-categories'). SystemChangeNotifier uniqueInstance doSilently: [ Smalltalk allClassesDo: [:cls | cls organization renameCategory: 'stepping and presenter' toBe: 'stepping']]. Smalltalk removeEmptyMessageCategories. ChangeSet newChanges: currentChanges.
Preferences resetHaloSpecifications. TheWorldMainDockingBar updateInstances. Flaps initializeFlapsQuads; initializeStandardFlaps. Vocabulary initializeStandardVocabularies. UserInterfaceTheme cleanUpAndReset.
"Next: Remove Etoys package from update map."!
Hi Dave --
Thank you for your thoughts. :-)
Maybe we can locate and remove selected Etoys features, which where relevant many years ago but broke irreparably because external resources are no longer available. Nebraska, for example, seems to expect an external infrastructure no longer available. Hmm... at least this change-set represents kind of a documentation artifact to reason about next steps.
It would be nice to have a (basic) Etoys in Squeak in some maintainable form. Morphic (i.e., Morph and PasteUpMorph) would benefit from not having too many Etoys complications baked in...
Best, Marcel Am 30.08.2023 04:27:22 schrieb David T. Lewis lewis@mail.msen.com: Marcel,
Thanks for posting the change set, I can see that a lot of work went into it. And thanks for starting the discussion.
I have tried the change set, and it works fine. A minor nit is that it needs a "Smalltalk cleanOutUndeclared" in the postscript.
From my point of view, I want to take some time to play with this
over the next couple of weeks to form a better opinion. In particular, I don't have a good sense of how much work it would be to maintain Etoys as an optional part of the image, as opposed to just take it out once without being able to reload.
In a perfect world, I would say that Etoys should be reloadable. This means that Etoys can be removed, and later reinstalled into some working state (yes objects and content would be lost but the basic functionality would in principle be restored). However, this is not a perfect world, and making Etoys be fully reloadable requires a lot of work that is probably never going to get done.
If reloadable Etoys is never going to happen, then what might be the next best thing? For me, I think it would be a new option in the Preference Wizard. Right at the point where it asks "Do you want to install extra packages?" it might better give me the the option to also remove Etoys.
If this was an option in the Preference Wizard, I am pretty sure that I personally would not select that option. I like being able to explore the interesting concepts in Etoys. But I also really appreciate the aesthetics and design principles that we see in Cuis, and I can see that it would be really helpful to be able to reduce cognitive complexity by removing all of the Etoys clutter that is not of general interest. This might be particularly important for new Squeak users, and also for students approaching Squeak for the first time.
The thing that I don't yet understand is how much work it would be to maintain Etoys removal as an option over time. It is easy for me to say that I would like to have it in the Preference Wizard, but I can see from the unload-etoys.33.cs change set that there are *lots* of methods impacted, and I don't know how much work it might be to keep that functionality healthy in years to come.
Again, thanks Marcel for posting this.
Dave
On Tue, Aug 29, 2023 at 03:47:19PM +0200, Marcel Taeumel via Squeak-dev wrote:
Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras:
- Games
- Sketches and PaintBox
- Flaps
- CalendarMorph
- SpectrumAnalyzerMorph
Here is what would still "work" through the package System:
- Object storage (ImageSegment etc.)
- ProjectLoading
Here is what would still work through the package Protocols:
- Lexicon tool
- Vocabulary framework
Here is what would be gone:
- Tiles, viewers, and scripts
- Players and costumes
- Pen trails, Turtles, ...
- References, CustomEventsRegistry, ScriptingSystem
- Siblings for (Player-only) uni-classes
- DeepCopier support for (Player-only) uni-classes
- Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
So...should we remove Etoys from Trunk at this point?
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel ???'From Squeak6.1alpha of 26 July 2023 [latest update: #22682] on 29 August 2023 at 3:33:41 pm'!
| currentChanges | currentChanges := ChangeSet current.
MenuIcons addClassVarName: #ScriptingIcons. MenuIcons classPool at: #ScriptingIcons put: ( (Smalltalk globals at: #ScriptingSystem) formDictionary associationsSelect: [:assoc | true "keep all for now" "(assoc key beginsWith: 'Halo-') or: [assoc key beginsWith: 'Debugger']"]).
ChangeSet newChanges: (ChangeSet new name: 'move-etoys-games-to-morphicextras'). #( "Keep the games as standalone example applications" 'Etoys-Squeakland-Morphic-Games' 'MorphicExtras-Games' 'Etoys-Squeakland-Morphic-Games-Chess' 'MorphicExtras-Games-Chess' 'Etoys-Squeakland-Morphic-Games-Chess960' 'MorphicExtras-Games-Chess960' 'Etoys-Squeakland-Morphic-Demo' 'MorphicExtras-Demo' ) pairsDo: [:oldCat :newCat | (SystemOrganization listAtCategoryNamed: oldCat) do: [:className | (self environment classNamed: className) category: newCat]]. "Rescue more examples from Etoys over to MorphicExtras" (Smalltalk classNamed: #CalendarMorph) category: 'MorphicExtras-Demo'. (Smalltalk classNamed: #SpectrumAnalyzerMorph) category: 'MorphicExtras-SoundInterface'. ChangeSet newChanges: currentChanges.
(MCPackage named: #EToys) unload.!
Object subclass: #DeepCopier instanceVariableNames: 'references uniClasses newUniClasses ' classVariableNames: '' poolDictionaries: '' category: 'System-Object Storage'!
!DeepCopier commentStamp: 'mt 8/28/2023 15:05' prior: 0! DeepCopier does a veryDeepCopy.
It is a complete tree copy using a dictionary. Any object that is 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. See Object|veryDeepCopy which calls (self veryDeepCopyWith: aDeepCopier).
When a tree of morphs points at a morph outside of itself, that morph should not be copied. Use our own kind of weak pointers for the 'potentially outside' morphs. Default is that any new class will have all of its fields deeply copied. If a field needs to be weakly copied, define veryDeepInner: and veryDeepFixupWith:. veryDeepInner: has the loop that actually copies the fields. If a class defines its own copy of veryDeepInner: (to leave some fields out), then veryDeepFixupWith: will be called on that object at the end. veryDeepInner: can compute an alternate object to put in a field. (Object veryDeepCopyWith: discovers which superclasses did not define veryDeepInner:, and very deeply copies the variables defined in those classes). To decide if a class needs veryDeepInner: and veryDeepFixupWith:, ask this about an instance: If I duplicate this object, does that mean that I also want to make duplicates of the things it holds onto? If yes, (i.e. a Paragraph does want a new copy of its Text) then do nothing. If no, (i.e. an undo command does not want to copy the objects it acts upon), then define veryDeepInner: and veryDeepFixupWith:.
Here is an analysis for the specific case of a morph being held by another morph. Does field X contain a morph? If not, no action needed. Is the morph in field X already a submorph of the object? Is it down lower in the submorph tree? If so, no action needed. Could the morph in field X every appear on the screen (be a submorph of some other morph)? If not, no action needed. If it could, you must write the methods veryDeepFixupWith: and veryDeepInner:, and in them, refrain from sending veryDeepCopyWith: to the contents of field X.
----- Things Ted is still considering ----- Rule: If object A has object C in a field, and A says (^ C) for the copy, but object B has A in a normal field and it gets deepCopied, and A in encountered first, then there will be two copies of C. (just be aware of it)
Dependents are now fixed up. Suppose a model has a dependent view. In the DependentFields dictionary, model -> (view ...). If only the model is copied, no dependents are created (no one knows about the new model). If only the view is copied, it is inserted into DependentFields on the right side. model -> (view copiedView ...). If both are copied, the new model has the new view as its dependent. If additional things depend on a model that is copied, the caller must add them to its dependents.
August 2023: There is no support for uni-classes at this time!!!
Model subclass: #FancyMailComposition instanceVariableNames: 'messageText theLinkToInclude to subject' classVariableNames: '' poolDictionaries: '' category: 'Nebraska-Network-Mail'! Object subclass: #MenuIcons instanceVariableNames: '' classVariableNames: 'Icons TranslatedIcons TranslationLocale ScriptingIcons ' poolDictionaries: '' category: 'Morphic-Menus'! Object subclass: #MorphExtension instanceVariableNames: 'locked visible sticky balloonText balloonTextSelector externalName isPartsDonor actorState player eventHandler otherProperties ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Kernel'! BorderedMorph subclass: #PasteUpMorph instanceVariableNames: 'presenter model cursor padding turtleTrailsForm turtlePen lastTurtlePositions isPartsBin indicateCursor wantsMouseOverHalos worldState ' classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler ' poolDictionaries: '' category: 'Morphic-Worlds'! AbstractLauncher subclass: #ProjectLauncher instanceVariableNames: 'showSplash splashURL whichFlaps eToyAuthentificationServer ' classVariableNames: 'SplashMorph ' poolDictionaries: '' category: 'System-Download'! Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl eToyUserListUrl eToyUserList keepAlive encodingName ' classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers ' poolDictionaries: '' category: 'Network-RemoteDirectory'!
!SmartRefStream commentStamp: 'mt 8/28/2023 15:44' prior: 0! Ordinary ReferenceStreams assume that the names and order of instance variables is exactly the same when an object file is written and read. SmartRefStream allows object files to be read even after instance variables have changed or the entire class has been renamed.
When an object file is written, no one knows how the classes will change in the future. Therefore, all conversion must be done when the file is read. The key is to store enough information in the file about the names of the instance variables of all outgoing classes.
SmartRefStream works best with only one tree of objects per file. You can nextPut: more than once, but each object tree gets its own class structure description, which is big.
Conversion of old objects is done by a method in each class called (convertToCurrentVersion: varDict refStream: smartRefStrm). At fileOut time, ChangeSet>>checkForConversionMethods creates a prototype of this method (if Preference #conversionMethodsAtFileOut is true). The programmer must edit this method to (1) test if the incoming object needs conversion, (2) put non-nil values into any new inst vars that need them, and (3) save the data of any inst vars that are being deleted.
Determining which old version is represented by the incoming object can be done in several ways: - noticing that a current inst var is nil when it should have data, - noticing that there is an older inst var name in the variable dictionary (varDict), - checking kinds of objects in one or more inst vars, or - retrieving the classVersion of the incoming object from the ref stream.
If a class is renamed, a method goes into SmartRefStream telling the new name.
The conversion method of the new class must be prepared to accept instances of the old class also. If no inst var names have changed, the conversion method does nothing.
An example: Suppose we change the representation of class Rectangle from ('origin' 'corner') to ('origin' 'extent'). Suppose lots of Rectangle instances are already out on files (in .pr project files, especially).
The programmer changes the class definition, modifies all the methods, and filesOut. A series of dialogs appear, asking if instances Rectangle might be in an object file, if 'extent' needs to be non-nil (yes), and if the info in 'corner' needs to be preserved (yes). This method appears:
Rectangle >> convertToCurrentVersion: varDict refStream: smartRefStrm "These variables are automatically stored into the new instance: #('origin'). Test for this particular conversion. Get values using expressions like (varDict at: 'foo')."
"New variables: #('extent'). If a non-nil value is needed, please assign it." "These are going away #('corner'). Possibly store their info in some other variable?" "Move your code above the ^ super... Delete extra comments." ^ super convertToCurrentVersion: varDict refStream: smartRefStrm
The programmer modifies it to be:
Rectangle >> convertToCurrentVersion: varDict refStream: smartRefStrm
(varDict includesKey: 'extent') ifFalse: ["old version!!" "Create the new extent, and preserve the info from the old corner" extent := (varDict at: 'corner') - origin. ]. ^ super convertToCurrentVersion: varDict refStream: smartRefStrm
This conversion method stays in the system and is ready to convert the old format of Rectangle whenever one is encountered in an object file. Note that the subclasses of Rectangle, (B3DViewport, CharacterBlock, and Quadrangle) do not need conversion methods. Their instances will be converted by the code in Rectangle.
Files written by SmartRefStream are in standard fileout format. You can mix raw objects with code to be filed in. The file starts out in the normal fileOut format. Definitions of new classes on the front.
structures Dictionary of (#Rectangle -> #( 'origin' 'corner')). Inst var names are strings. steady Set of Classes who have the same structure now as on the incoming file. Includes classes with same inst vars except for new ones added on the end. reshaped Dictionary of Classes who have a different structure now from the incoming file. Includes those with same inst vars but new version number. (old class name -> method selector to fill in data for version to version) renamed Dictionary of Classes who have a different name. Make an instance of the new class, and send it the conversion call. (old class name symbol -> new class name). renamedConv Dictionary of conversion selector for Classes who have a different name. (old class name symbol -> conversion selector). topCall Tells if next or nextPut: are working on the top object in the tree. nil if outside, the top object if deep inside.
See DataStream.typeIDFor: for where the tangle of objects is clipped, so the whole system will not be written on the file.
No object that is written on the file is ever a class. All class definitions are filed in. A class may be stored inside an ImageSegment that itself is stored in a SmartRefStream.
UniClasses are classes for the instance specific behavior of just one instance. See #newSubclass. When a UniClass is read in, and a class of the same name already exists, the incoming one is renamed. ObjectScanner converts the filed-in code.
Values in instance variables of UniClasses are stored in the array that tells the class structure. It is the fourth of the four top level objects. #(version (class-structure) the-object ((#Player25 scripts slotInfo costumeDictionary) (#Player26 scripts slotInfo costumeDictionary))).
There is a separate subclass for doing veryDeepCopy (in memory). Currently, any object for which objectToStoreOnDataStream return an object other than self, does this: The new object (a DiskProxy) is traced. When it comes time to go through the fields of the old object, they are not found as keys in references (DiskProxies are there instead). So the old field value is left in the new object. That is OK for StrikeFont, Class, MetaClass, DisplayScreen. But the DiskProxies are evaluated, which takes a lot of time.
Some metaclasses are put into the structures table. This is for when a block has a receiver that is a class. See checkFatalReshape:.
ImageSegments: A ReferenceStream is used to enumerate objects to put inside an ImageSegment. If an instance of a UniClass is seen, the class is put in also. A SmartRefStream is used to store the ImageSegment. Roots are nil, and the segment is a wordArray. We are encoding the outPointers. Structures contains all classes from both places. Must filter out UniClasses for some things, and do include them for putting source code at end of file. Do not write any class inst vars in file.
--Ted Kaehler and Bob Arning.
How are the selectors in the '*Morphic-conversion' protocol ending with something like
ttfclpomsswfpp0
constructed and what does it mean?
Answer: It is the initials of all instance variables followed by the class version integer. The initials allow to detect most changes to the instance variables, but if this is not sufficient (perhaps because the new var had the same initial, or the vars did not change in name at all) we still have the class version.
Most classes are still at version 0, but if you check implementers of classVersion you can find a few that were incremented to force a conversion on load.!
!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:05'! veryDeepCopy "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."
| copier new | copier := DeepCopier new: self initialDeepCopierSize. new := self veryDeepCopyWith: copier. copier references associationsDo: [:assoc | assoc value veryDeepFixupWith: copier]. copier fixDependents. ^ new! !
!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:05'! veryDeepCopyUsing: copier "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. Same as veryDeepCopy except copier (with dictionary) is supplied. ** do not delete this method, even if it has no callers **"
| new refs | new := self veryDeepCopyWith: copier. copier references associationsDo: [:assoc | assoc value veryDeepFixupWith: copier]. "Fix dependents" refs := copier references. DependentsFields associationsDo: [:pair | pair value do: [:dep | | newDep newModel | (newDep := refs at: dep ifAbsent: [nil]) ifNotNil: [ newModel := refs at: pair key ifAbsent: [pair key]. newModel addDependent: newDep]]]. ^ new! !
!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:07'! veryDeepCopyWith: deepCopier "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." | class index sub subAss new sup has mine | deepCopier references at: self ifPresent: [:newer | ^ newer]. "already did him" class := self class. class isMeta ifTrue: [^ self]. "a class" new := self shallowCopy. deepCopier references at: self put: new. "remember" (class isVariable and: [class isPointers]) ifTrue: [index := self basicSize. [index > 0] whileTrue: [sub := self basicAt: index. (subAss := deepCopier references associationAt: sub ifAbsent: [nil]) ifNil: [new basicAt: index put: (sub veryDeepCopyWith: deepCopier)] ifNotNil: [new basicAt: index put: subAss value]. index := index - 1]]. "Ask each superclass if it wants to share (weak copy) any inst vars" new veryDeepInner: deepCopier. "does super a lot"
"other superclasses want all inst vars deep copied" sup := class. index := class instSize. [has := sup compiledMethodAt: #veryDeepInner: ifAbsent: [nil]. has := has ifNil: [class isSystemDefined not "is a uniClass"] ifNotNil: [true]. mine := sup instVarNames. has ifTrue: [index := index - mine size] "skip inst vars" ifFalse: [1 to: mine size do: [:xx | sub := self instVarAt: index. (subAss := deepCopier references associationAt: sub ifAbsent: [nil]) "use association, not value, so nil is an exceptional value" ifNil: [new instVarAt: index put: (sub veryDeepCopyWith: deepCopier)] ifNotNil: [new instVarAt: index put: subAss value]. index := index - 1]]. (sup := sup superclass) == nil] whileFalse. new rehash. "force Sets and Dictionaries to rehash" ^ new ! !
!Object methodsFor: 'testing' stamp: 'mt 3/8/2023 10:43'! knownName
^ nil! !
!Class methodsFor: 'testing' stamp: 'mt 8/28/2023 14:56'! officialClass "I am not a UniClass. (See MorphicModel officialClass). Return the class you use to make new subclasses."
^ self! !
!Class methodsFor: 'fileIn/Out' stamp: 'mt 8/28/2023 14:56'! objectForDataStream: refStrm "I am about to be written on an object file. Write a reference to a class in Smalltalk instead."
refStrm insideASegment ifFalse: ["Normal use" ^ DiskProxy global: self theNonMetaClass name selector: #withClassVersion: args: {self classVersion}] ifTrue: ["recording objects to go into an ImageSegment" self isSystemDefined ifFalse: [^ self]. "do trace uni-classes" (refStrm rootObject includes: self) ifTrue: [^ self]. "is in roots, intensionally write out, ^ self"
"A normal class. remove it from references. Do not trace." refStrm references removeKey: self ifAbsent: []. "already there" ^ nil] ! !
!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'! toggleDiffing "Toggle whether diffs should be shown in the code pane. If any kind of diffs were being shown, stop showing diffs. If no kind of diffs were being shown, start showing whatever kind of diffs are called for by default."
| wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingAnyKindOfDiffs. self showDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'! togglePlainSource "Toggle whether plain source shown in the code pane"
| wasShowingPlainSource | self okToChange ifTrue: [wasShowingPlainSource := self showingPlainSource. wasShowingPlainSource ifTrue: [self showDocumentation: true] ifFalse: [contentsSymbol := #source]. self setContentsToForceRefetch. self changed: #contents]
! !
!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'! togglePrettyDiffing "Toggle whether pretty-diffing should be shown in the code pane"
| wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingPrettyDiffs. self showPrettyDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'! togglePrettyPrint "Toggle whether pretty-print is in effectin the code pane"
self okToChange ifTrue: [self showingPrettyPrint ifTrue: [contentsSymbol := #source] ifFalse: [contentsSymbol := #prettyPrint]. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'! toggleRegularDiffing "Toggle whether regular-diffing should be shown in the code pane"
| wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingRegularDiffs. self showRegularDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'misc' stamp: 'mt 3/23/2023 11:24'! refusesToAcceptCode "Answer whether receiver, given its current contentsSymbol, could accept code happily if asked to"
^ (#(byteCodes documentation) includes: self contentsSymbol)! !
!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'! toggleDecompile "Toggle the setting of the showingDecompile flag, unless there are unsubmitted edits that the user declines to discard"
| wasShowing | self okToChange ifTrue: [wasShowing := self showingDecompile. self showDecompile: wasShowing not. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'! toggleShowDocumentation "Toggle the setting of the showingDocumentation flag, unless there are unsubmitted edits that the user declines to discard"
| wasShowing | self okToChange ifTrue: [wasShowing := self showingDocumentation. self showDocumentation: wasShowing not. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'! toggleShowingByteCodes "Toggle whether the receiver is showing bytecodes"
self showByteCodes: self showingByteCodes not. self setContentsToForceRefetch. self contentsChanged! !
!Command class methodsFor: 'dog simple ui' stamp: 'mt 7/31/2023 11:10'! undoRedoButtons "Answer a morph that offers undo and redo buttons"
| wrapper | "self currentHand attachMorph: Command undoRedoButtons" wrapper := AlignmentMorph newColumn. wrapper color: Color veryVeryLightGray lighter; borderWidth: 0; layoutInset: 0; vResizing: #shrinkWrap; hResizing: #shrinkWrap. #((CrudeUndo undoLastCommand 'undo last command done' undoEnabled CrudeUndoDisabled CrudeUndoDisabled) (CrudeRedo redoNextCommand 'redo last undone command' redoEnabled CrudeRedoDisabled CrudeRedoDisabled)) do: [:tuple | | aButton | wrapper addTransparentSpacerOfSize: (8@0). aButton := UpdatingThreePhaseButtonMorph new. aButton onImage: (MenuIcons formAtKey: tuple first); offImage: (MenuIcons formAtKey: tuple fifth); pressedImage: (MenuIcons formAtKey: tuple sixth); getSelector: tuple fourth; color: Color transparent; target: self; actionSelector: tuple second; setNameTo: tuple second; setBalloonText: tuple third; extent: aButton onImage extent. wrapper addMorphBack: aButton. wrapper addTransparentSpacerOfSize: (8@0)]. ^ wrapper! !
!Debugger methodsFor: 'toolbuilder' stamp: 'mt 3/10/2023 11:26'! buildNotifierWith: builder label: label message: messageString | windowSpec listSpec textSpec panelSpec quads | windowSpec := builder pluggableWindowSpec new model: self; extent: self initialExtentForNotifier; label: label asString; children: OrderedCollection new.
panelSpec := builder pluggablePanelSpec new. panelSpec children: OrderedCollection new. quads := self preDebugButtonQuads. (self interruptedContext selector == #doesNotUnderstand:) ifTrue: [ quads := quads copyWith: { 'Create'. #createMethod. #magenta. 'create the missing method' } ]. (#(#notYetImplemented #shouldBeImplemented #requirement) includes: self interruptedContext selector) ifTrue: [ quads := quads copyWith: { 'Create'. #createImplementingMethod. #magenta. 'implement the marked method' } ]. (self interruptedContext selector == #subclassResponsibility) ifTrue: [ quads := quads copyWith: { 'Create'. #createOverridingMethod. #magenta. 'create the missing overriding method' } ]. quads do:[:spec| | buttonSpec | buttonSpec := builder pluggableButtonSpec new. buttonSpec model: self. buttonSpec label: spec first. buttonSpec action: spec second. buttonSpec help: spec fourth. spec size >= 5 ifTrue: [buttonSpec enabled: spec fifth]. panelSpec children add: buttonSpec. ]. panelSpec layout: #horizontal. "buttons" panelSpec frame: self preDebugButtonQuadFrame. windowSpec children add: panelSpec.
messageString notNil ifFalse:[ listSpec := builder pluggableListSpec new. listSpec model: self; list: #contextStackList; getIndex: #contextStackIndex; setIndex: #debugAt:; icon: #messageIconAt:; helpItem: #messageHelpAt:; frame: self contextStackFrame. windowSpec children add: listSpec. ] ifTrue:[ message := messageString. textSpec := builder pluggableTextSpec new. textSpec model: self; getText: #preDebugMessageString; setText: nil; selection: nil; menu: #debugProceedMenu:; frame: self contextStackFrame. windowSpec children add: textSpec. ].
^windowSpec! !
!Debugger methodsFor: 'initialize' stamp: 'mt 3/10/2023 11:26'! preDebugButtonQuads
^{ {'Proceed' translated. #proceed. #blue. 'continue execution' translated. #interruptedProcessShouldResume}. self class showTerminateButton ifTrue: [ {'Terminate' translated. #terminateProcess. #black. 'terminate this execution and close this window' translated}]. self class showAbandonButton ifTrue: [ {'Abandon' translated. #abandon. #black. 'terminate this execution aggressively and close this window' translated}]. {'Debug' translated. #debug. #red. 'bring up a debugger' translated}} reject: [:quad | quad isNil] ! !
!DeepCopier methodsFor: 'like fullCopy' stamp: 'mt 3/10/2023 15:37'! checkBasicClasses "Check that no indexes of instance vars have changed in certain classes. If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated. The idea is to catch a change while it is still in the system of the programmer who made it. DeepCopier new checkVariables "
| str objCls morphCls | str := '|veryDeepCopyWith: or veryDeepInner: is out of date.'. (objCls := self objInMemory: #Object) ifNotNil: [ objCls instSize = 0 ifFalse: [self error: 'Many implementers of veryDeepCopyWith: are out of date']]. (morphCls := self objInMemory: #Morph) ifNotNil: [ morphCls superclass == Object ifFalse: [self error: 'Morph', str]. (morphCls instVarNames copyFrom: 1 to: 6) = #('bounds' 'owner' 'submorphs' 'fullBounds' 'color' 'extension') ifFalse: [self error: 'Morph', str]]. "added ones are OK"! !
!DeepCopier methodsFor: 'like fullCopy' stamp: 'mt 8/28/2023 15:08'! initialize: size
references := IdentityDictionary new: size.! !
!ExtendedClipboardUnixInterface methodsFor: 'general-api-read' stamp: 'mt 8/11/2023 15:20'! readHTMLClipboardData | bytes source | "Answer a HTMLDocument object" bytes := self readClipboardData: 'text/html'. (bytes beginsWith: ' ifTrue: ["BAD HACK for Abiword" source := bytes asString convertFromWithConverter: UTF8TextConverter new] ifFalse: ["BAD HACK for mozilla" source := bytes asString convertFromWithConverter: (UTF16TextConverter new useLittleEndian: SmalltalkImage current isLittleEndian)]. ^ source asTextFromHtml! !
!FileList2 methodsFor: 'volume list and pattern' stamp: 'mt 8/16/2023 15:54'! listForPattern: pat "Make the list be those file names which match the pattern."
| sizePad newList entries | directory ifNil: [^#()]. entries := directory entries. (fileSelectionBlock isKindOf: MessageSend) ifTrue: [ fileSelectionBlock arguments: {entries}. newList := fileSelectionBlock value. fileSelectionBlock arguments: #(). ] ifFalse: [ newList := entries select: [:entry | fileSelectionBlock value: entry value: pat]. ]. newList := newList asArray sort: self sortBlock. sizePad := (newList inject: 0 into: [:mx :entry | mx max: entry fileSize]) asStringWithCommas size - 1. ^newList collect: [ :e | self fileNameFormattedFrom: e sizePad: sizePad ]! !
!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'! morphicViewGeneralLoaderInWorld: aWorld " FileList2 morphicViewGeneralLoaderInWorld: self currentWorld " | window aFileList buttons treePane textColor1 fileListPane pane2a pane2b fileTypeInfo fileTypeButtons fileTypeRow actionRow |
fileTypeInfo := self endingSpecs. window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new directory: FileDirectory default. aFileList fileSelectionBlock: self projectOnlySelectionBlock; modalView: window. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1 px; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners.
fileTypeButtons := fileTypeInfo collect: [ :each | (self blueButtonText: each first textColor: Color gray inWindow: window) setProperty: #enabled toValue: true; hResizing: #shrinkWrap; useSquareCorners ]. buttons := {{'OK'. Color lightGreen}. {'Cancel'. Color lightRed}} collect: [ :each | self blueButtonText: each first textColor: textColor1 color: each second inWindow: window ].
treePane := aFileList morphicDirectoryTreePane extent: 250 px @ 300 px; retractable: false; borderWidth: 0. fileListPane := aFileList morphicFileListPane extent: 350 px @ 300 px; retractable: false; borderWidth: 0. window addARow: {window fancyText: 'Find...' translated font: Preferences standardWindowTitleFont color: textColor1}. fileTypeRow := window addARowCentered: fileTypeButtons cellInset: 2 px. actionRow := window addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second } cellInset: 2 px. window addARow: { (window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2a fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). pane2b fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). " buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]. " fileTypeButtons do: [ :each | each on: #mouseUp send: #value:value: to: [ :evt :morph | self update: actionRow in: window fileTypeRow: fileTypeRow morphUp: morph. ] ]. buttons first on: #mouseUp send: #okHit to: aFileList. buttons second on: #mouseUp send: #cancelHit to: aFileList. aFileList postOpen. window position: aWorld topLeft + (aWorld extent - window extent // 2). aFileList directoryChangeBlock: [ :newDir | self update: actionRow in: window fileTypeRow: fileTypeRow morphUp: nil. self enableTypeButtons: fileTypeButtons info: fileTypeInfo forDir: newDir. ]. aFileList directory: aFileList directory. window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window openInWorld: aWorld.! !
!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'! morphicViewProjectLoader2InWorld: aWorld reallyLoad: aBoolean dirFilterType: aSymbol
| window aFileList buttons treePane textColor1 fileListPane pane2a pane2b treeExtent filesExtent |
window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new. aFileList optionalButtonSpecs: aFileList servicesForProjectLoader; fileSelectionBlock: ( aSymbol == #limitedSuperSwikiDirectoryList ifTrue: [ MessageSend receiver: Project current selector: #latestProjectVersionsFromFileEntries: ] ifFalse: [ self projectOnlySelectionBlock ] ); "dirSelectionBlock: self hideSqueakletDirectoryBlock;" modalView: window. aFileList directory: FileDirectory default. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1 px; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners. buttons := {{'OK'. Color lightGreen}. {'Cancel'. Color lightRed}} collect: [ :each | self blueButtonText: each first textColor: textColor1 color: each second inWindow: window ].
aWorld width < 800 px ifTrue: [ treeExtent := 150 px @ 300 px. filesExtent := 350 px @ 300 px. ] ifFalse: [ treeExtent := 350 px @ 500 px. filesExtent := 550 px @500 px. ]. (treePane := aFileList morphicDirectoryTreePaneFiltered: aSymbol) extent: treeExtent; retractable: false; borderWidth: 0. fileListPane := aFileList morphicFileListPane extent: filesExtent; retractable: false; borderWidth: 0. window addARow: { window fancyText: 'Load A Project' translated font: Preferences standardWindowTitleFont color: textColor1 }; addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second }; addARow: { window fancyText: 'Please select a project' translated font: Preferences standardButtonFont color: textColor1 }; addARow: { (window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2a fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). pane2b fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). " buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]. " buttons first on: #mouseUp send: (aBoolean ifTrue: [#okHitForProjectLoader] ifFalse: [#okHit]) to: aFileList. buttons second on: #mouseUp send: #cancelHit to: aFileList. aFileList postOpen. window position: aWorld topLeft + (aWorld extent - window extent // 2). window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window openInWorld: aWorld.! !
!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'! morphicViewProjectSaverFor: aProject " (FileList2 morphicViewProjectSaverFor: Project current) openInWorld " | window aFileList buttons treePane pane2 textColor1 option treeExtent buttonData buttonRow |
textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new directory: ServerDirectory projectDefaultDirectory. aFileList dirSelectionBlock: self hideSqueakletDirectoryBlock. window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. aFileList modalView: window. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners.
buttonData := Preferences enableLocalSave ifTrue: [{ {'Save'. #okHit. 'Save in the place specified below, and in the Squeaklets folder on your local disk'. Color lightGreen}. {'Save on local disk only'. #saveLocalOnlyHit. 'saves in the Squeaklets folder'. Color lightGreen}. {'Cancel'. #cancelHit. 'return without saving'. Color lightRed} }] ifFalse: [{ {'Save'. #okHit. 'Save in the place specified below, and in the Squeaklets folder on your local disk'. Color lightGreen}. {'Cancel'. #cancelHit. 'return without saving'. Color lightRed} }]. buttons := buttonData collect: [ :each | (self blueButtonText: each first textColor: textColor1 color: each fourth inWindow: window) setBalloonText: each third translated; hResizing: #shrinkWrap; on: #mouseUp send: each second to: aFileList ].
option := aProject world valueOfProperty: #SuperSwikiPublishOptions ifAbsent: [#initialDirectoryList]. aProject world removeProperty: #SuperSwikiPublishOptions.
treeExtent := Project current world height < 500 px ifTrue: [ 350 px @ 150 px ] ifFalse: [ 350 px @ 300 px ].
(treePane := aFileList morphicDirectoryTreePaneFiltered: option) extent: treeExtent; retractable: false; borderWidth: 0. window addARowCentered: { window fancyText: 'Publish This Project' translated font: Preferences standardWindowTitleFont color: textColor1 }. buttonRow := OrderedCollection new. buttons do: [:button | buttonRow add: button] separatedBy: [buttonRow add: ((Morph new extent: 30 px @ 5 px) color: Color transparent)].
" addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second. (Morph new extent: 30 px@ 5 px) color: Color transparent. buttons third };" window addARowCentered: buttonRow; addARowCentered: { (window inAColumn: {(ProjectViewMorph on: aProject) lock}) layoutInset: 4 px}; addARowCentered: { window fancyText: 'Please select a folder' translated font: Preferences standardButtonFont color: textColor1 }; addARow: { ( window inAColumn: { (pane2 := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) } ) layoutInset: 10 px }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2 fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). " buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]. " window morphicLayerNumber: window class dialogLayer. aFileList postOpen. window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window ! !
!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:52'! defaultsQuadsDefiningStackToolsFlap "Answer a structure defining the items on the default system Stack Tools flap. previously in quadsDefiningStackToolsFlap"
^ { {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}. {#StackMorph. #stackHelpWindow. 'Stack Help' translatedNoop. 'Some hints about how to use Stacks' translatedNoop}. {#TextMorph . #authoringPrototype. 'Simple Text' translatedNoop. 'Text that you can edit into anything you wish' translatedNoop}. {#TextMorph . #fancyPrototype. 'Fancy Text' translatedNoop. 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop}. {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}. {#StackMorph. #previousCardButton. 'Previous Card' translatedNoop. 'A button that takes the user to the previous card in the stack' translatedNoop}. {#StackMorph. #nextCardButton. 'Next Card' translatedNoop. 'A button that takes the user to the next card in the stack' translatedNoop} } asOrderedCollection ! !
!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:52'! defaultsQuadsDefiningSuppliesFlap "Answer a list of quads which define the objects to appear in the default Supplies flap. previously in quadsDefiningSuppliesFlap"
^ { {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}. {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}. {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}. {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}. {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}. {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}. {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}. {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}. {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}. {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}. {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}. {#TabbedPalette. #authoringPrototype. 'TabbedPalette' translatedNoop. 'A structure with tabs' translatedNoop}. {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}. {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}. {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}. {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop} } asOrderedCollection! !
!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 14:38'! defaultsQuadsDefiningToolsFlap "Answer a structure defining the default Tools flap. previously in quadsDefiningToolsFlap"
^ OrderedCollection new addAll: #( (Browser prototypicalToolWindow 'Browser' 'A Browser is a tool that allows you to view all the code of all the classes in the system') (TranscriptStream openMorphicTranscript 'Transcript' 'A Transcript is a window usable for logging and debugging; browse references to #Transcript for examples of how to write to it.') (Workspace prototypicalToolWindow 'Workspace' 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.')); add: { FileList2 . #prototypicalToolWindow. 'File List'. 'A File List is a tool for browsing folders and files on disks and FTP servers.' }; addAll: #( (DualChangeSorter prototypicalToolWindow 'Change Sorter' 'Shows two change sets side by side') (SelectorBrowser prototypicalToolWindow 'Method Finder' 'A tool for discovering methods by providing sample values for arguments and results') (MessageNames prototypicalToolWindow 'Message Names' 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.') (PreferencesBrowser prototypicalToolWindow 'Preferences' 'Allows you to control numerous options') (Utilities recentSubmissionsWindow 'Recent' 'A message browser that tracks the most recently-submitted methods') (ProcessBrowser prototypicalToolWindow 'Processes' 'A Process Browser shows you all the running processes') (PackagePaneBrowser prototypicalToolWindow 'Packages' 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"') (ChangeSorter prototypicalToolWindow 'Change Set' 'A tool that allows you to view and manipulate all the code changes in a single change set')); yourself! !
!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:53'! defaultsQuadsDefiningWidgetsFlap "Answer a structure defining the default Widgets flap. previously in quadsDefiningWidgetsFlap"
^ #( (TrashCanMorph new 'Trash' 'A tool for discarding objects') (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there') (GeeMailMorph new 'Gee-Mail' 'A place to present annotated content') (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.') (FrameRateMorph authoringPrototype 'FrameRate' 'An indicator of how fast your system is running') (MagnifierMorph newRound 'Magnifier' 'A magnifying glass') (ObjectsTool newStandAlone 'ObjectCatalog' 'A tool that lets you browse the catalog of objects') ) asOrderedCollection! !
!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:50'! initializeFlapsQuads "initialize the list of dynamic flaps quads. self initializeFlapsQuads" FlapsQuads := nil. self registeredFlapsQuads at: 'Stack Tools' put: self defaultsQuadsDefiningStackToolsFlap; at: 'Supplies' put: self defaultsQuadsDefiningSuppliesFlap; at: 'Tools' put: self defaultsQuadsDefiningToolsFlap; at: 'Widgets' put: self defaultsQuadsDefiningWidgetsFlap. ^ self registeredFlapsQuads! !
!Flaps class methodsFor: 'new flap' stamp: 'mt 8/4/2023 14:02'! addLocalFlap: anEvent titled: title onEdge: edge
| flapTab menu world | flapTab := self newFlapTitled: title onEdge: edge. (world := anEvent hand world) addMorphFront: flapTab. menu := flapTab buildHandleMenu: anEvent hand. flapTab addTitleForHaloMenu: menu. flapTab computeEdgeFraction. menu popUpEvent: anEvent in: world.! !
!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 8/10/2023 11:29'! addStandardFlaps "Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed. " SharedFlapTabs ifNil: [SharedFlapTabs := OrderedCollection new]. SharedFlapTabs add: self newSqueakFlap. SharedFlapTabs add: self newSuppliesFlap. SharedFlapTabs add: self newToolsFlap. SharedFlapTabs add: self newWidgetsFlap. SharedFlapTabs add: self newStackToolsFlap.
Preferences showProjectNavigator ifTrue:[SharedFlapTabs add: self newNavigatorFlap].
SharedFlapTabs add: self newObjectsFlap. self disableGlobalFlapWithID: 'Stack Tools' translated.
Preferences showProjectNavigator ifTrue:[self disableGlobalFlapWithID: 'Navigator' translated].
^ SharedFlapTabs! !
!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 7/31/2023 11:11'! newSqueakFlap "Answer a new default 'Squeak' flap for the left edge of the screen"
| aFlap aFlapTab aButton aClock buttonColor anOffset bb aFont | aFlap := PasteUpMorph newSticky borderWidth: 0. aFlapTab := FlapTab new referent: aFlap. aFlapTab setName: 'Squeak' translated edge: #left color: Color brown lighter lighter. aFlapTab position: (0 @ ((Display height - aFlapTab height) // 2)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
aFlap cellInset: 14@14. aFlap beFlap: true. aFlap color: (Color brown muchLighter lighter "alpha: 0.3"). aFlap extent: 150 @ self currentWorld height. aFlap layoutPolicy: TableLayout new. aFlap wrapCentering: #topLeft. aFlap layoutInset: 2. aFlap listDirection: #topToBottom. aFlap wrapDirection: #leftToRight.
"self addProjectNavigationButtonsTo: aFlap." anOffset := 16.
aClock := ClockMorph newSticky. aClock color: Color red. aClock showSeconds: false. aClock font: (TextStyle default fontAt: 3). aClock step. aClock setBalloonText: 'The time of day. If you prefer to see seconds, check out my menu.' translated. aFlap addCenteredAtBottom: aClock offset: anOffset.
buttonColor := Color cyan muchLighter. bb := SimpleButtonMorph new target: Smalltalk. bb color: buttonColor. aButton := bb copy. aButton actionSelector: #saveSession. aButton setBalloonText: 'Make a complete snapshot of the current state of the image onto disk.' translated. aButton label: 'save' translated font: (aFont := Preferences standardButtonFont). aFlap addCenteredAtBottom: aButton offset: anOffset.
aButton := bb copy target: MCMcmUpdater. aButton actionSelector: #updateFromServer. aButton label: 'load code updates' translated font: aFont. aButton color: buttonColor. aButton setBalloonText: 'Check the Squeak server for any new code updates, and load any that are found.' translated. aFlap addCenteredAtBottom: aButton offset: anOffset.
aButton := SimpleButtonMorph new target: Smalltalk; actionSelector: #aboutThisSystem; label: 'about this system' translated font: aFont. aButton color: buttonColor. aButton setBalloonText: 'click here to find out version information' translated. aFlap addCenteredAtBottom: aButton offset: anOffset.
aFlap addCenteredAtBottom: (Preferences themeChoiceButtonOfColor: buttonColor font: aFont) offset: anOffset.
aButton := TrashCanMorph newSticky. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton startStepping.
^ aFlapTab
"Flaps replaceGlobalFlapwithID: 'Squeak' translated "! !
!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 8/28/2023 14:29'! newSuppliesFlapFromQuads: quads positioning: positionSymbol "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen. Use #center as the positionSymbol to have it centered at the bottom of the screen, or #right to have it placed off near the right edge."
| aFlapTab aStrip hPosition | aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: quads. "self twiddleSuppliesButtonsIn: aStrip." aFlapTab := FlapTab new referent: aStrip beSticky. aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter. hPosition := positionSymbol == #center ifTrue: [(Display width // 2) - (aFlapTab width // 2)] ifFalse: [Display width - (aFlapTab width + 22)]. aFlapTab position: (hPosition @ (self currentWorld height - aFlapTab height)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
aStrip extent: self currentWorld width @ 136. aStrip beFlap: true. aStrip autoLineLayout: true.
^ aFlapTab
"Flaps replaceGlobalFlapwithID: 'Supplies' translated"! !
!Flaps class methodsFor: 'replacement' stamp: 'mt 8/4/2023 15:19'! replaceGlobalFlapwithID: flapID "If there is a global flap with flapID, replace it with an updated one."
| replacement tabs | (tabs := self globalFlapTabsWithID: flapID) size = 0 ifTrue: [^ self]. tabs do: [:tab | self removeFlapTab: tab keepInList: false]. flapID = 'Stack Tools' translated ifTrue: [replacement := self newStackToolsFlap]. flapID = 'Supplies' translated ifTrue: [replacement := self newSuppliesFlap]. flapID = 'Tools' translated ifTrue: [replacement := self newToolsFlap]. flapID = 'Widgets' translated ifTrue: [replacement := self newWidgetsFlap]. flapID = 'Navigator' translated ifTrue: [replacement := self newNavigatorFlap]. flapID = 'Squeak' translated ifTrue: [replacement := self newSqueakFlap]. replacement ifNil: [^ self]. self addGlobalFlap: replacement. self currentWorld ifNotNil: [self currentWorld addGlobalFlaps]
"Flaps replaceFlapwithID: 'Widgets' translated "! !
!FontSubstitutionDuringLoading methodsFor: 'accessing' stamp: 'mt 8/11/2023 13:59'! defaultAction familyName ifNil: [ familyName := 'NoName' ]. pixelSize ifNil: [ pixelSize := 12 ].
^((familyName beginsWith: 'Comic') ifTrue: [ TextStyle named: (Preferences standardDefaultTextFont familyName) ] ifFalse: [ TextStyle default ]) fontOfSize: pixelSize.! !
!Form methodsFor: 'converting' stamp: 'mt 8/16/2023 16:54'! blendColor: aTranslucentColor
| form canvas | form := self deepCopy asFormOfDepth: 32. canvas := form getCanvas. canvas stencil: form at: 0 @ 0 sourceRect: (0 @ 0 extent: form extent) color: aTranslucentColor. ^ canvas form! !
!Form methodsFor: 'scaling, rotation' stamp: 'sw 4/16/2008 00:13'! scaledToHeight: newHeight "Answer the receiver, scaled such that it has the desired height."
newHeight = self height ifTrue: [^ self]. ^self magnify: self boundingBox by: (newHeight / self height) smoothing: 2. ! !
!Form methodsFor: 'scaling, rotation' stamp: 'ct 9/17/2019 18:50'! scaledToWidth: newWidth "Answer the receiver, scaled such that it has the desired width."
newWidth = self width ifTrue: [^ self]. ^self magnify: self boundingBox by: (newWidth / self width) smoothing: 2. ! !
!Form class methodsFor: '*MorphicExtras-examples' stamp: 'mt 8/14/2023 16:21'! gridFormExample "Original was in Morph >> #setStandardTexture and #textureParameters and #makeGraphPaperGrid:...
Morph new color: Form gridFormExample; extent: 500@500; openInHand
"
^ self gridFormOrigin: 0@0 grid: 16 px background: Color black line: Color lightGreen lighter lighter ! !
!Form class methodsFor: '*MorphicExtras-sprites' stamp: 'mt 8/14/2023 16:20'! gridFormOrigin: origin grid: smallGrid background: backColor line: lineColor
| bigGrid gridForm gridOrigin | gridOrigin := origin \ smallGrid. bigGrid := (smallGrid asPoint x) @ (smallGrid asPoint y). gridForm := Form extent: bigGrid depth: Display depth. backColor ifNotNil: [gridForm fillWithColor: backColor]. gridOrigin x to: gridForm width by: smallGrid asPoint x do: [:x | gridForm fill: (x@0 extent: 1@gridForm height) fillColor: lineColor]. gridOrigin y to: gridForm height by: smallGrid asPoint y do: [:y | gridForm fill: (0@y extent: gridForm width@1) fillColor: lineColor]. ^ InfiniteForm with: gridForm! !
!GetTextExporter class methodsFor: 'utilities' stamp: 'mt 8/4/2023 13:49'! listAllHelp "self listAllHelp" | spec specs oCatalog flap flapSelectors allKeys oCatalogHelp flapHelp | oCatalog := Dictionary new. Morph withAllSubclasses do: [:aClass | (aClass class includesSelector: #descriptionForPartsBin) ifTrue: [spec := aClass descriptionForPartsBin. oCatalog at: spec formalName put: spec documentation]]. Morph withAllSubclasses do: [:aClass | (aClass class includesSelector: #supplementaryPartsDescriptions) ifTrue: [specs := aClass supplementaryPartsDescriptions. specs do: [:each | oCatalog at: each formalName put: each documentation]]]. flap := Dictionary new. flapSelectors := #( #defaultsQuadsDefiningStackToolsFlap #defaultsQuadsDefiningSuppliesFlap #defaultsQuadsDefiningToolsFlap #defaultsQuadsDefiningWidgetsFlap ). flapSelectors do: [:selector | specs := Flaps perform: selector. specs do: [:each | flap at: each third put: each fourth]]. allKeys := oCatalog keys intersection: flap keys. allKeys asArray sort do: [:each | oCatalogHelp := oCatalog at: each ifAbsent: ['']. flapHelp := flap at: each ifAbsent: ['']. oCatalogHelp = flapHelp ifFalse: [Transcript cr; show: 'Name: ' , each. Transcript cr; show: 'O: ' , oCatalogHelp. Transcript cr; show: 'F: ' , flapHelp. Transcript cr.
]]! !
!ImageSegment methodsFor: 'fileIn' stamp: 'mt 8/16/2023 16:51'! declareAndPossiblyRename: classThatIsARoot | existing catInstaller | "The class just arrived in this segment. How fit it into the Smalltalk dictionary? If it had an association, that was installed with associationDeclareAt:."
catInstaller := [ classThatIsARoot category: Object categoryForUniclasses. ]. classThatIsARoot superclass addSubclass: classThatIsARoot. (Smalltalk includesKey: classThatIsARoot name) ifFalse: [ "Class entry in Smalltalk not referred to in Segment, install anyway." catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. existing := Smalltalk at: classThatIsARoot name. existing xxxClass == ImageSegmentRootStub ifTrue: [ "We are that segment!! Must ask it carefully!!" catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. existing == false | (existing == nil) ifTrue: [ "association is in outPointers, just installed" catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. "Conflict with existing global or copy of the class" (existing isKindOf: Class) ifTrue: [ classThatIsARoot isSystemDefined not ifTrue: [ "UniClass. give it a new name" classThatIsARoot setName: MorphicModel chooseUniqueClassName. catInstaller value. "must be after new name" ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. "Take the incoming one" self inform: 'Using newly arrived version of ', classThatIsARoot name. classThatIsARoot superclass removeSubclass: classThatIsARoot. "just in case" (Smalltalk at: classThatIsARoot name) becomeForward: classThatIsARoot. catInstaller value. ^ classThatIsARoot superclass addSubclass: classThatIsARoot]. self error: 'Name already in use by a non-class: ', classThatIsARoot name. ! !
!ImageSegment class methodsFor: 'fileIn/Out' stamp: 'mt 8/28/2023 15:10'! copyFromRootsLocalFileFor: rootArray sizeHint: segSize
^ NativeImageSegment new copyFromRootsLocalFileFor: rootArray sizeHint: segSize! !
!Inspector methodsFor: 'menu' stamp: 'mt 8/28/2023 14:33'! inspectorKey: aChar from: view "Respond to a Command key issued while the cursor is over my field list"
^ aChar caseOf: { [$x] -> [self removeSelection].
[$i] -> [self inspectSelection]. [$I] -> [self exploreSelection]. [$b] -> [self browseClass]. [$h] -> [self browseClassHierarchy]. [$p] -> [self browseFullProtocol]. [$r] -> [self browseVariableReferences]. [$a] -> [self browseVariableAssignments]. [$N] -> [self browseClassRefs]. [$c] -> [self copyName] } otherwise: [self arrowKey: aChar from: view]! !
!Inspector methodsFor: 'menu' stamp: 'mt 3/10/2023 15:12'! mainFieldListMenu: aMenu "Arm the supplied menu with items for the field-list of the receiver"
aMenu addStayUpItemSpecial.
self addObjectItemsTo: aMenu.
(#(self ellipsis element nil) includes: self typeOfSelection) ifTrue: [self addCollectionItemsTo: aMenu].
self typeOfSelection = #instVar ifTrue: [self addInstVarItemsTo: aMenu].
self addFieldItemsTo: aMenu. self addClassItemsTo: aMenu.
^ aMenu! !
!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 7/31/2023 10:45'! formAtKey: aString "Answer the form saved under the given key"
^(Symbol lookup: aString) ifNotNil: [ :aKey | ScriptingIcons at: aKey ifAbsent: [ self blankIcon ] ] ifNil: [ self blankIcon ]! !
!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:08'! formPressedAtKey: aSymbol "Answer the form for pressed button. It is automatically generated if unavailable." "(ScriptingSystem formPressedAtKey: #TryIt) asMorph openInHand" | pressedName pressedImage | pressedName := (aSymbol , 'Pressed') asSymbol. ((ScriptingIcons includesKey: aSymbol) and: [(ScriptingIcons includesKey: pressedName) not]) ifTrue: [pressedImage := ((self formAtKey: aSymbol) blendColor: (Color black alpha: 0.3)) colorReduced. ScriptingIcons at: pressedName put: pressedImage]. ^ self formAtKey: pressedName! !
!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:11'! saveForm: aForm atKey: aKey ScriptingIcons at: aKey asSymbol put: aForm! !
!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:05'! scriptingIcons
^ ScriptingIcons ifNil: [ScriptingIcons := IdentityDictionary new]! !
!MessageSet methodsFor: 'filtering' stamp: 'mt 8/28/2023 15:11'! filterMessageList "Allow the user to refine the list of messages." | builder menuSpec | builder := ToolBuilder default. menuSpec := builder pluggableMenuSpec new model: self; yourself. menuSpec addList: #( ('unsent messages' filterToUnsentMessages 'filter to show only messages that have no senders') - ('messages that send...' filterToSendersOf 'filter to show only messages that send a selector I specify') ('messages that do not send...' filterToNotSendersOf 'filter to show only messages that do not send a selector I specify') - ('messages whose selector is...' filterToImplementorsOf 'filter to show only messages with a given selector I specify') ('messages whose selector is NOT...' filterToNotImplementorsOf 'filter to show only messages whose selector is NOT a seletor I specify') - ('messages in current change set' filterToCurrentChangeSet 'filter to show only messages that are in the current change set') ('messages not in current change set' filterToNotCurrentChangeSet 'filter to show only messages that are not in the current change set') - ('messages in any change set' filterToAnyChangeSet 'filter to show only messages that occur in at least one change set') ('messages not in any change set' filterToNotAnyChangeSet 'filter to show only messages that do not occur in any change set in the system') - ('messages authored by me' filterToCurrentAuthor 'filter to show only messages whose authoring stamp has my initials') ('messages not authored by me' filterToNotCurrentAuthor 'filter to show only messages whose authoring stamp does not have my initials') - ('messages logged in .changes file' filterToMessagesInChangesFile 'filter to show only messages whose latest source code is logged in the .changes file') ('messages only in .sources file' filterToMessagesInSourcesFile 'filter to show only messages whose latest source code is logged in the .sources file') - ('messages with prior versions' filterToMessagesWithPriorVersions 'filter to show only messages that have at least one prior version') ('messages without prior versions' filterToMessagesWithoutPriorVersions 'filter to show only messages that have no prior versions') - ('uncommented messages' filterToUncommentedMethods 'filter to show only messages that do not have comments at the beginning') ('commented messages' filterToCommentedMethods 'filter to show only messages that have comments at the beginning') - ('messages in hardened classes' filterToMessagesWithHardenedClasses 'filter to show only messages of established classes (as opposed to Uniclasses such as MorphicModel23)') - ('methods in classes with matching names' filterToMatchingClassesNames 'filter to show only methods of classes with names that match the given criteria (wildcards are allowed)') ('methods in package...' filterToPackage 'filter to show only methods of a given package') ('methods not in package...' filterToNotPackage 'filter to show only methods not of a given package') - ('messages that...' filterToMessagesThat 'let me type in a block taking a class and a selector, which will specify yea or nay concerning which elements should remain in the list')). builder runModal: (builder open: menuSpec).! !
!Lexicon methodsFor: 'toolbuilder' stamp: 'mt 7/31/2023 11:13'! addSpecialButtonsTo: buttonPanelSpec with: builder
| homeCatBtnSpec menuBtnSpec mostGenericBtnSpec | homeCatBtnSpec := builder pluggableButtonSpec new model: self; action: #showHomeCategory; label: MenuIcons smallHomeIcon scaleIconToDisplay; help: 'show this method''s home category'; yourself. menuBtnSpec := builder pluggableButtonSpec new model: self; action: #offerMenu; label: (MenuIcons formAtKey: #TinyMenu) asMorph; help: 'click here to get a menu with further options'; yourself. mostGenericBtnSpec :=builder pluggableButtonSpec new model: self; action: #chooseLimitClass; label: #limitClassString; help: 'Governs which classes'' methods should be shown. If this is the same as the viewed class, then only methods implemented in that class will be shown. If it is ProtoObject, then methods of all classes in the vocabulary will be shown.'. buttonPanelSpec children add: homeCatBtnSpec; addFirst: mostGenericBtnSpec; addFirst: menuBtnSpec.! !
!InstanceBrowser methodsFor: 'menu commands' stamp: 'mt 8/16/2023 16:52'! offerMenu "Offer a menu to the user, in response to the hitting of the menu button on the tool pane"
| aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu title: ('Messages of {1}' translated format: {objectViewed nameForViewer}). aMenu addStayUpItem. aMenu addTranslatedList: #( ('vocabulary...' chooseVocabulary) ('what to show...' offerWhatToShowMenu) - ('inst var refs (here)' setLocalInstVarRefs) ('inst var defs (here)' setLocalInstVarDefs) ('class var refs (here)' setLocalClassVarRefs) -
('navigate to a sender...' navigateToASender) ('recent...' navigateToRecentMethod) ('show methods in current change set' showMethodsInCurrentChangeSet) ('show methods with initials...' showMethodsWithInitials) - "('toggle search pane' toggleSearch)"
- - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' browseClassHierarchy) ('browse protocol (p)' browseFullProtocol) - ('fileOut' fileOutMessage) ('printOut' printOutMessage) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('versions (v)' browseVersions) ('inheritance (i)' methodHierarchy) - ('references... (r)' browseVariableReferences) ('assignments... (a)' browseVariableAssignments) - ('inspector on me' inspectViewee) - ('more...' shiftedYellowButtonActivity)).
^ aMenu popUpInWorld: self currentWorld! !
!MethodCall methodsFor: 'initialization' stamp: 'mt 8/28/2023 14:54'! receiver: aReceiver methodInterface: aMethodInterface "Initialize me to have the given receiver and methodInterface"
receiver := aReceiver. selector := aMethodInterface selector. methodInterface := aMethodInterface. arguments := aMethodInterface defaultArguments. lastValue := nil.! !
!MethodFinder methodsFor: 'initialize' stamp: 'mt 3/10/2023 15:58'! initialize "The methods we are allowed to use. (MethodFinder new initialize) "
Approved := Set new. AddAndRemove := Set new. Blocks := Set new. "These modify an argument and are not used by the MethodFinder: longPrintOn: printOn: storeOn: sentTo: storeOn:base: printOn:base: absPrintExactlyOn:base: absPrintOn:base: absPrintOn:base:digitCount: writeOn: writeScanOn: possibleVariablesFor:continuedFrom: printOn:format:"
"Object" #("in class, instance creation" categoryForUniclasses chooseUniqueClassName initialInstance isSystemDefined newFrom: officialClass readCarefullyFrom: "accessing" at: basicAt: basicSize bindWithTemp: in: size yourself "testing" basicType ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: isColor isFloat isFraction isInMemory isInteger isMorph isNil isNumber isPoint isText isTransparent isWebBrowser knownName notNil pointsTo: wantsSteps "comparing" = == closeTo: hash identityHash identityHashPrintString ~= ~~ "copying" copy shallowCopy "dependents access" canDiscardEdits dependents hasUnacceptedEdits "updating" changed changed: okToChange update: windowIsClosing "printing" fullPrintString isLiteral longPrintString printString storeString stringForReadout stringRepresentation "class membership" class isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass "error handling" "user interface" addModelMenuItemsTo:forMorph:hand: defaultLabelForInspector fullScreenSize initialExtent modelWakeUp mouseUpBalk: newTileMorphRepresentative windowActiveOnFirstClick windowReqNewLabel: "system primitives" asOop instVarAt: instVarNamed: "private" "associating" -> "converting" as: asOrderedCollection asString "casing" caseOf: caseOf:otherwise: "binding" bindingOf: "macpal" contentsChanged currentEvent currentHand currentWorld flash instanceVariableValues "flagging" flag: "translation support" "objects from disk" "finalization" ) do: [:sel | Approved add: sel]. #(at:add: at:modify: at:put: basicAt:put: "NOT instVar:at:" "message handling" perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: ) do: [:sel | AddAndRemove add: sel].
"Boolean, True, False, UndefinedObject" #("logical operations" & eqv: not xor: | "controlling" and: ifFalse: ifFalse:ifTrue: ifTrue: ifTrue:ifFalse: or: "copying" "testing" isEmptyOrNil) do: [:sel | Approved add: sel].
"Behavior" #("initialize-release" "accessing" compilerClass decompilerClass evaluatorClass format methodDict parserClass sourceCodeTemplate subclassDefinerClass "testing" instSize instSpec isBits isBytes isFixed isPointers isVariable isWeak isWords "copying" "printing" printHierarchy "creating class hierarchy" "creating method dictionary" "instance creation" basicNew basicNew: new new: "accessing class hierarchy" allSubclasses allSubclassesWithLevelDo:startingLevel: allSuperclasses subclasses superclass withAllSubclasses withAllSuperclasses "accessing method dictionary" allSelectors changeRecordsAt: compiledMethodAt: compiledMethodAt:ifAbsent: firstCommentAt: lookupSelector: selectors selectorsDo: selectorsWithArgs: "slow but useful ->" sourceCodeAt: sourceCodeAt:ifAbsent: sourceMethodAt: sourceMethodAt:ifAbsent: "accessing instances and variables" allClassVarNames allInstVarNames allSharedPools classVarNames instVarNames instanceCount sharedPools someInstance subclassInstVarNames "testing class hierarchy" inheritsFrom: kindOfSubclass "testing method dictionary" canUnderstand: classThatUnderstands: hasMethods includesSelector: whichClassIncludesSelector: whichSelectorsAccess: whichSelectorsReferTo: whichSelectorsReferTo:special:byte: whichMethodsStoreInto: "enumerating" "user interface") do: [:sel | Approved add: sel].
"ClassDescription" #("initialize-release" "accessing" classVersion isMeta name theNonMetaClass "copying" "printing" classVariablesString instanceVariablesString sharedPoolsString "instance variables" checkForInstVarsOK: "method dictionary" "organization" category organization whichCategoryIncludesSelector: "compiling" acceptsLoggingOfCompilation wantsChangeSetLogging "fileIn/Out" definition "private" ) do: [:sel | Approved add: sel].
"Class" #("initialize-release" "accessing" classPool "testing" "copying" "class name" "instance variables" "class variables" classVarAt: classVariableAssociationAt: "pool variables" "compiling" "subclass creation" "fileIn/Out" ) do: [:sel | Approved add: sel].
"Metaclass" #("initialize-release" "accessing" isSystemDefined soleInstance "copying" "instance creation" "instance variables" "pool variables" "class hierarchy" "compiling" "fileIn/Out" nonTrivial ) do: [:sel | Approved add: sel].
"Context, BlockContext" #(receiver client method receiver tempAt: "debugger access" pc selector sender shortStack sourceCode tempNames tempsAndValues "controlling" "printing" "system simulation" "initialize-release" "accessing" hasMethodReturn home numArgs "evaluating" value value:ifError: value:value: value:value:value: value:value:value:value: valueWithArguments: "controlling" "scheduling" "instruction decoding" "printing" "private" "system simulation" ) do: [:sel | Approved add: sel]. #(value: "<- Association has it as a store" ) do: [:sel | AddAndRemove add: sel].
"Message" #("inclass, instance creation" selector: selector:argument: selector:arguments: "accessing" argument argument: arguments sends: "printing" "sending" ) do: [:sel | Approved add: sel]. #("private" setSelector:arguments:) do: [:sel | AddAndRemove add: sel].
"Magnitude" #("comparing" < <= > >= between:and: "testing" max: min: min:max: ) do: [:sel | Approved add: sel].
"Date, Time" #("in class, instance creation" fromDays: fromSeconds: fromString: newDay:month:year: newDay:year: today "in class, general inquiries" dateAndTimeNow dayOfWeek: daysInMonth:forYear: daysInYear: firstWeekdayOfMonth:year: indexOfMonth: leapYear: nameOfDay: nameOfMonth: "accessing" day leap monthIndex monthName weekday year "arithmetic" addDays: subtractDate: subtractDays: "comparing" "inquiries" dayOfMonth daysInMonth daysInYear daysLeftInYear firstDayOfMonth previous: "converting" asSeconds "printing" mmddyyyy printFormat: "private" weekdayIndex "in class, instance creation" fromSeconds: now "in class, general inquiries" dateAndTimeFromSeconds: dateAndTimeNow millisecondClockValue millisecondsToRun: totalSeconds "accessing" hours minutes seconds "arithmetic" addTime: subtractTime: "comparing" "printing" intervalString print24 "converting") do: [:sel | Approved add: sel]. #("private" ) do: [:sel | AddAndRemove add: sel].
"Number" #("in class" readFrom:base: "arithmetic" * + - / // \ abs negated quo: reciprocal rem: "mathematical functions" arcCos arcSin arcTan arcTan: cos exp floorLog: ln log log: raisedTo: raisedToInteger: sin sqrt squared tan "truncation and round off" ceiling detentBy:atMultiplesOf:snap: floor roundTo: roundUpTo: rounded truncateTo: truncated "comparing" "testing" even isDivisibleBy: isInfinite isNaN isZero negative odd positive sign strictlyPositive "converting" @ asInteger asNumber asPoint asSmallAngleDegrees degreesToRadians radiansToDegrees "intervals" to: to:by: "printing" printStringBase: storeStringBase: ) do: [:sel | Approved add: sel].
"Integer" #("in class" primesUpTo: "testing" isPowerOfTwo "arithmetic" alignedTo: "comparing" "truncation and round off" atRandom normalize "enumerating" timesRepeat: "mathematical functions" degreeCos degreeSin factorial gcd: lcm: take: "bit manipulation" << >> allMask: anyMask: bitAnd: bitClear: bitInvert bitInvert32 bitOr: bitShift: bitXor: lowBit noMask: "converting" asCharacter asColorOfDepth: asFloat asFraction asHexDigit "printing" asStringWithCommas hex hex8 radix: "system primitives" lastDigit replaceFrom:to:with:startingAt: "private" "benchmarks" ) do: [:sel | Approved add: sel].
"SmallInteger, LargeNegativeInteger, LargePositiveInteger" #("arithmetic" "bit manipulation" highBit "testing" "comparing" "copying" "converting" "printing" "system primitives" digitAt: digitLength "private" fromString:radix: ) do: [:sel | Approved add: sel]. #(digitAt:put: ) do: [:sel | AddAndRemove add: sel].
"Float" #("arithmetic" "mathematical functions" reciprocalLogBase2 timesTwoPower: "comparing" "testing" "truncation and round off" exponent fractionPart integerPart significand significandAsInteger "converting" asApproximateFraction asIEEE32BitWord asTrueFraction "copying") do: [:sel | Approved add: sel].
"Fraction, Random" #(denominator numerator reduced next nextValue) do: [:sel | Approved add: sel]. #(setNumerator:denominator:) do: [:sel | AddAndRemove add: sel].
"Collection" #("accessing" anyOne "testing" includes: includesAllOf: includesAnyOf: includesSubstringAnywhere: isEmpty isSequenceable occurrencesOf: "enumerating" collect: collect:thenSelect: count: detect: detect:ifNone: detectMax: detectMin: detectSum: inject:into: reject: select: select:thenCollect: intersection: "converting" asBag asCharacterSet asSet asSortedArray asSortedCollection asSortedCollection: "printing" "private" maxSize "arithmetic" "math functions" average max median min range sum) do: [:sel | Approved add: sel]. #("adding" add: addAll: addIfNotPresent: "removing" remove: remove:ifAbsent: removeAll: removeAllFoundIn: removeAllSuchThat: remove:ifAbsent:) do: [:sel | AddAndRemove add: sel].
"SequenceableCollection" #("comparing" hasEqualElements: "accessing" allButFirst allButLast at:ifAbsent: atAll: atPin: atRandom: atWrap: fifth first fourth identityIndexOf: identityIndexOf:ifAbsent: indexOf: indexOf:ifAbsent: indexOf:startingAt:ifAbsent: indexOfSubCollection:startingAt: indexOfSubCollection:startingAt:ifAbsent: last second sixth third "removing" "copying" , copyAfterLast: copyAt:put: copyFrom:to: copyReplaceAll:with: copyReplaceFrom:to:with: copyUpTo: copyUpToLast: copyWith: copyWithout: copyWithoutAll: forceTo:paddingWith: shuffled sorted: "enumerating" withIndexCollect: findFirst: findLast: pairsCollect: with:collect: withIndexCollect: polynomialEval: "converting" asArray asDictionary asFloat32Array asFloat64Array asIntegerArray asStringWithCr asWordArray reversed "private" copyReplaceAll:with:asTokens: ) do: [:sel | Approved add: sel]. #( swap:with:) do: [:sel | AddAndRemove add: sel].
"ArrayedCollection, Bag" #("private" defaultElement "sorting" isSorted "accessing" cumulativeCounts sortedCounts sortedElements "testing" "adding" add:withOccurrences: "removing" "enumerating" ) do: [:sel | Approved add: sel]. #( mergeSortFrom:to:by: sort sort: add: add:withOccurrences: "private" setDictionary ) do: [:sel | AddAndRemove add: sel].
"Other messages that modify the receiver" #(atAll:put: atAll:putAll: atAllPut: atWrap:put: replaceAll:with: replaceFrom:to:with: removeFirst removeLast) do: [:sel | AddAndRemove add: sel].
self initialize2.
" MethodFinder new initialize. MethodFinder new organizationFiltered: Set "
! !
!MissingFont methodsFor: 'handling' stamp: 'mt 3/7/2023 15:07'! defaultAction familyName ifNil: [ familyName := 'NoName' ]. pixelSize ifNil: [ pixelSize := 12 ].
^((familyName beginsWith: 'Comic') ifTrue: [ TextStyle named: (Preferences standardButtonFont familyName) ] ifFalse: [ TextStyle default ]) fontOfSize: pixelSize.! !
!Morph methodsFor: 'accessing' stamp: 'mt 8/11/2023 16:29'! balloonText "Answer balloon help text or nil, if no help is available." "NB: subclasses may override such that they programatically construct the text, for economy's sake, such as model phrases in a Viewer."
| balloonSelector | extension ifNil: [^ nil].
extension balloonText ifNotNil: [:balloonText | ^ balloonText]. balloonSelector := extension balloonTextSelector ifNil: [^ nil]. balloonSelector isUnary ifTrue: [ (self respondsTo: balloonSelector) ifTrue: [^ self perform: balloonSelector]. (self model respondsTo: balloonSelector) ifTrue: [^ self model perform: balloonSelector]]. ^ nil! !
!Morph methodsFor: 'copying' stamp: 'mt 3/10/2023 14:51'! duplicate "Make and return a duplicate of the receiver"
| newMorph aName w topRend | ((topRend := self topRendererOrSelf) ~~ self) ifTrue: [^ topRend duplicate].
self okayToDuplicate ifFalse: [^ self]. aName := (w := self world) ifNotNil: [w nameForCopyIfAlreadyNamed: self]. newMorph := self veryDeepCopy. aName ifNotNil: [newMorph setNameTo: aName].
newMorph arrangeToStartStepping. newMorph privateOwner: nil. "no longer in world" newMorph isPartsDonor: false. "no longer parts donor" ^ newMorph! !
!Morph methodsFor: 'debug and other' stamp: 'mt 3/10/2023 15:09'! buildDebugMenu: aHand "Answer a debugging menu for the receiver. The hand argument is seemingly historical and plays no role presently"
| aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu addStayUpItem. (self hasProperty: #errorOnDraw) ifTrue: [aMenu add: 'start drawing again' translated action: #resumeAfterDrawError. aMenu addLine]. (self hasProperty: #errorOnStep) ifTrue: [aMenu add: 'start stepping again' translated action: #resumeAfterStepError. aMenu addLine]. (self hasProperty: #errorOnLayout) ifTrue: [aMenu add: 'start layouting again' translated action: #resumeAfterLayoutError. aMenu addLine].
aMenu add: 'inspect morph' translated action: #inspectInMorphic:. aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain. Smalltalk isMorphic ifFalse: [aMenu add: 'inspect morph (in MVC)' translated action: #inspect].
self isMorphicModel ifTrue: [aMenu add: 'inspect model' translated target: self model action: #inspect; add: 'explore model' translated target: self model action: #explore].
aMenu add: 'explore morph' translated target: self selector: #exploreInMorphic:.
aMenu addLine.
aMenu add: 'browse morph class' translated target: self selector: #browseHierarchy. (self isMorphicModel) ifTrue: [aMenu add: 'browse model class' target: self model selector: #browseHierarchy]. aMenu addLine.
self addViewingItemsTo: aMenu. aMenu add: 'make own subclass' translated action: #subclassMorph; add: 'save morph in file' translated action: #saveOnFile; addLine; add: 'call #tempCommand' translated action: #tempCommand; add: 'define #tempCommand' translated action: #defineTempCommand; addLine;
add: 'control-menu...' translated target: self selector: #invokeMetaMenu:; add: 'edit balloon help' translated action: #editBalloonHelpText.
^ aMenu! !
!Morph methodsFor: 'debug and other' stamp: 'mt 8/16/2023 17:11'! deleteAnyMouseActionIndicators
self changed. (self valueOfProperty: #mouseActionIndicatorMorphs ifAbsent: [#()]) do: [ :each | each delete "one is probably enough, but be safe" ]. self removeProperty: #mouseActionIndicatorMorphs. self hasRolloverBorder: false. self removeProperty: #rolloverWidth. self removeProperty: #rolloverColor. self layoutChanged. self changed.
! !
!Morph methodsFor: 'dropping/grabbing' stamp: 'mt 8/4/2023 14:49'! justDroppedInto: aMorph event: anEvent "This message is sent to a dropped morph after it has been dropped on -- and been accepted by -- a drop-sensitive morph"
| partsBinCase cmd | (self formerOwner notNil and: [self formerOwner ~~ aMorph]) ifTrue: [self removeHalo]. self formerOwner: nil. self formerPosition: nil. cmd := self valueOfProperty: #undoGrabCommand. cmd ifNotNil:[aMorph rememberCommand: cmd. self removeProperty: #undoGrabCommand]. (partsBinCase := aMorph isPartsBin) ifFalse: [self isPartsDonor: false]. (self isInWorld and: [partsBinCase not]) ifTrue: [self world startSteppingSubmorphsOf: self]. "Note an unhappy inefficiency here: the startStepping... call will often have already been called in the sequence leading up to entry to this method, but unfortunately the isPartsDonor: call often will not have already happened, with the result that the startStepping... call will not have resulted in the startage of the steppage."! !
!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:54'! handleMouseDown: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseDown: and #mouseDown: in your custom morphs. See #handlerForMouseDown: and #mouseDownPriority."
anEvent wasHandled ifTrue:[^self]. "not interested" anEvent hand removePendingBalloonFor: self. anEvent wasHandled: true.
"Make me modal during mouse transitions" anEvent hand newMouseFocus: self event: anEvent.
"this mouse down could be the start of a gesture, or the end of a gesture focus" (self isGestureStart: anEvent) ifTrue: [^ self gestureStart: anEvent].
self mouseDown: anEvent.
(self handlesMouseStillDown: anEvent) ifTrue:[ self startStepping: #handleMouseStillDown: at: Time millisecondClockValue + self mouseStillDownThreshold arguments: {anEvent copy resetHandlerFields} stepTime: self mouseStillDownStepRate ]. ! !
!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:54'! handleMouseEnter: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseOver: and #mouseEnter: in your custom morphs. Also see/use #handlesMouseOverDragging: and #mouseEnterDragging:."
(anEvent isDraggingEvent) ifTrue:[ (self handlesMouseOverDragging: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseEnterDragging: anEvent]. ^self]. self wantsBalloon ifTrue:[anEvent hand triggerBalloonFor: self after: self balloonHelpDelayTime]. (self handlesMouseOver: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseEnter: anEvent. ].! !
!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:55'! handleMouseLeave: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseOver: and #mouseLeave: in your custom morphs. Also see/use #handlesMouseOverDragging: and #mouseLeaveDragging:."
anEvent hand removePendingBalloonFor: self. anEvent isDraggingEvent ifTrue:[ (self handlesMouseOverDragging: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseLeaveDragging: anEvent]. ^self]. (self handlesMouseOver: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseLeave: anEvent. ]. ! !
!Morph methodsFor: 'halos and balloon help' stamp: 'mt 8/14/2023 15:59'! addHandlesTo: aHaloMorph box: box "Add halo handles to the halo. Apply the halo filter if appropriate."
aHaloMorph haloBox: box.
Preferences haloSpecifications do: [:aSpec | (self wantsHaloHandleWithSelector: aSpec addHandleSelector inHalo: aHaloMorph) ifTrue: [aHaloMorph perform: aSpec addHandleSelector with: aSpec]].
aHaloMorph innerTarget addOptionalHandlesTo: aHaloMorph box: box! !
!Morph methodsFor: 'halos and balloon help' stamp: 'mt 8/11/2023 16:50'! balloonHelpTextForHandle: aHandle "Answer a string providing balloon help for the given halo handle" | itsSelector | itsSelector := aHandle eventHandler firstMouseSelector. itsSelector == #doRecolor:with: ifTrue: [^ 'Change color']. itsSelector == #mouseDownInDimissHandle:with: ifTrue: [^ TrashCanMorph preserveTrash ifTrue: ['Move to trash'] ifFalse: ['Remove from screen']]. #(#(#addFullHandles 'More halo handles') #(#addSimpleHandles 'Fewer halo handles') #(#chooseEmphasisOrAlignment 'Emphasis & alignment') #(#chooseFont 'Change font') #(#chooseStyle 'Change style') #(#dismiss 'Remove') #(#doDebug:with: 'Debug') #(#doDirection:with: 'Choose forward direction') #(#doDup:with: 'Duplicate') #(#doMenu:with: 'Menu') #(#doGrab:with: 'Pick up') #(#editButtonsScript 'See the script for this button') #(#editDrawing 'Repaint') #(#mouseDownInCollapseHandle:with: 'Collapse') #(#mouseDownOnHelpHandle: 'Help') #(#paintBackground 'Paint background') #(#prepareToTrackCenterOfRotation:with: 'Move object or set center of rotation') #(#presentViewMenu 'Present the Viewing menu') #(#startDrag:with: 'Move') #(#startGrow:with: 'Change size (Ctrl + drag blue button)') #(#startRot:with: 'Rotate') #(#startScale:with: 'Change scale') #(#tearOffTile 'Make a tile representing this object') #(#trackCenterOfRotation:with: 'Set center of rotation') ) do: [:pair | itsSelector == pair first ifTrue: [^ pair last]]. ^ 'unknown halo handle'translated! !
!Morph methodsFor: 'menu' stamp: 'mt 8/11/2023 14:44'! addYellowButtonMenuItemsTo: aMenu event: evt "Populate aMenu with appropriate menu items for a yellow-button (context menu) click." aMenu defaultTarget: self. "" aMenu addStayUpItem. "" self addModelYellowButtonItemsTo: aMenu event: evt. "" Preferences generalizedYellowButtonMenu ifFalse: [^ self]. "" aMenu addLine. aMenu add: 'inspect' translated action: #inspect. "" aMenu addLine. self world selectedObject == self ifTrue: [aMenu add: 'deselect' translated action: #removeHalo] ifFalse: [aMenu add: 'select' translated action: #addHalo]. "" self isWorldMorph ifFalse: ["" aMenu addLine. aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: evt hand]. "" self isWorldMorph ifFalse: ["" Smalltalk at: #NCAAConnectorMorph ifPresent: [:connectorClass | aMenu addLine. aMenu add: 'connect to' translated action: #startWiring. aMenu addLine]. ""
self isFullOnScreen ifFalse: [aMenu add: 'move onscreen' translated action: #goHome]]. "" self addLayoutMenuItems: aMenu hand: evt hand. (owner notNil and: [owner isTextMorph]) ifTrue: [self addTextAnchorMenuItems: aMenu hand: evt hand]. "" self isWorldMorph ifFalse: ["" aMenu addLine. self addToggleItemsToHaloMenu: aMenu]. "" aMenu addLine. self isWorldMorph ifFalse: [aMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:]. self hasStrings ifTrue: [ aMenu add: 'copy text' translated action: #clipText]. "" self addExportMenuItems: aMenu hand: evt hand. "" self isWorldMorph not ifTrue: ["" aMenu addLine. aMenu add: 'adhere to edge...' translated action: #adhereToEdge]. "" self addCustomMenuItems: aMenu hand: evt hand! !
!Morph methodsFor: 'menu' stamp: 'mt 3/10/2023 16:07'! wantsYellowButtonMenu "Answer true if the receiver wants a yellow button menu" self valueOfProperty: #wantsYellowButtonMenu ifPresentDo: [:value | ^ value]. "" self isInSystemWindow ifTrue: [^ false]."" ^ Preferences generalizedYellowButtonMenu! !
!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:59'! absorbStateFromRenderer: aRenderer "Transfer knownName, actorState, visible over from aRenderer, which was formerly imposed above me as a transformation shell but is now going away."
| current | (current := aRenderer actorStateOrNil) ifNotNil: [self actorState: current. aRenderer actorState: nil].
(current := aRenderer knownName) ifNotNil: [self setNameTo: current. aRenderer setNameTo: nil].
self visible: aRenderer visible! !
!Morph methodsFor: 'menus' stamp: 'mt 3/10/2023 14:25'! addHaloActionsTo: aMenu "Add items to aMenu representing actions requestable via halo"
| subMenu | subMenu := MenuMorph new defaultTarget: self. subMenu addTitle: self externalName. subMenu addStayUpItemSpecial. subMenu addLine. subMenu add: 'delete' translated action: #dismissViaHalo. subMenu balloonTextForLastItem: 'Delete this object -- warning -- can be destructive!!' translated.
self maybeAddCollapseItemTo: subMenu. subMenu add: 'grab' translated action: #openInHand. subMenu balloonTextForLastItem: 'Pick this object up -- warning, since this removes it from its container, it can have adverse effects.' translated.
subMenu addLine.
subMenu add: 'resize' translated action: #resizeFromMenu. subMenu balloonTextForLastItem: 'Change the size of this object' translated.
subMenu add: 'duplicate' translated action: #maybeDuplicateMorph. subMenu balloonTextForLastItem: 'Hand me a copy of this object' translated. "Note that this allows access to the non-instancing duplicate even when this is a uniclass instance"
subMenu addLine.
subMenu add: 'set color' translated target: self renderedMorph action: #changeColor. subMenu balloonTextForLastItem: 'Change the color of this object' translated.
subMenu addLine.
subMenu add: 'inspect' translated target: self action: #inspect. subMenu balloonTextForLastItem: 'Open an Inspector on this object' translated.
aMenu add: 'halo actions...' translated subMenu: subMenu ! !
!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:47'! addMiscExtrasTo: aMenu "Add a submenu of miscellaneous extra items to the menu."
| realOwner realMorph subMenu | subMenu := MenuMorph new defaultTarget: self.
self isWorldMorph ifFalse: [subMenu add: 'adhere to edge...' translated action: #adhereToEdge. subMenu addLine].
realOwner := (realMorph := self topRendererOrSelf) owner. (realOwner isKindOf: TextPlusPasteUpMorph) ifTrue: [subMenu add: 'GeeMail stuff...' translated subMenu: (realOwner textPlusMenuFor: realMorph)].
subMenu add: 'add mouse up action' translated action: #addMouseUpAction; add: 'remove mouse up action' translated action: #removeMouseUpAction; add: 'hand me tiles to fire this button' translated action: #handMeTilesToFire. subMenu addLine. subMenu add: 'arrowheads on pen trails...' translated action: #setArrowheads. subMenu addLine.
subMenu defaultTarget: self topRendererOrSelf. subMenu add: 'draw new path' translated action: #definePath. subMenu add: 'follow existing path' translated action: #followPath. subMenu add: 'delete existing path' translated action: #deletePath. subMenu addLine.
self addGestureMenuItems: subMenu hand: self currentHand.
aMenu add: 'extras...' translated subMenu: subMenu! !
!Morph methodsFor: 'menus' stamp: 'mt 8/16/2023 15:58'! addStandardHaloMenuItemsTo: aMenu hand: aHandMorph "Add standard halo items to the menu"
| unlockables |
self isWorldMorph ifTrue: [^ self addWorldHaloMenuItemsTo: aMenu hand: aHandMorph].
aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: aHandMorph. aMenu addLine.
self addFillStyleMenuItems: aMenu hand: aHandMorph. self addBorderStyleMenuItems: aMenu hand: aHandMorph. self addDropShadowMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph. self addHaloActionsTo: aMenu. owner isTextMorph ifTrue:[self addTextAnchorMenuItems: aMenu hand: aHandMorph]. aMenu addLine. self addToggleItemsToHaloMenu: aMenu. aMenu addLine. self addCopyItemsTo: aMenu. self addExportMenuItems: aMenu hand: aHandMorph. self addMiscExtrasTo: aMenu. self addDebuggingItemsTo: aMenu hand: aHandMorph.
aMenu addLine. aMenu defaultTarget: self.
aMenu addLine.
unlockables := self submorphs select: [:m | m isLocked]. unlockables size = 1 ifTrue: [aMenu add: ('unlock "{1}"' translated format: unlockables first externalName) action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' translated action: #unlockContents].
aMenu defaultTarget: aHandMorph. ! !
!Morph methodsFor: 'menus' stamp: 'mt 3/10/2023 16:06'! addToggleItemsToHaloMenu: aMenu "Add standard true/false-checkbox items to the memu"
#( (resistsRemovalString toggleResistsRemoval 'whether I should be reistant to easy deletion via the pink X handle') (stickinessString toggleStickiness 'whether I should be resistant to a drag done by mousing down on me') (lockedString lockUnlockMorph 'when "locked", I am inert to all user interactions') (hasClipSubmorphsString changeClipSubmorphs 'whether the parts of objects within me that are outside my bounds should be masked.') (hasDirectionHandlesString changeDirectionHandles 'whether direction handles are shown with the halo') (hasDragEnabledString changeDrag 'whether I am open to having objects dragged out of me') (hasDropEnabledString changeDrop 'whether I am open to having objects dropped into me') ) do: [:each | aMenu addUpdating: each first action: each second. aMenu balloonTextForLastItem: each third translated].
self couldHaveRoundedCorners ifTrue: [aMenu addUpdating: #roundedCornersString action: #toggleCornerRounding. aMenu balloonTextForLastItem: 'whether my corners should be rounded' translated]! !
!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:59'! transferStateToRenderer: aRenderer "Transfer knownName, actorState, visible over to aRenderer, which is being imposed above me as a transformation shell"
| current | (current := self actorStateOrNil) ifNotNil: [aRenderer actorState: current. self actorState: nil].
(current := self knownName) ifNotNil: [aRenderer setNameTo: current. self setNameTo: nil].
aRenderer simplySetVisible: self visible
! !
!Morph methodsFor: 'meta-actions' stamp: 'mt 3/10/2023 16:06'! buildHandleMenu: aHand "Build the morph menu for the given morph's halo's menu handle. This menu has two sections. The first section contains commands that are interpreted by the hand; the second contains commands provided by the target morph. This method allows the morph to decide which items should be included in the hand's section of the menu."
| menu | menu := MenuMorph new defaultTarget: self. menu addStayUpItem. menu addLine. self addStandardHaloMenuItemsTo: menu hand: aHand. menu defaultTarget: aHand. self addAddHandMenuItemsForHalo: menu hand: aHand. menu defaultTarget: self. self addCustomHaloMenuItems: menu hand: aHand. menu defaultTarget: aHand. ^ menu ! !
!Morph methodsFor: 'naming' stamp: 'mt 3/8/2023 10:49'! renameTo: aName
self knownName = aName ifTrue: [^ aName]. self topRendererOrSelf setNameTo: aName. ^ aName! !
!Morph methodsFor: 'stepping' stamp: 'mt 8/28/2023 15:14'! step "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message." ! !
!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:53'! stepAt: millisecondClockValue "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message. The millisecondClockValue parameter gives the value of the millisecond clock at the moment of dispatch. Default is to dispatch to the parameterless step method for the morph, but this protocol makes it possible for some morphs to do differing things depending on the clock value" self step ! !
!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:53'! stepTime "Answer the desired time between steps in milliseconds. This default implementation requests that the 'step' method be called once every second."
^ 1000! !
!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:57'! wantsSteps "Return true if the receiver overrides the default Morph step method." "Details: Find first class in superclass chain that implements #step and return true if it isn't class Morph."
| c | self isPartsDonor ifTrue: [^ false]. c := self class. [c includesSelector: #step] whileFalse: [c := c superclass]. ^ c ~= Morph! !
!Morph methodsFor: 'thumbnail' stamp: 'mt 8/14/2023 17:40'! representativeNoTallerThan: maxHeight norWiderThan: maxWidth thumbnailHeight: thumbnailHeight "Return a morph representing the receiver but which is no taller than aHeight. If the receiver is already small enough, just return it, else return a MorphThumbnail companioned to the receiver, enforcing the maxWidth. If the receiver personally *demands* thumbnailing, do it even if there is no size-related reason to do it."
self permitsThumbnailing ifFalse: [^ self]. (self fullBounds height <= maxHeight and: [self fullBounds width <= maxWidth]) ifTrue: [^ self].
^ MorphThumbnail new extent: maxWidth @ (thumbnailHeight min: self fullBounds height); morphRepresented: self! !
!Morph methodsFor: 'WiW support' stamp: 'mt 3/7/2023 15:07'! eToyRejectDropMorph: morphToDrop event: evt
| tm am |
tm := TextMorph new beAllFont: ((TextStyle named: Preferences standardButtonFont familyName) fontOfSize: 24); contents: 'GOT IT!!'. (am := AlignmentMorph new) color: Color yellow; layoutInset: 10; useRoundedCorners; vResizing: #shrinkWrap; hResizing: #shrinkWrap; addMorph: tm; fullBounds; position: (self bounds center - (am extent // 2)); openInWorld: self world. SoundService default playSoundNamed: 'yum' ifAbsentReadFrom: 'yum.aif'. morphToDrop rejectDropMorphEvent: evt. "send it back where it came from" am delete ! !
!Morph methodsFor: 'private' stamp: 'mt 3/10/2023 14:53'! privateMoveBy: delta "Private!! Use 'position:' instead." | fill | bounds := bounds translateBy: delta. fullBounds ifNotNil: [fullBounds := fullBounds translateBy: delta]. fill := self fillStyle. fill isOrientedFill ifTrue: [fill origin: fill origin + delta]! !
!Morph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/10/2023 14:50'! delete "Remove the receiver as a submorph of its owner and make its new owner be nil." | oldWorld | self removeHalo. (oldWorld := self world) ifNotNil: [ self disableSubmorphFocusForHand: self activeHand. self activeHand releaseKeyboardFocus: self; releaseMouseFocus: self]. owner ifNotNil: [ self privateDelete. "remove from world"].! !
!Morph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/10/2023 14:27'! goBehind "Move the receiver to bottom z-order."
| topRend | topRend := self topRendererOrSelf. topRend owner ifNotNil: [:own | own addMorphBack: topRend] ! !
!Morph methodsFor: 'submorphs - layers' stamp: 'dgd 8/31/2004 16:21'! wantsToBeTopmost "Answer if the receiver want to be one of the topmost objects in its owner" ^ self isFlapOrTab! !
!BorderedMorph methodsFor: 'menu' stamp: 'mt 4/11/2018 08:30'! changeBorderWidth: evt | handle origin aHand newWidth oldWidth | aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand]. origin := aHand position. oldWidth := self borderWidth. (handle := HandleMorph new) forEachPointDo: [:newPoint | handle removeAllMorphs. handle addMorph: (LineMorph from: origin to: newPoint color: Color black width: 1). newWidth := (newPoint - origin) r asInteger // 5. self borderWidth: newWidth] lastPointDo: [:newPoint | handle deleteBalloon. self halo ifNotNil: [:halo | halo addHandles]. self rememberCommand: (Command new cmdWording: 'border change' translated; undoTarget: self selector: #borderWidth: argument: oldWidth; redoTarget: self selector: #borderWidth: argument: newWidth)]. aHand attachMorph: handle. handle setProperty: #helpAtCenter toValue: true. handle showBalloon: 'Move cursor farther from this point to increase border width. Click when done.' translated hand: evt hand. handle startStepping! !
!AlignmentMorph methodsFor: 'geometry' stamp: 'mt 3/7/2023 14:37'! addTransparentSpacerOfSize: aPoint "Required for several MorphicExtras and other non-Etoys stuff."
self addMorphBack: ((Morph new extent: aPoint asPoint) color: Color transparent)! !
!BookPageSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'! addControls "Add the control bar at the top of the tool."
| bb r str aCheckbox aWrapper | r := AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0. r wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. bb := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort)). bb setBalloonText: 'Accept the changes made here as the new page-order for this book' translated. r addTransparentSpacerOfSize: 12. bb := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #delete)). bb setBalloonText: 'Forgot any changes made here, and dismiss this sorter' translated.
"eliminate the parts-bin button on the book-page sorters... r addTransparentSpacerOfSize: 24 @ 0.
aCheckbox := UpdatingThreePhaseButtonMorph checkBox. aCheckbox target: self; actionSelector: #togglePartsBinStatus; arguments: #(); getSelector: #getPartsBinStatus. str := StringMorph contents: 'Parts bin' translated font: Preferences standardButtonFont. aWrapper := AlignmentMorph newRow beTransparent. aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0. aWrapper addMorphBack: (self wrapperFor: aCheckbox); addMorphBack: (self wrapperFor: str lock). r addMorphBack: aWrapper."
self addMorphFront: r ! !
!BookPageSorterMorph methodsFor: 'initialization' stamp: 'mt 8/16/2023 13:52'! initialize "initialize the state of the receiver" super initialize. "" self extent: Display extent - 100; listDirection: #topToBottom; wrapCentering: #topLeft; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 3. pageHolder := PasteUpMorph new. pageHolder vResizeToFit: true; autoLineLayout: true. pageHolder extent: self extent - self borderWidth. pageHolder hResizing: #shrinkWrap. "pageHolder cursor: 0." "causes a walkback as of 5/25/2000" self addControls. self addMorphBack: pageHolder! !
!BooklikeMorph methodsFor: 'misc' stamp: 'mt 8/4/2023 13:41'! playPageFlipSound: soundName PageFlipSoundOn "mechanism to suppress sounds at init time" ifTrue: [self playSoundNamed: soundName]. ! !
!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:39'! addBookMenuItemsTo: aMenu hand: aHandMorph | controlsShowing subMenu | subMenu := MenuMorph new defaultTarget: self. subMenu add: 'previous page' translated action: #previousPage. subMenu add: 'next page' translated action: #nextPage. subMenu add: 'goto page' translated action: #goToPage. subMenu add: 'insert a page' translated action: #insertPage. subMenu add: 'delete this page' translated action: #deletePage.
controlsShowing := self hasSubmorphWithProperty: #pageControl. controlsShowing ifTrue: [subMenu add: 'hide page controls' translated action: #hidePageControls. subMenu add: 'fewer page controls' translated action: #fewerPageControls] ifFalse: [subMenu add: 'show page controls' translated action: #showPageControls]. self isInFullScreenMode ifTrue: [ subMenu add: 'exit full screen' translated action: #exitFullScreen. ] ifFalse: [ subMenu add: 'show full screen' translated action: #goFullScreen. ]. subMenu addLine. subMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:. subMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:. subMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:. subMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:.
subMenu addLine. subMenu add: 'sort pages' translated action: #sortPages:. subMenu add: 'uncache page sorter' translated action: #uncachePageSorter. (self hasProperty: #dontWrapAtEnd) ifTrue: [subMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true] ifFalse: [subMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false].
subMenu addLine. subMenu add: 'search for text' translated action: #textSearch. (aHandMorph pasteBuffer class isKindOf: PasteUpMorph class) ifTrue: [subMenu add: 'paste book page' translated action: #pasteBookPage].
subMenu add: 'send all pages to server' translated action: #savePagesOnURL. subMenu add: 'send this page to server' translated action: #saveOneOnURL. subMenu add: 'reload all from server' translated action: #reload. subMenu add: 'copy page url to clipboard' translated action: #copyUrl. subMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype. newPagePrototype ifNotNil: [subMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype].
aMenu add: 'book...' translated subMenu: subMenu ! !
!BookMorph methodsFor: 'menu' stamp: 'mt 8/11/2023 14:44'! invokeBookMenu "Invoke the book's control panel menu." | aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'Book' translated. aMenu addStayUpItem. aMenu add: 'find...' translated action: #textSearch. aMenu add: 'go to page...' translated action: #goToPage. aMenu addLine.
aMenu addList: { {'sort pages' translated. #sortPages}. {'uncache page sorter' translated. #uncachePageSorter}}. (self hasProperty: #dontWrapAtEnd) ifTrue: [aMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true] ifFalse: [aMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false]. aMenu addList: { {'make bookmark' translated. #bookmarkForThisPage}. {'make thumbnail' translated. #thumbnailForThisPage}}. aMenu addUpdating: #showingPageControlsString action: #toggleShowingOfPageControls. aMenu addUpdating: #showingFullScreenString action: #toggleFullScreen.
aMenu addLine. aMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:. aMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:. aMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:. aMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:.
aMenu addLine. (self primaryHand pasteBuffer class isKindOf: PasteUpMorph class) ifTrue: [aMenu add: 'paste book page' translated action: #pasteBookPage].
aMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype. newPagePrototype ifNotNil: [ aMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype].
aMenu add: (self dragNDropEnabled ifTrue: ['close dragNdrop'] ifFalse: ['open dragNdrop']) translated action: #changeDragAndDrop. aMenu add: 'make all pages this size' translated action: #makeUniformPageSize.
aMenu addUpdating: #keepingUniformPageSizeString target: self action: #toggleMaintainUniformPageSize. aMenu addLine.
aMenu add: 'send all pages to server' translated action: #savePagesOnURL. aMenu add: 'send this page to server' translated action: #saveOneOnURL. aMenu add: 'reload all from server' translated action: #reload. aMenu add: 'copy page url to clipboard' translated action: #copyUrl.
aMenu addLine. aMenu add: 'load PPT images from slide #1' translated action: #loadImagesIntoBook. aMenu add: 'background color for all pages...' translated action: #setPageColor. aMenu add: 'make a thread of projects in this book' translated action: #buildThreadOfProjects.
aMenu popUpEvent: self world activeHand lastEvent in: self world ! !
!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:38'! saveAsNumberedURLs "Write out all pages in this book that are not showing, onto a server. The local disk could be the server. For any page that does not have a SqueakPage and a url already, name that page file by its page number. Any pages that are already totally out will stay that way."
| stem list firstTime | firstTime := (self valueOfProperty: #url) isNil. stem := self getStemUrl. "user must approve" stem isEmpty ifTrue: [^self]. firstTime ifTrue: [self setProperty: #futureUrl toValue: stem , '.bo']. self reserveUrlsIfNeeded. pages withIndexDo: [:aPage :ind | "does write the current page too"
aPage isInMemory ifTrue: ["not out now" aPage saveOnURL: stem , ind printString , '.sp']]. list := pages collect: [:aPage | aPage sqkPage prePurge]. "knows not to purge the current page" list := (list select: [:each | each notNil]) asArray. "do bulk become:" (list collect: [:each | each contentsMorph]) elementsExchangeIdentityWith: (list collect: [:spg | MorphObjectOut new xxxSetUrl: spg url page: spg]). self saveIndexOnURL. firstTime ifTrue: ["Put a thumbnail into the hand"
URLMorph grabForBook: self. self setProperty: #futureUrl toValue: nil "clean up"]! !
!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:39'! saveOnUrlPage: pageMorph "Write out this single page in this book onto a server. See savePagesOnURL. (Don't compute the texts, only this page's is written.)" | stem ind response rand newPlace dir | "Don't give the chance to put in a different place. Assume named by number" ((self valueOfProperty: #url) isNil and: [pages first url notNil]) ifTrue: [response := Project uiManager chooseOptionFrom: {'Old book' translated. 'New book sharing old pages' translated} title: 'Modify the old book, or make a new book sharing its pages?' translated. response = 2 ifTrue: ["Make up new url for .bo file and confirm with user." "Mark as shared" [rand := String new: 4. 1 to: rand size do: [:ii | rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)]. (newPlace := self getStemUrl) ifEmpty: [^ self]. newPlace := (newPlace copyUpToLast: $/), '/BK', rand, '.bo'. dir := ServerFile new fullPath: newPlace. (dir includesKey: dir fileName)] whileTrue. "keep doing until a new file" self setProperty: #url toValue: newPlace]. response = 0 ifTrue: [^ self]].
stem := self getStemUrl. "user must approve" stem ifEmpty: [^ self]. ind := pages identityIndexOf: pageMorph ifAbsent: [self error: 'where is the page?' translated]. pageMorph isInMemory ifTrue: "not out now" [pageMorph saveOnURL: stem,(ind printString),'.sp']. self saveIndexOfOnly: pageMorph.! !
!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:40'! savePagesOnURL "Write out all pages in this book onto a server. For any page that does not have a SqueakPage and a url already, ask the user for one. Give the option of naming all page files by page number. Any pages that are not in memory will stay that way. The local disk could be the server."
| response list firstTime newPlace rand dir bookUrl | self getAllText. "stored with index later" response := Project uiManager chooseOptionFrom: {'Use page numbers' translated. 'Type in file names' translated. 'Save in a new place (using page numbers)' translated. 'Save in a new place (typing names)' translated. 'Save new book sharing old pages' translated. } title: 'Each page will be a file on the server. Do you want to page numbers be the names of the files? or name each one yourself?' translated. response = 1 ifTrue: [self saveAsNumberedURLs. ^ self]. response = 3 ifTrue: [self forgetURLs; saveAsNumberedURLs. ^ self]. response = 4 ifTrue: [self forgetURLs]. response = 5 ifTrue: ["Make up new url for .bo file and confirm with user." "Mark as shared" [rand := String new: 4. 1 to: rand size do: [:ii | rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)]. (newPlace := self getStemUrl) isEmpty ifTrue: [^ self]. newPlace := (newPlace copyUpToLast: $/), '/BK', rand, '.bo'. dir := ServerFile new fullPath: newPlace. (dir includesKey: dir fileName)] whileTrue. "keep doing until a new file"
self setProperty: #url toValue: newPlace. self saveAsNumberedURLs. bookUrl := self valueOfProperty: #url. (SqueakPage stemUrl: bookUrl) = (SqueakPage stemUrl: currentPage url) ifTrue: [bookUrl := true]. "not a shared book" (URLMorph grabURL: currentPage url) book: bookUrl. ^ self]. response = 0 ifTrue: [^ self].
"self reserveUrlsIfNeeded. Need two passes here -- name on one, write on second" pages do: [:aPage | "does write the current page too" aPage isInMemory ifTrue: "not out now" [aPage saveOnURLbasic]]. "ask user if no url"
list := pages collect: [:aPage | aPage sqkPage prePurge]. "knows not to purge the current page" list := (list select: [:each | each notNil]) asArray. "do bulk become:" (list collect: [:each | each contentsMorph]) elementsExchangeIdentityWith: (list collect: [:spg | MorphObjectOut new xxxSetUrl: spg url page: spg]).
firstTime := (self valueOfProperty: #url) isNil. self saveIndexOnURL. firstTime ifTrue: "Put a thumbnail into the hand" [URLMorph grabForBook: self. self setProperty: #futureUrl toValue: nil]. "clean up" ! !
!BookMorph methodsFor: 'navigation' stamp: 'mt 8/4/2023 13:34'! goToPageMorph: aMorph "Set the given morph as the current page; run closing and opening scripts as appropriate"
self goToPage: (pages identityIndexOf: aMorph ifAbsent: [^ self "abort"]) transitionSpec: nil! !
!BookMorph methodsFor: 'navigation' stamp: 'mt 8/4/2023 13:30'! goToPageMorph: newPage transitionSpec: transitionSpec "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly. Apply the transitionSpec provided."
| pageIndex aWorld oldPageIndex ascending tSpec readIn | pages isEmpty ifTrue: [^self]. self setProperty: #searchContainer toValue: nil. "forget previous search" self setProperty: #searchOffset toValue: nil. self setProperty: #searchKey toValue: nil. pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"]. readIn := newPage isInMemory not. oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil]. ascending := (oldPageIndex isNil or: [newPage == currentPage]) ifTrue: [nil] ifFalse: [oldPageIndex < pageIndex]. tSpec := transitionSpec ifNil: ["If transition not specified by requestor..."
newPage valueOfProperty: #transitionSpec ifAbsent: [" ... then consult new page"
self transitionSpecFor: self " ... otherwise this is the default"]]. self flag: #arNote. "Probably unnecessary" (aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus]. currentPage ifNotNil: [currentPage updateCachedThumbnail]. self currentPage notNil ifTrue: [(((pages at: pageIndex) owner isKindOf: TransitionMorph) and: [(pages at: pageIndex) isInWorld]) ifTrue: [^self "In the process of a prior pageTurn"]. ascending ifNotNil: ["Show appropriate page transition and start new page when done"
currentPage stopStepping. (pages at: pageIndex) position: currentPage position. ^(TransitionMorph effect: tSpec second direction: tSpec third inverse: (ascending or: [transitionSpec notNil]) not) showTransitionFrom: currentPage to: (pages at: pageIndex) in: self whenStart: [self playPageFlipSound: tSpec first] whenDone: [currentPage delete; fullReleaseCachedState. self insertPageMorphInCorrectSpot: (pages at: pageIndex). self adjustCurrentPageForFullScreen. self snapToEdgeIfAppropriate. aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. aWorld := self world. readIn ifTrue: [currentPage updateThumbnailUrlInBook: self url. currentPage sqkPage computeThumbnail "just store it"]]].
"No transition, but at least decommission current page" currentPage delete; fullReleaseCachedState]. self insertPageMorphInCorrectSpot: (pages at: pageIndex). "sets currentPage" self adjustCurrentPageForFullScreen. self snapToEdgeIfAppropriate. aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. aWorld := self world. readIn ifTrue: [currentPage updateThumbnailUrl. currentPage sqkPage computeThumbnail "just store it"].! !
!DockingBarMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 16:05'! wantsYellowButtonMenu "Answer true if the receiver wants a yellow button menu" ^ true! !
!EventRecorderMorph methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:52'! makeStatusLightIn: aPoint
^statusLight := EllipseMorph new extent: aPoint; color: Color green; borderWidth: 0! !
!GraphMorph methodsFor: 'accessing'! valueAtCursor: aPointOrNumber
data isEmpty ifTrue: [^ 0]. data at: ((cursor truncated max: 1) min: data size) put: (self asNumber: aPointOrNumber). self flushCachedForm. ! !
!GraphMorph methodsFor: 'commands'! appendValue: aPointOrNumber
| newVal | (data isKindOf: OrderedCollection) ifFalse: [data := data asOrderedCollection]. newVal := self asNumber: aPointOrNumber. data addLast: newVal. newVal < minVal ifTrue: [minVal := newVal]. newVal > maxVal ifTrue: [maxVal := newVal]. self cursor: data size. self flushCachedForm. ! !
!GraphMorph methodsFor: 'private' stamp: 'mt 8/14/2023 16:25'! asNumber: aPointOrNumber
^ aPointOrNumber isPoint ifTrue: [aPointOrNumber r] ifFalse: [aPointOrNumber]! !
!GraphicalDictionaryMenu methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'! initializeFor: aTarget fromDictionary: aDictionary "Initialize me for a target and a dictionary."
| anIndex aButton | self baseDictionary: aDictionary. target := aTarget. coexistWithOriginal := true. self extent: 210 @ 210. self clipSubmorphs: true. self layoutPolicy: ProportionalLayout new. aButton := (IconicButton new) borderWidth: 0; labelGraphic: (MenuIcons formAtKey: 'TinyMenu'); color: Color transparent; actWhen: #buttonDown; actionSelector: #showMenu; target: self; setBalloonText: 'menu'. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (-50 @ 6 extent: aButton extent)). aButton := (SimpleButtonMorph new) target: self; borderColor: Color black; label: 'Prev'; actionSelector: #downArrowHit; actWhen: #whilePressed; setBalloonText: 'show previous picture'; yourself. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (-24 @ 4 extent: aButton extent)). aButton := (SimpleButtonMorph new) target: self; borderColor: Color black; label: 'Next'; actionSelector: #upArrowHit; actWhen: #whilePressed; setBalloonText: 'show next pictutre'. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (24 @ 4 extent: aButton extent)). self addMorph: ((UpdatingStringMorph new) contents: ' '; target: self; putSelector: #renameGraphicTo:; getSelector: #truncatedNameOfGraphic; useStringFormat; setBalloonText: 'The name of the current graphic'; yourself) fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ 0) offsets: (10 @ 40 corner: -10 @ 60)). self addMorph: ((Morph new) extent: 100 @ 4; color: Color black) fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ 0) offsets: (0 @ 60 corner: 0 @ 64)). formDisplayMorph := (Thumbnail new) extent: 100 @ 100; useInterpolation: true; maxWidth: 300 minHeight: 100; yourself. formDisplayMorph layoutFrame: (LayoutFrame fractions: (0 @ 0 extent: 0@0) offsets: (8 @ 72 corner: 108 @ 172)). self addMorph: formDisplayMorph. self minimumExtent: 116@180. target ifNotNil: [(anIndex := formChoices indexOf: target form ifAbsent: []) ifNotNil: [currentIndex := anIndex]]. self updateThumbnail! !
!GraphicalDictionaryMenu methodsFor: 'menu commands' stamp: 'mt 8/16/2023 13:50'! repaintEntry "Let the user enter into painting mode to repaint the item and save it back."
| aWorld bnds sketchEditor aPaintBox formToEdit |
(aWorld := self world) assureNotPaintingElse: [^ self].
formToEdit := formChoices at: currentIndex. bnds := (submorphs second boundsInWorld origin extent: formToEdit extent) intersect: aWorld bounds. bnds := bnds expandBy: 60@60. sketchEditor := SketchEditorMorph new. aWorld addMorphFront: sketchEditor. sketchEditor initializeFor: ((aWorld drawingClass withForm: formToEdit) position: submorphs second positionInWorld) inBounds: bnds pasteUpMorph: aWorld paintBoxPosition: bnds topRight. sketchEditor afterNewPicDo: [:aForm :aRect | formChoices at: currentIndex put: aForm. baseDictionary at: (entryNames at: currentIndex) put: aForm. self updateThumbnail. (aPaintBox := aWorld paintBoxOrNil) ifNotNil: [aPaintBox delete]] ifNoBits: [(aPaintBox := aWorld paintBoxOrNil) ifNotNil: [aPaintBox delete]].
! !
!HandMorph methodsFor: 'paste buffer' stamp: 'mt 3/10/2023 14:49'! pasteMorph
| aPastee | PasteBuffer ifNil: [^ self inform: 'Nothing to paste.' translated]. self attachMorph: (aPastee := self objectToPaste). aPastee align: aPastee center with: self position.! !
!HandMorphForReplay methodsFor: 'event handling' stamp: 'mt 8/28/2023 14:05'! processEvents "Play back the next event"
| evt hadMouse hadAny tracker | suspended == true ifTrue: [^ self]. hadMouse := hadAny := false. tracker := recorder objectTrackingEvents. [(evt := recorder nextEventToPlay) isNil] whileFalse: [ ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self]. tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp]. evt type == #EOF ifTrue: [recorder pauseIn: self currentWorld. ^ self]. evt type == #startSound ifTrue: [evt argument play. recorder synchronize. ^ self].
evt isMouse ifTrue: [hadMouse := true]. (evt isMouse or: [evt isKeyboard]) ifTrue: [self handleEvent: (evt setHand: self) resetHandlerFields. hadAny := true]]. (mouseClickState notNil and: [hadMouse not]) ifTrue: ["No mouse events during this cycle. Make sure click states time out accordingly"
mouseClickState handleEvent: lastMouseEvent asMouseMove from: self]. hadAny ifFalse: ["No pending events. Make sure z-order is up to date"
self mouseOverHandler processMouseOver: lastMouseEvent]! !
!ImageMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:15'! setNewImageFrom: formOrNil "Change the receiver's image to be one derived from the supplied form. If nil is supplied, clobber any existing image in the receiver, and in its place put a default graphic, either the one known to the receiver as its default value"
formOrNil ifNotNil: [^ self image: formOrNil]. self image: (Form extent: 16@16 depth: 32) ! !
!GrabPatchMorph methodsFor: 'dropping' stamp: 'mt 8/14/2023 17:31'! wantsToBeDroppedInto: aMorph "Only into PasteUps that are not part bins"
^ aMorph isWorldMorph! !
!GrabPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:11'! initialize "Initialize the receiver. Emblazon the GrabPatch icon on its face"
super initialize. self image: (MenuIcons formAtKey: 'GrabPatch'). self setProperty: #ignorePartsBinDrop toValue: true! !
!GrabPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:11'! initializeToStandAlone "Initialize the receiver. Emblazon the GrabPatch icon on its face"
super initializeToStandAlone. self image: (MenuIcons formAtKey: 'GrabPatch')! !
!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'mt 8/23/2023 13:48'! insertNewProject
[MorphicProject openViewOn: nil] on: ProjectViewOpenNotification do: [ :ex | ex resume: false].! !
!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'mt 8/11/2023 14:44'! moreCommands "Put up a menu of options"
| allThreads aMenu others target | allThreads := self class knownThreads. aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'navigation' translated.
self flag: #deferred. "Probably don't want that stay-up item, not least because the navigation-keystroke stuff is not dynamically handled" aMenu addStayUpItem.
others := (allThreads keys reject: [ :each | each = threadName]) asArray sort. others do: [ :each | aMenu add: ('switch to <{1}>' translated format:{each}) selector: #switchToThread: argument: each ].
aMenu addList: { {'switch to recent projects' translated. #getRecentThread}. #-. {'create a new thread' translated. #threadOfNoProjects}. {'edit this thread' translated. #editThisThread}. {'create thread of all projects' translated. #threadOfAllProjects}. #-. {'First project in thread' translated. #firstPage}. {'Last project in thread' translated. #lastPage} }.
(target := self currentIndex + 2) > listOfPages size ifFalse: [ aMenu add: ('skip over next project ({1})' translated format:{(listOfPages at: target - 1) first}) action: #skipOverNext ].
aMenu addList: { {'jump within this thread' translated. #jumpWithinThread}. {'insert new project' translated. #insertNewProject}. #-. {'simply close this navigator' translated. #delete}. {'destroy this thread' translated. #destroyThread}. #- }.
(self currentWorld keyboardNavigationHandler == self) ifFalse:[ aMenu add: 'start keyboard navigation with this thread' translated action: #startKeyboardNavigation ] ifTrue: [ aMenu add: 'stop keyboard navigation with this thread' translated action: #stopKeyboardNavigation ].
aMenu popUpInWorld.! !
!LassoPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'! initialize "Initialize the receiver. Sets its image to the lasso picture"
super initialize. self image: (MenuIcons formAtKey: 'Lasso')! !
!LassoPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'! initializeToStandAlone "Initialize the receiver such that it can live on its own. Sets its image to the lasso picture"
super initializeToStandAlone. self image: (MenuIcons formAtKey: 'Lasso')! !
!Morph class methodsFor: 'fileIn/Out' stamp: 'mt 3/8/2023 09:07'! fromFileName: fullName "Reconstitute a Morph from the file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world"
| aFileStream morphOrList | aFileStream := (MultiByteBinaryOrTextStream with: ((FileStream readOnlyFileNamed: fullName) binary contentsOfEntireFile)) binary reset. morphOrList := aFileStream fileInObjectAndCode. Project current world addMorphsAndModel: morphOrList.! !
!Morph class methodsFor: '*MorphicExtras-parts bin' stamp: 'mt 8/4/2023 14:43'! supplementaryPartsDescriptions "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
^ {DescriptionForPartsBin formalName: 'NextPage' translatedNoop categoryList: {'Multimedia' translatedNoop} documentation: 'A button which, when clicked, takes the reader to the next page of a book' translatedNoop globalReceiverSymbol: #BookMorph nativitySelector: #nextPageButton. DescriptionForPartsBin formalName: 'PreviousPage' translatedNoop categoryList: {'Multimedia'} documentation: 'A button which, when clicked, takes the reader to the previous page of a book' translatedNoop globalReceiverSymbol: #BookMorph nativitySelector: #previousPageButton.}! !
!GraphicalDictionaryMenu class methodsFor: 'example' stamp: 'mt 7/31/2023 11:13'! example "GraphicalDictionaryMenu example" | aDict | aDict := Dictionary new. #('ColorTilesOff' 'ColorTilesOn' 'Controls') do: [:aString | aDict at: aString put: (MenuIcons formAtKey: aString)]. self openOn: aDict withLabel: 'Testing One Two Three'! !
!ImageMorph class methodsFor: 'scripting' stamp: 'mt 3/15/2023 14:10'! authoringPrototype | aMorph aForm | aMorph := super authoringPrototype. aForm := MenuIcons formAtKey: 'Image'. aForm ifNil: [aForm := aMorph image rotateBy: 90]. aMorph image: aForm. ^ aMorph! !
!GrabPatchMorph class methodsFor: 'instance creation' stamp: 'mt 7/31/2023 11:11'! authoringPrototype "Answer a prototype for use in a parts bin"
^ self new image: (MenuIcons formAtKey: 'GrabPatch'); markAsPartsDonor; setBalloonText: 'Use this to grab a rectangular patch from the screen'; yourself! !
!LassoPatchMorph class methodsFor: 'instance creation' stamp: 'mt 7/31/2023 11:13'! authoringPrototype "Answer a prototype for use in a parts bin"
^ self new image: (MenuIcons formAtKey: 'Lasso'); markAsPartsDonor; setBalloonText: 'Drop this on the desktop and you can then grab a patch from the screen with a lasso.'; yourself! !
!MorphExtension methodsFor: 'accessing - other properties' stamp: 'mt 3/10/2023 14:57'! sortedPropertyNames "answer the receiver's property names in a sorted way"
| props | props := WriteStream on: (Array new: 10). locked == true ifTrue: [props nextPut: #locked]. visible == false ifTrue: [props nextPut: #visible]. sticky == true ifTrue: [props nextPut: #sticky]. balloonText isNil ifFalse: [props nextPut: #balloonText]. balloonTextSelector isNil ifFalse: [props nextPut: #balloonTextSelector]. externalName isNil ifFalse: [props nextPut: #externalName]. isPartsDonor == true ifTrue: [props nextPut: #isPartsDonor]. actorState isNil ifFalse: [props nextPut: #actorState]. eventHandler isNil ifFalse: [props nextPut: #eventHandler]. otherProperties ifNotNil: [otherProperties associationsDo: [:a | props nextPut: a key]]. ^props contents sort: [:s1 :s2 | s1 <= s2]! !
!MorphExtension methodsFor: 'connectors-copying' stamp: 'mt 3/10/2023 16:11'! veryDeepInner: deepCopier "Copy all of my instance variables. Some otherProperties need to be not copied at all, but shared. Their names are given by copyWeakly. Some otherProperties should not be copied or shared. Their names are given by propertyNamesNotCopied. This is special code for the dictionary. See DeepCopier, and veryDeepFixupWith:."
| namesOfWeaklyCopiedProperties weaklyCopiedValues | super veryDeepInner: deepCopier. locked := locked veryDeepCopyWith: deepCopier. visible := visible veryDeepCopyWith: deepCopier. sticky := sticky veryDeepCopyWith: deepCopier. balloonText := balloonText veryDeepCopyWith: deepCopier. balloonTextSelector := balloonTextSelector veryDeepCopyWith: deepCopier. externalName := externalName veryDeepCopyWith: deepCopier. isPartsDonor := isPartsDonor veryDeepCopyWith: deepCopier. actorState := actorState veryDeepCopyWith: deepCopier. eventHandler := eventHandler veryDeepCopyWith: deepCopier. "has its own restrictions"
otherProperties ifNil: [ ^self ].
otherProperties := otherProperties copy. self propertyNamesNotCopied do: [ :propName | otherProperties removeKey: propName ifAbsent: [] ].
namesOfWeaklyCopiedProperties := self copyWeakly. weaklyCopiedValues := namesOfWeaklyCopiedProperties collect: [ :propName | otherProperties removeKey: propName ifAbsent: [] ].
"Now copy all the others." otherProperties := otherProperties veryDeepCopyWith: deepCopier.
"And replace the weak ones." namesOfWeaklyCopiedProperties with: weaklyCopiedValues do: [ :name :value | value ifNotNil: [ otherProperties at: name put: value ]]. ! !
!MorphExtension methodsFor: 'other' stamp: 'mt 3/10/2023 16:11'! isDefault "Return true if the receiver is a default and can be omitted" locked == true ifTrue: [^ false]. visible == false ifTrue: [^ false]. sticky == true ifTrue: [^ false]. balloonText isNil ifFalse: [^ false]. balloonTextSelector isNil ifFalse: [^ false]. externalName isNil ifFalse: [^ false]. isPartsDonor == true ifTrue: [^ false]. actorState isNil ifFalse: [^ false]. eventHandler isNil ifFalse: [^ false]. otherProperties ifNotNil: [otherProperties isEmpty ifFalse: [^ false]]. ^ true! !
!MorphExtension methodsFor: 'printing' stamp: 'mt 3/10/2023 16:11'! printOn: aStream "Append to the argument, aStream, a sequence of characters that identifies the receiver." super printOn: aStream. aStream nextPutAll: ' ' , self identityHashPrintString. locked == true ifTrue: [aStream nextPutAll: ' [locked] ']. visible == false ifTrue: [aStream nextPutAll: '[not visible] ']. sticky == true ifTrue: [aStream nextPutAll: ' [sticky] ']. balloonText ifNotNil: [aStream nextPutAll: ' [balloonText] ']. balloonTextSelector ifNotNil: [aStream nextPutAll: ' [balloonTextSelector: ' , balloonTextSelector printString , '] ']. externalName ifNotNil: [aStream nextPutAll: ' [externalName = ' , externalName , ' ] ']. isPartsDonor == true ifTrue: [aStream nextPutAll: ' [isPartsDonor] ']. eventHandler ifNotNil: [aStream nextPutAll: ' [eventHandler = ' , eventHandler printString , '] ']. (otherProperties isNil or: [otherProperties isEmpty ]) ifTrue: [^ self]. aStream nextPutAll: ' [other: '. self otherProperties keysDo: [:aKey | aStream nextPutAll: ' (' , aKey , ' -> ' , (self otherProperties at: aKey) printString , ')']. aStream nextPut: $]! !
!MorphHierarchy class methodsFor: 'opening' stamp: 'mt 8/4/2023 14:46'! openOrDelete | oldMorph | oldMorph := Project current world submorphs detect: [:each | each hasProperty: #morphHierarchy] ifNone: [| newMorph | newMorph := self new asMorph. newMorph bottomLeft: self currentHand position. newMorph openInWorld. ^ self]. "" oldMorph delete! !
!MorphListItemWrapper methodsFor: 'accessing' stamp: 'mt 3/10/2023 16:07'! contents "Answer the receiver's contents"
| tentative submorphs | tentative := item submorphs collect: [:each | each renderedMorph].
submorphs := tentative reject: [:each | each isKindOf: HaloMorph].
^ submorphs collect: [:each | self class with: each]! !
!MorphicModel methodsFor: 'submorphs - accessing' stamp: 'mt 3/10/2023 14:52'! allKnownNames "Return a list of all known names based on the scope of the receiver. If the receiver is a member of a uniclass, incorporate the original 1997 logic that queries the known names of the values of all the instance variables."
| superNames | superNames := super allKnownNames. "gather them from submorph tree" ^self class isUniClass ifTrue: [superNames , (self instanceVariableValues select: [:e | e notNil and: [e knownName notNil]] thenCollect: [:e | e knownName])] ifFalse: [superNames]! !
!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 3/8/2023 11:01'! copyFromRootsForExport: rootArray "When possible, use copySmartRootsExport:. This way may not copy a complete tree of objects. Add to roots: all of the methods pointed to from the outside by blocks." | newRoots segSize symbolHolder | arrayOfRoots := rootArray. "self halt." symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers, so they will be in outPointers" "Creation of the segment happens here" self copyFromRoots: arrayOfRoots sizeHint: 0. segSize := segment size. [(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize]. "with methods pointed at from outside" [(newRoots := self rootsIncludingBlocks) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize]. "with methods, blocks from outPointers" "Zap sender of a homeContext. Can't send live stacks out." "Why not? eem 7/3/2017 15:31" 1 to: outPointers size do: [:ii | | outPointer | outPointer := outPointers at: ii. (outPointer isBlock or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil]]. symbolHolder size "Keep reference to symbolHolder until the last"! !
!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/28/2023 15:10'! copyFromRootsLocalFileFor: rootArray sizeHint: segSize
arrayOfRoots := rootArray. self copyFromRoots: arrayOfRoots sizeHint: segSize.! !
!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/28/2023 15:40'! copySmartRootsExport: rootArray "Use SmartRefStream to find the object. Make them all roots. Create the segment in memory. Project should be in first five objects in rootArray." | newRoots segSize symbolHolder replacements naughtyBlocks allClasses sizeHint proj dummy world |
world := Project current world. symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers, so they will be in outPointers"
dummy := ReferenceStream on: (DummyStream on: nil). "Write to a fake Stream, not a file" "Collect all objects" dummy insideASegment: true. "So Uniclasses will be traced" dummy rootObject: rootArray. "inform him about the root" dummy nextPut: rootArray. (proj :=dummy project) ifNotNil: [self dependentsSave: dummy]. allClasses := SmartRefStream new uniClassInstVarsRefs: dummy. "catalog the extra objects in UniClass inst vars. Put into dummy" allClasses do: [:cls | dummy references at: cls class put: false. "put MorphicModel5 class in roots" dummy blockers removeKey: cls class ifAbsent: []]. "refs := dummy references." arrayOfRoots := self smartFillRoots: dummy. "guaranteed none repeat" replacements := dummy blockers. dummy project "recompute it" ifNil: [self error: 'lost the project!!']. dummy project class == DiskProxy ifTrue: [self error: 'saving the wrong project']. dummy := nil. "Allow dummy to be GC'ed below (bytesLeft)." naughtyBlocks := arrayOfRoots select: [ :each | each isContext and: [each hasInstVarRef]].
"since the caller switched ActiveWorld, put the real one back temporarily" naughtyBlocks isEmpty ifFalse: [world becomeActiveDuring: [world firstHand becomeActiveDuring: [ | goodToGo | goodToGo := (Project uiManager chooseOptionFrom: #('keep going' 'stop and take a look') title: 'Some block(s) which reference instance variables are included in this segment. These may fail when the segment is loaded if the class has been reshaped. What would you like to do?') = 1. goodToGo ifFalse: [naughtyBlocks inspect. self error: 'Here are the bad blocks']]]]. "Creation of the segment happens here"
"try using one-quarter of memory min: four megs to publish (will get bumped up later if needed)" sizeHint := (Smalltalk bytesLeft // 4 // 4) min: 1024*1024. self copyFromRoots: arrayOfRoots sizeHint: sizeHint areUnique: true. segSize := segment size. [(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true]. "with methods pointed at from outside" [(newRoots := self rootsIncludingBlocks) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true]. "with methods, blocks from outPointers" 1 to: outPointers size do: [:ii | | outPointer | outPointer := outPointers at: ii. (outPointer isBlock or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil]. "substitute new object in outPointers" (replacements includesKey: outPointer) ifTrue: [outPointers at: ii put: (replacements at: outPointer)]]. proj ifNotNil: [self dependentsCancel: proj]. symbolHolder. "hold onto symbolHolder until the last."! !
!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/16/2023 16:58'! smartFillRoots: dummy | refs known ours ww blockers | "Put all traced objects into my arrayOfRoots. Remove some that want to be in outPointers. Return blockers, an IdentityDictionary of objects to replace in outPointers."
blockers := dummy blockers. known := (refs := dummy references) size. refs keys do: [:obj | "copy keys to be OK with removing items" (obj isSymbol) ifTrue: [refs removeKey: obj. known := known-1]. (obj class == PasteUpMorph) ifTrue: [ obj isWorldMorph & (obj owner == nil) ifTrue: [ (dummy project ~~ nil and: [obj == dummy project world]) ifFalse: [ refs removeKey: obj. known := known-1. blockers at: obj put: (StringMorph contents: 'The worldMorph of a different world')]]]. "Make a ProjectViewMorph here" "obj class == Project ifTrue: [Transcript show: obj; cr]." (blockers includesKey: obj) ifTrue: [ refs removeKey: obj ifAbsent: [known := known+1]. known := known-1]. ]. ours := (dummy project ifNil: [Project current]) world. refs keysDo: [:obj | obj isMorph ifTrue: [ ww := obj world. (ww == ours) | (ww == nil) ifFalse: [ refs removeKey: obj. known := known-1. blockers at: obj put: (StringMorph contents: obj printString, ' from another world')]]]. "keep original roots on the front of the list" dummy rootObject do: [:rr | refs removeKey: rr ifAbsent: []]. ^dummy rootObject, refs keys asArray! !
!NativeImageSegment methodsFor: 'testing' stamp: 'mt 3/8/2023 11:01'! findRogueRootsImSeg: rootArray "This is a tool to track down unwanted pointers into the segment. If we don't deal with these pointers, the segment turns out much smaller than it should. These pointers keep a subtree of objects out of the segment. 1) Break all owner pointers in submorphs and all scripts. 2) Create the segment and look at outPointers. 3) Remove those we expect. 4) Remember to quit without saving -- the owner pointers are smashed."
| suspects bag1 bag2 | arrayOfRoots := rootArray. self findRogueRootsPrep. "and free that context!!" Smalltalk garbageCollect. self copyFromRoots: arrayOfRoots sizeHint: 0.
suspects := outPointers select: [:oo | oo isMorph]. suspects size > 0 ifTrue: [suspects inspect]. bag1 := Bag new. bag2 := Bag new. outPointers do: [:key | (key isKindOf: Class) ifTrue: [bag2 add: key class name] ifFalse: [(#(Symbol Point Rectangle True False String Float Color Form ColorForm StrikeFont Metaclass UndefinedObject TranslucentColor) includes: key class name) ifTrue: [bag2 add: key class name] ifFalse: [bag1 add: key class name]]]. "(bag sortedCounts) is the SortedCollection" (StringHolder new contents: bag1 sortedCounts printString, '
', bag2 sortedCounts printString) openLabel: 'Objects pointed at by the outside'. self halt: 'Examine local variables pointIn and inSeg'.
"Use this in inspectors: outPointers select: [:oo | oo class == ]. " ! !
!NativeImageSegment methodsFor: 'testing' stamp: 'mt 3/10/2023 15:12'! findRogueRootsPrep "Part of the tool to track down unwanted pointers into the segment. Break all owner pointers in submorphs, scripts, and viewers in flaps."
| wld morphs | wld := arrayOfRoots detect: [:obj | obj isMorph ifTrue: [obj isWorldMorph] ifFalse: [false]] ifNone: [nil]. wld ifNil: [wld := arrayOfRoots detect: [:obj | obj isMorph] ifNone: [^ self error: 'can''t find a root morph']]. morphs := IdentitySet new: 400. wld allMorphsDo: [:m | morphs add: m]. morphs do: [:mm | "break the back pointers" mm isInMemory ifTrue: [ (mm respondsTo: #target) ifTrue: [ mm nearestOwnerThat: [:ow | ow == mm target ifTrue: [mm target: nil. true] ifFalse: [false]]]. (mm respondsTo: #arguments) ifTrue: [ mm arguments do: [:arg | arg ifNotNil: [ mm nearestOwnerThat: [:ow | ow == arg ifTrue: [mm arguments at: (mm arguments indexOf: arg) put: nil. true] ifFalse: [false]]]]]. mm eventHandler ifNotNil: ["recipients point back up" (morphs includesAllOf: (mm eventHandler allRecipients)) ifTrue: [ mm eventHandler: nil]]. "temporary, until using Model for PartsBin" (mm isMorphicModel) ifTrue: [ (mm model isMorphicModel) ifTrue: [ mm model breakDependents]]. (mm isTextMorph) ifTrue: [mm setContainer: nil]]]. (Smalltalk includesKey: #Owners) ifTrue: [Smalltalk at: #Owners put: nil]. "in case findOwnerMap: is commented out" "self findOwnerMap: morphs." morphs do: [:mm | "break the back pointers" mm isInMemory ifTrue: [mm privateOwner: nil]]. "more in extensions?" ! !
!NebraskaCommunicatorMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/11/2023 13:59'! textEntryFieldNamed: aSymbol with: aString help: helpString
| f col | f := (StringMorph new contents: aString; font: Preferences standardDefaultTextFont; yourself) setBalloonText: helpString; on: #mouseUp send: #editEvent:for: to: self. self field: aSymbol is: f. col := (self inAColumn: {f}) color: Color white; hResizing: #shrinkWrap. ^col! !
!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:52'! acceptTo: someText forMorph: aMorph
| betterText |
betterText := self improveText: someText forMorph: aMorph. self transmitStreamedObject: (SmartRefStream streamedRepresentationOf: betterText) to: self ipAddress. aMorph setText: '' asText. self appendMessage: self startOfMessageFromMe, ' - ', betterText, String cr.
^true! !
!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:56'! appendMessage: aText
receivingPane setText: (receivingPane text append: aText).! !
!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:54'! improveText: someText forMorph: aMorph
| betterText conversions fontForAll |
fontForAll := TextStyle default. betterText := someText veryDeepCopy. conversions := OrderedCollection new. betterText runs withStartStopAndValueDo: [:start :stop :attributes | attributes do: [:att | (att isMemberOf: TextFontChange) ifTrue: [ conversions add: {att. start. stop} ] ] ]. conversions do: [ :old | | newAttr | betterText removeAttribute: old first from: old second to: old third. newAttr := TextFontReference toFont: (fontForAll fontAt: old first fontNumber). newAttr fontNumber: old first fontNumber. betterText addAttribute: newAttr from: old second to: old third. ]. ^betterText! !
!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:57'! reportError: aString
receivingPane setText: (receivingPane text append: (aString asText addAttribute: TextColor red), String cr).! !
!NebraskaFridgeMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:52'! acceptDroppingMorph: morphToDrop event: evt
| outData |
(morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt ]. self eToyRejectDropMorph: morphToDrop event: evt. "we will keep a copy" (morphToDrop isKindOf: NebraskaSenderMorph) ifTrue: [ self class addRecipient: morphToDrop. ^self rebuild ]. self stopFlashing. "7 mar 2001 - remove #veryDeepCopy" outData := SmartRefStream streamedRepresentationOf: morphToDrop. self resetIndicator: #working. self class fridgeRecipients do: [ :each | self transmitStreamedObject: outData to: each ipAddress ].
! !
!NebraskaMorphsWelcomeMorph methodsFor: 'initialization' stamp: 'mt 8/11/2023 13:59'! initialize "initialize the state of the receiver" | earMorph | super initialize. ""
self layoutInset: 8 @ 8. "earMorph := (EToyListenerMorph makeListeningToggle: true) asMorph." earMorph := TextMorph new contents: 'Morphs welcome here'; fontName: Preferences standardDefaultTextFont familyName size: 18; centered; lock. self addARow: {earMorph}. self setBalloonText: 'My presence in this world means received morphs may appear automatically' translated! !
!NebraskaMultiChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:52'! acceptTo: someText forMorph: aMorph
| streamedMessage betterText |
betterText := self improveText: someText forMorph: aMorph. streamedMessage := SmartRefStream streamedRepresentationOf: {targetIPAddresses. betterText}. targetIPAddresses do: [ :each | self transmitStreamedObject: streamedMessage to: each. ]. aMorph setText: '' asText. self appendMessage: self startOfMessageFromMe, ' - ', betterText, String cr.
^true! !
!NebraskaSenderMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:53'! acceptDroppingMorph: morphToDrop event: evt
| myCopy outData |
(morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it"
"7 mar 2001 - remove #veryDeepCopy" myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position. self stopFlashing.
outData := SmartRefStream streamedRepresentationOf: myCopy. self resetIndicator: #working. self transmitStreamedObject: outData to: self ipAddress.
! !
!NebraskaSenderMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:53'! sendStatusReply
| null | null := String with: 0 asCharacter. NebraskaPeerToPeer new sendSomeData: { NebraskaIncomingMessage typeStatusReply,null. Preferences defaultAuthorName,null. (SmartRefStream streamedRepresentationOf: (NebraskaGateKeeperMorph acceptableTypesFor: self ipAddress)). } to: self ipAddress for: self. ! !
!NebraskaServerMorph methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:54'! rebuild
| myServer toggle closeBox font |
font := StrikeFont familyName: #Palatino size: 14. self removeAllMorphs. self setColorsAndBorder. self updateCurrentStatusString. toggle := SimpleHierarchicalListMorph new perform: ( fullDisplay ifTrue: [#expandedForm] ifFalse: [#notExpandedForm] ). closeBox := SimpleButtonMorph new borderWidth: 0; label: 'X' font: Preferences standardButtonFont; color: Color transparent; actionSelector: #delete; target: self; extent: 14@14; setBalloonText: 'End Nebraska session' translated.
self addARow: { self inAColumn: {closeBox}. self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentStatusString; contents: self currentStatusString; stepTime: 2000; lock. }. self inAColumn: { toggle asMorph on: #mouseUp send: #toggleFull to: self; setBalloonText: 'Show more or less of Nebraska Status' translated }. }. myServer := self server. (myServer isNil or: [fullDisplay not]) ifTrue: [ ^self world startSteppingSubmorphsOf: self ]. "--- the expanded display ---" self addARow: { self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentBacklogString; contents: self currentBacklogString; stepTime: 2000; lock. }. }.
self addARow: { self inAColumn: { (StringMorph contents: '--clients--' translated) lock; font: font. }. }.
myServer clients do: [ :each | self addARow: { UpdatingStringMorph new useStringFormat; target: each; font: font; getSelector: #currentStatusString; contents: each currentStatusString; stepTime: 2000; lock. } ]. self world startSteppingSubmorphsOf: self.! !
!NebraskaServerMorph methodsFor: 'initialization' stamp: 'mt 8/23/2023 13:26'! setColorsAndBorder
self color: (Color r: 0.9 g: 0.9 b: 0.9). self borderStyle: (BorderStyle raised width: 1). self useRoundedCorners! !
!NetworkTerminalMorph methodsFor: 'events-processing' stamp: 'mt 8/14/2023 11:29'! handleMouseDown: anEvent anEvent wasHandled ifTrue:[^self]. anEvent hand removePendingBalloonFor: self. anEvent wasHandled: true. anEvent hand newMouseFocus: self event: anEvent. anEvent hand removeHaloFromClick: anEvent on: self. self sendEventAsIs: anEvent.! !
!NetworkTerminalMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:53'! acceptDroppingMorph: morphToDrop event: evt
| myCopy outData null |
(morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it"
"7 mar 2001 - remove #veryDeepCopy" myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position.
outData := SmartRefStream streamedRepresentationOf: myCopy. null := String with: 0 asCharacter. NebraskaPeerToPeer new sendSomeData: { NebraskaIncomingMessage typeMorph,null. Preferences defaultAuthorName,null. outData } to: connection remoteSocketAddress hostNumber for: self. ! !
!NewHandleMorph methodsFor: 'initialization' stamp: 'mt 3/10/2023 16:07'! initialize "initialize the state of the receiver"
super initialize. "" waitingForClickInside := true.! !
!ObjectExplorer methodsFor: 'menus' stamp: 'mt 8/28/2023 14:40'! explorerKey: aChar from: view event: event
event anyModifierKeyPressed ifFalse: [^ false].
self object ifNotNil: [ aChar == $i ifTrue: [self inspectSelection. ^ true]. aChar == $I ifTrue: [self exploreSelection. ^ true].
aChar == $b ifTrue: [self browseFull. ^ true]. aChar == $h ifTrue: [self browseClassHierarchy. ^ true]. aChar == $c ifTrue: [self copyName. ^ true]. aChar == $p ifTrue: [self browseFullProtocol. ^ true]. aChar == $N ifTrue: [self browseClassRefs. ^ true]].
^ false! !
!ObjectlandMorph methodsFor: 'projects' stamp: 'mt 8/11/2023 15:16'! fillObjectlandProject
^ self fillObjectlandProjectWith: { self createGamesProject. self createGraphicsProject. self createToolsProject. self createSoundsProject }! !
!ObjectsTool methodsFor: 'search' stamp: 'mt 8/11/2023 13:59'! newSearchPane "Answer a type-in pane for searches"
| aTextMorph | aTextMorph := TextMorph new setProperty: #defaultContents toValue: ('' asText allBold addAttribute: (TextFontChange font3)); setTextStyle: (TextStyle fontArray: { Preferences standardDefaultTextFont }); setDefaultContentsIfNil; on: #keyStroke send: #searchPaneCharacter: to: self; setNameTo: 'SearchPane'; setBalloonText: 'Type here and all entries that match will be shown.' translated; vResizing: #shrinkWrap; hResizing: #spaceFill; margins: 4 px @ 6 px; backgroundColor: Color white. ^ aTextMorph! !
!PackageDependencyTest methodsFor: 'tests' stamp: 'mt 3/15/2023 14:59'! testMorphic self testPackage: #Morphic dependsExactlyOn: #( Balloon #'Chronology-Core' Collections Compiler Compression Files Graphics 'Installer-Core' "Because of TheWorldMainDockingBar's install feature ..." Kernel MonticelloConfigurations MorphicExtras Multilingual Network Sound System SystemReporter #'ToolBuilder-Kernel' #'ToolBuilder-Morphic' Tools TrueType ).! !
!PackageDependencyTest methodsFor: 'failures' stamp: 'mt 3/15/2023 14:58'! expectedFailures
^ #(testSystem testTools)! !
!PaintBoxMorph methodsFor: 'actions' stamp: 'mt 8/10/2023 15:31'! currentColor: aColor
currentColor := aColor.! !
!PaintBoxMorph methodsFor: 'initialization' stamp: 'mt 8/28/2023 14:39'! addLabels
self addGraphicLabels ifFalse: [self addTextualLabels].! !
!PaintBoxMorph methodsFor: 'initialization' stamp: 'mt 8/10/2023 15:30'! beSupersized "Not supported."! !
!PaintBoxMorph methodsFor: 'other' stamp: 'mt 8/28/2023 14:39'! offsetFromMaxBounds "location of normal PaintBox within maxBounds." | left | left := self left. self flag: #useBiggerPaintingBox. left := left - (( self width * 1.5)- self width). ^ left - colorMemory left @ 0! !
!PaintBoxMorph class methodsFor: 'instance creation' stamp: 'mt 8/28/2023 15:42'! new
| pb | pb := self prototype veryDeepCopy. pb stampHolder normalize. "Get the stamps to show" "Get my own copies of the brushes so I can modify them" #(brush1: brush2: brush3: brush4: brush5: brush6:) do: [:sel | | dualUse button | button := pb submorphNamed: sel. button offImage: button offImage deepCopy. dualUse := button onImage == button pressedImage. "sometimes shared" button onImage: button onImage deepCopy. dualUse ifTrue: [button pressedImage: button onImage] ifFalse: [button pressedImage: button pressedImage deepCopy]. ]. pb showColor. pb fixUpRecentColors. pb addLabels. ^ pb! !
!ParagraphEditor methodsFor: 'editing keys' stamp: 'mt 8/11/2023 14:44'! changeEmphasis: characterStream "Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change. Keeps typeahead."
| keyCode attribute oldAttributes index thisSel colors extras |
"control 0..9 -> 0..9" keyCode := ('0123456789' indexOf: sensor keyboard ifAbsent: [1]) - 1.
oldAttributes := paragraph text attributesAt: self pointIndex forStyle: paragraph textStyle. thisSel := self selection.
"Decipher keyCodes for Command 0-9..." "(keyCode between: 1 and: 5) ifTrue: [ attribute := TextFontChange fontNumber: keyCode ]."
keyCode = 5 ifTrue: [ | labels lines | colors := #(#black #magenta #red #yellow #green #blue #cyan #white ). extras := #('Link to comment of class' 'Link to definition of class' 'Link to hierarchy of class' 'Link to method' ).
labels := colors , #('choose color...' 'Do it' 'Print it' ) , extras , #('be a web URL link' 'Edit hidden info' 'Copy hidden info' ). lines := Array with: colors size + 1.
"index := (PopUpMenu labelArray: labels lines: lines) startUp. " index := UIManager default chooseFrom: labels lines: lines. index = 0 ifTrue: [ ^ true].
index <= colors size ifTrue: [ attribute := TextColor color: (Color perform: (colors at: index)) ] ifFalse: [ index := index - colors size - 1. "Re-number!!!!!!"
index = 0 ifTrue: [ attribute := self chooseColor ].
index = 1 ifTrue: [ attribute := TextDoIt new. thisSel := attribute analyze: self selection asString ].
index = 2 ifTrue: [ attribute := TextPrintIt new. thisSel := attribute analyze: self selection asString ].
extras size = 0 & (index > 2) ifTrue: [ index := index + 4 "skip those" ].
index = 3 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Comment' ].
index = 4 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Definition' ].
index = 5 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Hierarchy' ].
index = 6 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString ].
index = 7 ifTrue: [ attribute := TextURL new. thisSel := attribute analyze: self selection asString ].
index = 8 ifTrue: [ "Edit hidden info" thisSel := self hiddenInfo. "includes selection" attribute := TextEmphasis normal ].
index = 9 ifTrue: [ "Copy hidden info" self copyHiddenInfo. ^ true ].
"no other action" thisSel ifNil: [ ^ true ] ] ].
(keyCode between: 6 and: 9) ifTrue: [ sensor leftShiftDown ifTrue: [ keyCode = 6 ifTrue: [ attribute := TextKern kern: -1 ]. keyCode = 7 ifTrue: [ attribute := TextKern kern: 1 ] ] ifFalse: [ "And remember this: nine is fine for underline, obliter-eight it as you see fit, seven has been bold for ever'n, which leaves six as the obivous fix to emphasize your poetics." attribute := TextEmphasis perform: (#(italic bold struckOut underlined) at: keyCode - 5). oldAttributes do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]] ] ].
keyCode = 0 ifTrue: [attribute := TextEmphasis normal].
attribute ifNil: [^ true].
beginTypeInBlock ~~ nil ifTrue: [ "only change emphasisHere while typing" self insertTypeAhead: characterStream. emphasisHere := Text addAttribute: attribute toArray: oldAttributes. ^ true ].
self replaceSelectionWith: (thisSel asText addAttribute: attribute).
^ true ! !
!ParagraphEditor class methodsFor: 'class initialization' stamp: 'mt 8/11/2023 14:47'! yellowButtonMenu
^ SelectionMenu fromArray: StringHolder yellowButtonMenuItems! !
!ParagraphEditor class methodsFor: 'keyboard shortcut tables' stamp: 'mt 8/11/2023 14:45'! initializeCmdKeyShortcuts "Initialize the (unshifted) command-key (or alt-key) shortcut table."
"NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"
"ParagraphEditor initialize"
| cmdMap |
cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash"
cmdMap at: 1 + 1 put: #cursorHome:. "home key" cmdMap at: 4 + 1 put: #cursorEnd:. "end key" cmdMap at: 8 + 1 put: #backspace:. "ctrl-H or delete key" cmdMap at: 11 + 1 put: #cursorPageUp:. "page up key" cmdMap at: 12 + 1 put: #cursorPageDown:. "page down key" cmdMap at: 13 + 1 put: #crWithIndent:. "cmd-Return" cmdMap at: 27 + 1 put: #offerMenuFromEsc:. "escape key" cmdMap at: 28 + 1 put: #cursorLeft:. "left arrow key" cmdMap at: 29 + 1 put: #cursorRight:. "right arrow key" cmdMap at: 30 + 1 put: #cursorUp:. "up arrow key" cmdMap at: 31 + 1 put: #cursorDown:. "down arrow key" cmdMap at: 32 + 1 put: #selectWord:. "space bar key" cmdMap at: 127 + 1 put: #forwardDelete:. "del key"
'0123456789' do: [:char | cmdMap at: char asciiValue + 1 put: #changeEmphasis:].
"triplet = {character. comment selector. novice appropiated}" #( ($a #selectAll: ) ($b #browseIt: ) ($c #copySelection: ) ($d #doIt: ) ($e #exchange: ) ($f #find: ) ($g #findAgain: ) ($h #setSearchString: ) ($i #inspectIt: ) ($j #doAgainOnce: ) ($k #offerFontMenu: ) ($l #cancel: ) ($m #implementorsOfIt: ) ($n #sendersOfIt: ) ($o #spawnIt: ) ($p #printIt: ) ($q #querySymbol: ) ($s #save: ) ($t #tempCommand: ) ($u #align: ) ($v #paste: ) ($w #backWord: ) ($x #cut: ) ($y #swapChars: ) ($z #undo: ) ) do:[:triplet | cmdMap at: triplet first asciiValue + 1 put: triplet second].
CmdActions := cmdMap. ! !
!ParagraphEditor class methodsFor: 'keyboard shortcut tables' stamp: 'mt 8/11/2023 14:46'! initializeShiftCmdKeyShortcuts "Initialize the shift-command-key (or control-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the capitalized versions of the letters. TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values."
| cmdMap |
"shift-command and control shortcuts" cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash"
cmdMap at: ( 1 + 1) put: #cursorHome:. "home key" cmdMap at: ( 4 + 1) put: #cursorEnd:. "end key" cmdMap at: ( 8 + 1) put: #forwardDelete:. "ctrl-H or delete key" cmdMap at: (11 + 1) put: #cursorPageUp:. "page up key" cmdMap at: (12 + 1) put: #cursorPageDown:. "page down key" cmdMap at: (13 + 1) put: #crWithIndent:. "ctrl-Return" cmdMap at: (27 + 1) put: #offerMenuFromEsc:. "escape key" cmdMap at: (28 + 1) put: #cursorLeft:. "left arrow key" cmdMap at: (29 + 1) put: #cursorRight:. "right arrow key" cmdMap at: (30 + 1) put: #cursorUp:. "up arrow key" cmdMap at: (31 + 1) put: #cursorDown:. "down arrow key" cmdMap at: (32 + 1) put: #selectWord:. "space bar key" cmdMap at: (45 + 1) put: #changeEmphasis:. "cmd-sh-minus" cmdMap at: (61 + 1) put: #changeEmphasis:. "cmd-sh-plus" cmdMap at: (127 + 1) put: #forwardDelete:. "del key"
"triplet = {character. comment selector. novice appropiated}" #( ($a argAdvance: ) ($b browseItHere: ) ($c compareToClipboard: ) ($d debugIt: ) ($e methodStringsContainingIt:) ($f displayIfFalse: ) ($g fileItIn: ) ($h cursorTopHome: ) ($i exploreIt: ) ($j doAgainMany: ) ($k changeStyle: ) ($m selectCurrentTypeIn: ) ($n referencesToIt: ) ($p makeProjectLink: ) ($s search: ) ($t displayIfTrue: ) ($u changeLfToCr: ) ($v pasteInitials: ) ($w methodNamesContainingIt:) ($x makeLowercase: ) ($y makeUppercase: ) ($z makeCapitalized: ) ) do:[:triplet | cmdMap at: (triplet first asciiValue + 1) put: triplet second. "plain keys" cmdMap at: (triplet first asciiValue - 32 + 1) put: triplet second. "shifted keys" cmdMap at: (triplet first asciiValue - 96 + 1) put: triplet second. "ctrl keys" ].
ShiftCmdActions := cmdMap! !
!PasteUpMorph methodsFor: 'accessing' stamp: 'mt 8/11/2023 16:19'! flapTab "Answer the tab affilitated with the receiver. Normally every flap tab is expected to have a PasteUpMorph which serves as its 'referent.'"
self isFlap ifFalse: [^ nil]. ^ self flapTabs detect: [:any| any referent == self] ifNone: [nil]! !
!PasteUpMorph methodsFor: 'caching' stamp: 'mt 3/10/2023 15:07'! releaseCachedState super releaseCachedState. self isWorldMorph ifTrue:[self cleanseStepList].! !
!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'mt 8/14/2023 17:42'! acceptDroppingMorph: dropped event: evt "The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied"
| aMorph | (self isWorldMorph and: [dropped isTransferMorph] and: [self hasTransferMorphConverter not]) ifTrue: [ dropped dragTransferType = #filesAndDirectories ifTrue: [^ self dropFiles: dropped passenger event: evt]. dropped dragTransferType = #sourceCode ifTrue: [^ self dropSourceCode: dropped passenger event: evt]. dropped dragTransferType = #inspectorField "See Tools-Inspector" ifTrue: [^ self dropInspectorField: dropped passenger event: evt]. dropped dragTransferType = #explorerField "See Tools-Explorer" ifTrue: [^ self dropExplorerField: dropped passenger from: dropped source model event: evt]].
aMorph := self morphToDropFrom: dropped. self isWorldMorph ifFalse: [super acceptDroppingMorph: aMorph event: evt] ifTrue: ["Add the given morph to this world and start stepping it if it wants to be." aMorph isInWorld ifFalse: [aMorph position: evt position]. self addMorphFront: aMorph. (aMorph fullBounds intersects: self viewBox) ifFalse: [Beeper beep. aMorph position: self bounds center]].
aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]].
self isPartsBin ifTrue: [aMorph isPartsDonor: true. aMorph stopSteppingSelfAndSubmorphs. aMorph suspendEventHandler] ifFalse: [self world startSteppingSubmorphsOf: aMorph].
self bringTopmostsToFront.! !
!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'mt 8/14/2023 17:41'! morphToDropFrom: aMorph "Given a morph being carried by the hand which the hand is about to drop, answer the actual morph to be deposited. Normally this would be just the morph itself, but several unusual cases arise, which this method is designed to service."
| aNail representee handy posBlock | handy := self isWorldMorph ifTrue: [self primaryHand] ifFalse: [self currentHand]. posBlock := [:z | | tempPos | tempPos := handy position - ((handy targetOffset - aMorph formerPosition) * (z extent / aMorph extent)) rounded. self pointFromWorld: tempPos]. self alwaysShowThumbnail ifTrue: [aNail := aMorph representativeNoTallerThan: self maxHeightToAvoidThumbnailing norWiderThan: self maximumThumbnailWidth thumbnailHeight: self heightForThumbnails. aNail == aMorph ifFalse: [aMorph formerPosition: aMorph position. aNail position: (posBlock value: aNail)]. ^aNail]. ((aMorph isKindOf: MorphThumbnail) and: [(representee := aMorph morphRepresented) owner isNil]) ifTrue: [representee position: (posBlock value: representee). ^representee].
^aMorph morphToDropInPasteUp: self! !
!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/15/2023 13:45'! handlesKeyboard: evt ^self isWorldMorph! !
!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/15/2023 13:45'! keyStroke: anEvent "A keystroke has been made. Service event handlers and, if it's a keystroke presented to the world, dispatch it to #unfocusedKeystroke:"
| selected | super keyStroke: anEvent. "Give event handlers a chance"
selected := self selectedObject. selected isNil ifFalse:[ selected moveOrResizeFromKeystroke: anEvent ].
self isWorldMorph ifTrue: [self keystrokeInWorld: anEvent]! !
!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 16:08'! mouseDown: evt "Handle a mouse down event." | grabbedMorph handHadHalos |
(Preferences generalizedYellowButtonMenu and: [evt yellowButtonPressed]) ifTrue: [^ self yellowButtonActivity: evt shiftPressed].
grabbedMorph := self morphToGrab: evt. grabbedMorph ifNotNil:[ grabbedMorph isSticky ifTrue:[^self]. self isPartsBin ifFalse:[^evt hand grabMorph: grabbedMorph]. grabbedMorph := grabbedMorph partRepresented duplicate. grabbedMorph restoreSuspendedEventHandler. (grabbedMorph fullBounds containsPoint: evt position) ifFalse:[grabbedMorph position: evt position]. "Note: grabbedMorph is ownerless after duplicate so use #grabMorph:from: instead" ^ evt hand grabMorph: grabbedMorph from: self].
(super handlesMouseDown: evt) ifTrue:[^super mouseDown: evt].
handHadHalos := evt hand halo notNil.
evt hand removeHalo. "shake off halos" evt hand releaseKeyboardFocus. "shake of keyboard foci"
self submorphs select:[:each | each hasProperty: #morphHierarchy] thenDo:[:each | each delete].
(evt shiftPressed not and:[ self isWorldMorph not and:[ self wantsEasySelection not ]]) ifTrue:[ "explicitly ignore the event if we're not the world and we'll not select, so that we could be picked up if need be" evt wasHandled: false. ^ self. ].
( evt shiftPressed or: [ self wantsEasySelection ] ) ifTrue:[ "We'll select on drag, let's decide what to do on click" | clickSelector |
clickSelector := nil.
evt shiftPressed ifTrue:[ clickSelector := #findWindow:. ] ifFalse:[ self isWorldMorph ifTrue:[ clickSelector := handHadHalos ifTrue: [ #delayedInvokeWorldMenu: ] ifFalse: [ #invokeWorldMenu: ] ] ].
evt hand waitForClicksOrDrag: self event: evt selectors: { clickSelector. nil. nil. #dragThroughOnDesktop: } threshold: HandMorph dragThreshold. ] ifFalse:[ "We wont select, just bring world menu if I'm the world" self isWorldMorph ifTrue:[ handHadHalos ifTrue: [ self delayedInvokeWorldMenu: evt ] ifFalse: [ self invokeWorldMenu: evt ] ] ]. ! !
!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/7/2023 18:18'! windowEvent: anEvent
self windowEventHandler ifNotNil: [^self windowEventHandler windowEvent: anEvent].
anEvent type caseOf: { [#windowClose] -> [TheWorldMenu basicNew quitSession].
[#windowDeactivated] -> [ "The host window has been deactivated. Until it regains the focus, honor the fact that we will not receive keyboard events again by changing the current keyboard focus morph. windowHostFocusMorph represents the host system which now holds the keyboard focus instead of the previousFocus." (self valueOfProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | "There is currently no exact-once guarantee for this event type from the VM. Mark any older host focus morph as inactive, it will be held as the previousFocus of the next host focus morph." hostFocus active: false]. self setProperty: #windowHostFocusMorph toValue: (WindowHostFocusMorph new in: [:hostFocus | hostFocus previousFocus: anEvent hand keyboardFocus. anEvent hand newKeyboardFocus: hostFocus.]; yourself)]. [#windowActivated] -> [ "Alright, the spook is over!! We have back control over the keyboard focus, delete the windowHostFocusMorph and restore the previous focus holder." (self removeProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | hostFocus active: false. (anEvent hand keyboardFocus == hostFocus and: [hostFocus previousFocus notNil]) ifTrue: [anEvent hand newKeyboardFocus: hostFocus previousFocus]]]. } otherwise: []! !
!PasteUpMorph methodsFor: 'events-processing' stamp: 'mt 3/10/2023 16:09'! tryInvokeHalo: aUserInputEvent
Morph haloForAll ifFalse: [ ^ self ].
(self transferHalo: aUserInputEvent) ifTrue: "The event was handled, don't let it cause any further side-effects." [ aUserInputEvent ignore ].! !
!PasteUpMorph methodsFor: 'events-processing' stamp: 'mt 3/10/2023 11:27'! tryInvokeMetaMenu: anEvent
| innerMost target | Morph metaMenuForAll ifFalse: [^ self].
innerMost := (self morphsAt: anEvent position unlocked: true) first.
"Traverse the owner chain if some morph does not want to show its meta menu." target := innerMost. [target isNil or: [target wantsMetaMenu]] whileFalse: [target := target owner]. target ifNil: [^ self].
target invokeMetaMenu: anEvent. anEvent ignore.! !
!PasteUpMorph methodsFor: 'halos and balloon help' stamp: 'mt 3/7/2023 17:39'! wantsHaloFromClick (owner isSystemWindow) ifTrue: [^ false]. ^ true. ! !
!PasteUpMorph methodsFor: 'initialization' stamp: 'mt 3/10/2023 15:29'! initialize "initialize the state of the receiver" super initialize. "" padding := 3. self enableDragNDrop. self clipSubmorphs: true. self initializeKeyboardShortcuts. self initializeMouseShortcuts.! !
!PasteUpMorph methodsFor: 'menu & halo' stamp: 'mt 8/11/2023 16:18'! addCustomMenuItems: menu hand: aHandMorph "Add morph-specific menu itemns to the menu for the hand" super addCustomMenuItems: menu hand: aHandMorph.
self isWorldMorph ifTrue: [ | twm | menu addLine. menu addUpdating: #showWorldMainDockingBarString action: #toggleShowWorldMainDockingBar.
menu addLine.
Flaps sharedFlapsAllowed ifTrue: [ menu addUpdating: #suppressFlapsString target: Project current action: #toggleFlapsSuppressed. ].
twm := TheWorldMenu new. twm world: self project: Project current hand: aHandMorph.
menu add: 'old desktop menu... (W)' translated subMenu: twm buildWorldMenu. ]. ! !
!PasteUpMorph methodsFor: 'menu & halo' stamp: 'mt 8/16/2023 16:02'! addWorldHaloMenuItemsTo: aMenu hand: aHandMorph "Add standard halo items to the menu, given that the receiver is a World"
| unlockables | self addFillStyleMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph.
aMenu addLine. self addWorldToggleItemsToHaloMenu: aMenu. aMenu addLine. self addCopyItemsTo: aMenu. self addExportMenuItems: aMenu hand: aHandMorph. self addMiscExtrasTo: aMenu.
self addDebuggingItemsTo: aMenu hand: aHandMorph.
aMenu addLine. aMenu defaultTarget: self.
aMenu addLine.
unlockables := self submorphs select: [:m | m isLocked]. unlockables size = 1 ifTrue: [aMenu add: ('unlock "{1}"' translated format:{unlockables first externalName})action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' translated action: #unlockContents].
aMenu defaultTarget: aHandMorph. ! !
!PasteUpMorph methodsFor: 'options' stamp: 'mt 8/4/2023 14:08'! autoLineLayout: aBoolean "Make the receiver be viewed with auto-line-layout, which means that its submorphs will be laid out left-to-right and then top-to-bottom in the manner of a word processor, or (if aBoolean is false,) cease applying auto-line-layout"
aBoolean ifTrue:[ self layoutPolicy: TableLayout new. self layoutInset: 8; cellGap: 4. self listDirection: #leftToRight; wrapDirection: #topToBottom. ] ifFalse:[ self layoutPolicy: nil. self layoutInset: 0; cellGap: 0. ]. ! !
!PasteUpMorph methodsFor: 'undo' stamp: 'fbs 12/31/2013 12:08'! onceAgainDismiss: aMorph "Occasioned by a redo of a dismiss-via-halo"
aMorph dismissMorph. TrashCanMorph preserveTrash ifTrue: [TrashCanMorph slideDismissalsToTrash ifTrue:[aMorph slideToTrash: nil] ifFalse:[TrashCanMorph moveToTrash: aMorph]]! !
!PasteUpMorph methodsFor: 'undo' stamp: 'mt 8/4/2023 14:45'! reintroduceIntoWorld: aMorph "The given morph is being raised from the dead. Bring it back to life."
(aMorph valueOfProperty: #lastPosition) ifNotNil: [:pos | aMorph position: pos]. aMorph openInWorld
! !
!PasteUpMorph methodsFor: 'WiW support' stamp: 'raa 11/14/2017 07:47'! installAsActiveSubprojectIn: enclosingWorld at: newBounds titled: aString | window howToOpen tm boundsForWorld | howToOpen := self embeddedProjectDisplayMode. "#scaled may be the only one that works at the moment" submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." boundsForWorld := howToOpen == #naked ifTrue: [newBounds] ifFalse: [bounds]. worldState canvas: nil. worldState viewBox: boundsForWorld. self bounds: boundsForWorld.
"self viewBox: Display boundingBox." "worldState handsDo: [:h | h initForEvents]." self installFlaps.
"SystemWindow noteTopWindowIn: self." "self displayWorldSafely." howToOpen == #naked ifTrue: [enclosingWorld addMorphFront: self]. howToOpen == #window ifTrue: [window := (SystemWindow labelled: aString) model: self. window addMorph: self frame: (0 @ 0 extent: 1.0 @ 1.0). window openInWorld: enclosingWorld]. howToOpen == #frame ifTrue: [window := (AlignmentMorphBob1 new) minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color green; bounds: newBounds. window addMorph: self. window openInWorld: enclosingWorld]. howToOpen == #scaled ifTrue: [self position: 0 @ 0. window := (EmbeddedWorldBorderMorph new) minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color green; bounds: newBounds. tm := BOBTransformationMorph new. window addMorph: tm. tm addMorph: self. window openInWorld: enclosingWorld. tm changeWorldBoundsToShow: bounds. self arrangeToStartSteppingIn: enclosingWorld "tm scale: (tm width / self width min: tm height / self height) asFloat."]! !
!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 8/14/2023 17:32'! findWindow: evt "Present a menu names of windows and naked morphs, and activate the one that gets chosen. Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo." | menu expanded collapsed nakedMorphs | menu := MenuMorph new. expanded := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed not]. collapsed := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed]. nakedMorphs := self submorphsSatisfying: [:m | m isSystemWindow not and: [(m isFlapTab) not]]. (expanded isEmpty & (collapsed isEmpty & nakedMorphs isEmpty)) ifTrue: [^ Beeper beep]. (expanded sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: (w label contractTo: 80) target: w action: #beKeyWindow. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. (expanded isEmpty | (collapsed isEmpty & nakedMorphs isEmpty)) ifFalse: [menu addLine]. (collapsed sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: (w label contractTo: 80) target: w action: #collapseOrExpand. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. nakedMorphs isEmpty ifFalse: [menu addLine]. (nakedMorphs sort: [:w1 :w2 | w1 nameForFindWindowFeature caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) do: [:w | menu add: (w nameForFindWindowFeature contractTo: 80) target: w action: #comeToFrontAndAddHalo]. menu addTitle: 'find window' translated.
menu popUpEvent: evt in: self.! !
!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 11:27'! invokeWorldMenu: evt "Put up the world menu, triggered by the passed-in event."
self putUpWorldMenu: evt.! !
!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 11:27'! keystrokeInWorld: evt "A keystroke was hit when no keyboard focus was set, so it is sent here to the world instead."
| aChar isCmd ascii | aChar := evt keyCharacter. (ascii := aChar asciiValue) = Character escape asciiValue ifTrue: [evt commandKeyPressed ifFalse: [^ self putUpWorldMenuFromEscapeKey]]. (evt controlKeyPressed not and: [(#(1 4 8 28 29 30 31 32) includes: ascii) "home, end, backspace, arrow keys, space" and: [self keyboardNavigationHandler notNil]]) ifTrue: [self keyboardNavigationHandler navigateFromKeystroke: aChar].
isCmd := evt commandKeyPressed and: [Preferences cmdKeysInText]. (isCmd and: [Preferences honorDesktopCmdKeys]) ifTrue: [^ self dispatchCommandKeyInWorld: aChar event: evt].
"It was unhandled. Remember the keystroke." self lastKeystroke: evt keyString. self triggerEvent: #keyStroke! !
!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/8/2023 10:36'! putUpNewMorphMenu "Put up the New Morph menu in the world"
TheWorldMenu new world: self project: Project current hand: self currentHand; newMorph! !
!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 16:08'! putUpWorldMenuFromEscapeKey
self putUpWorldMenu: self currentEvent.! !
!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/10/2023 13:57'! allNonWindows "Answer all non-window submorphs"
^submorphs select: [:m | (m isSystemWindow) not and: [m wantsToBeTopmost not]]! !
!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/10/2023 15:29'! beWorldForProject: aProject
self privateOwner: nil. worldState := WorldState new. self addHand: HandMorph new. self setProperty: #optimumExtentFromAuthor toValue: Display extent. self startSteppingSubmorphsOf: self! !
!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/15/2023 13:18'! initForProject: aWorldState
worldState := aWorldState. self viewBox: Display boundingBox. self color: Preferences defaultWorldColor. self addHand: HandMorph new. self setProperty: #optimumExtentFromAuthor toValue: Display extent. self borderWidth: 0. model := nil. ! !
!PasteUpMorph methodsFor: 'world state' stamp: 'mt 8/11/2023 16:20'! install
owner := nil. "since we may have been inside another world previously"
submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." self viewBox: Display boundingBox. EventSensor default flushEvents. worldState handsDo: [:h | h initForEvents]. self installFlaps. self borderWidth: 0. "default" (Preferences showSecurityStatus and: [SecurityManager default isInRestrictedMode]) ifTrue: [self borderWidth: 2; borderColor: Color red]. SystemWindow noteTopWindowIn: self.! !
!PasteUpMorph methodsFor: 'world state' stamp: 'mt 8/10/2023 15:27'! paintBox "Return the painting controls widget (PaintBoxMorph) to be used for painting in this world. If there is not already a PaintBox morph, or if it has been deleted from this world, create a new one."
| newPaintBox refPoint | self allMorphsDo: [:m | (m isKindOf: PaintBoxMorph) ifTrue: [^ m]]. refPoint := self topRight. newPaintBox := PaintBoxMorph new. newPaintBox position: (refPoint - (newPaintBox width @ 0)). self addMorph: newPaintBox. ^ newPaintBox ! !
!PasteUpMorph methodsFor: 'world state' stamp: 'sw 9/2/1999 12:01'! paintBoxOrNil "Return the painting controls widget (PaintBoxMorph) to be used for painting in this world. If there is not already a PaintBox morph return nil"
self allMorphsDo: [:m | (m isKindOf: PaintBoxMorph) ifTrue: [^ m]]. ^ nil ! !
!PasteUpMorph methodsFor: '*Tools' stamp: 'mt 3/10/2023 16:08'! defaultDesktopCommandKeyTriplets "Answer a list of triplets of the form [+ optional fourth element, a for use in desktop-command-key-help] that will provide the default desktop command key handlers. If the selector takes an argument, that argument will be the command-key event" "World initializeDesktopCommandKeySelectors"
| noviceKeys expertKeys |
noviceKeys := { {$r. self. #restoreMorphicDisplay. 'Redraw the screen' translated}. {$M. self. #toggleShowWorldMainDockingBar. 'Show/Hide the Main Docking Bar' translated}. {$]. Smalltalk. #saveSession. 'Save the image.' translated}. }.
expertKeys := { {$b. SystemBrowser. #defaultOpenBrowser. 'Open a new System Browser' translated}. {$k. Workspace. #open. 'Open a new Workspace' translated}. {$m. self. #putUpNewMorphMenu. 'Put up the "New Morph" menu' translated}. {$O. self. #findAMonticelloBrowser. 'Bring a Monticello window into focus.' translated}. {$t. self. #findATranscript:. 'Make a System Transcript visible' translated}. {$w. SystemWindow. #closeTopWindow. 'Close the topmost window' translated}. {Character escape. SystemWindow. #closeTopWindow. 'Close the topmost window' translated}.
{$C. self. #findAChangeSorter:. 'Make a Change Sorter visible' translated}.
{$L. self. #findAFileList:. 'Make a File List visible' translated}. {$P. self. #findAPreferencesPanel:. 'Activate the Preferences tool' translated}. {$R. Utilities. #browseRecentSubmissions. 'Make a Recent Submissions browser visible' translated}.
{$W. self. #findAMessageNamesWindow:. 'Make a MessageNames tool visible' translated}. {$Z. ChangeList. #browseRecentLog. 'Browse recently-logged changes' translated}.
{$. SystemWindow. #sendTopWindowToBack. 'Send the top window to the back' translated}. {$_. Smalltalk. #quitPrimitive. 'Quit the image immediately.' translated}.
{$-. Preferences. #decreaseFontSize. 'Decrease all font sizes' translated}. {$+. Preferences. #increaseFontSize. 'Increase all font sizes' translated}. }.
^ noviceKeys, expertKeys! !
!PasteUpMorph methodsFor: 'flaps' stamp: 'mt 8/4/2023 14:02'! addGlobalFlaps "Must make global flaps adapt to world. Do this even if not shown, so the old world will not be pointed at by the flaps."
| use thisWorld | use := Flaps sharedFlapsAllowed. Project current flapsSuppressed ifTrue: [use := false]. "Smalltalk isMorphic ifFalse: [use := false]." thisWorld := use ifTrue: [self] ifFalse: [PasteUpMorph new initForProject: "fake to be flap owner" WorldState new; bounds: (0@0 extent: 4000@4000); viewBox: (0@0 extent: 4000@4000)].
Flaps globalFlapTabsIfAny do: [:aFlapTab | (Project current isFlapEnabled: aFlapTab) ifTrue: [(aFlapTab world == thisWorld) ifFalse: [thisWorld addMorphFront: aFlapTab]. "always do" use ifTrue: [aFlapTab spanWorld. aFlapTab adjustPositionAfterHidingFlap. aFlapTab flapShowing ifTrue: [aFlapTab showFlap]]]]! !
!PasteUpMorph methodsFor: 'flaps' stamp: 'nice 12/27/2009 20:14'! localFlapTabs "Answer a list of local flap tabs in the current project"
| globalList aList | globalList := Flaps globalFlapTabsIfAny. aList := OrderedCollection new. submorphs do: [:m | | aFlapTab | ((m isFlapTab) and: [(globalList includes: m) not]) ifTrue: [aList add: m] ifFalse: [((m isFlap) and: [(aFlapTab := m submorphs detect: [:n | n isFlapTab] ifNone: [nil]) notNil]) ifTrue: [aList add: aFlapTab]]]. ^ aList! !
!PasteUpMorph methodsFor: '*services-base' stamp: 'mt 8/4/2023 14:03'! openWorldMenu | menu | menu := (TheWorldMenu new world: self project: nil hand: self primaryHand) buildWorldMenu. menu addTitle: Preferences desktopMenuTitle translated. menu openInHand! !
!PasteUpMorph methodsFor: '*services-base' stamp: 'mt 8/28/2023 14:42'! worldMenu ^ TheWorldMenu new world: self project: nil hand: self primaryHand! !
!PasteUpMorph class methodsFor: 'scripting' stamp: 'mt 3/15/2023 13:30'! authoringPrototype "Answer an instance of the receiver suitable for placing in a parts bin for authors"
| proto | proto := self new markAsPartsDonor. proto color: Color green muchLighter; extent: 100 @ 80; borderColor: (Color r: 0.645 g: 0.935 b: 0.161). proto extent: 300 @ 240. proto beSticky. ^ proto! !
!PasteUpMorph class methodsFor: '*MorphicExtras-class initialization' stamp: 'mt 7/31/2023 11:14'! initialize "Initialize the class"
self registerInFlapsRegistry.! !
!PolygonMorph methodsFor: 'stepping' stamp: 'mt 3/10/2023 15:01'! stepTime "Answer the desired time between steps in milliseconds."
^ 100! !
!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:59'! printStandardSystemFonts "self printStandardSystemFonts"
| string | string := String streamContents: [ :s |
#(standardDefaultTextFont standardListFont standardFlapFont standardMenuFont windowTitleFont standardBalloonHelpFont standardCodeFont standardButtonFont) do: [:selector | | font | font := Preferences perform: selector. s nextPutAll: selector; space; nextPutAll: font familyName; space; nextPutAll: (AbstractFont emphasisStringFor: font emphasis); nextPutAll: ' points: '; print: font pointSize; nextPutAll: ' height: '; print: font height; cr ]].
(StringHolder new) contents: string; openLabel: 'Current system font settings' translated. ! !
!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:58'! refreshFontSettings "Try to update all the current font settings to make things consistent."
UserInterfaceTheme current applyAfter: [ self setFlapsFontTo: (self standardFlapFont); setWindowTitleFontTo: (self windowTitleFont); setListFontTo: (self standardListFont); setMenuFontTo: (self standardMenuFont); setSystemFontTo: (TextStyle defaultFont); setCodeFontTo: (self standardCodeFont); setBalloonHelpFontTo: (BalloonMorph balloonFont)].
SystemWindow allSubInstancesDo: [ :s | | rawLabel | rawLabel := s getRawLabel. rawLabel owner vResizing: #spaceFill. rawLabel font: rawLabel font. s setLabel: s label. s replaceBoxes ].! !
!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:59'! restoreFontsAfter: aBlock
"Restore the currently chosen set of standard fonts after evaluating aBlock. Used for tests that modify the default fonts."
| standardDefaultTextFont standardListFont standardMenuFont windowTitleFont standardBalloonHelpFont standardCodeFont standardButtonFont |
standardDefaultTextFont := Preferences standardDefaultTextFont. standardListFont := Preferences standardListFont. standardMenuFont := Preferences standardMenuFont. windowTitleFont := Preferences windowTitleFont. standardBalloonHelpFont := Preferences standardBalloonHelpFont. standardCodeFont := Preferences standardCodeFont. standardButtonFont := Preferences standardButtonFont. ^ UserInterfaceTheme current applyAfter: [ aBlock ensure: [ Preferences setSystemFontTo: standardDefaultTextFont. Preferences setListFontTo: standardListFont. Preferences setMenuFontTo: standardMenuFont. Preferences setWindowTitleFontTo: windowTitleFont. Preferences setBalloonHelpFontTo: standardBalloonHelpFont. Preferences setCodeFontTo: standardCodeFont. Preferences setButtonFontTo: standardButtonFont]]. ! !
!Preferences class methodsFor: 'support - misc' stamp: 'mt 3/7/2023 15:42'! personalizeUserMenu: aMenu "The user has clicked on the morphic desktop with the yellow mouse button (option+click on the Mac); a menu is being constructed to present to the user in response; its default target is the current world. In this method, you are invited to add items to the menu as per personal preferences. The default implementation, for illustrative purposes, sets the menu title to 'personal', and adds items for go-to-previous-project, show/hide flaps, and load code updates"
aMenu addTitle: 'personal' translated. "Remove or modify this as per personal choice"
aMenu addStayUpItem. aMenu add: 'previous project' translated action: #goBack. aMenu add: 'load latest code updates' translated target: MCMcmUpdater action: #updateFromServer. aMenu add: 'about this system...' translated target: Smalltalk action: #aboutThisSystem.! !
!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'! classicHaloSpecs "Non-iconic halos with traditional placements"
"Preferences installClassicHaloSpecs" "Preferences resetHaloSpecifications" " <- will result in the standard default halos being reinstalled" "NB: listed below in clockwise order"
^ #( " selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addMenuHandle: left top (red) none) (addDismissHandle: leftCenter top (red muchLighter) 'Halo-Dismiss') (addGrabHandle: center top (black) none) (addDragHandle: rightCenter top (brown) none) (addDupHandle: right top (green) none) (addDebugHandle: right topCenter (blue veryMuchLighter) none) (addGrowHandle: right bottom (yellow) none) (addScaleHandle: right bottom (lightOrange) none) (addFontEmphHandle: rightCenter bottom (lightBrown darker) none) (addFontStyleHandle: center bottom (lightRed) none) (addFontSizeHandle: leftCenter bottom (lightGreen) none)
(addRecolorHandle: right bottomCenter (magenta darker) none)
(addRotateHandle: left bottom (blue) none))
! !
!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/8/2023 11:41'! customHaloSpecs "Intended for you to modify to suit your personal preference. What is implemented in the default here is just a skeleton; in comment at the bottom of this method are some useful lines you may wish to paste in to the main body here, possibly modifying positions, colors, etc.. Note that in this example, we include: Dismiss handle, at top-left Menu handle, at top-right Resize handle, at bottom-right Rotate handle, at bottom-left Drag handle, at top-center Recolor handle, at left-center. (this one is NOT part of the standard formulary -- it is included here to illustrate how to add non-standard halos) Note that the optional handles for specialized morphs, such as Sketch, Text, PasteUp, are also included"
^ #( (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addMenuHandle: right top (red) 'Halo-Menu') (addDragHandle: center top (brown) 'Halo-Drag') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale')
(addRecolorHandle: left center (green muchLighter lighter) 'Halo-Recolor')
(addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRotateHandle: left bottom (blue) 'Halo-Rot')
(addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug')
)
" Other useful handles...
selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------
(addTileHandle: left bottomCenter (lightBrown) 'Halo-Tile') (addViewHandle: left center (cyan) 'Halo-View') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addFewerHandlesHandle: left topCenter (paleBuff) 'Halo-FewerHandles') (addPaintBgdHandle: right center (lightGray) 'Halo-Paint') (addRepaintHandle: right center (lightGray) 'Halo-Paint') " ! !
!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/8/2023 11:30'! haloSpecificationsForWorld | desired | "Answer a list of HaloSpecs that describe which halos are to be used on a world halo, what they should look like, and where they should be situated" "Preferences resetHaloSpecifications"
desired := #(addDebugHandle: addMenuHandle: addHelpHandle: addRecolorHandle:). ^ self haloSpecifications select: [:spec | desired includes: spec addHandleSelector]! !
!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'! iconicHaloSpecifications "Answer an array that characterizes the locations, colors, icons, and selectors of the halo handles that may be used in the iconic halo scheme"
"Preferences resetHaloSpecifications"
^ #( " selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addCollapseHandle: left topCenter (tan) 'Halo-Collapse') (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addMenuHandle: leftCenter top (red) 'Halo-Menu') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor') ) ! !
!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'! simpleFullHaloSpecifications "This method gives the specs for the 'full' handles variant when simple halos are in effect"
"Preferences resetHaloSpecifications"
^ #( " selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addMenuHandle: leftCenter top (red) 'Halo-Menu') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale') (addFewerHandlesHandle: left topCenter (paleBuff) 'Halo-FewerHandles') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor')
) ! !
!Preferences class methodsFor: 'defaults' stamp: 'mt 8/29/2023 15:25'! defaultValueTableForCurrentRelease "Answer a table defining default values for all the preferences in the release. Returns a list of (pref-symbol, boolean-symbol) pairs"
^ #( (alternativeBrowseIt false) (annotationPanes false) (areaFillsAreTolerant false) (areaFillsAreVeryTolerant false) (automaticKeyGeneration false) (balloonHelpEnabled true) (balloonHelpInMessageLists false) (caseSensitiveFinds false) (changeSetVersionNumbers true) (checkForSlips true) (checkForUnsavedProjects true) (cmdDotEnabled true) (collapseWindowsInPlace false) (confirmFirstUseOfStyle true) (conversionMethodsAtFileOut false) (debugHaloHandle true) (debugPrintSpaceLog false) (debugShowDamage false) (decorateBrowserButtons true) (diffsInChangeList true) (diffsWithPrettyPrint false) (dismissAllOnOptionClose false) (fastDragWindowForMorphic true) (fullScreenLeavesDeskMargins true) (higherPerformance false) (honorDesktopCmdKeys true) (logDebuggerStackToFile true) (menuKeyboardControl false) (modalColorPickers true) (mouseOverForKeyboardFocus false) (navigatorOnLeftEdge true) (optionalButtons true) (passwordsOnPublish false) (personalizedWorldMenu true) (postscriptStoredAsEPS false) (projectViewsInWindows true) (projectZoom true) (projectsSentToDisk false) (readDocumentAtStartup true) (restartAlsoProceeds false) (reverseWindowStagger true) (roundedMenuCorners true) (scrollBarsNarrow false) (scrollBarsOnRight true) (securityChecksEnabled false) (showBoundsInHalo false) (showDirectionForSketches false) (showDirectionHandles false) (showProjectNavigator false) (showSecurityStatus true) (signProjectFiles true) (smartUpdating true) (startInUntrustedDirectory false) (systemWindowEmbedOK false) (timeStampsInMenuTitles true) (turnOffPowerManager false) (twentyFourHourFileStamps true) (uniqueNamesInHalos false) (useButtonPropertiesToFire false) (warnAboutInsecureContent true) (warnIfNoChangesFile true) (warnIfNoSourcesFile true))
" Preferences defaultValueTableForCurrentRelease do: [:pair | (Preferences preferenceAt: pair first ifAbsent: [nil]) ifNotNilDo: [:pref | pref defaultValue: (pair last == true)]]. Preferences chooseInitialSettings. "! !
!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/10/2023 16:09'! disableProgrammerFacilities "Warning: do not call this lightly!! It disables all access to menus, debuggers, halos. There is no guaranteed return from this, which is to say, you cannot necessarily reenable these things once they are disabled -- you can only use whatever the UI of the current project affords, and you cannot even snapshot -- you can only quit.
You can completely reverse the work of this method by calling the dual Preferences method enableProgrammerFacilities, provided you have left yourself leeway to bring about a call to that method.
To set up a system that will come up in such a state, you have to request the snapshot in the same breath as you disable the programmer facilities. To do this, put the following line into the 'do' menu and then evaluate it from that 'do' menu:
Preferences disableProgrammerFacilities.
You will be prompted for a new image name under which to save the resulting image."
Beeper beep. (self confirm: 'CAUTION!!!! This is a drastic step!! Do you really want to do this?') ifFalse: [Beeper beep. ^self inform: 'whew!!']. self disable: #cmdDotEnabled. "No user-interrupt-into-debugger" self compileAccessorForPreferenceNamed: #cmdGesturesEnabled value: false. "No halos, etc." self compileAccessorForPreferenceNamed: #cmdKeysInText value: false. "No user commands invokable via cmd-key combos in text editor" self disable: #warnIfNoSourcesFile. self disable: #warnIfNoChangesFile. Smalltalk saveAs! !
!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/10/2023 16:09'! enableProgrammerFacilities "Meant as a one-touch recovery from a #disableProgrammerFacilities call." "Preferences enableProgrammerFacilities"
self enable: #cmdDotEnabled. self compileAccessorForPreferenceNamed: #cmdGesturesEnabled value: true. self compileAccessorForPreferenceNamed: #cmdKeysInText value: true. self enable: #warnIfNoSourcesFile. self enable: #warnIfNoChangesFile.! !
!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/15/2023 13:50'! setNotificationParametersForStandardPreferences "Set up the notification parameters for the standard preferences that require need them. When adding new Preferences that require use of the notification mechanism, users declare the notifcation info as part of the call that adds the preference, or afterwards -- the two relevant methods for doing that are: Preferences.addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: and Preference changeInformee:changeSelector:"
"Preferences setNotificationParametersForStandardPreferences"
#( (annotationPanes annotationPanesChanged) (optionalButtons optionalButtonsChanged) (smartUpdating smartUpdatingChanged) ) do:
[:pair | | aPreference | aPreference := self preferenceAt: pair first. aPreference changeInformee: self changeSelector: pair second]! !
!Preferences class methodsFor: 'initialization - save/load' stamp: 'mt 3/7/2023 13:27'! loadPreferencesFrom: aFile
| stream params dict desktopColor patternsToIgnore | patternsToIgnore := #('*updateMapName' '*defaultUpdateURL'). stream := ReferenceStream fileNamed: aFile. params := stream next. self assert: (params isKindOf: IdentityDictionary). params removeKey: #PersonalDictionaryOfPreferences. dict := stream next. self assert: (dict isKindOf: IdentityDictionary). desktopColor := stream next. stream close. dict rehash. "See http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217817...." dict keys reject: [:key | patternsToIgnore anySatisfy: [:pattern | pattern match: key]] thenDo: [:key | | value | value := dict at: key. (self preferenceAt: key ifAbsent: [nil]) ifNotNil: [:pref | [pref preferenceValue: value preferenceValue] on: Deprecation do: [ : err | "Ignore preferences which may not be supported anymore."]]]. params keysAndValuesDo: [ :key :value | self setParameter: key to: value ]. Project current world fillStyle: desktopColor.! !
!ProgressMorph methodsFor: 'private' stamp: 'mt 8/11/2023 14:00'! fontOfPointSize: size ^ (TextConstants at: Preferences standardDefaultTextFont familyName ifAbsent: [TextStyle default]) fontOfPointSize: size! !
!Project methodsFor: 'displaying' stamp: 'mt 8/28/2023 14:08'! displayZoom: entering "Show the project transition when entering a new project" | newDisplay vanishingPoint | "Show animated zoom to new display" newDisplay := self imageForm. entering ifTrue: [vanishingPoint := Sensor cursorPoint] ifFalse: [vanishingPoint := self viewLocFor: CurrentProject]. Display zoomIn: entering orOutTo: newDisplay at: 0@0 vanishingPoint: vanishingPoint.! !
!Project methodsFor: 'file in/out' stamp: 'mt 8/16/2023 15:46'! exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: noInteraction
| exportChangeSet |
"An experimental version to fileout a changeSet first so that a project can contain its own classes"
"Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target image. Name it .extSeg. Player classes are included automatically." exportChangeSet := nil. (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [ (noInteraction or: [self confirm: 'Would you like to include all the changes in the change set as part of this publishing operation?' translated]) ifTrue: [ exportChangeSet := changeSet ]. ].
^ self exportSegmentWithChangeSet: exportChangeSet fileName: aFileName directory: aDirectory withoutInteraction: noInteraction! !
!Project methodsFor: 'menu messages' stamp: 'mt 8/23/2023 13:50'! validateProjectNameIfOK: aBlock
| details |
details := world valueOfProperty: #ProjectDetails. details ifNotNil: ["ensure project info matches real project name" details at: 'projectname' put: self name. ]. self doWeWantToRename ifTrue: [self notify: 'Please choose another name!!'] ifFalse: [aBlock value: details]! !
!MorphicProject methodsFor: 'initialize' stamp: 'mt 3/8/2023 09:42'! initialize "Initialize a new Morphic Project"
super initialize.
world := PasteUpMorph newWorldForProject: self. self setWorldBackground: true.
Locale switchToID: CurrentProject localeID.
Project current isMorphic ifTrue: [ "Only trigger tool builders etc. if we are already in the same kind of project because there is global state that cannot yet be configured in a dynamic scope such as 'ToolBuilder default'." self assureMainDockingBarPresenceMatchesPreference].! !
!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/16/2023 17:02'! exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory withoutInteraction: noInteraction "Store my project out on the disk as an *exported* ImageSegment. All outPointers will be in a form that can be resolved in the target image. Name it .extSeg. Whatdo we do about subProjects, especially if they are out as local image segments? Force them to come in? Player classes are included automatically."
| is str ans revertSeg roots holder collector fd mgr stacks |
"Files out a changeSet first, so that a project can contain its own classes" world ifNil: [^ false].
ScrapBook default emptyScrapBook. world currentHand pasteBuffer: nil. "don't write the paste buffer." world currentHand mouseOverHandler initialize. "forget about any references here" "Display checkCurrentHandForObjectToPaste." Command initialize. world clearCommandHistory. world fullReleaseCachedState. world cleanseStepList. world localFlapTabs size = world flapTabs size ifFalse: [noInteraction ifTrue: [^ false]. self error: 'Still holding onto Global flaps']. world releaseSqueakPages. holder := Project allProjects. "force them in to outPointers, where DiskProxys are made"
"Just export me, not my previous version" revertSeg := self parameterAt: #revertToMe. self removeParameter: #revertToMe.
roots := OrderedCollection new. roots add: self; add: world; add: transcript; add: aChangeSetOrNil; add: thumbnail; add: world activeHand.
roots := roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail"
fd := aDirectory directoryNamed: self resourceDirectoryName. fd assureExistence. "Clean up resource references before writing out" mgr := self resourceManager. self resourceManager: nil. ResourceCollector current: ResourceCollector new. ResourceCollector current localDirectory: fd. ResourceCollector current baseUrl: self resourceUrl. ResourceCollector current initializeFrom: mgr. ProgressNotification signal: '2:findingResources' extra: '(collecting resources...)' translated. "Must activate old world because this is run at #armsLength. Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent will not be captured correctly if referenced from blocks or user code." world becomeActiveDuring: [is := ImageSegment copySmartRootsExport: roots asArray. "old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)"]. self resourceManager: mgr. collector := ResourceCollector current. ResourceCollector current: nil. ProgressNotification signal: '2:foundResources' extra: ''. is state = #tooBig ifTrue: [collector replaceAll. ^ false].
str := ''. "considered legal to save a project that has never been entered" (is outPointers includes: world) ifTrue: [str := str, '\Project''s own world is not in the segment.' translated withCRs]. str isEmpty ifFalse: [ans := Project uiManager chooseOptionFrom: {'Do not write file' translated. 'Write file anyway' translated. 'Debug' translated} title: str. ans = 1 ifTrue: [revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. ^ false]. ans = 3 ifTrue: [collector replaceAll. self halt: 'Segment not written' translated]]. stacks := is findStacks.
is writeForExportWithSources: aFileName inDirectory: fd changeSet: aChangeSetOrNil. SecurityManager default signFile: aFileName directory: fd. "Compress all files and update check sums" collector forgetObsolete. self storeResourceList: collector in: fd. self storeHtmlPageIn: fd. self storeManifestFileIn: fd. self writeStackText: stacks in: fd registerIn: collector. "local proj.005.myStack.t" self compressFilesIn: fd to: aFileName in: aDirectory resources: collector. "also deletes the resource directory" "Now update everything that we know about" mgr updateResourcesFrom: collector.
revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. world flapTabs do: [:ft | (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. ^ true ! !
!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/11/2023 16:06'! storeSegment "Store my project out on the disk as an ImageSegment. Keep the outPointers in memory. Name it .seg. *** Caller must be holding (Project alInstances) to keep subprojects from going out. ***"
| currentWorld is sizeHint | currentWorld := Project current world. (currentWorld == world) ifTrue: [^ false]. "self inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ false]. "already done" world ifNil: [^ false].
ScrapBook default emptyScrapBook. currentWorld checkCurrentHandForObjectToPaste. world releaseSqueakPages. sizeHint := self projectParameters at: #segmentSize ifAbsent: [0].
is := ImageSegment copyFromRootsLocalFileFor: {world} sizeHint: sizeHint.
is state = #tooBig ifTrue: [^ false]. is segment size < 2000 ifTrue: ["debugging" Transcript show: self name, ' only ', is segment size printString, 'bytes in Segment.'; cr]. self projectParameters at: #segmentSize put: is segment size. is extract; writeToFile: self name. ^ true! !
!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/11/2023 16:08'! storeSegmentNoFile "For testing. Make an ImageSegment. Keep the outPointers in memory. Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)"
| is currentWorld | currentWorld := Project current world. (currentWorld == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ self]. "already done" world ifNil: [^ self].
"Do this on project enter" ScrapBook default emptyScrapBook. currentWorld checkCurrentHandForObjectToPaste2.
is := ImageSegment copyFromRootsLocalFileFor: {world} sizeHint: 0.
is segment size < 800 ifTrue: ["debugging" Transcript show: self name, ' did not get enough objects'; cr. ^ Beeper beep].
is extract. "is instVarAt: 2 put: is segment clone." "different memory"! !
!MorphicProject methodsFor: 'enter' stamp: 'mt 3/10/2023 15:01'! enterAsActiveSubprojectWithin: enclosingWorld
"Install my ChangeSet, Transcript, and scheduled views as current globals.
If returningFlag is true, we will return to the project from whence the current project was entered; don't change its previousProject link in this case. If saveForRevert is true, save the ImageSegment of the project being left. If revertFlag is true, make stubs for the world of the project being left. If revertWithoutAsking is true in the project being left, then always revert."
"Experimental mods for initial multi-project work: 1. assume in morphic (this eliminated need for ) 2. assume is false (usual case) - removed 3. assume is false 4. assume is false - now auto false n.u. 5. no zooming 6. assume false - could be dangerous here 7. assume no isolation problems (isolationHead ==) 8. no closing scripts "
self isCurrentProject ifTrue: [^ self].
"guards ifNotNil: [ guards := guards reject: [:obj | obj isNil]. guards do: [:obj | obj okayToEnterProject ifFalse: [^ self]] ]."
"CurrentProject makeThumbnail." "--> Display bestGuessOfCurrentWorld triggerClosingScripts." CurrentProject displayDepth: Display depth.
displayDepth == nil ifTrue: [displayDepth := Display depth]. "Display newDepthNoRestore: displayDepth."
"(world hasProperty: #letTheMusicPlay) ifTrue: [world removeProperty: #letTheMusicPlay] ifFalse: [Smalltalk at: #ScorePlayer ifPresent: [:playerClass | playerClass allSubInstancesDo: [:player | player pause]]]."
"returningFlag ifTrue: [nextProject := CurrentProject] ifFalse: [previousProject := CurrentProject]."
"CurrentProject saveState." "CurrentProject := self." "Smalltalk newChanges: changeSet." "TranscriptStream newTranscript: transcript." "Sensor flushKeyboard." "recorderOrNil := Display pauseMorphicEventRecorder."
"Display changeMorphicWorldTo: world." "Signifies Morphic" world installAsActiveSubprojectIn: enclosingWorld titled: self name.
"recorderOrNil ifNotNil: [recorderOrNil resumeIn: world]." self removeParameter: #exportState. "self spawnNewProcessAndTerminateOld: true"! !
!MorphicProject methodsFor: 'enter' stamp: 'mt 8/28/2023 14:28'! finalEnterActions: leavingProject "Perform the final actions necessary as the receiver project is entered"
| navigator armsLengthCmd navType thingsToUnhibernate | "If this image has a global World variable, update it now" Smalltalk globals at: #World ifPresent: [ :w | Smalltalk globals at: #World put: world ]. world install. world transferRemoteServerFrom: leavingProject world. "(revertFlag | saveForRevert | forceRevert) ifFalse: [ (Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [ self storeSomeSegment]]."
"Transfer event recorder to me." leavingProject isMorphic ifTrue: [ leavingProject world pauseEventRecorder ifNotNil: [:rec | rec resumeIn: world]].
self initializeMenus. self projectParameters at: #projectsToBeDeleted ifPresent: [ :projectsToBeDeleted | self removeParameter: #projectsToBeDeleted. projectsToBeDeleted do: [:each | each delete]].
Locale switchToID: self localeID.
thingsToUnhibernate := world valueOfProperty: #thingsToUnhibernate ifAbsent: [#()]. thingsToUnhibernate do: [:each | each unhibernate]. world removeProperty: #thingsToUnhibernate.
navType := ProjectNavigationMorph preferredNavigator. armsLengthCmd := self parameterAt: #armsLengthCmd ifAbsent: [nil]. navigator := world findA: navType. (Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator and: [navigator isNil]]) ifTrue: [(navigator := navType new) bottomLeft: world bottomLeft; openInWorld: world]. navigator notNil & armsLengthCmd notNil ifTrue: [navigator color: Color lightBlue]. armsLengthCmd notNil ifTrue: [self flapsSuppressed: true. navigator ifNotNil: [navigator visible: false]. armsLengthCmd openInWorld: world]. world reformulateUpdatingMenus. self assureMainDockingBarPresenceMatchesPreference.
world repairEmbeddedWorlds.! !
!MorphicProject methodsFor: 'enter' stamp: 'mt 8/11/2023 16:05'! finalExitActions: enteringProject
"Pause sound players, subject to preference settings" (world hasProperty: #letTheMusicPlay) ifTrue: [world removeProperty: #letTheMusicPlay] ifFalse: [SoundService stop].
world sleep.
(world findA: ProjectNavigationMorph) ifNotNil: [:navigator | navigator retractIfAppropriate].
self clearGlobalState. EventSensor default flushEvents.
self world submorphsDo: [:ea | ea removeProperty: #dropShadow].! !
!MorphicProject methodsFor: 'release' stamp: 'mt 3/10/2023 15:10'! prepareForDelete "The window in which the project is housed is about to deleted. Perform any necessary actions to prepare for deletion."
Smalltalk at: #WonderlandCameraMorph ifPresent:[:aClass | world submorphs do: "special release for wonderlands" [:m | (m isKindOf: aClass) and: [m getWonderland release]]]. ! !
!MorphicProject methodsFor: 'language' stamp: 'mt 3/10/2023 16:07'! chooseNaturalLanguage "Put up a menu allowing the user to choose the natural language for the project"
| aMenu availableLanguages | aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'choose language' translated. aMenu lastItem setBalloonText: 'This controls the human language in which tiles should be viewed. It is potentially extensible to be a true localization mechanism, but initially it only works in the classic tile scripting system. Each project has its own private language choice' translated. aMenu addStayUpItem.
availableLanguages := NaturalLanguageTranslator availableLanguageLocaleIDs sorted:[:x :y | x displayName < y displayName].
availableLanguages do: [:localeID | aMenu addUpdating: #stringForLanguageNameIs: target: Locale selector: #switchToID: argumentList: {localeID}]. aMenu popUpInWorld
"Project current chooseNaturalLanguage"! !
!MorphicProject methodsFor: 'language' stamp: 'mt 8/4/2023 15:20'! updateLocaleDependents "Set the project's natural language as indicated"
Flaps disableGlobalFlaps: false. Flaps enableGlobalFlaps.
(self isFlapIDEnabled: 'Navigator' translated) ifFalse: [Flaps enableDisableGlobalFlapWithID: 'Navigator' translated].
ScrapBook default emptyScrapBook. MenuIcons initializeTranslations.
super updateLocaleDependents.
"self setFlaps. self setPaletteFor: aLanguageSymbol."! !
!MorphicProject methodsFor: 'scheduling & debugging' stamp: 'mt 3/10/2023 11:26'! interruptCleanUpFor: interruptedProcess "Clean up things in case of a process interrupt."
super interruptCleanUpFor: interruptedProcess.
self uiProcess == interruptedProcess ifTrue: [ self currentHand ifNotNil: [:hand | hand interrupted]. world removeProperty: #shouldDisplayWorld].! !
!Project class methodsFor: 'utilities' stamp: 'mt 3/15/2023 14:01'! removeAll: projects "Project removeAll: (Project allSubInstances copyWithout: Project current)"
AllProjects := nil. Smalltalk garbageCollect.
ProjectHistory currentHistory initialize. projects do: [:project | Project deletingProject: project].
Smalltalk garbageCollect. Smalltalk garbageCollect. ! !
!ProjectLauncher methodsFor: 'initialization' stamp: 'mt 8/4/2023 13:21'! setupFlaps "Only called when the image has been launched in a browser. If I am requested to show all flaps, then if flaps already exist, use them as is, else set up to show the default set of standard flaps."
whichFlaps = 'all' ifTrue: [Flaps sharedFlapsAllowed ifFalse: [Flaps enableGlobalFlaps]]! !
!ProjectLauncher methodsFor: 'running' stamp: 'mt 8/4/2023 13:23'! startUp | scriptName loader isUrl | self setupFlaps. Smalltalk firstArgMightBeDocument ifTrue: [scriptName := Smalltalk documentPath. scriptName := scriptName convertFromSystemString. scriptName isEmpty ifFalse: ["figure out if script name is a URL by itself" isUrl := (scriptName asLowercase beginsWith: 'http://') or: [(scriptName asLowercase beginsWith: 'file://') or: [scriptName asLowercase beginsWith: 'ftp://']]. isUrl ifFalse: [| encodedPath pathTokens | "Allow for ../dir/scriptName arguments" pathTokens := scriptName splitBy: FileDirectory slash. pathTokens := pathTokens collect: [:s | s encodeForHTTP]. encodedPath := pathTokens reduce: [:acc :each | acc , FileDirectory slash , each]. scriptName := (FileDirectory default uri resolveRelativeURI: encodedPath) asString]]] ifFalse: [scriptName := '']. scriptName isEmptyOrNil ifTrue: [^ self]. loader := CodeLoader new. loader loadSourceFiles: (Array with: scriptName). (scriptName asLowercase endsWith: '.pr') ifTrue: [self installProjectFrom: loader] ifFalse: [loader installSourceFiles]! !
!ProjectLoading class methodsFor: 'accessing' stamp: 'mt 8/28/2023 13:46'! projectStreamFromArchive: archive | ext prFiles entry unzipped | ext := FileDirectory dot, Project projectExtension. prFiles := archive members select:[:any| any fileName endsWith: ext]. prFiles isEmpty ifTrue: ['']. entry := prFiles first. unzipped := MultiByteBinaryOrTextStream on: (ByteArray new: entry uncompressedSize). entry extractTo: unzipped. ^unzipped reset! !
!ProjectLoading class methodsFor: 'loading' stamp: 'mt 8/28/2023 13:51'! openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView clearOriginFlag: clearOriginFlag "Reconstitute a Morph from the selected file, presumed to represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world."
| morphOrList archive mgr substituteFont numberOfFontSubstitutes resultArray anObject project manifests dict | ProgressNotification signal: '0.2'. archive := preStream isZipArchive ifTrue:[ZipArchive new readFrom: preStream] ifFalse:[nil]. archive ifNotNil:[ manifests := (archive membersMatching: '*manifest'). (manifests size = 1 and: [((dict := self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression']) ifTrue: [^ self notify: 'S-Expression format projects not supported. Use Squeak 6.0 or older.']].
morphOrList := self morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive. morphOrList ifNil: [^ self]. ProgressNotification signal: '0.4'. resultArray := self fileInName: aFileName archive: archive morphOrList: morphOrList. anObject := resultArray first. numberOfFontSubstitutes := resultArray second. substituteFont := resultArray third. mgr := resultArray fourth. preStream close. ProgressNotification signal: '0.7'. "the hard part is over" (anObject isKindOf: ImageSegment) ifTrue: [ project := self loadImageSegment: anObject fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr. project noteManifestDetailsIn: dict. clearOriginFlag ifTrue: [project forgetExistingURL]. ProgressNotification signal: '0.8'. ^ project ifNil: [self inform: 'No project found in this file' translated] ifNotNil: [ProjectEntryNotification signal: project]]. Project current openViewAndEnter: anObject! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'tak 9/3/2006 11:00'! checkSecurity: aFileName preStream: preStream projStream: projStream "Answer true if passed" | trusted enterRestricted | trusted := SecurityManager default positionToSecureContentsOf: projStream. trusted ifFalse: [enterRestricted := (preStream isTypeHTTP or: [aFileName isNil]) ifTrue: [Preferences securityChecksEnabled] ifFalse: [Preferences standaloneSecurityChecksEnabled]. enterRestricted ifTrue: [SecurityManager default enterRestrictedMode ifFalse: [preStream close. ^ false]]]. ^ true ! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'mt 8/28/2023 13:49'! fileInName: aFileName archive: archive morphOrList: morphOrList | baseChangeSet substituteFont numberOfFontSubstitutes exceptions anObject mgr | ResourceCollector current: ResourceCollector new. baseChangeSet := ChangeSet current. self useTempChangeSet. "named zzTemp" "The actual reading happens here" substituteFont := Preferences standardDefaultTextFont copy. numberOfFontSubstitutes := 0. exceptions := Set new. [[anObject := morphOrList fileInObjectAndCodeForProject] on: MissingFont do: [ :ex | exceptions add: ex. numberOfFontSubstitutes := numberOfFontSubstitutes + 1. ex resume: substituteFont ]] ensure: [ ChangeSet newChanges: baseChangeSet]. mgr := ResourceManager new initializeFrom: ResourceCollector current. mgr fixJISX0208Resource. mgr registerUnloadedResources. archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName]. ResourceCollector current: nil. ^ {anObject. numberOfFontSubstitutes. substituteFont. mgr}! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'mt 8/28/2023 14:00'! loadImageSegment: morphOrList fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr
| proj projectsToBeDeleted f | (f := (Flaps globalFlapTabWithID: 'Navigator' translated)) ifNotNil: [f hideFlap]. proj := morphOrList arrayOfRoots detect: [:mm | mm isKindOf: Project] ifNone: [^ nil]. proj projectParameterAt: #substitutedFont put: substituteFont. proj projectParameters at: #MultiSymbolInWrongPlace put: false. "Yoshiki did not put MultiSymbols into outPointers in older images!!" morphOrList arrayOfRoots do: [:obj | obj fixUponLoad: proj seg: morphOrList "imageSegment"]. (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [ morphOrList arrayOfRoots do: [:obj | (obj isKindOf: HashedCollection ) ifTrue: [obj rehash]]].
proj resourceManager: mgr. "proj versionFrom: preStream." proj lastDirectory: aDirectoryOrNil. proj setParent: Project current. projectsToBeDeleted := OrderedCollection new. existingView == #none ifFalse: [ self makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted]. ChangeSet allChangeSets add: proj changeSet. Project current projectParameters at: #deleteWhenEnteringNewProject ifPresent: [ :ignored | projectsToBeDeleted add: Project current. Project current removeParameter: #deleteWhenEnteringNewProject. ]. projectsToBeDeleted isEmpty ifFalse: [ proj projectParameters at: #projectsToBeDeleted put: projectsToBeDeleted. ]. ^ proj! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'pre 8/22/2019 15:03'! makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted existingView ifNil: [ Smalltalk isMorphic ifTrue: [ proj createViewIfAppropriate. ] ifFalse: [ ChangeSet allChangeSets add: proj changeSet. Project current openProject: proj. "Note: in MVC we get no further than the above" ]. ] ifNotNil: [ (existingView project isKindOf: DiskProxy) ifFalse: [ existingView project changeSet name: ChangeSet defaultName. projectsToBeDeleted add: existingView project. ]. (existingView owner isSystemWindow) ifTrue: [ existingView owner model: proj ]. existingView project: proj. ]. ! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'cmm 10/23/2013 16:24'! morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive "Answer morphOrList or nil if problem happened" | projStream localDir morphOrList | projStream := archive ifNil: [preStream] ifNotNil: [self projectStreamFromArchive: archive]. (self checkSecurity: aFileName preStream: preStream projStream: projStream) ifFalse: [^nil]. localDir := Project squeakletDirectory. aFileName ifNotNil: [ (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName ~= localDir pathName]) ifTrue: [ localDir deleteFileNamed: aFileName. (localDir fileNamed: aFileName) binary nextPutAll: preStream remainingContents; close. ]. ]. morphOrList := projStream asUnZippedStream. preStream sleep. "if ftp, let the connection close" ^ morphOrList ! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'yo 2/5/2008 17:15'! parseManifest: aString
| dict line index key value aStream | aStream := aString readStream. dict := Dictionary new. [(line := aStream nextLine) notNil] whileTrue: [ index := line indexOf: $:. index > 0 ifTrue: [ key := line copyFrom: 1 to: index - 1. value := (line copyFrom: index + 1 to: line size) withBlanksTrimmed. dict at: key put: value. ]. ]. ^ dict.! !
!ProjectNavigationMorph methodsFor: 'buttons' stamp: 'mt 8/10/2023 11:32'! makeTheAdvancedButtons
^{ self buttonNewProject. self buttonShare. self buttonPrev. self buttonNext. self buttonPublish. self buttonNewer. self buttonTell. self buttonFind. self buttonFullScreen. "self buttonFlaps." }, ( Preferences includeSoundControlInNavigator ifTrue: [{self buttonSound}] ifFalse: [#()] ), { self buttonLanguage. self buttonUndo. self buttonQuit. } ! !
!ProjectNavigationMorph methodsFor: 'buttons' stamp: 'mt 8/28/2023 14:27'! makeTheButtons ^ self makeTheAdvancedButtons! !
!ProjectNavigationMorph methodsFor: 'the actions' stamp: 'mt 8/23/2023 13:51'! doPublishButtonMenuEvent: evt
| selection | selection := UIManager default chooseFrom: { 'Publish' translated. 'Publish As...' translated. 'Publish to Different Server' translated. } values: { [self publishProject]. [self publishProjectAs]. [self publishDifferent]. } title: 'Publish options' translated. selection ifNil: [^self]. selection value.
! !
!ProjectSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'! addControls "Add the control bar at the top of the tool."
| b r partsBinButton newButton aWrapper | newButton := ImageMorph new image: (Project current makeThumbnail scaledToSize: 48@36). newButton on: #mouseDown send: #insertNewProject: to: self. newButton setBalloonText: 'Make a new Project' translated. (partsBinButton := UpdatingThreePhaseButtonMorph checkBox) target: self; actionSelector: #togglePartsBinStatus; arguments: #(); getSelector: #getPartsBinStatus. (r := AlignmentMorph newRow) color: Color transparent; borderWidth: 0; layoutInset: 0; cellInset: 10@0; wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. b := SimpleButtonMorph new target: self; color: self defaultColor darker; borderColor: Color black. r addMorphBack: (self wrapperFor: (b label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort)). b := SimpleButtonMorph new target: self; color: self defaultColor darker; borderColor: Color black. r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #delete)); addTransparentSpacerOfSize: 8 @ 0; addMorphBack: (self wrapperFor: (newButton)); addTransparentSpacerOfSize: 8 @ 0.
aWrapper := AlignmentMorph newRow beTransparent. aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0. aWrapper addMorphBack: (self wrapperFor: partsBinButton); addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated font: Preferences standardButtonFont) lock). r addMorphBack: aWrapper.
self addMorphFront: r. ! !
!ProjectSorterMorph methodsFor: 'initialization' stamp: 'mt 8/14/2023 16:22'! initialize "initialize the state of the receiver"
super initialize. self useRoundedCorners. pageHolder useRoundedCorners; borderWidth: 0; color: (Form gridFormOrigin: 0 @ 0 grid: 32 @ 32 background: Color white line: Color blue muchLighter)! !
!ProjectSorterMorph methodsFor: 'controls' stamp: 'mt 8/23/2023 13:50'! insertNewProject: evt
[MorphicProject openViewOn: nil] on: ProjectViewOpenNotification do: [ :ex | ex resume: false].! !
!RecordingControlsMorph methodsFor: 'button commands' stamp: 'mt 8/22/2023 15:53'! makeTile "Make a tile representing my sound. Get a sound-name from the user by which the sound is to be known."
| tile | recorder verifyExistenceOfRecordedSound ifFalse: [^ self]. recorder pause. tile := InterimSoundMorph new sound: (SampledSound samples: recorder condensedSamples samplingRate: recorder samplingRate). tile bounds: tile fullBounds. tile openInHand! !
!ReferenceMorph methodsFor: 'menu' stamp: 'mt 8/14/2023 17:24'! changeTabGraphic
| aGraphicalMenu | aGraphicalMenu := GraphicalMenu new initializeFor: submorphs first withForms: submorphs first reasonableForms coexist: true. self primaryHand attachMorph: aGraphicalMenu.! !
!ReferenceMorph methodsFor: 'menu' stamp: 'mt 7/31/2023 11:15'! graphicalMorphForTab | formToUse | formToUse := self valueOfProperty: #priorGraphic ifAbsent: [MenuIcons formAtKey: 'squeakyMouse']. ^ SketchMorph withForm: formToUse! !
!FlapTab methodsFor: 'show & hide' stamp: 'mt 8/4/2023 14:02'! showFlap "Open the flap up"
| thicknessToUse flapOwner |
"19 sept 2000 - going for all paste ups <- raa note" flapOwner := self pasteUpMorph. self referentThickness <= 0 ifTrue: [thicknessToUse := lastReferentThickness ifNil: [100]. self orientation == #horizontal ifTrue: [referent height: thicknessToUse] ifFalse: [referent width: thicknessToUse]]. inboard ifTrue: [self stickOntoReferent]. "makes referent my owner, and positions me accordingly" referent pasteUpMorph == flapOwner ifFalse: [flapOwner accommodateFlap: self. "Make room if needed" flapOwner addMorphFront: referent. flapOwner startSteppingSubmorphsOf: referent. self positionReferent]. inboard ifFalse: [self adjustPositionVisAVisFlap]. flapShowing := true.
self pasteUpMorph hideFlapsOtherThan: self ifClingingTo: edgeToAdhereTo.
flapOwner bringTopmostsToFront! !
!ReferenceStream class methodsFor: 'accessing' stamp: 'mt 8/28/2023 15:43'! versionCode "Answer a number representing the 'version' of the ReferenceStream facility; this is stashed at the beginning of ReferenceStreams, as a secondary versioning mechanism (the primary one is the fileTypeCode). At present, it serves for information only, and is not checked for compatibility at reload time, but could in future be used to branch to variant code. "
" 1 = original version 1992" " 2 = HyperSqueak. PathFromHome used for Objs outside the tree. SqueakSupport SysLibrary for shared globals like Display and StrikeFonts. File has version number, class structure, then an IncomingObjects manager. 8/16/96 tk. Extended to SmartRefStream. class structure also keeps superclasse chain. Does analysis on structure to see when translation methods are needed. Embedable in file-ins. (factored out HyperSqueak support) Feb-May 97 tk" " 3 = Reference objects are byte offsets relative to the start of the object portion of the file. Rectangles with values -2048 to 2047 are encoded compactly." " 4 = If UniClasses have class instance variables, append their values in the form (#Class43 (val1 val2 vla3)). An array of those. Can still read version 3." ^ 4! !
!ReleaseBuilder class methodsFor: 'scripts' stamp: 'mt 8/16/2023 15:43'! configureTools "Initialize well-known tools and other resources."
FileList initialize. FileServices initialize. "register file reader services" RealEstateAgent standardSize: 650@425. SMLoaderPlus setDefaultFilters: #(filterSafelyAvailable).
"Default applications and tools." SystemBrowser default: TreeBrowser. MailSender default: nil. SoundService default: BaseSoundSystem. ToolSet default: StandardToolSet. WebBrowser default: nil. ! !
!ReleaseBuilder class methodsFor: 'scripts - support' stamp: 'mt 3/7/2023 14:05'! discardUserObjects
"Remove the classes." MorphicModel removeUninstantiatedSubclassesSilently.
"Clean-up environment hick-ups." Environment default allClassesDo: [:cls | (cls isUniClass and: [cls environment ~~ Environment default]) ifTrue: [Environment default forgetClass: cls logged: false]]. Environment default declarations select: [:binding | (binding value isBehavior and: [binding value isUniClass]) and: [binding value isObsolete]] thenDo: [:binding | SystemOrganization removeElement: binding key. Environment default removeKey: binding key].
"Remove auto-generated accessors. See Preferences." (MCPackage named: 'Autogenerated') unload.
"Remove empty categories for user objects. See Object class >> #categoryForUniclasses." SystemOrganizer cleanUp: true.! !
!RemoteHandMorph methodsFor: 'event handling' stamp: 'mt 8/28/2023 14:35'! transmitEvent: aMorphicEvent "Transmit the given event to all remote connections." | firstEvt | self readyToTransmit ifFalse: [^ self]. self lastEventTransmitted = aMorphicEvent ifTrue: [^ self]. sendBuffer ifNil: [sendBuffer := WriteStream on: (String new: 10000)]. sendBuffer nextPutAll: aMorphicEvent storeString; cr. self lastEventTransmitted: aMorphicEvent.
sendSocket isConnected ifTrue:[ sendState = #opening ifTrue: [ "connection established; disable TCP delays on sends" sendSocket setOption: 'TCP_NODELAY' value: true. "send worldExtent as first event" firstEvt := MorphicUnknownEvent new setType: #worldBounds argument: self worldBounds extent. sendSocket sendData: firstEvt storeString, (String with: Character cr). Transcript show: 'Connection established with remote WorldMorph at '; show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. sendState := #connected]. sendSocket sendData: sendBuffer contents. ] ifFalse: [ owner primaryHand removeEventListener: self. sendState = #connected ifTrue: [ "other end has closed; close our end" Transcript show: 'Closing connection with remote WorldMorph at '; show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. sendSocket close. sendState := #closing]].
sendBuffer reset. ! !
!ResourceCollector methodsFor: 'initialize' stamp: 'mt 3/15/2023 14:07'! initialize originalMap := IdentityDictionary new. stubMap := IdentityDictionary new. locatorMap := IdentityDictionary new. internalStubs := IdentityDictionary new.! !
!ScreenController methodsFor: 'nested menus' stamp: 'mt 7/31/2023 11:19'! helpMenu "Answer the help menu to be put up as a screen submenu"
^ SelectionMenu labelList: #( 'about this system...' 'update code from server' 'preferences...'
'command-key help' 'font size summary' 'useful expressions' 'view graphical imports' 'standard graphics library'),
(Array with: (SoundService soundEnablingString)) ,
#( 'set author initials...' 'vm statistics' 'space left') lines: #(1 4 6 11) selections: #( aboutThisSystem absorbUpdatesFromServer editPreferences openCommandKeyHelp fontSizeSummary openStandardWorkspace viewImageImports soundOnOrOff setAuthorInitials vmStatistics garbageCollect) " ScreenController new helpMenu startUp "! !
!ScrollableField methodsFor: 'menu' stamp: 'mt 8/11/2023 14:47'! getMenu: shiftKeyState ^ shiftKeyState not ifTrue: [TextEditor yellowButtonMenu] ifFalse: [TextEditor shiftedYellowButtonMenu]! !
!SelectionMorph methodsFor: 'halo commands' stamp: 'mt 3/10/2023 15:26'! duplicate "Make a duplicate of the receiver and havbe the hand grab it"
selectedItems := self duplicateMorphCollection: selectedItems. selectedItems reverseDo: [:m | (owner ifNil: [self currentWorld]) addMorph: m]. dupLoc := self position. self currentHand grabMorph: self.! !
!ServerDirectory class methodsFor: 'school support' stamp: 'mt 3/10/2023 11:45'! projectDefaultDirectory
^ FileDirectory default! !
!ServerDirectory class methodsFor: 'server prefs' stamp: 'mt 8/16/2023 15:50'! parseServerEntryFrom: stream
| server type directory entries serverName |
entries := ExternalSettings parseServerEntryArgsFrom: stream.
serverName := entries at: 'name' ifAbsent: [^nil]. directory := entries at: 'directory' ifAbsent: [^nil]. type := entries at: 'type' ifAbsent: [^nil]. type = 'file' ifTrue: [ server := self determineLocalServerDirectory: directory. entries at: 'userListUrl' ifPresent:[:value | "Ignore" ]. entries at: 'baseFolderSpec' ifPresent:[:value | "Ignore" ]. ^self addLocalProjectDirectory: server]. type = 'bss' ifTrue: [server := SuperSwikiServer new type: #http]. type = 'http' ifTrue: [server := HTTPServerDirectory new type: #ftp]. type = 'ftp' ifTrue: [server := ServerDirectory new type: #ftp].
server directory: directory. entries at: 'server' ifPresent: [:value | server server: value]. entries at: 'user' ifPresent: [:value | server user: value]. entries at: 'group' ifPresent: [:value | server groupName: value]. entries at: 'passwdseq' ifPresent: [:value | server passwordSequence: value asNumber]. entries at: 'url' ifPresent: [:value | server altUrl: value]. entries at: 'loaderUrl' ifPresent: [:value | server loaderUrl: value]. entries at: 'acceptsUploads' ifPresent: [:value | server acceptsUploads: value asLowercase = 'true']. entries at: 'userListUrl' ifPresent:[:value | "Ignore" ]. entries at: 'encodingName' ifPresent:[:value | server encodingName: value]. ServerDirectory addServer: server named: serverName. ! !
!IconicButton methodsFor: 'initialization' stamp: 'mt 3/7/2023 15:06'! initializeWithThumbnail: aThumbnail withLabel: aLabel andColor: aColor andSend: aSelector to: aReceiver "Initialize the receiver to show aThumbnail on its face, giving it the label supplied and arranging for it, when the button goes down on it, to obtain a new morph by sending the supplied selector to the supplied receiver"
| labeledItem nonTranslucent | nonTranslucent := aColor asNontranslucentColor. labeledItem := AlignmentMorph newColumn. labeledItem color: nonTranslucent. labeledItem borderWidth: 0. labeledItem layoutInset: 4@0; cellPositioning: #center. labeledItem addMorph: aThumbnail. labeledItem addMorphBack: (Morph new extent: (4@4)) beTransparent. labeledItem addMorphBack: (TextMorph new backgroundColor: nonTranslucent; contentsAsIs: aLabel; beAllFont: Preferences standardButtonFont; centered).
self beTransparent; labelGraphic: ((labeledItem imageForm: 32 backgroundColor: nonTranslucent forRectangle: labeledItem fullBounds) replaceColor: nonTranslucent withColor: Color transparent); borderWidth: 0; target: aReceiver; actionSelector: #launchPartVia:label:; arguments: {aSelector. aLabel}; actWhen: #buttonDown.
self stationarySetup.! !
!IconicButton methodsFor: 'initialization' stamp: 'mt 3/15/2023 14:10'! setDefaultLabel self labelGraphic: (MenuIcons formAtKey: 'squeakyMouse')! !
!HaloMorph methodsFor: 'handles' stamp: 'mt 3/15/2023 13:34'! addDismissHandle: handleSpec "Add the dismiss handle according to the spec, unless my target resists dismissal"
| dismissHandle | target okayToAddDismissHandle ifTrue: [dismissHandle := self addHandle: handleSpec on: #mouseDown send: #mouseDownInDimissHandle:with: to: self. dismissHandle on: #mouseUp send: #maybeDismiss:with: to: self. dismissHandle on: #mouseDown send: #setDismissColor:with: to: self. dismissHandle on: #mouseMove send: #setDismissColor:with: to: self] ! !
!HaloMorph methodsFor: 'handles' stamp: 'mt 8/11/2023 14:24'! addDupHandle: haloSpec "Add the halo that offers duplication"
self addHandle: haloSpec on: #mouseDown send: #doDup:with: to: self
! !
!HaloMorph methodsFor: 'handles' stamp: 'sw 1/26/2000 16:16'! addHelpHandle: haloSpec target balloonText ifNotNil: [(self addHandle: haloSpec on: #mouseDown send: #mouseDownOnHelpHandle: to: innerTarget) on: #mouseUp send: #deleteBalloon to: innerTarget] ! !
!HaloMorph methodsFor: 'handles' stamp: 'RAA 3/15/2001 11:24'! addRecolorHandle: haloSpec "Add a recolor handle to the receiver, if appropriate"
| recolorHandle |
"since this halo now opens a more general properties panel, allow it in all cases" "innerTarget canSetColor ifTrue:"
recolorHandle := self addHandle: haloSpec on: #mouseUp send: #doRecolor:with: to: self. recolorHandle on: #mouseUp send: #doRecolor:with: to: self
! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/15/2023 14:10'! addGraphicalHandleFrom: formKey at: aPoint "Add the supplied form as a graphical handle centered at the given point. Return the handle." | handle aForm | aForm := (MenuIcons formAtKey: formKey) ifNil: [MenuIcons formAtKey: #SolidMenu]. handle := ImageMorph new image: aForm; bounds: (Rectangle center: aPoint extent: aForm extent). handle borderColor: Color black; borderWidth: 2. handle wantsYellowButtonMenu: false. self addMorph: handle. handle on: #mouseUp send: #endInteraction: to: self. ^ handle ! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/15/2023 14:10'! createHandleAt: aPoint color: aColor iconName: iconName | bou handle | bou := Rectangle center: aPoint extent: self handleSize asPoint. Preferences alternateHandlesLook ifTrue: [handle := RectangleMorph newBounds: bou color: aColor. handle useRoundedCorners. self setColor: aColor toHandle: handle] ifFalse: [handle := EllipseMorph newBounds: bou color: aColor]. handle borderWidth: 0; wantsYellowButtonMenu: false. "" iconName isNil ifFalse: [| form | form := MenuIcons formAtKey: iconName. form isNil ifFalse: [| image | image := ImageMorph new. image image: form scaleIconToDisplay. image color: aColor makeForegroundColor. image lock. handle addMorphCentered: image]]. "" ^ handle! !
!HaloMorph methodsFor: 'private' stamp: 'mt 2/19/2021 14:52'! doGrow: evt with: growHandle "Called while the mouse is down in the grow handle"
| newExtent extentToUse scale | evt hand obtainHalo: self. newExtent := (target pointFromWorld: evt cursorPoint - positionOffset) - target topLeft. evt shiftPressed ifTrue: [ scale := (newExtent x / (originalExtent x max: 1)) min: (newExtent y / (originalExtent y max: 1)). newExtent := (originalExtent x * scale) asInteger @ (originalExtent y * scale) asInteger ]. (newExtent x < 1 or: [newExtent y < 1 ]) ifTrue: [^ self]. target renderedMorph setExtentFromHalo: (extentToUse := newExtent). growHandle position: evt cursorPoint - (growHandle extent // 2). self layoutChanged. (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | "Update the final extent" cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: extentToUse] ! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/8/2023 11:29'! doRecolor: evt with: aHandle "The mouse went down in the 'recolor' halo handle. Allow the user to change the color of the innerTarget"
evt hand obtainHalo: self. (aHandle containsPoint: evt cursorPoint) ifFalse: "only do it if mouse still in handle on mouse up" [self delete. target addHalo: evt] ifTrue: [innerTarget changeColor. self showingDirectionHandles ifTrue: [self addHandles]]! !
!HaloMorph methodsFor: 'private' stamp: 'ul 12/12/2009 14:11'! doRot: evt with: rotHandle "Update the rotation of my target if it is rotatable. Keep the relevant command object up to date."
| degrees | evt hand obtainHalo: self. degrees := (evt cursorPoint - (target pointInWorld: target referencePosition)) degrees. degrees := degrees - angleOffset degrees. degrees := degrees detentBy: 10.0 atMultiplesOf: 90.0 snap: false. degrees = 0.0 ifTrue: [self setColor: Color lightBlue toHandle: rotHandle] ifFalse: [self setColor: Color blue toHandle: rotHandle]. rotHandle submorphsDo: [:m | m color: rotHandle color makeForegroundColor]. self removeAllHandlesBut: rotHandle. self showingDirectionHandles ifFalse: [self showDirectionHandles: true addHandles: false]. self addDirectionHandles.
target rotationDegrees: degrees.
rotHandle position: evt cursorPoint - (rotHandle extent // 2). (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | "Update the final rotation" cmd redoTarget: target renderedMorph selector: #heading: argument: degrees]. self layoutChanged! !
!HaloMorph methodsFor: 'private' stamp: 'ul 12/12/2009 14:11'! doScale: evt with: scaleHandle "Update the scale of my target if it is scalable." | newHandlePos colorToUse | evt hand obtainHalo: self. newHandlePos := evt cursorPoint - (scaleHandle extent // 2). target scaleToMatch: newHandlePos. colorToUse := target scale = 1.0 ifTrue: [Color yellow] ifFalse: [Color orange]. self setColor: colorToUse toHandle: scaleHandle. scaleHandle submorphsDo: [:m | m color: colorToUse makeForegroundColor]. scaleHandle position: newHandlePos. self layoutChanged.
(self valueOfProperty: #commandInProgress) ifNotNil:[:cmd | "Update the final extent" cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent ]. ! !
!HaloMorph methodsFor: 'private' stamp: 'mt 8/11/2023 17:00'! endInteraction: event "Clean up after a user interaction with the a halo control"
| m | (target isInWorld not or: [owner isNil]) ifTrue: [^self]. [target isFlexMorph and: [target hasNoScaleOrRotation]] whileTrue: [m := target firstSubmorph. target removeFlexShell. target := m]. self restoreTargetDropShadows. target changedViaHalo: self. self isInWorld ifTrue: ["make sure handles show in front, even if flex shell added" self flag: #tofix. "mt: Try to avoid deleting and re-creating an event handler (here: the handle) while handling the event." self comeToFront. self addHandles. event hand newMouseFocus: self]. (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | self rememberCommand: cmd. self removeProperty: #commandInProgress].! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/10/2023 15:08'! maybeDismiss: evt with: dismissHandle "Ask hand to dismiss my target if mouse comes up in it."
evt hand obtainHalo: self. (dismissHandle containsPoint: evt cursorPoint) ifFalse: [self delete. target addHalo: evt] ifTrue: [target resistsRemoval ifTrue: [(Project uiManager chooseOptionFrom: {'Yes' translated. 'Um, no, let me reconsider' translated.} title: 'Really throw this away?' translated) = 1 ifFalse: [^ self]]. evt hand removeHalo. self delete. target dismissViaHalo].! !
!HaloMorph methodsFor: 'private' stamp: 'HenrikSperreJohansen 1/21/2011 18:34'! mouseDownInDimissHandle: evt with: dismissHandle evt hand obtainHalo: self. SoundService soundEnabled ifTrue: [TrashCanMorph playMouseEnterSound]. self removeAllHandlesBut: dismissHandle. self setColor: Color darkGray toHandle: dismissHandle. ! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/10/2023 13:51'! startDrag: evt with: dragHandle "Drag my target without removing it from its owner."
self obtainHaloForEvent: evt andRemoveAllHandlesBut: dragHandle. target aboutToBeDraggedViaHalo. positionOffset := dragHandle center - (target point: target position in: owner).! !
!HaloMorph methodsFor: 'private' stamp: 'ct 2/28/2022 16:24'! startGrow: evt with: growHandle "Initialize resizing of my target. Launch a command representing it, to support Undo"
| botRt | self obtainHaloForEvent: evt andRemoveAllHandlesBut: growHandle. self backupAndHideTargetDropShadows. target aboutToBeGrownViaHalo.
botRt := target point: target bottomRight in: owner. positionOffset := (self world viewBox containsPoint: botRt) ifTrue: [evt cursorPoint - botRt] ifFalse: [0@0].
self setProperty: #commandInProgress toValue: (Command new cmdWording: ('resize ' translated, target nameForUndoWording); undoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent).
originalExtent := target extent! !
!HaloMorph methodsFor: 'private' stamp: 'mt 8/11/2023 16:59'! startRot: evt with: rotHandle "Initialize rotation of my target if it is rotatable. Launch a command object to represent the action"
self obtainHaloForEvent: evt andRemoveAllHandlesBut: rotHandle. self backupAndHideTargetDropShadows. target aboutToBeRotatedViaHalo. target isFlexMorph ifFalse: [target addFlexShellIfNecessary]. growingOrRotating := true.
self removeAllHandlesBut: rotHandle. "remove all other handles" angleOffset := evt cursorPoint - (target pointInWorld: target referencePosition). angleOffset := Point r: angleOffset r degrees: angleOffset degrees - target rotationDegrees. self setProperty: #commandInProgress toValue: (Command new cmdWording: ('rotate ' translated, target nameForUndoWording); undoTarget: target renderedMorph selector: #heading: argument: target rotationDegrees)
! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/7/2023 16:46'! startScale: evt with: scaleHandle "Initialize scaling of my target."
self obtainHaloForEvent: evt andRemoveAllHandlesBut: scaleHandle. self backupAndHideTargetDropShadows. target aboutToBeScaledViaHalo. target isFlexMorph ifFalse: [target addFlexShellIfNecessary]. growingOrRotating := true. positionOffset := 0@0. originalExtent := target extent ! !
!HaloMorph methodsFor: 'pop up' stamp: 'mt 3/15/2023 13:40'! popUpFor: morph at: position hand: hand
super popUpFor: morph at: position hand: hand.
self startStepping.! !
!HaloMorph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/15/2023 13:40'! delete "Delete the halo. Tell the target that it no longer has the halo; accept any pending edits to the name; and then actually delete myself"
self acceptNameEdit. super delete.! !
!SketchEditorMorph methodsFor: 'initialization' stamp: 'mt 8/10/2023 15:28'! initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph."
| paintBoxBounds worldBounds | self setProperty: #recipientPasteUp toValue: aPasteUpMorph.
paintBoxBounds := self world paintBox bounds. worldBounds := self world bounds.
self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: ((boundsToUse topRight extent: paintBoxBounds extent) translatedToBeWithin: worldBounds) topLeft. ! !
!SketchEditorMorph methodsFor: 'start & finish' stamp: 'mt 8/10/2023 15:34'! cancelOutOfPainting "The user requested to back out of a painting session without saving"
self deleteSelfAndSubordinates. emptyPicBlock ifNotNil: [emptyPicBlock value]. "note no args to block!!" hostView ifNotNil: [hostView changed]. ^ nil! !
!SketchEditorMorph methodsFor: 'start & finish' stamp: 'mt 8/10/2023 15:34'! deliverPainting: result evt: evt "Done painting. May come from resume, or from original call. Execute user's post painting instructions in the block. Always use this standard one. 4/21/97 tk"
| newBox newForm ans | palette ifNotNil: "nil happens" [palette setAction: #paint: evt: evt]. "Get out of odd modes" "rot := palette getRotations." "rotate with heading, or turn to and fro" "palette setRotation: #normal." result == #cancel ifTrue: [ ans := Project uiManager chooseOptionFrom: { 'throw it away' translated. 'keep painting it' translated} title: 'Do you really want to throw away what you just painted?' translated. ^ ans = 1 ifTrue: [self cancelOutOfPainting] ifFalse: [nil]]. "cancelled out of cancelling."
"hostView rotationStyle: rot." "rotate with heading, or turn to and fro" newBox := paintingForm rectangleEnclosingPixelsNotOfColor: Color transparent. registrationPoint ifNotNil: [registrationPoint := registrationPoint - newBox origin]. "relative to newForm origin" newForm := Form extent: newBox extent depth: paintingForm depth. newForm copyBits: newBox from: paintingForm at: 0@0 clippingBox: newForm boundingBox rule: Form over fillColor: nil. newForm isAllWhite ifTrue: [(self valueOfProperty: #background) == true ifFalse: [^ self cancelOutOfPainting]].
newForm fixAlpha. "so alpha channel stays intact for 32bpp"
self delete. "so won't find me again" dimForm ifNotNil: [dimForm delete]. newPicBlock value: newForm value: (newBox copy translateBy: bounds origin).! !
!SketchMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:15'! setNewFormFrom: formOrNil "Set the receiver's form as indicated. If nil is provided, then a default form will be used"
formOrNil ifNotNil: [^ self form: formOrNil]. self form: (Form extent: 16@16 depth: 32) ! !
!SketchMorph methodsFor: 'initialization' stamp: 'mt 3/15/2023 14:10'! initialize "initialize the state of the receiver" ^ self initializeWith: (MenuIcons formAtKey: 'Painting') deepCopy! !
!SketchMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 14:30'! addPaintingItemsTo: aMenu hand: aHandMorph | subMenu movies | subMenu := MenuMorph new defaultTarget: self. subMenu add: 'repaint' translated action: #editDrawing; add: 'set rotation center' translated action: #setRotationCenter; add: 'reset forward-direction' translated action: #resetForwardDirection; add: 'set rotation style' translated action: #setRotationStyle; add: 'erase pixels of color' translated action: #erasePixelsUsing:; add: 'recolor pixels of color' translated action: #recolorPixelsUsing:; add: 'reduce color palette' translated action: #reduceColorPalette:; add: 'detect edges' translated action: #edgeDetect; add: 'sharpen' translated action: #sharpen; add: 'blur' translated action: #blur; add: 'emboss' translated action: #emboss; add: 'add a border around this shape...' translated action: #addBorderToShape:. movies := (self world rootMorphsAt: aHandMorph targetPoint) select: [:m | (m isKindOf: MovieMorph) or: [m isSketchMorph]]. movies size > 1 ifTrue: [subMenu add: 'insert into movie' translated action: #insertIntoMovie:]. aMenu add: 'painting...' translated subMenu: subMenu! !
!SketchMorph methodsFor: 'menu' stamp: 'mt 8/10/2023 15:33'! editDrawingIn: aPasteUpMorph forBackground: forBackground "Edit an existing sketch."
| w bnds sketchEditor rotCenter aWorld aPaintBox | self world assureNotPaintingElse: [^self]. w := aPasteUpMorph world.
w displayWorld. self visible: false. bnds := forBackground ifTrue: [aPasteUpMorph boundsInWorld] ifFalse: [self boundsInWorld expandBy: 60 @ 60]. sketchEditor := SketchEditorMorph new. forBackground ifTrue: [sketchEditor setProperty: #background toValue: true]. w addMorphFront: sketchEditor. sketchEditor initializeFor: self inBounds: bnds pasteUpMorph: aPasteUpMorph. rotCenter := self rotationCenter.
sketchEditor afterNewPicDo: [:aForm :aRect | | tfx | self visible: true. self form: aForm. tfx := aPasteUpMorph transformFrom: aPasteUpMorph world. self topRendererOrSelf position: (tfx globalPointToLocal: aRect origin). self rotationStyle: sketchEditor rotationStyle. self forwardDirection: sketchEditor forwardDirection. (rotCenter notNil and: [(rotCenter = (0.5 @ 0.5)) not]) ifTrue: [self rotationCenter: rotCenter]. aWorld := self world. (aPaintBox := aWorld paintBox) ifNotNil: [aPaintBox delete].
forBackground ifTrue: [self goBehind "shouldn't be necessary"]] ifNoBits: []! !
!SketchMorph methodsFor: 'menus' stamp: 'mt 3/10/2023 16:09'! addToggleItemsToHaloMenu: aCustomMenu "Add toggle-items to the halo menu" super addToggleItemsToHaloMenu: aCustomMenu. aCustomMenu addUpdating: #useInterpolationString target: self action: #toggleInterpolation.! !
!SketchMorph methodsFor: 'menus' stamp: 'mt 8/11/2023 13:42'! chooseNewGraphic "Allow the user to choose a different form for her form-based morph"
| aGraphicalMenu | aGraphicalMenu := GraphicalMenu new initializeFor: self withForms: self reasonableForms coexist: true. self primaryHand attachMorph: aGraphicalMenu.! !
!SketchMorph methodsFor: 'parts bin' stamp: 'mt 3/15/2023 14:10'! initializeToStandAlone super initializeToStandAlone. self initializeWith: (MenuIcons formAtKey: 'Painting') deepCopy
! !
!ColorPickerMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 14:01'! mouseUp: evt
self stopStepping. sourceHand := nil. deleteOnMouseUp ifTrue: [self delete]. self updateTargetColor. ! !
!ColorPickerMorph methodsFor: 'menu' stamp: 'mt 3/15/2023 14:09'! pickUpColorFor: aMorph "Show the eyedropper cursor, and modally track the mouse through a mouse-down and mouse-up cycle"
| aHand localPt | aHand := aMorph ifNil: [self activeHand] ifNotNil: [aMorph activeHand]. aHand ifNil: [aHand := self currentHand]. self addToWorld: aHand world near: (aMorph ifNil: [aHand world]) fullBounds. self owner ifNil: [^ self].
aHand showTemporaryCursor: (MenuIcons formAtKey: #Eyedropper) hotSpotOffset: 2@14. "<<<< the form was changed a bit??"
self updateContinuously: false. [Sensor anyButtonPressed] whileFalse: [self trackColorUnderMouse]. self deleteAllBalloons.
localPt := Sensor cursorPoint - self topLeft. self inhibitDragging ifFalse: [ (DragBox containsPoint: localPt) ifTrue: ["Click or drag the drag-dot means to anchor as a modeless picker" ^ self anchorAndRunModeless: aHand]. ]. (clickedTranslucency := TransparentBox containsPoint: localPt) ifTrue: [selectedColor := originalColor].
self updateContinuously: true. [Sensor anyButtonPressed] whileTrue: [self updateTargetColorWith: self indicateColorUnderMouse]. aHand newMouseFocus: nil; showTemporaryCursor: nil; flushEvents. self delete.
! !
!ColorPickerMorph methodsFor: 'private' stamp: 'mt 3/10/2023 14:01'! pickColorAt: aGlobalPoint
| alpha selfRelativePoint pickedColor | clickedTranslucency ifNil: [clickedTranslucency := false]. selfRelativePoint := (self globalPointToLocal: aGlobalPoint) - self topLeft. (FeedbackBox containsPoint: selfRelativePoint) ifTrue: [^ self]. (RevertBox containsPoint: selfRelativePoint) ifTrue: [^ self updateColor: originalColor feedbackColor: originalColor].
"check for transparent color and update using appropriate feedback color " (TransparentBox containsPoint: selfRelativePoint) ifTrue: [clickedTranslucency ifFalse: [^ self]. "Can't wander into translucency control" alpha := (selfRelativePoint x - TransparentBox left - 10) asFloat / (TransparentBox width - 20) min: 1.0 max: 0.0. "(alpha roundTo: 0.01) printString , ' ' displayAt: 0@0." " -- debug" self updateColor: (selectedColor alpha: alpha) feedbackColor: (selectedColor alpha: alpha). ^ self].
"pick up color, either inside or outside this world" clickedTranslucency ifTrue: [^ self]. "Can't wander out of translucency control" self locationIndicator visible: false. self refreshWorld. pickedColor := Display colorAt: aGlobalPoint. self locationIndicator visible: true. self refreshWorld. self updateColor: ( (selectedColor isColor and: [selectedColor isTranslucentColor]) ifTrue: [pickedColor alpha: selectedColor alpha] ifFalse: [pickedColor] ) feedbackColor: pickedColor! !
!SmartRefStream methodsFor: 'read write' stamp: 'mt 3/10/2023 15:43'! initKnownRenames renamed at: #FlasherMorph put: #Flasher; at: #AlansTextPlusMorph put: #TextPlusMorph; at: #Project put: #MorphicProject; at: #InputSensor put: #EventSensor; yourself! !
!SmartRefStream methodsFor: 'read write' stamp: 'mt 3/10/2023 15:43'! restoreClassInstVars "Install the values of the class instance variables of UniClasses."
self flag: #todo. "mt: See EToys in Squeak 6.0 and before."! !
!SqueakToolsDebuggerHelp class methodsFor: 'pages' stamp: 'mt 3/15/2023 14:10'! showForm: aSymbol | form contents | form := MenuIcons formAtKey: aSymbol. contents := (String with: Character cr) asText, (Text string: ' ' attribute: (TextFontReference toFont: (FormSetFont new fromFormArray: (Array with: form) asciiStart: Character space asInteger ascent: form height))), (String with: Character cr) asText. ^contents! !
!SystemWindow methodsFor: 'initialization' stamp: 'mt 3/10/2023 16:09'! initializeLabelArea "Initialize the label area (titlebar) for the window."
labelString ifNil: [labelString := 'Untitled Window']. label := StringMorph new contents: labelString; font: (self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont]); yourself. "Add collapse box so #labelHeight will work" collapseBox := self createCollapseBox. stripes := Array with: (RectangleMorph newBounds: bounds) with: (RectangleMorph newBounds: bounds). "see extent:" self addLabelArea. self setLabelWidgetAllowance. self addCloseBox. self class moveMenuButtonRight ifTrue: [self addLabel. self addMenuControl] ifFalse: [self addMenuControl. self addLabel]. self addExpandBox. labelArea addMorphBack: collapseBox. self setFramesForLabelArea. ! !
!SystemWindow methodsFor: 'menu' stamp: 'dao 10/1/2004 12:57'! fullScreenMaximumExtent "Zoom Window to Full World size with possible DeskMargins obey the maximum extent rules"
| left right possibleBounds | left := right := 0. self paneMorphs do: [:pane | ((pane isKindOf: ScrollPane) and: [pane retractableScrollBar]) ifTrue: [pane scrollBarOnLeft ifTrue: [left := left max: pane scrollBarThickness] ifFalse: [right := right max: pane scrollBarThickness]]]. possibleBounds := self worldBounds insetBy: (left @ 0 corner: right @ 0).
self maximumExtent ifNotNil: [possibleBounds := possibleBounds origin extent: ( self maximumExtent min: ( possibleBounds extent ))]. ((Flaps sharedFlapsAllowed and: [Project current flapsSuppressed not]) or: [Preferences fullScreenLeavesDeskMargins]) ifTrue: [possibleBounds := possibleBounds insetBy: 22]. self bounds: possibleBounds! !
!SystemWindow methodsFor: 'menu' stamp: 'mt 3/10/2023 14:27'! sendToBack | aWorld nextWindow | aWorld := self world. nextWindow := aWorld submorphs detect: [:m | (m isSystemWindow) and: [m ~~ self]] ifNone: [^self]. nextWindow beKeyWindow. aWorld addMorphBack: self! !
!SystemWindow methodsFor: 'open/close' stamp: 'mt 3/7/2023 17:40'! delete | thisWorld | self mustNotClose ifTrue: [^self]. model okToClose ifFalse: [^self]. thisWorld := self world.
self activeHand removeKeyboardListener: self.
self isFlexed ifTrue: [owner delete] ifFalse: [super delete]. model windowIsClosing; release. model := nil.
SystemWindow noteTopWindowIn: thisWorld! !
!SystemWindow methodsFor: 'stepping' stamp: 'mt 8/28/2023 15:51'! stepAt: millisecondClockValue "If the receiver is not collapsed, step it, after first stepping the model."
(isCollapsed not or: [self wantsStepsWhenCollapsed]) ifTrue: [model ifNotNil: [model stepAt: millisecondClockValue in: self]. super stepAt: millisecondClockValue]
"Since this method ends up calling step, the model-stepping logic should not be duplicated there."! !
!SystemWindow methodsFor: 'stepping' stamp: 'mt 3/10/2023 15:01'! wantsSteps "Return true if the model wants its view to be stepped. For an open system window, we give the model to offer an opinion"
self isPartsDonor ifTrue: [^ false]. ^ isCollapsed not and: [model wantsStepsIn: self]! !
!SystemWindow methodsFor: 'top window' stamp: 'mt 3/7/2023 17:40'! comeToFront
"Modal windows: Walk along the modal owner chain, the bring all to top." self modalOwner ifNotNil: [:mo | mo isSystemWindow ifTrue: [ ^ mo modalOwner ifNil: [mo comeToFrontModally] ifNotNil: [:omo | omo comeToFront]]]. self modalChild ifNotNil: [^ self comeToFrontModally].
"Now show me." super comeToFront.
"Label should be visible to interact with." self assureLabelAreaVisible.! !
!TabMorph methodsFor: 'tabs' stamp: 'mt 8/4/2023 13:36'! tabSelected "Called when the receiver is hit. First, bulletproof against someone having taken the structure apart. My own action basically requires that my grand-owner be a TabbedPalette" (owner isKindOf: IndexTabs) ifFalse: [^ Beeper beep]. (owner owner isKindOf: TabbedPalette) ifFalse: [^ Beeper beep]. owner owner selectTab: self! !
!TabSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'! addControls "Add the control bar at the top of the tool."
| b r | b := SimpleButtonMorph new target: self; borderColor: Color black. r := AlignmentMorph newRow. r color: b color; borderWidth: 0; layoutInset: 0. r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. r wrapCentering: #topLeft. r addMorphBack: (b label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort). b := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (b label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #cancelSort). self addMorphFront: r. ! !
!TabSorterMorph methodsFor: 'initialization' stamp: 'mt 8/16/2023 13:52'! initialize "Initialize the receiver."
super initialize. self removeAllMorphs.
self extent: 300@100. pageHolder := PasteUpMorph new. pageHolder vResizeToFit: true; autoLineLayout: true. pageHolder extent: self extent - self borderWidth. pageHolder padding: 8. pageHolder cursor: 0. self addControls. self addMorphBack: pageHolder! !
!TabbedPalette methodsFor: 'palette menu' stamp: 'mt 8/4/2023 13:42'! addBookMenuItemsTo: aCustomMenu hand: aHandMorph aCustomMenu add: 'add palette menu' translated action: #addMenuTab.! !
!TabbedPalette methodsFor: 'palette menu' stamp: 'mt 7/31/2023 11:20'! addMenuTab "Add the menu tab. This is ancient code, not much in the spirit of anything current"
| aMenu aTab aGraphic sk | aMenu := MenuMorph new defaultTarget: self. aMenu stayUp: true. "aMenu add: 'clear' translated action: #showNoPalette." aMenu add: 'sort tabs' translated action: #sortTabs:. aMenu add: 'choose new colors for tabs' translated action: #recolorTabs. aMenu setProperty: #paletteMenu toValue: true. "aMenu add: 'make me the Standard palette' translated action: #becomeStandardPalette." aTab := self addTabForBook: aMenu withBalloonText: 'a menu of palette-related controls' translated. aTab highlightColor: tabsMorph highlightColor; regularColor: tabsMorph regularColor. tabsMorph laySubpartsOutInOneRow; layoutChanged.
aGraphic := MenuIcons formAtKey: 'TinyMenu'. aGraphic ifNotNil: [aTab removeAllMorphs. aTab addMorph: (sk := Project current world drawingClass withForm: aGraphic). sk position: aTab position. sk lock. aTab fitContents]. self layoutChanged! !
!TabbedPalette methodsFor: 'user-interface' stamp: 'mt 8/4/2023 13:36'! selectTab: aTab | currentPalette morphToInstall oldTab aSketchEditor | oldTab := tabsMorph highlightedTab. (oldTab notNil and: [(morphToInstall := oldTab morphToInstall) isKindOf: PaintBoxMorph]) ifTrue: [(aSketchEditor := self world submorphOfClass: SketchEditorMorph) ifNotNil: [aSketchEditor cancelOutOfPainting]. morphToInstall delete].
tabsMorph selectTab: aTab. morphToInstall := aTab morphToInstall.
(morphToInstall isKindOf: PaintBoxMorph) "special case, maybe generalize this need?" ifFalse: [self goToPageMorph: morphToInstall] ifTrue: [self showNoPaletteAndHighlightTab: aTab. self world addMorphFront: morphToInstall. morphToInstall position: ((self left max: 90) "room for the pop-out-to-left panel" @ (tabsMorph bottom))].
(currentPalette := self currentPalette) ifNotNil: [currentPalette layoutChanged]. self snapToEdgeIfAppropriate! !
!TabbedPalette class methodsFor: 'scripting' stamp: 'mt 7/31/2023 11:20'! authoringPrototype | aTabbedPalette aBook aTab | aTabbedPalette := self new markAsPartsDonor. aTabbedPalette pageSize: 200 @ 300. aTabbedPalette tabsMorph highlightColor: Color red regularColor: Color blue. aTabbedPalette addMenuTab.
aBook := BookMorph new setNameTo: 'one'; pageSize: aTabbedPalette pageSize. aBook color: Color blue muchLighter. aBook removeEverything; insertPage; showPageControls. aBook currentPage addMorphBack: (Project current world drawingClass withForm: (MenuIcons formAtKey: 'squeakyMouse')). aTab := aTabbedPalette addTabForBook: aBook.
aBook := BookMorph new setNameTo: 'two'; pageSize: aTabbedPalette pageSize. aBook color: Color red muchLighter. aBook removeEverything; insertPage; showPageControls. aBook currentPage addMorphBack: CurveMorph authoringPrototype. aTabbedPalette addTabForBook: aBook.
aTabbedPalette selectTab: aTab.
aTabbedPalette beSticky. aTabbedPalette tabsMorph hResizing: #spaceFill. ^ aTabbedPalette! !
!TextMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 16:10'! getMenu: shiftKeyState ^ shiftKeyState not ifTrue: [TextEditor yellowButtonMenu] ifFalse: [TextEditor shiftedYellowButtonMenu]! !
!TextMorph methodsFor: 'events-processing' stamp: 'mt 3/15/2023 13:46'! handleKeystroke: anEvent "Overwritten to support tab-among-fields preference."
anEvent wasHandled ifTrue:[^self]. (self handlesKeyboard: anEvent) ifFalse: [^ self]. (anEvent hand keyboardFocus ~~ self and: [self handlesKeyboardOnlyOnFocus]) ifTrue: [^ self].
^ super handleKeystroke: anEvent! !
!TextMorph methodsFor: 'menu' stamp: 'mt 8/16/2023 13:54'! addCustomMenuItems: aCustomMenu hand: aHandMorph | outer | super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu add: 'text properties...' translated action: #changeTextColor. aCustomMenu addUpdating: #autoFitString target: self action: #autoFitOnOff. aCustomMenu addUpdating: #wrapString target: self action: #wrapOnOff. aCustomMenu add: 'text margins...' translated action: #changeMargins:. aCustomMenu add: 'add predecessor' translated action: #addPredecessor:. aCustomMenu add: 'add successor' translated action: #addSuccessor:.
outer := self owner. outer ifNotNil: [ outer isLineMorph ifTrue: [container isNil ifTrue: [Smalltalk at: #TextOnCurveContainer ifPresent: [:ignored | aCustomMenu add: 'follow owner''s curve' translated action: #followCurve]] ifFalse: [aCustomMenu add: 'reverse direction' translated action: #reverseCurveDirection. aCustomMenu add: 'set baseline' translated action: #setCurveBaseline:]] ifFalse: [self fillsOwner ifFalse: [aCustomMenu add: 'fill owner''s shape' translated action: #fillingOnOff] ifTrue: [aCustomMenu add: 'rectangular bounds' translated action: #fillingOnOff]. self avoidsOcclusions ifFalse: [aCustomMenu add: 'avoid occlusions' translated action: #occlusionsOnOff] ifTrue: [aCustomMenu add: 'ignore occlusions' translated action: #occlusionsOnOff]]]. ! !
!TextMorph class methodsFor: 'parts bin' stamp: 'mt 3/7/2023 15:07'! fancyPrototype
| t | t := self authoringPrototype. t autoFit: false; extent: 150@75. t borderWidth: 2; margins: 4@0; useRoundedCorners. "Why not rounded?" "fancy font, shadow, rounded" t fontName: Preferences standardButtonFont familyName size: 18; textColor: Color blue; fillStyle: Color lightBrown. t addDropShadow.
"Strangeness here in order to avoid two offset copies of the default contents when operating in an mvc project before cursor enters the morphic window" t paragraph. ^ t! !
!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 8/11/2023 15:18'! extrasMenuOn: aDockingBar
aDockingBar addItem: [ :it| it contents: 'Extras' translated; addSubMenu: [:menu| menu addItem:[:item| item contents: 'Recover Changes' translated; help: 'Recover changes after a crash' translated; icon: MenuIcons smallDocumentClockIcon; target: ChangeList; selector: #browseRecentLog]. menu addItem:[:item| item contents: 'Recover Method Versions' translated; help: 'Recover versions of deleted methods' translated; target: ChangeList; selector: #browseMethodVersions]. menu addLine. menu addItem:[:item| item contents: 'Themes & Colors' translated; subMenuUpdater: self selector: #themesAndWindowColorsOn: ]. menu addItem:[:item| item contents: 'Scale Factor' translated; subMenuUpdater: self selector: #scaleFactorsOn:]. menu addItem:[:item| item contents: 'Language' translated; subMenuUpdater: self selector: #languageTranslatorsOn: ]. menu addItem:[:item| item contents: 'Set Author Initials' translated; help: 'Sets the author initials' translated; icon: MenuIcons smallUserQuestionIcon; target: Utilities; selector: #setAuthorInitials]. menu addItem:[:item| item contents: 'Restore Display (r)' translated; help: 'Redraws the entire display' translated; target: Project current; selector: #restoreDisplay]. menu addItem:[:item| item contents: 'Rebuild Menus' translated; help: 'Rebuilds the menu bar' translated; target: TheWorldMainDockingBar; selector: #updateInstances]. menu addLine. menu addItem:[:item| item contents: 'Start Profiler' translated; help: 'Starts the profiler' translated; icon: MenuIcons smallTimerIcon; target: self; selector: #startMessageTally]. menu addItem:[:item| item contents: 'Collect Garbage' translated; help: 'Run the garbage collector and report space usage' translated; target: Utilities; selector: #garbageCollectAndReport]. menu addItem:[:item| item contents: 'Purge Undo Records' translated; help: 'Save space by removing all the undo information remembered in all projects' translated; target: CommandHistory; selector: #resetAllHistory]. menu addItem:[:item| item contents: 'VM statistics' translated; help: 'Virtual Machine information' translated; target: self; selector: #vmStatistics]. menu addLine. menu addItem:[:item| item contents: 'Graphical Imports' translated; help: 'View the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList' translated; target: (Imports default); selector: #viewImages]. menu addItem:[:item| item contents: 'Browse My Changes' translated; help: 'Browse all of my changes since the last time #condenseSources was run.' translated; target: SystemNavigation new; selector: #browseMyChanges]. ] ]! !
!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 3/7/2023 13:59'! themesAndWindowColorsOn: menu | themes | menu addItem:[:item| item contents: 'Fonts' translated; subMenuUpdater: Preferences selector: #fontConfigurationMenu:; icon: MenuIcons smallFontsIcon]. menu addLine. menu addItem:[:item| item contents: (Model useColorfulWindows ifTrue: [''] ifFalse: ['']), 'Colorful Windows' translated; target: self; selector: #toggleColorfulWindows]. menu addItem:[:item| item contents: (SystemWindow gradientWindow not ifTrue: [''] ifFalse: ['']), 'Flat Widget Look' translated; target: self; selector: #toggleGradients]. menu addLine. menu addItem:[:item | item contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow]) ifTrue: [''] ifFalse: ['']), 'Soft Shadows' translated; target: self; selector: #toggleSoftShadows]. menu addItem:[:item | item contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow not]) ifTrue: [''] ifFalse: ['']), 'Hard Shadows' translated; target: self; selector: #toggleHardShadows]. menu addLine. menu addItem:[:item | item contents: (SystemWindow roundedWindowCorners ifTrue: [''] ifFalse: ['']), 'Rounded Window/Dialog Look' translated; target: self; selector: #toggleRoundedWindowLook]. menu addItem:[:item | item contents: (PluggableButtonMorph roundedButtonCorners ifTrue: [''] ifFalse: ['']), 'Rounded Button/Scrollbar/Menu Look' translated; target: self; selector: #toggleRoundedButtonLook]. menu addLine. themes := UserInterfaceTheme allThemes asArray sort: #name ascending. themes := themes select: [ :each | each isGenuine]. themes ifEmpty: [ menu addItem: [ :item | item contents: '(No UI themes found.)' translated; isEnabled: false ] ]. themes do: [ :each | menu addItem: [ :item | item contents: (UserInterfaceTheme current name = each name ifTrue: [''] ifFalse: ['']), each name; target: each; selector: #applyScaled ] ]. menu addLine; add: 'Restore UI theme background' translated target: self selector: #restoreThemeBackground; add: 'Reset all UI themes' translated target: self selector: #resetAllThemes; add: 'Edit current UI theme...' translated target: self selector: #editCurrentTheme.! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/4/2023 13:59'! addObjectsAndTools: menu self fillIn: menu from: { nil. { 'objects (o)'. { #myWorld. #activateObjectsTool }. 'A tool for finding and obtaining many kinds of objects' }. { 'new morph...'. { self. #newMorph }. 'Offers a variety of ways to create new objects' }. nil. { 'flaps...'. { self. #flapsDo }. 'A menu relating to use of flaps. For best results, use "keep this menu up"' }. { 'projects...'. { self. #projectDo }. 'A menu of commands relating to use of projects' }. { 'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}. nil }! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:54'! addPrintAndDebug: menu self fillIn: menu from: { { 'make screenshot'. {self. #saveScreenshot}. 'makes a screenshot and saves it to disk'}. "{ 'print PS to file...'. { self. #printWorldOnFile }. 'write the world into a postscript file' }." { 'debug...'. { self. #debugDo }. 'a menu of debugging items' } }! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:58'! addUtilities: menu self fillIn: menu from: { { 'open...'. { self. #openWindow } }. { 'windows...'. { self. #windowsDo } }. { 'changes...'. { self. #changesDo } } }. self fillIn: menu from: { { 'help...'. { self. #helpDo }. 'puts up a menu of useful items for updating the system, determining what version you are running, and much else' }. { 'appearance...'. { self. #appearanceDo }. 'put up a menu offering many controls over appearance.' } }. self fillIn: menu from: { { 'do...'. { Utilities. #offerCommonRequests }. 'put up an editible list of convenient expressions, and evaluate the one selected.' } }! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:57'! appearanceMenu "Build the appearance menu for the world."
^self fillIn: (self menu: 'appearance...') from: {
{'preferences...' . { self . #openPreferencesBrowser} . 'Opens a "Preferences Browser" which allows you to alter many settings' } . {'preferences wizard...' . { self . #openPreferencesWizard} . 'Opens a "Preferences Wizard" which allows you to alter many settings in a guided fashion' } . {'choose set of preferences...' . { Preferences . #offerThemesMenu} . 'Presents you with a menu of sets or preferences; each item''s balloon-help will tell you about the particular set. If you choose one, many different preferences that come along are set at the same time; you can subsequently change any settings by using a Preferences Panel'} . nil . {'system fonts...' . { self . #standardFontDo} . 'Choose the standard fonts to use for code, lists, menus, window titles, etc.'}. nil. {'full screen on' . { DisplayScreen . #fullScreenOn} . 'puts you in full-screen mode, if not already there.'}. {'full screen off' . { DisplayScreen . #fullScreenOff} . 'if in full-screen mode, takes you out of it.'}. nil. {'set display depth...' . {self. #setDisplayDepth} . 'choose how many bits per pixel.'}. {'set desktop color...' . {self. #changeBackgroundColor} . 'choose a uniform color to use as desktop background.'}. {'set gradient color...' . {self. #setGradientColor} . 'choose second color to use as gradient for desktop background.'}.
}! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 7/31/2023 11:19'! helpMenu "Build the help menu for the world." | menu |
menu := self menu: 'help...'.
self fillIn: menu from: { {'about this system...'. {Smalltalk. #aboutThisSystem}. 'current version information.'}. {'update code from server'. {MCMcmUpdater. #updateFromServer}. 'load latest code updates via the internet'}. {'preferences...'. {self. #openPreferencesBrowser}. 'view and change various options.'}. {'set language...' . {Project. #chooseNaturalLanguage}. 'choose the language in which tiles should be displayed.'} . nil. {'command-key help'. { TheWorldMainDockingBar instance . #commandKeyHelp}. 'summary of keyboard shortcuts.'} }.
self addGestureHelpItemsTo: menu.
self fillIn: menu from: { {'world menu help'. { self . #worldMenuHelp}. 'helps find menu items buried in submenus.'}. "{'info about flaps' . { Utilities . #explainFlaps}. 'describes how to enable and use flaps.'}." {'font size summary' . { TextStyle . #fontSizeSummary}. 'summary of names and sizes of available fonts.'}. {'useful expressions' . { Utilities . #openStandardWorkspace}. 'a window full of useful expressions.'}. {'annotation setup...' . { Preferences . #editAnnotations}. 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools'}. nil. {'graphical imports' . { Imports default . #viewImages}. 'view the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList'}. nil. {'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}. {#soundEnablingString . { SoundService . #toggleSoundEnabled}. 'turning sound off will completely disable Squeak''s use of sound.'}. nil.
{'set author initials...' . { Utilities . #setAuthorInitials }. 'supply initials to be used to identify the author of code and other content.'}. {'vm statistics' . { self . #vmStatistics}. 'obtain some intriguing data about the vm.'}. nil. {'purge undo records' . { CommandHistory . #resetAllHistory }. 'save space by removing all the undo information remembered in all projects.'}. {'space left' . { self . #garbageCollect}. 'perform a full garbage-collection and report how many bytes of space remain in the image.'}. }.
^menu
! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/16/2023 11:24'! newMorph "The user requested 'new morph' from the world menu. Put up a menu that allows many ways of obtaining new morphs."
| menu |
menu := self menu: 'Add a new morph'. menu add: 'from paste buffer' translated target: myHand action: #pasteMorph; add: 'from alphabetical list' translated subMenu: self alphabeticalMorphMenu; add: 'from a file...' translated target: self action: #readMorphFromAFile. menu addLine. menu add: 'grab rectangle from screen' translated target: myWorld action: #grabDrawingFromScreen:; add: 'grab with lasso from screen' translated target: myWorld action: #grabLassoFromScreen:; add: 'grab rubber band from screen' translated target: myWorld action: #grabRubberBandFromScreen:; add: 'grab flood area from screen' translated target: myWorld action: #grabFloodFromScreen:. menu addLine. menu add: 'make link to project...' translated target: self action: #projectThumbnail.
self doPopUp: menu. ! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/11/2023 16:37'! openMenu "Build the open window menu for the world."
| menu | menu := self menu: 'open...'. menu defaultTarget: ToolSet default. menu addList: ToolSet menuItems. menu defaultTarget: self. self fillIn: menu from: { nil. {'file...' . { self . #openFileDirectly} . 'Lets you open a window on a single file'}. {'transcript (t)' . {self . #openTranscript}. 'A window used to report messages sent to Transcript' }. "{'inner world' . { WorldWindow . #test1} }." nil. }. self fillIn: menu from: self class registeredOpenCommands. menu addLine.
self fillIn: menu from: { {'morphic project' . {self. #openMorphicProject} . 'Creates a new morphic project'}. {'mvc project' . {self. #openMVCProject} . 'Creates a new project of the classic "mvc" style'} }.
^menu ! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/11/2023 16:37'! projectMenu "Build the project menu for the world." | menu |
self flag: #bob0302.
menu := self menu: 'projects...'. self fillIn: menu from: { { 'save on server (also makes a local copy)' . { #myProject . #storeOnServer } }. { 'save to a different server' . { #myProject . #saveAs } }. { 'save project on local file only' . { #myWorld . #saveOnFile } }. { 'see if server version is more recent...' . { #myProject . #loadFromServer } }. { 'load project from file...' . { self . #loadProject } }. nil. }.
self fillIn: menu from: { { 'create new morphic project' . { self . #openMorphicProject } }. { 'create new mvc project'. { self . #openMVCProject } }. }.
self fillIn: menu from: { nil. { 'go to previous project' . { Project . #returnToPreviousProject } }. { 'go to next project' . { Project . #advanceToNextProject } }. { 'jump to project...' . { #myWorld . #jumpToProject } }. }. self fillIn: menu from: { nil. { 'save for future revert' . { #myProject . #saveForRevert } }. { 'revert to saved copy' . { #myProject . #revert } }. }.
^ menu! !
!TheWorldMenu methodsFor: '*MorphicExtras-windows & flaps menu' stamp: 'mt 8/4/2023 15:18'! formulateFlapsMenu: aMenu "Fill aMenu with appropriate content"
aMenu addTitle: 'flaps' translated. aMenu addStayUpItem. Preferences classicNavigatorEnabled ifTrue: [aMenu addUpdating: #navigatorShowingString enablementSelector: #enableProjectNavigator target: Preferences selector: #toggle: argumentList: #(showProjectNavigator). aMenu balloonTextForLastItem: (Preferences preferenceAt: #showProjectNavigator) helpString translated].
Flaps sharedFlapsAllowed ifTrue: [self fillIn: aMenu from: {{#suppressFlapsString. {Project current. #toggleFlapsSuppressed}. 'Whether prevailing flaps should be shown in the project right now or not.'}}.
aMenu addUpdating: #automaticFlapLayoutString target: Preferences selector: #toggle: argumentList: #(automaticFlapLayout). aMenu balloonTextForLastItem: (Preferences preferenceAt: #automaticFlapLayout) helpString translated.
aMenu addLine. Flaps addIndividualGlobalFlapItemsTo: aMenu].
self fillIn: aMenu from: { nil.
{'make a new flap'. {Flaps. #addLocalFlap}. 'Create a new flap. You can later make it into a shared flap is you wish.'}.
nil.}. Flaps sharedFlapsAllowed ifTrue: [aMenu addWithLabel: 'put shared flaps on bottom' translated enablementSelector: #showSharedFlaps target: Flaps selector: #sharedFlapsAlongBottom argumentList: #(). aMenu balloonTextForLastItem: 'Group all the standard shared flaps along the bottom edge of the screen' translated.
self fillIn: aMenu from: { {'destroy all shared flaps'. {Flaps. #disableGlobalFlaps}. 'Destroy all the shared flaps and disable their use in all projects.'}}] ifFalse: [aMenu add: 'install default shared flaps' translated target: Flaps action: #enableGlobalFlaps. aMenu balloonTextForLastItem: 'Create the default set of shared flaps' translated. aMenu addLine].
self fillIn: aMenu from: { nil. {'about flaps...'. {Flaps . #explainFlaps}. 'Gives a window full of details about how to use flaps.'}}! !
!ThreePhaseButtonMorph class methodsFor: 'class initialization' stamp: 'mt 3/15/2023 14:11'! initialize "ThreePhaseButtonMorph initialize" | extent inset | extent := 12@12. inset := 3.
#('CheckBoxOff' 'CheckBoxOn' 'CheckBoxPressed') do: [:button | | f r | f := ColorForm extent: extent depth: 1. f colors: {Color transparent. Color black}. f borderWidth: 1. r := f boundingBox insetBy: inset. button = 'CheckBoxPressed' ifTrue: [f border: r width: 1]. button = 'CheckBoxOn' ifTrue: [f fillBlack: r]. MenuIcons saveForm: f atKey: button].
#('RadioButtonOff' 'RadioButtonOn' 'RadioButtonPressed') do: [:button | | f r c | f := ColorForm extent: extent depth: 1. f colors: {Color transparent. Color black}. r := f boundingBox. c := f getCanvas. c frameOval: r color: Color black. r := r insetBy: inset. button = 'RadioButtonPressed' ifTrue: [c frameOval: r color: Color black]. button = 'RadioButtonOn' ifTrue: [c fillOval: r color: Color black]. MenuIcons saveForm: f atKey: button]! !
!ThreePhaseButtonMorph class methodsFor: 'instance creation' stamp: 'mt 3/15/2023 14:09'! labelSymbol: aSymbol "(self labelSymbol: #TryIt) openInHand" | aButton form | aButton := ThreePhaseButtonMorph new. form := MenuIcons formAtKey: aSymbol. aButton offImage: form. aButton image: form. aButton pressedImage: (MenuIcons formPressedAtKey: aSymbol). ^ aButton! !
!ThumbnailMorph methodsFor: 'stepping' stamp: 'mt 8/28/2023 14:37'! stepTime "Adjust my step time to the time it takes drawing my referent" drawTime ifNil:[^ 250]. ^(20 * drawTime) max: 250.! !
!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'! actualViewee "Return the actual morph to be viewed, or nil if there isn't an appropriate morph to view."
| aMorph actualViewee | aMorph := self morphToView ifNil: [^ nil]. aMorph isInWorld ifFalse: [^ nil]. actualViewee := viewSelector ifNil: [aMorph] ifNotNil: [objectToView perform: viewSelector]. actualViewee == 0 ifTrue: [^ nil]. "valueAtCursor result for an empty HolderMorph" actualViewee ifNil: [actualViewee := objectToView]. (actualViewee isMorph and: [actualViewee isFlexMorph and: [actualViewee submorphs size = 1]]) ifTrue: [actualViewee := actualViewee firstSubmorph]. ^ actualViewee! !
!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'! formOrMorphToView "Answer the form to be viewed, or the morph to be viewed, or nil"
| actualViewee | (objectToView isForm) ifTrue: [^objectToView]. actualViewee := viewSelector ifNil: [objectToView] ifNotNil: [objectToView perform: viewSelector]. ^actualViewee == 0 ifTrue: [nil "valueAtCursor result for an empty HolderMorph"] ifFalse: [actualViewee]! !
!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'! morphToView "If the receiver is viewing some object, answer a morph can be thought of as being viewed; A gesture is made toward generalizing this beyond the morph/player regime, in that a plain blue rectangle is returned rather than simply failing if the referent is not itself displayable."
objectToView ifNil: [^ nil]. ^ objectToView isMorph ifTrue: [objectToView] ifFalse: [RectangleMorph new color: Color blue]! !
!TransformationMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 15:02'! removeFlexShell "Remove the shell used to make a morph rotatable and scalable."
| oldHalo unflexed myWorld refPos aPosition | self isInWorld ifFalse: [^self]. refPos := self referencePosition. myWorld := self world. oldHalo := self halo. submorphs isEmpty ifTrue: [^ self delete]. aPosition := (owner submorphIndexOf: self) ifNil: [1]. unflexed := self firstSubmorph. self submorphs do: [:m | m position: self center - (m extent // 2). owner addMorph: m asElementNumber: aPosition]. unflexed absorbStateFromRenderer: self. oldHalo ifNotNil: [oldHalo setTarget: unflexed]. myWorld ifNotNil: [myWorld startSteppingSubmorphsOf: unflexed]. self delete. unflexed referencePosition: refPos. ^ unflexed! !
!TransformationMorph methodsFor: 'private' stamp: 'mt 3/10/2023 11:18'! adjustAfter: changeBlock "Cause this morph to remain centered where it was before, and choose appropriate smoothing, after a change of scale or rotation." | oldRefPos | oldRefPos := self referencePosition. changeBlock value. self chooseSmoothing. self layoutChanged. owner ifNotNil: [owner invalidRect: bounds] ! !
!TranslucentProgessMorph methodsFor: 'drawing' stamp: 'mt 3/7/2023 15:07'! drawOn: aCanvas
| revealPercentage revealingStyle revealingColor revealingBounds revealToggle x baseColor revealTimes secondsRemaining stringToDraw where fontToUse innerBounds |
innerBounds := bounds. opaqueBackgroundColor ifNotNil: [ aCanvas frameAndFillRectangle: bounds fillColor: opaqueBackgroundColor borderWidth: 8 borderColor: Color blue. innerBounds := innerBounds insetBy: 8. ]. revealTimes := (self valueOfProperty: #revealTimes) ifNil: [^self]. revealPercentage := (revealTimes first / revealTimes second) asFloat. revealingStyle := self revealingStyle. x := self valueOfProperty: #progressStageNumber ifAbsent: [1]. baseColor := Color perform: (#(red blue green magenta cyan yellow) atPin: x). revealingColor := baseColor alpha: 0.2. revealingStyle = 3 ifTrue: [ "wrap and change color" revealPercentage > 1.0 ifTrue: [ revealingColor := baseColor alpha: (0.2 + (revealingStyle / 10) min: 0.5). ]. revealPercentage := revealPercentage fractionPart. ]. revealingStyle = 2 ifTrue: [ "peg at 75 and blink" revealPercentage > 0.75 ifTrue: [ revealToggle := self valueOfProperty: #revealToggle ifAbsent: [true]. self setProperty: #revealToggle toValue: revealToggle not. revealToggle ifTrue: [revealingColor := baseColor alpha: 0.8.]. ]. revealPercentage := revealPercentage min: 0.75. ]. revealingBounds := innerBounds withLeft: innerBounds left + (innerBounds width * revealPercentage) truncated. aCanvas fillRectangle: revealingBounds color: revealingColor. secondsRemaining := (revealTimes second - revealTimes first / 1000) rounded. secondsRemaining > 0 ifTrue: [ fontToUse := StrikeFont familyName: Preferences standardButtonFont familyName size: 24. stringToDraw := secondsRemaining printString. where := innerBounds corner - ((fontToUse widthOfString: stringToDraw) @ fontToUse height). aCanvas drawString: stringToDraw in: (where corner: innerBounds corner) font: fontToUse color: Color black. aCanvas drawString: stringToDraw in: (where - (1@1) corner: innerBounds corner) font: fontToUse color: Color white. ].
! !
!TrashCanMorph methodsFor: 'event handling' stamp: 'mt 8/11/2023 13:45'! doubleClick: evt evt hand world addMorphCentered: ScrapBook default scrapBook! !
!UpdatingRectangleMorph methodsFor: 'setting' stamp: 'mt 3/10/2023 15:02'! valueProvider "Answer the object to which my get/set messages should be sent. This is inefficient and contorted in order to support grandfathered content for an earlier design"
^ target! !
!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:28'! decimalPlaces: aNumber "Set the receiver's number of decimal places to be shown."
| constrained | self setProperty: #decimalPlaces toValue: (constrained := aNumber min: 11). self pvtFloatPrecision: (Utilities floatPrecisionForDecimalPlaces: constrained).! !
!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 15:45'! target: anObject
target := anObject. floatPrecision := 1. ! !
!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:02'! valueFromContents "Return a new value from the current contents string."
format = #symbol ifTrue: [^ lastValue]. format = #string ifTrue: [^ contents]. ^ Compiler evaluate: contents ! !
!UpdatingStringMorph methodsFor: 'target access' stamp: 'mt 3/10/2023 14:13'! readFromTarget "Update my readout from my target"
| v ret | (target isNil or: [getSelector isNil]) ifTrue: [^contents]. ret := self checkTarget. ret ifFalse: [^ '0']. v := target perform: getSelector. "scriptPerformer" (v isKindOf: Text) ifTrue: [v := v asString]. ^self acceptValueFromTarget: v! !
!UserInterfaceTheme methodsFor: 'private - fonts' stamp: 'mt 7/31/2023 11:21'! installSystemFont: aFont "Establish the default text font and style. Update the #defaultFontIndex in all known text styles to reflect the system's new default point size."
| aStyle | self flag: #todo. "mt: Support derivatives such as bold and italic." aStyle := aFont textStyleOrNil. "mt: Must be installed and thus never be nil!!" aStyle defaultFontIndex: (aStyle fontIndexOfPointSize: aFont pointSize "drop emphasis").
TextStyle setDefault: aStyle. TextStyle actualTextStyles "no defaults" do: [:ea | ea isTTCStyle ifTrue: [ea defaultFont asPointSize: aFont pointSize "May generate new pointSize"]. ea defaultFontIndex: (ea fontIndexOfPointSize: aFont pointSize)].
RealEstateAgent resetScaleFactor.
Flaps replaceToolsFlap.! !
!CommunityTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addDarkWindowColors: aUserInterfaceTheme "self createDark apply." aUserInterfaceTheme set: #uniformWindowColor for: #Model to: Color darkGray;
set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color darker] ]; set: #unfocusedLabelColor for: #SystemWindow to: Color veryLightGray; set: #focusedLabelColor for: #SystemWindow to: Color white;
set: #customWindowColor for: #Browser to: self dbBlue; set: #customWindowColor for: #ChangeList to: self dbBlue; set: #customWindowColor for: #ChangeSorter to: self dbBlue; set: #customWindowColor for: #ChatNotes to: self dbPurple twiceDarker; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self dbPurple twiceDarker; set: #customWindowColor for: #Debugger to: self dbRed; set: #customWindowColor for: #DualChangeSorter to: self dbOrange twiceDarker; set: #customWindowColor for: #FileContentsBrowser to: self dbGray; set: #customWindowColor for: #FileList to: self dbGray; set: #customWindowColor for: #Inspector to: self dbYellow duller; set: #customWindowColor for: #InstanceBrowser to: self dbYellow duller; set: #customWindowColor for: #Lexicon to: self dbGreen; set: #customWindowColor for: #MCTool to: self dbOrange twiceDarker; set: #customWindowColor for: #MessageNames to: self dbGreen; set: #customWindowColor for: #MessageSet to: self dbGreen; set: #customWindowColor for: #ObjectExplorer to: self dbYellow duller; set: #customWindowColor for: #PackagePaneBrowser to: self dbBlue; set: #customWindowColor for: #PluggableFileList to: self dbGray; set: #customWindowColor for: #PreferenceBrowser to: self dbBlue; set: #customWindowColor for: #ProcesBrowser to: self dbAqua; set: #customWindowColor for: #SMLoader to: self dbOrange twiceDarker; set: #customWindowColor for: #SMLoaderPlus to: self dbOrange twiceDarker; set: #customWindowColor for: #SMReleaseBrowser to: self dbOrange twiceDarker; set: #customWindowColor for: #SelectorBrowser to: self dbBlue; set: #customWindowColor for: #StringHolder to: self dbGray; set: #customWindowColor for: #TestRunner to: self dbPink darker; set: #customWindowColor for: #TranscriptStream to: self dbGray; set: #customWindowColor for: #VersionsBrowser to: self dbPurple twiceDarker; set: #customWindowColor for: #Workspace to: self dbPink darker.! !
!MonokaiTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addDarkWindowColors: theme "self createDark apply." theme set: #uniformWindowColor for: #Model to:( self invisibleColor adjustBrightness: 0.16) "lighter twice";
set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: -0.16 "darker twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: [ Model useColorfulWindows ifTrue: [(Color r: 0.285 g: 0.282 b: 0.242) "invisible color"] ifFalse: [(Color r: 0.972 g: 0.972 b: 0.948) "foreground color"] ]; set: #focusedLabelColor for: #SystemWindow to: [ Model useColorfulWindows ifTrue: [(Color r: 0.152 g: 0.156 b: 0.133) "background color"] ifFalse: [(Color r: 0.901 g: 0.858 b: 0.455) "yellow"] ];
set: #customWindowColor for: #Browser to: self green duller; set: #customWindowColor for: #ChangeList to: self blue duller; set: #customWindowColor for: #ChangeSorter to: self blue duller; set: #customWindowColor for: #ChatNotes to: self magenta duller; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet duller; set: #customWindowColor for: #Debugger to: self red duller; set: #customWindowColor for: #DualChangeSorter to: self blue duller; set: #customWindowColor for: #FileContentsBrowser to: self yellow duller; set: #customWindowColor for: #FileList to: self yellow duller; set: #customWindowColor for: #InstanceBrowser to: self cyan duller; set: #customWindowColor for: #Lexicon to: self cyan duller; set: #customWindowColor for: #MCTool to: self violet duller; set: #customWindowColor for: #MessageNames to: self green duller; set: #customWindowColor for: #MessageSet to: self cyan duller; set: #customWindowColor for: #PackagePaneBrowser to: self green duller; set: #customWindowColor for: #PluggableFileList to: self yellow duller; set: #customWindowColor for: #PreferenceBrowser to: self cyan duller; set: #customWindowColor for: #SMLoader to: self orange duller; set: #customWindowColor for: #SMLoaderPlus to: self orange duller; set: #customWindowColor for: #SMReleaseBrowser to: self orange duller; set: #customWindowColor for: #SelectorBrowser to: self cyan duller; set: #customWindowColor for: #StringHolder to: self yellow duller; set: #customWindowColor for: #TestRunner to: self orange duller; set: #customWindowColor for: #TranscriptStream to: self orange duller; set: #customWindowColor for: #VersionsBrowser to: self violet duller.! !
!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addDarkWindowColors: theme "doIt: [self createDark apply.]"
theme set: #uniformWindowColor for: #Model to: (self darkBackgroundHighlights adjustBrightness: 0.16 "lighter twice");
set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: -0.16 "darker twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: self darkContentEmphasized; set: #focusedLabelColor for: #SystemWindow to: self darkContentEmphasizedMore;
set: #customWindowColor for: #Browser to: self green; set: #customWindowColor for: #ChangeList to: self blue; set: #customWindowColor for: #ChangeSorter to: self blue; set: #customWindowColor for: #ChatNotes to: self magenta; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet; set: #customWindowColor for: #Debugger to: self red; set: #customWindowColor for: #DualChangeSorter to: self blue; set: #customWindowColor for: #FileContentsBrowser to: self yellow; set: #customWindowColor for: #FileList to: self yellow; set: #customWindowColor for: #InstanceBrowser to: self cyan; set: #customWindowColor for: #Lexicon to: self cyan; set: #customWindowColor for: #MCTool to: self violet; set: #customWindowColor for: #MessageNames to: self green; set: #customWindowColor for: #MessageSet to: self cyan; set: #customWindowColor for: #PackagePaneBrowser to: self green; set: #customWindowColor for: #PluggableFileList to: self yellow; set: #customWindowColor for: #PreferenceBrowser to: self cyan; set: #customWindowColor for: #SMLoader to: self orange; set: #customWindowColor for: #SMLoaderPlus to: self orange; set: #customWindowColor for: #SMReleaseBrowser to: self orange; set: #customWindowColor for: #SelectorBrowser to: self cyan; set: #customWindowColor for: #StringHolder to: self yellow; set: #customWindowColor for: #TestRunner to: self orange; set: #customWindowColor for: #TranscriptStream to: self orange; set: #customWindowColor for: #VersionsBrowser to: self violet.! !
!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addLightWindowColors: theme "You have to create dark first. doIt: [self createDark. self createLight apply.]"
theme set: #uniformWindowColor for: #Model to: (self lightBackgroundHighlights adjustBrightness: -0.16 "darker twice");
set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: 0.16 "lighter twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: self lightContentEmphasized; set: #focusedLabelColor for: #SystemWindow to: self lightContentEmphasizedMore;
set: #customWindowColor for: #Browser to: self green; set: #customWindowColor for: #ChangeList to: self blue; set: #customWindowColor for: #ChangeSorter to: self blue; set: #customWindowColor for: #ChatNotes to: self magenta; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet; set: #customWindowColor for: #Debugger to: (self red adjustSaturation: -0.27 brightness: 0.27); set: #customWindowColor for: #DualChangeSorter to: self blue; set: #customWindowColor for: #FileContentsBrowser to: self yellow; set: #customWindowColor for: #FileList to: self yellow; set: #customWindowColor for: #InstanceBrowser to: self cyan; set: #customWindowColor for: #Lexicon to: self cyan; set: #customWindowColor for: #MCTool to: self violet; set: #customWindowColor for: #MessageNames to: self green; set: #customWindowColor for: #MessageSet to: self cyan; set: #customWindowColor for: #PackagePaneBrowser to: self green; set: #customWindowColor for: #PluggableFileList to: self yellow; set: #customWindowColor for: #PreferenceBrowser to: self cyan; set: #customWindowColor for: #SMLoader to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SMLoaderPlus to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SMReleaseBrowser to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SelectorBrowser to: self cyan; set: #customWindowColor for: #StringHolder to: self yellow; set: #customWindowColor for: #TestRunner to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #TranscriptStream to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #VersionsBrowser to: self violet.! !
!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addDullerWindowColors: theme
theme set: #uniformWindowColor for: #Model to: Color veryVeryLightGray duller; set: #customWindowColor for: #Browser to: (Color r: 0.764 g: 0.9 b: 0.63) duller; set: #customWindowColor for: #ChangeList to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #ChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #ChatNotes to: (Color r: 1.0 g: 0.7 b: 0.8) duller; set: #customWindowColor for: #ClassCommentVersionsBrowser to: (Color r: 0.753 g: 0.677 b: 0.9) duller; set: #customWindowColor for: #Debugger to: (Color r: 0.9 g: 0.719 b: 0.719) duller; set: #customWindowColor for: #DualChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #FileContentsBrowser to: (Color r: 0.7 g: 0.7 b: 0.508) duller; set: #customWindowColor for: #FileList to: (Color r: 0.65 g: 0.65 b: 0.65) duller; set: #customWindowColor for: #InstanceBrowser to: (Color r: 0.726 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #Lexicon to: (Color r: 0.79 g: 0.9 b: 0.79) duller; set: #customWindowColor for: #MCTool to: (Color r: 0.65 g: 0.691 b: 0.876) duller; set: #customWindowColor for: #MessageNames to: (Color r: 0.639 g: 0.9 b: 0.497) duller; set: #customWindowColor for: #MessageSet to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #PackagePaneBrowser to: (Color r: 0.9 g: 0.9 b: 0.63) duller; set: #customWindowColor for: #PluggableFileList to: Color lightYellow duller; set: #customWindowColor for: #PreferenceBrowser to: (Color r: 0.671 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #SMLoader to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SMLoaderPlus to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SMReleaseBrowser to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SelectorBrowser to: (Color r: 0.45 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #StringHolder to: (Color r: 0.9 g: 0.9 b: 0.719) duller; set: #customWindowColor for: #TestRunner to: (Color r: 0.9 g: 0.576 b: 0.09) duller; set: #customWindowColor for: #TranscriptStream to: (Color r: 0.9 g: 0.75 b: 0.45) duller; set: #customWindowColor for: #VersionsBrowser to: (Color r: 0.782 g: 0.677 b: 0.9) duller.! !
!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addWindowColors: theme
theme set: #titleFont for: #SystemWindow to: [Preferences windowTitleFont]; set: #borderColorModifier for: #SystemWindow to: [ [:c | c adjustBrightness: -0.3] ]; set: #borderColorModifier for: #ScrollPane to: [ [:c | c adjustBrightness: -0.3] ]; set: #borderWidth for: #SystemWindow to: 1; derive: #resizerColorModifier for: #AbstractResizerMorph from: #SystemWindow at: #borderColorModifier;
set: #uniformWindowColor for: #Model to: Color veryVeryLightGray; derive: #uniformWindowColor for: #TranscriptStream from: #Model; derive: #color for: #SystemWindow from: #Model at: #uniformWindowColor; "Fall back for windows without models."
set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color darker] ]; set: #unfocusedLabelColor for: #SystemWindow to: Color darkGray; set: #focusedLabelColor for: #SystemWindow to: Color black;
set: #customWindowColor for: #Browser to: (Color r: 0.764 g: 0.9 b: 0.63); set: #customWindowColor for: #ChangeList to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #ChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #ChatNotes to: (Color r: 1.0 g: 0.7 b: 0.8); set: #customWindowColor for: #ClassCommentVersionsBrowser to: (Color r: 0.753 g: 0.677 b: 0.9); set: #customWindowColor for: #Debugger to: (Color r: 0.9 g: 0.719 b: 0.719); set: #customWindowColor for: #DualChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #FileContentsBrowser to: (Color r: 0.7 g: 0.7 b: 0.508); set: #customWindowColor for: #FileList to: (Color r: 0.65 g: 0.65 b: 0.65); set: #customWindowColor for: #InstanceBrowser to: (Color r: 0.726 g: 0.9 b: 0.9); set: #customWindowColor for: #Lexicon to: (Color r: 0.79 g: 0.9 b: 0.79); set: #customWindowColor for: #MCTool to: (Color r: 0.65 g: 0.691 b: 0.876); set: #customWindowColor for: #MessageNames to: (Color r: 0.639 g: 0.9 b: 0.497); set: #customWindowColor for: #MessageSet to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #PackagePaneBrowser to: (Color r: 0.9 g: 0.9 b: 0.63); set: #customWindowColor for: #PluggableFileList to: Color lightYellow; set: #customWindowColor for: #PreferenceBrowser to: (Color r: 0.671 g: 0.9 b: 0.9); set: #customWindowColor for: #SMLoader to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SMLoaderPlus to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SMReleaseBrowser to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SelectorBrowser to: (Color r: 0.45 g: 0.9 b: 0.9); set: #customWindowColor for: #StringHolder to: (Color r: 0.9 g: 0.9 b: 0.719); set: #customWindowColor for: #TestRunner to: (Color r: 0.9 g: 0.576 b: 0.09); set: #customWindowColor for: #TranscriptStream to: (Color r: 0.9 g: 0.75 b: 0.45); set: #customWindowColor for: #VersionsBrowser to: (Color r: 0.782 g: 0.677 b: 0.9).! !
!TrimTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addWindowColors: theme
| windowColorBrightnessAdjustment | windowColorBrightnessAdjustment := -0.35. theme set: #titleFont for: #SystemWindow to: [Preferences windowTitleFont]; set: #borderColorModifier for: #SystemWindow to: [ [:c | c adjustBrightness: -0.1] ]; set: #borderColorModifier for: #ScrollPane to: [ [:c | c adjustBrightness: 0.1] ]; set: #borderWidth for: #SystemWindow to: 1;
set: #uniformWindowColor for: #Model to: self gray76;
set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color alphaMixed: 0.5 with: self gray40] ]; set: #unfocusedLabelColor for: #SystemWindow to: self gray168; set: #focusedLabelColor for: #SystemWindow to: Color white;
set: #customWindowColor for: #Browser to: ((Color r: 0.764 g: 0.9 b: 0.63) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChangeList to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChangeSorter to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChatNotes to: ((Color r: 1.0 g: 0.7 b: 0.8) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ClassCommentVersionsBrowser to: ((Color r: 0.753 g: 0.677 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #Debugger to: ((Color r: 0.9 g: 0.719 b: 0.719) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #DualChangeSorter to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #FileContentsBrowser to: ((Color r: 0.7 g: 0.7 b: 0.508) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #FileList to: ((Color r: 0.65 g: 0.65 b: 0.65) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #InstanceBrowser to: ((Color r: 0.726 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #Lexicon to: ((Color r: 0.79 g: 0.9 b: 0.79) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MCTool to: ((Color r: 0.65 g: 0.691 b: 0.876) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MessageNames to: ((Color r: 0.639 g: 0.9 b: 0.497) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MessageSet to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PackagePaneBrowser to: ((Color r: 0.9 g: 0.9 b: 0.63) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PluggableFileList to: (Color lightYellow adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PreferenceBrowser to: ((Color r: 0.671 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMLoader to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMLoaderPlus to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMReleaseBrowser to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SelectorBrowser to: ((Color r: 0.45 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #StringHolder to: ((Color r: 0.9 g: 0.9 b: 0.719) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #TestRunner to: ((Color r: 0.9 g: 0.576 b: 0.09) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #TranscriptStream to: ((Color r: 0.9 g: 0.75 b: 0.45) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #VersionsBrowser to: ((Color r: 0.782 g: 0.677 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment).! !
!Utilities class methodsFor: 'common requests' stamp: 'mt 8/11/2023 15:01'! initializeCommonRequestStrings "Initialize the common request strings, a directly-editable list of expressions that can be evaluated from the 'do...' menu."
CommonRequestStrings := StringHolder new contents: 'Utilities emergencyCollapse. Utilities closeAllDebuggers. RecentMessages default revertMostRecent. - MCFileBasedRepository flushAllCaches - Sensor keyboard. ParagraphEditor abandonChangeText. Cursor normal show. - CommandHistory resetAllHistory. Project allInstancesDo: [:p | p displayDepth: 16]. ScriptingSystem inspectFormDictionary. Form fromUser bitEdit. Display border: (0@0 extent: 640@480) width: 2. - Undeclared inspect. Undeclared removeUnreferencedKeys; inspect. Transcript clear. GIFReadWriter grabScreenAndSaveOnDisk. FrameRateMorph new openInHand. - Utilities reconstructTextWindowsFromFileNamed: ''TW''. Utilities storeTextWindowContentsToFileNamed: ''TW''. ChangeSet removeEmptyUnnamedChangeSets. ChangesOrganizer reorderChangeSets.'
"Utilities initializeCommonRequestStrings"! !
!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:55'! addControls | slider aWrapper m aButton | aWrapper := AlignmentMorph newRow. aWrapper color: Color transparent; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 @ 5. aWrapper wrapCentering: #topLeft. aButton := self buttonName: 'X' action: #delete. aButton setBalloonText: 'Close WaveEditor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Menu' translated action: #invokeMenu. aButton setBalloonText: 'Open a menu' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play' translated action: #play. aButton setBalloonText: 'Play sound' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play Before' translated action: #playBeforeCursor. aButton setBalloonText: 'Play before cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play After' translated action: #playAfterCursor. aButton setBalloonText: 'Play after cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play Loop' translated action: #playLoop. aButton setBalloonText: 'Play the loop' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Test' translated action: #playTestNote. aButton setBalloonText: 'Test the note' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Save' translated action: #saveInstrument. aButton setBalloonText: 'Save the sound' translated. aWrapper addMorphBack: aButton.
aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set Loop End' translated action: #setLoopEnd. aButton setBalloonText: 'Set loop end at cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set One Cycle' translated action: #setOneCycle. aButton setBalloonText: 'Set one cycle' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set Loop Start' translated action: #setLoopStart. aButton setBalloonText: 'Set the loop start at cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. self addMorphBack: aWrapper. aWrapper := AlignmentMorph newRow. aWrapper color: self color; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5 @ 20; wrapCentering: #center; cellPositioning: #leftCenter. m := StringMorph new contents: 'Index: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #cursor; putSelector: #cursor:; font: Preferences standardButtonFont; growable: false; width: 71; step. aWrapper addMorphBack: m. m := StringMorph new contents: 'Value: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #valueAtCursor; putSelector: #valueAtCursor:; font: Preferences standardButtonFont; growable: false; width: 50; step. aWrapper addMorphBack: m. slider := SimpleSliderMorph new color: color; extent: 200 @ 10; target: self; actionSelector: #scrollTime:. aWrapper addMorphBack: slider. m := Morph new color: aWrapper color; extent: 10 @ 5. "spacer" aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #startIndex; putSelector: #startIndex:; font: Preferences standardButtonFont; width: 40; step. aWrapper addMorphBack: m. self addMorphBack: aWrapper! !
!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:56'! addLoopPointControls
| m aWrapper | aWrapper := AlignmentMorph newRow. aWrapper color: self color; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
m := StringMorph new contents: 'Loop end: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopEnd; putSelector: #loopEnd:; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Loop length: ' translated ; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopLength; putSelector: #loopLength:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Loop cycles: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopCycles; putSelector: #loopCycles:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Frequency: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #perceivedFrequency; putSelector: #perceivedFrequency:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m.
self addMorphBack: aWrapper ! !
!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:53'! buttonName: aString action: aSymbol "Create a button with the given label and action selector, and answer it."
^ SimpleButtonMorph new target: self; label: aString font: Preferences standardButtonFont; actionSelector: aSymbol! !
WebCamMorph class removeSelector: #additionsToViewerCategories! SymbolListType removeSelector: #initialValueForASlotFor:! StringType removeSelector: #initialValueForASlotFor:! SoundType removeSelector: #initialValueForASlotFor:! PointType removeSelector: #initialValueForASlotFor:! NumberType removeSelector: #initialValueForASlotFor:! GraphicType removeSelector: #initialValueForASlotFor:!
!GraphicType reorganize! ('initial value') ('initialization' initialize) !
ColorType removeSelector: #initialValueForASlotFor:! BooleanType removeSelector: #initialValueForASlotFor:! DataType removeSelector: #initialValueForASlotFor:! Vocabulary removeSelector: #isEToyVocabulary! UpdatingStringMorph removeSelector: #isEtoyReadout!
!UpdatingStringMorph reorganize! ('accessing' autoAcceptOnFocusLoss autoAcceptOnFocusLoss: decimalPlaces decimalPlaces: floatPrecision format getSelector getSelector: growable growable: maximumWidth maximumWidth: minWidth minWidth: putSelector putSelector: pvtFloatPrecision: target target: valueFromContents) ('copying' veryDeepFixupWith: veryDeepInner:) ('editing' acceptContents acceptValue: addCustomMenuItems:hand: doneWithEdits lostFocusWithoutAccepting setDecimalPlaces: setFontSize setFontStyle setPrecision setToAllowTextEdit toggleGrowability userEditsAllowed) ('event handling' handlesMouseDown: mouseDown: wouldAcceptKeyboardFocus) ('events-processing' handlerForMouseDown:) ('formats' useDefaultFormat useStringFormat useSymbolFormat) ('initialization' defaultMaximumWidth defaultMinimumWidth initialize) ('stepping' step stepTime stepTime: updateContentsFrom:) ('target access' acceptValueFromTarget: checkTarget informTarget readFromTarget setDecimalPlacesFromTypeIn: stringForNumericValue:) ('layout' fitContents) ('*MorphicExtras-accessing' floatPrecision:) !
UpdatingRectangleMorph removeSelector: #isEtoyReadout!
!UpdatingRectangleMorph reorganize! ('accessing' contents contents: getSelector getSelector: putSelector putSelector: target target: userEditsAllowed) ('copying' veryDeepFixupWith: veryDeepInner:) ('event handling' handlesMouseDown: mouseUp:) ('initialization' defaultBorderColor) ('setting' setTargetColor: valueProvider) ('stepping' step stepTime) ('target access' readFromTarget) !
UpdatingMenuItemMorph removeSelector: #adaptToWorld:! ThumbnailMorph removeSelector: #isEtoyReadout!
!ThumbnailMorph reorganize! ('accessing' getSelector getSelector: putSelector target) ('caching' releaseCachedState) ('copying' veryDeepFixupWith: veryDeepInner:) ('display' drawForForm:on: drawMeOn: scaleFor:in:) ('drawing' drawOn:) ('initialization' defaultBorderWidth defaultColor initialize objectToView: objectToView:viewSelector:) ('stepping' step stepTime) ('texture support' installAsWonderlandTextureOn:) ('what to view' actualViewee formOrMorphToView morphToView) !
ThreePhaseButtonMorph initialize!
!ThreePhaseButtonMorph class reorganize! ('class initialization' initialize) ('instance creation' checkBox labelSymbol: radioButton) ('preferences' themeProperties) !
ThreePhaseButtonMorph removeSelector: #adaptToWorld:! TheWorldMenu removeSelector: #adaptToWorld:! TheWorldMenu removeSelector: #menuColorString! TheWorldMenu removeSelector: #mvcProjectsAllowed! TheWorldMenu removeSelector: #roundedCornersString! TheWorldMenu removeSelector: #toggleMenuColorPolicy!
!TheWorldMenu reorganize! ('action' commandKeyTypedIntoMenu: doMenuItem:with: projectThumbnail saveScreenshot setGradientColor soundEnablingString staggerPolicyString toggleRoundedCorners toggleWindowPolicy) ('commands' changeBackgroundColor cleanUpWorld garbageCollect loadProject lookForSlips newMorphOfClass:event: openBrowser openFileDirectly openFileList openMorphicProject openMVCProject openPreferencesBrowser openPreferencesWizard openTranscript openWorkspace projectForMyWorld quitSession readMorphFromAFile saveAndQuit saveWorldInFile setDisplayDepth splitNewMorphList:depth: startMessageTally vmStatistics worldMenuHelp) ('construction' addObjectsAndTools: addPrintAndDebug: addProjectEntries: addRestoreDisplay: addSaveAndQuit: addUtilities: alphabeticalMorphMenu appearanceMenu buildWorldMenu changesMenu colorForDebugging: debugMenu fillIn:from: helpMenu makeConvenient: newMorph openMenu projectMenu remoteMenu) ('mechanics' menu: world:project:hand:) ('menu' addGestureHelpItemsTo:) ('popups' appearanceDo changesDo debugDo doPopUp: helpDo openWindow projectDo remoteDo standardFontDo) ('windows & flaps menu' suppressFlapsString windowsDo windowsMenu) ('*MorphicExtras-action' createStandardPartsBin launchCustomPartsBin toggleFlapSuppressionInProject) ('*MorphicExtras-construction' myMenuColor) ('*MorphicExtras-mechanics') ('*MorphicExtras-windows & flaps menu' flapsDo flapsMenu formulateFlapsMenu: globalFlapsEnabled newGlobalFlapString) ('*Tools' browseRecentLog openChangeSorter1 openChangeSorter2 openMessageNames openProcessBrowser openSelectorBrowser startThenBrowseMessageTally) ('*MorphicExtras-Postscript Canvases' printWorldOnFile) !
TextMorphForEditView removeSelector: #wouldAcceptKeyboardFocusUponTab!
!TextMorph class reorganize! ('class initialization' cleanUp defaultEditorClass defaultEditorClass: initialize registerInFlapsRegistry unload) ('connectorstext-parts bin' boldAuthoringPrototype) ('new-morph participation' includeInNewMorphMenu) ('parts bin' borderedPrototype exampleBackgroundLabel fancyPrototype) ('scripting' authoringPrototype defaultNameStemForInstances) ('instance creation' string:fontName: string:fontName:size: string:fontName:size:wrap: string:size:) ('*MorphicExtras-parts bin' supplementaryPartsDescriptions) !
TextMorph removeSelector: #cursor! TextMorph removeSelector: #cursorWrapped:! TextMorph removeSelector: #getAllButFirstCharacter! TextMorph removeSelector: #holderForCharacters! TextMorph removeSelector: #insertCharacters:! TextMorph removeSelector: #insertContentsOf:! TextMorph removeSelector: #setAllButFirstCharacter:! TextMorph removeSelector: #wouldAcceptKeyboardFocusUponTab!
!TextMorph reorganize! ('accessing' autoFit: backgroundColor backgroundColor: borderWidth: caretColor caretColor: contents contentsAsIs: contentsWrapped: contents: contents:wrappedTo: crAction crAction: editor elementCount font: getFirstCharacter getLastCharacter hasTranslucentColor isAutoFit isWrapped margins margins: newContents: plainTextOnly plainTextOnly: readOnly readOnly: selectAll selectFrom:to: selectInterval: selection selectionColor selectionColor: selectionInterval selectionInterval: setCharacters: setFirstCharacter: setLastCharacter: text textAlignment textAlignmentSymbol textColor textColor: textStyle textStyle: unfocusedSelectionColor unfocusedSelectionColor: userString wrapFlag:) ('alignment' centered justified leftFlush rightFlush) ('anchors' adjustTextAnchor: anchorMorph:at:type:) ('caching' loadCachedState releaseCachedState) ('change reporting' ownerChanged) ('classification' isTextMorph) ('containment' avoidsOcclusions fillingOnOff fillsOwner fillsOwner: occlusionsOnOff recognizerArena setContainer:) ('copying' copy veryDeepFixupWith: veryDeepInner:) ('drawing' areasRemainingToFill: debugDrawLineRectsOn: drawNullTextOn: drawOn:) ('editing' acceptContents acceptOnCR cancelEdits cancelEditsSafely chooseAlignment chooseEmphasis chooseEmphasisOrAlignment chooseFont chooseStyle handleEdit: handleInteraction:fromEvent: hasUnacceptedEdits: passKeyboardFocusTo: setCompositionWindow xeqLinkText:withParameter:) ('event handling' click: getMenu: handlesKeyboard: handlesMouseDown: handlesMouseMove: handlesMouseOver: handlesMouseStillDown: hasFocus keyboardFocusChange: keyStroke: mouseDown: mouseEnter: mouseLeave: mouseMove: mouseUp: startDrag: wantsKeyboardFocus yellowButtonActivity:) ('events-processing' handleKeystroke:) ('geometry' bounds container defaultLineHeight extent: maximumContainerExtent privateMoveBy: textBounds) ('geometry testing' containsPoint:) ('initialization' beAllFont: defaultBorderWidth defaultColor fontName:pointSize: fontName:size: initialize setTextStyle: string:fontName:size: string:fontName:size:wrap:) ('layout' acceptDroppingMorph:event: averageLineLength averageLineLength: doLayoutIn: layoutChanged minCompositionHeight minCompositionWidth minHeight minWidth) ('linked frames' addPredecessor: addSuccessor: firstCharacterIndex firstInChain isLinkedTo: lastCharacterIndex predecessor recomposeChain startingIndex successor withSuccessorsDo:) ('menu' addCustomMenuItems:hand: autoFitOnOff autoFitString changeMargins: changeTextColor followCurve reverseCurveDirection setCurveBaseline: wrapOnOff wrapString) ('multi level undo' editHistory) ('objects from disk' convertToCurrentVersion:refStream: fixUponLoad:seg:) ('visual properties' fillStyle fillStyle:) ('*MorphicExtras-accessing' getCharacters) ('*MorphicExtras-copying' updateReferencesUsing:) ('private' adjustLineIndicesBy: clippingRectangle composeToBounds compositionRectangle createParagraph editorClass fit installEditorToReplace: paragraph paragraphClass predecessorChanged predecessor:successor: privateOwner: releaseEditor releaseParagraph releaseParagraphReally removedMorph: selectionChanged selectionChanged: setDefaultContentsIfNil setPredecessor: setSuccessor: text:textStyle: text:textStyle:wrap:color:predecessor:successor: updateFromParagraph) ('blinking' blinkStart blinkStart: onBlinkCursor resetBlinkCursor startBlinking stopBlinking) ('layout-properties' hResizing hResizing: vResizing vResizing: wrapDirection) ('printing' fullPrintOn:) ('Multilingual-ImmPlugin' preferredKeyboardPosition) ('submorphs - add/remove' addMorphFront:fromWorldPosition: delete goBehind) ('converting' asText withNoLineLongerThan:) !
TabbedPalette removeSelector: #becomeStandardPalette!
!TabbedPalette reorganize! ('dropping/grabbing' wantsDroppedMorph:event:) ('halos and balloon help' defersHaloOnClickTo:) ('initialization' addTabFor:font: addTabForBook: addTabForBook:withBalloonText: defaultColor defaultPageSize initialize newTabs: setInitialState) ('misc menu items' recolorTabs showNoPalette showNoPaletteAndHighlightTab: sortTabs:) ('miscellaneous' currentPalette tabsMorph) ('navigation' transitionSpecFor:) ('other' setExtentFromHalo:) ('palette menu' addBookMenuItemsTo:hand: addMenuTab) ('scraps tab' hasScrapsTab scrapsBook showScrapsTab) ('user-interface' selectTab: selectTabNamed: selectTabOfBook: tabMorphs tabNamed:) ('submorphs - add/remove' replaceSubmorph:by:) !
SystemWindow removeSelector: #extantSketchEditor! SystemWindow removeSelector: #wantsExpandBox! SystemWindow removeSelector: #wantsHalo!
!SystemWindow reorganize! ('drawing' areasRemainingToFill: colorForInsets makeMeVisible wantsRoundedCorners) ('events' doFastFrameDrag: filterEvent:for: handleListenEvent: handleMouseDown: handleMouseUp: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: paneTransition: secondaryPaneTransition:divider: startDragFromLabel: wantsToBeDroppedInto:) ('geometry' extent: justDroppedInto:event: labelRect paneMorphs panelRect position: removeMenuBox setPaneRectsFromBounds) ('initialization' addCloseBox addExpandBox addGrips addKeyboardShortcuts addLabelArea addMenuControl applyModelExtent boxExtent createBox: createCloseBox createCollapseBox createExpandBox createMenuBox defaultBounds defaultColor initialize initializeKeyboardShortcuts initializeLabelArea initializeWithLabel: maximumExtent maximumExtent: model: removeKeyboardShortcuts replaceBoxes setDefaultParameters setFramesForLabelArea) ('label' addLabel getRawLabel knownName label labelArea labelHeight labelWidgetAllowance relabel relabelEvent: setLabel: setLabelWidgetAllowance tryToRenameTo: update: widthOfFullLabelText) ('layout' assureLabelAreaVisible changeCellGapOfLayoutFrames: convertAlignment displayScaleChangedBy: layoutBounds putLabelItemsInLabelArea) ('menu' addCustomMenuItems:hand: buildWindowMenu changeColor deleteCloseBox fullScreen fullScreenMaximumExtent makeClosable makeSecondTopmost makeUnclosable offerWindowMenu sendToBack setWindowColor takeOutOfWindow wantsYellowButtonMenu) ('object fileIn' convertToCurrentVersion:refStream:) ('open/close' anyOpenWindowLikeMeIn: closeBoxHit delete initialExtent mustNotClose openAsIs openAsIsIn: openInWorld: openInWorld:extent: openInWorldExtent: postAcceptBrowseFor:) ('panes' addMorph:frame: addMorph:fullFrame: holdsTranscript paneMorphSatisfying: replacePane:with: setUpdatablePanesFrom: titleAndPaneText updatablePanes updateBox:color: updateBoxesColor:) ('resize/collapse' allowReframeHandles allowReframeHandles: collapse collapseOrExpand collapsedFrame contractToOriginalSize dragToEdgeDistance dragToEdgesSelectorFor:in: expand expandBoxHit expandToFullScreen fastFramingOn fullFrame getBoundsWithFlex getCollapsedFrame isCollapsed isPoint:nearBottomLeftOf: isPoint:nearBottomOf: isPoint:nearBottomRightOf: isPoint:nearLeftOf: isPoint:nearRightOf: isPoint:nearTopLeftOf: isPoint:nearTopOf: isPoint:nearTopRightOf: mouseLeaveEvent:fromPane: paneWithLongestSide:near: reframePanesAdjoining:along:to: setBoundsWithFlex: unexpandedFrame unexpandedFrame:) ('stepping' amendSteppingStatus stepAt: stepTime wantsSteps wantsStepsWhenCollapsed) ('testing' isSystemWindow isWindowForModel: shouldDropOnMouseUp wantsToBeCachedByHand) ('top window' beKeyWindow beKeyWindowIfNeeded: comeToFront comeToFrontModally dimWindowButtons isKeyWindow undimWindowButtons updatePanesFromSubmorphs) ('thumbnail' icon) ('polymorph' modalChild modalLockTo: modalOwner modalUnlockFrom: rememberedKeyboardFocus) ('focus' activate defaultFocusMorph defaultFocusMorph: isActive isActive: isLookingFocused isLookingFocused: lockWindowDecorations lockWindowTitle lookFocused lookUnfocused passivate passivateIfNeeded unlockWindowDecorations unlockWindowTitle updateFocusLookAtHand updateFocusLookForKeyboardFocus windowDecorations) ('colors' existingPaneColor gradientWithColor: paneColor paneColor: paneColorToUse paneColorToUseWhenNotActive raisedColor refreshWindowColor restoreDefaultPaneColor setStripeColorsFrom: setWindowColor: updatePaneColors) ('user interface' applyUserInterfaceTheme) ('*ToolBuilder-Morphic-opening' openAsTool) ('*services-base' requestor topWindow) ('*60Deprecated-open/close' anyOpenWindowLikeMe) !
SuperSwikiServer removeSelector: #matchingEntries:! StringButtonMorph removeSelector: #adaptToWorld:!
!StringButtonMorph reorganize! ('accessing' actionSelector actionSelector: arguments arguments: target target:) ('button' doButtonAction) ('copying' updateReferencesUsing: veryDeepFixupWith: veryDeepInner:) ('event handling' handlesMouseDown: handlesMouseStillDown: mouseDown: mouseMove: mouseStillDown: mouseUp:) ('initialization' initialize) ('menu' addCustomMenuItems:hand: addTargetingMenuItems:hand: clearTarget setActWhen setActionSelector setArguments setLabel setTarget:) ('submorphs - add/remove' actWhen:) ('classification' isButton) !
SqueakFurtherCorePackagesHelp class removeSelector: #etoys!
!SmartRefStream reorganize! ('accessing' structures: superclasses:) ('class changed shape' catalogValues:size: conversionMethodsFor: storeInstVarsIn:from: writeClassRename:was: writeClassRenameMethod:was:fromInstVars: writeConversionMethod:class:was:fromInstVars:to: writeConversionMethodIn:fromInstVars:to:renamedFrom:) ('conversion' inputSensorx0 worldMorphbosfcebbfgccpmcpbttloiairfidcuwhavcdsll0) ('import image segment' applyConversionMethodsTo:className:varMap: checkFatalReshape: convert1:to:allVarMaps: convert2:allVarMaps: mapClass:origName: reshapedClassesIn:) ('read write' appendClassDefns checkCrLf initKnownRenames initShapeDicts instVarInfo: mapClass: moreObjects next nextAndClose nextPut: nextPutObjOnly: noHeader readInstance readInstanceSize:clsname:refPosn: readShortInst readWordLike recordImageSegment: renamed renamedConv restoreClassInstVars saveClassInstVars scanFrom: scanFrom:environment: setStream: setStream:reading: structures superclasses uniClasesDo: uniClassInstVarsRefs: verifyStructure versionSymbol:) ('*Morphic-conversion' bookPageMorphbosfcepcbbfgcc0 clippingMorphbosfcep0 clippingMorphbosfcepc0 dropShadowMorphbosfces0 layoutMorphbosfcepbbochvimol0 layoutMorphbosfcepcbbochvimol0 morphicEventtcbks0 morphicSoundEventtcbkss0 multiNewParagraphttfclpomsswfpp0 myMorphbosfce0 newMorphicEventts0) ('*ST80-conversion' scrollControllermvslrrsmsms0) ('*Graphics-conversion' transparentColorrcc0) ('strings-conversion' abstractStringx0 multiStringx0 multiSymbolx0) !
ColorPickerMorph removeSelector: #delete! ColorPickerMorph removeSelector: #getColorFromKedamaWorldIfPossible:!
!ColorPickerMorph reorganize! ('accessing' argument argument: deleteOnMouseUp deleteOnMouseUp: locationIndicator originalColor: selectedColor selector selector: sourceHand sourceHand: target target: updateContinuously updateContinuously:) ('drawing' drawOn:) ('event handling' handlesMouseDown: inhibitDragging mouseDown: mouseUp:) ('geometry testing' containsPoint:) ('halos and balloon help' isLikelyRecipientForMouseOverHalos) ('initialization' buildChartForm choseModalityFromPreference initialize initializeForPropertiesPanel initializeModal: updateSelectorDisplay) ('menu' addCustomMenuItems:hand: pickUpColorFor: toggleDeleteOnMouseUp toggleUpdateContinuously) ('other' addToWorld:near: bestPositionNear:inWorld: indicateColorUnderMouse putUpFor:near: trackColorUnderMouse) ('stepping' step stepTime) ('private' anchorAndRunModeless: argumentsWith: deleteAllBalloons modalBalloonHelpAtPoint: pickColorAt: positionOfColor: trackColorAt: updateAlpha: updateColor:feedbackColor: updateTargetColor updateTargetColorWith:) ('submorphs - add/remove' delete) !
SketchMorph removeSelector: #firstIntersectionWithLineFrom:to:!
!SketchMorph reorganize! ('accessing' form form: framesToDwell framesToDwell: keepAspectRatio keepAspectRatio: nominalForm: originalForm: rotatedForm scaleFactor scalePoint scalePoint: setNewFormFrom: useInterpolation useInterpolation: wantsSimpleSketchMorphHandles) ('caching' releaseCachedState) ('drawing' canBeEnlargedWithB3D drawHighResolutionOn:in: drawInterpolatedImage:on: drawOn: generateInterpolatedForm generateRotatedForm) ('support' baseGraphic baseGraphic: flipHorizontal flipVertical rotationStyle rotationStyle: wantsRecolorHandle) ('geometry' extent:) ('geometry testing' containsPoint:) ('halos and balloon help' isLikelyRecipientForMouseOverHalos wantsDirectionHandles wantsDirectionHandles:) ('initialization' initialize initializeWith:) ('layout' layoutChanged) ('menu' addBorderToShape: addCustomMenuItems:hand: addPaintingItemsTo:hand: blur callThisBaseGraphic edgeDetect editDrawing editDrawingIn:forBackground: emboss erasePixelsOfColor: erasePixelsUsing: insertIntoMovie: recolorPixelsOfColor:with: recolorPixelsUsing: reduceColorPalette: restoreBaseGraphic restoreBaseGraphicFromMenu setRotationStyle sharpen toggleInterpolation useInterpolationString) ('menus' addFillStyleMenuItems:hand: addToggleItemsToHaloMenu: changePixelsOfColor:toColor: chooseNewGraphic collapse) ('objects from disk' convertToCurrentVersion:refStream:) ('other' newForm: replaceSelfWithMovie) ('parts bin' initializeToStandAlone) ('pen support' clearExtent:fillColor: penOnMyForm revealPenStrokes) ('rotate scale and flex' forwardDirection: heading:) ('*MorphicExtras-testing' canDrawAtHigherResolution) !
SketchEditorMorph removeSelector: #wantsHaloFromClick! SimpleSliderMorph removeSelector: #isLikelyRecipientForMouseOverHalos!
!SimpleSliderMorph reorganize! ('accessing' actionSelector actionSelector: arguments arguments: maxVal maxVal: minVal minVal: target target:) ('copying' updateReferencesUsing: veryDeepFixupWith: veryDeepInner:) ('initialization' initialize) ('menu' addCustomMenuItems:hand: addSliderMenuItems:hand: addTargetingMenuItems:hand: clearTarget descendingString setActionSelector setArguments setLabel setMaxVal setMinVal setMinVal: setTarget: toggleDescending toggleTruncate truncateString) ('model access' setValue:) ('parts bin' initializeToStandAlone) ('private' adjustToValue: getScaledValue setMaxVal: setScaledValue: truncate truncate:) !
SimpleHierarchicalListMorph class removeSelector: #submorphsExample!
!SimpleHierarchicalListMorph class reorganize! ('instance creation' expandedForm notExpandedForm on:list:selected:changeSelected: on:list:selected:changeSelected:menu: on:list:selected:changeSelected:menu:keystroke:) ('preferences' applyUserInterfaceTheme expandAllLimit expandAllLimit: themeProperties wrappedNavigation wrappedNavigation:) !
HaloMorph removeSelector: #addChooseGraphicHandle:! HaloMorph removeSelector: #addMakeSiblingHandle:! HaloMorph removeSelector: #addPaintBgdHandle:! HaloMorph removeSelector: #addPoohHandle:! HaloMorph removeSelector: #addRepaintHandle:! HaloMorph removeSelector: #addScriptHandle:! HaloMorph removeSelector: #addTileHandle:! HaloMorph removeSelector: #addViewHandle:! HaloMorph removeSelector: #addViewingHandle:! HaloMorph removeSelector: #doDupOrMakeSibling:with:! HaloMorph removeSelector: #doMakeSibling:with:! HaloMorph removeSelector: #doMakeSiblingOrDup:with:! HaloMorph removeSelector: #fadeIn! HaloMorph removeSelector: #fadeInInitially! HaloMorph removeSelector: #fadeOut! HaloMorph removeSelector: #fadeOutFinally! HaloMorph removeSelector: #handleEntered! HaloMorph removeSelector: #handleLeft! HaloMorph removeSelector: #isMagicHalo! HaloMorph removeSelector: #isMagicHalo:! HaloMorph removeSelector: #mouseDown:! HaloMorph removeSelector: #openViewerForTarget:with:! HaloMorph removeSelector: #popUpMagicallyFor:hand:! HaloMorph removeSelector: #tearOffTileForTarget:with:! SimpleHaloMorph removeSelector: #isMagicHalo! SimpleHaloMorph removeSelector: #popUpMagicallyFor:hand:!
!IconicButton reorganize! ('events' mouseEnter: mouseLeave:) ('initialization' borderNormal borderThick buttonSetup defaultBorderWidth initialize initializeWithThumbnail:withLabel:andColor:andSend:to: initializeWithThumbnail:withLabel:andSend:to: setDefaultLabel stationarySetup) ('menu' addLabelItemsTo:hand:) ('button' doButtonAction) ('compatibility' dim undim) ('ui' darken darkenedForm restoreImage shedSelvedge) ('label' labelFromString: labelGraphic: labelMorph) ('*MorphicExtras-initialization' initializeToShow:withLabel:andSend:to:) !
SimpleButtonMorph removeSelector: #adaptToWorld:!
!ServerDirectory class reorganize! ('available servers' addLocalProjectDirectory: addServer:named: localProjectDirectories nameForServer: projectServers removeServerNamed: removeServerNamed:ifAbsent: resetLocalProjectDirectories resetServers serverForURL: serverNamed: serverNamed:ifAbsent: serverNames servers) ('class initialization' cleanUp: initialize) ('misc' defaultStemUrl newFrom: on: parseFTPEntry: secondsForDay:month:yearOrTime:thisMonth:thisYear:) ('school support' projectDefaultDirectory) ('server prefs' determineLocalServerDirectory: fetchExternalSettingsIn: parseServerEntryFrom: releaseExternalSettings serverConfDirectoryName storeCurrentServersIn: transferServerDefinitionsToExternal) ('*UpdateStream-server groups' convertGroupNames groupNames serverInGroupNamed: serversInGroupNamed:) !
Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl keepAlive encodingName' classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers' poolDictionaries: '' category: 'Network-RemoteDirectory'! SelectionMorph removeSelector: #couldMakeSibling! SelectionMorph removeSelector: #preferredDuplicationHandleSelector! ScrollableField removeSelector: #cursorWrapped:! ScrollableField removeSelector: #getAllButFirstCharacter! ScrollableField removeSelector: #getNumericValue! ScrollableField removeSelector: #insertCharacters:! ScrollableField removeSelector: #insertContentsOf:! ScrollableField removeSelector: #setNumericValue:!
!ScreeningMorph reorganize! ('accessing' passElseBlock: passingColor:) ('drawing' fullDrawOn:) ('halos and balloon help' wantsRecolorHandle) ('geometry testing' containsPoint:) ('initialization' initialize) ('layout' layoutChanged) ('menu' addCustomMenuItems:hand: chooseBlockingColor choosePassingColor exchange showScreenOnly showScreenOverSource showScreened showSourceOnly) ('private' removedMorph: screenForm screenMorph sourceMorph) ('submorphs - add/remove' addMorph:) !
ScreenController removeSelector: #standardGraphicsLibrary! ReleaseBuilder class removeSelector: #beautifyEtoys! FlapTab removeSelector: #makeNewDrawing:! FlapTab removeSelector: #startOrFinishDrawing:! FlapTab removeSelector: #thicknessString! Quadrangle class removeSelector: #exampleInViewer!
!ProjectSorterMorph reorganize! ('initialization' addControls defaultBorderWidth defaultColor initialize navigator:listOfPages:) ('event handling' clickFromSorterEvent:morph:) ('controls' insertNewProject:) ('private' morphsForMyContentsFrom:sizedTo: sorterMorphForProjectNamed:) !
ProjectNavigationMorph removeSelector: #buttonPaint! ProjectNavigationMorph removeSelector: #doNewPainting! ProjectNavigationMorph removeSelector: #editProjectInfo! ProjectNavigationMorph removeSelector: #makeTheSimpleButtons!
!ProjectLoading class reorganize! ('accessing' projectStreamFromArchive: thumbnailFromUrl:) ('loading' installRemoteNamed:from:named:in: openFromDirectory:andFileName: openFromFile:fromDirectory:withProjectView: openName:stream:fromDirectory:withProjectView: openName:stream:fromDirectory:withProjectView:clearOriginFlag: openOn:) ('utilities' bestAccessToFileName:andDirectory: useTempChangeSet) ('loading - support' checkSecurity:preStream:projStream: fileInName:archive:morphOrList: loadImageSegment:fromDirectory:withProjectView:numberOfFontSubstitutes:substituteFont:mgr: makeExistingView:project:projectsToBeDeleted: morphOrList:stream:fromDirectory:archive: parseManifest:) !
ProjectLauncher removeSelector: #cancelLogin! ProjectLauncher removeSelector: #doEtoyLogin! ProjectLauncher removeSelector: #loginAs:! ProjectLauncher removeSelector: #prepareForLogin! ProjectLauncher removeSelector: #proceedWithLogin! ProjectLauncher removeSelector: #startUpAfterLogin! AbstractLauncher subclass: #ProjectLauncher instanceVariableNames: 'showSplash splashURL whichFlaps' classVariableNames: 'SplashMorph' poolDictionaries: '' category: 'System-Download'!
!ProjectLauncher reorganize! ('initialization' initialize setupFlaps setupFromParameters) ('running' hideSplashMorph installProjectFrom: showSplashMorph startUp) ('private' showSplash) !
Project class removeSelector: #publishInSexp!
!Project class reorganize! ('class initialization' cleanUp: cleanUpProjectPreferences initialize localeChanged rebuildAllProjects) ('constants' current uiManager uiProcess) ('squeaklet on server' enterIfThereOrFind: fromUrl: isBadNameForStoring: loaderUrl mostRecent:onServer: namedUrl: parseProjectFileName: projectExtension serverDirectoryFromURL: serverFileFromURL: squeakletDirectory sweep:) ('utilities' addingProject: advanceToNextProject allNames allNamesAndProjects allProjects allProjectsOrdered canWeLoadAProjectNow chooseNaturalLanguage deletingProject: enter: flattenProjectHierarchy forget: hierarchyOfNamesAndProjects jumpToProject jumpToSelection: maybeForkInterrupt named: named:in: namedWithDepth: ofWorld: projectHierarchy releaseProjectReferences: removeAll: removeAllButCurrent returnToParentProject returnToPreviousProject storeAllInSegments topProject versionForFileName:) ('*Morphic-Support' allMorphicProjects) ('error recovery' tryEmergencyEvaluatorForRecovery: tryOtherProjectForRecovery:) ('shrinking' removeProjectsFromSystem) ('snapshots' shutDown: startUp:) ('*ST80-Support' allMVCProjects) ('preferences') ('*60Deprecated-error recovery' handlePrimitiveError:) ('*61Deprecated-utilities' resumeProcess:) !
MorphicProject removeSelector: #exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction:! MorphicProject removeSelector: #initMorphic! MorphicProject removeSelector: #myPlayerClasses! MorphicProject removeSelector: #setFlaps!
!MorphicProject reorganize! ('display' displayScaleChangedFrom:to: invalidate noDisplayDuring: previewImageForm restore viewLocFor:) ('initialize' initialize installPasteUpAsWorld: openProject: setWorldBackground:) ('testing' isMorphic) ('menu messages' assureNavigatorPresenceMatchesPreference makeThumbnail) ('utilities' addItem:toMenu:selection:color:thumbnail: composeDisplayTextIntoForm: createViewIfAppropriate do:withProgressInfoOn:label: findAFolderForProject:label: findProjectView: jumpToProject launchSystemFiles:event: offerMenu:from:shifted: pointerMoved setAsBackground: showImage:named: textWindows) ('docking bars support' assureMainDockingBarPresenceMatchesPreference createOrUpdateMainDockingBar dockingBar dockingBar: removeMainDockingBar showWorldMainDockingBar showWorldMainDockingBar: showWorldMainDockingBarString toggleShowWorldMainDockingBar) ('file in/out' acceptProjectDetails: armsLengthCommand:withDescription: compressFilesIn:to:in: compressFilesIn:to:in:resources: exportSegmentWithChangeSet:fileName:directory: exportSegmentWithChangeSet:fileName:directory:withoutInteraction: loadFromServer: noteManifestDetailsIn: storeSegment storeSegmentNoFile) ('enter' clearGlobalState enterAsActiveSubprojectWithin: finalEnterActions: finalExitActions: initializeMenus isIncompletelyLoaded resumeEventRecorder: scheduleProcessForEnter startUpActions suspendProcessForDebug terminateProcessForLeave wakeUpTopWindow) ('squeaklet on server' enterIfThereOrFind: openBlankProjectNamed:) ('release' deletingProject: prepareForDelete) ('language' chooseNaturalLanguage updateLocaleDependents) ('editors' bitEdit: bitEdit:at:scale: editCharacter:ofFont: formEdit: formViewClass openImage:name:saveResource:) ('futures' future:do:at:args: future:send:at:args:) ('active process' spawnNewProcess spawnNewProcessAndTerminateOld: spawnNewProcessIfThisIsUI: uiProcess uiProcess:) ('transcripter' displayTranscripter: initializeParagraphForTranscripter:) ('subprojects' addProject: subProjects) ('accessing' color topMorphicProject) ('updating' applyUserInterfaceTheme canApplyUserInterfaceTheme) ('scheduling & debugging' addDeferredUIMessage: fatalDrawingError: interruptCleanUpFor: lastDeferredUIMessage openDebuggerWindow: recursiveError: restoreDisplay resumeProcessSafely: suspendProcessSafely:) ('flaps support' assureFlapIntegrity cleanseDisabledGlobalFlapIDsList enableDisableGlobalFlap: flapsSuppressed: globalFlapEnabledString: globalFlapWithIDEnabledString: isFlapEnabled: isFlapIDEnabled: suppressFlapsString toggleFlapsSuppressed) ('protocols' currentVocabulary) !
Project removeSelector: #restoreReferences!
!Project reorganize! ('accessing' changeSet color displayDepth displayDepth: explicitName explicitName: findProjectView: forgetExistingURL labelString lastDirectory: lastSavedAtSeconds name nameAdjustedForDepth nextProject nilParentError previousProject projectChangeSet renameTo: storeNewPrimaryURL: thumbnail thumbnail: topProject transcript uiManager urlList viewSize viewSize: world) ('active process' depth spawnNewProcessIfThisIsUI: uiProcess) ('displaying' displayDepthChanged displayScaleChangedFrom:to: displaySizeChanged displayZoom: imageForm imageFormOfSize:depth: invalidate noDisplayDuring: previewImageForm restore restoreDisplay showZoom shrinkDisplay viewLocFor:) ('file in/out' armsLengthCommand:withDescription: assureIntegerVersion bumpVersion: couldBeSwappedOut currentVersionNumber decideAboutCreatingBlank: doArmsLengthCommand: downloadUrl ensureChangeSetNameUnique exportSegmentFileName:directory: exportSegmentFileName:directory:withoutInteraction: exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction: exportSegmentWithCatagories:classes:fileName:directory: exportSegmentWithChangeSet:fileName:directory: findAFolderToLoadProjectFrom findAFolderToStoreProjectIn fromMyServerLoad: hasBadNameForStoring htmlPagePrototype loadFromServer loadFromServer: objectForDataStream: primaryServer primaryServerIfNil: projectExtension revert saveAs saveForRevert serverList squeakletDirectory storeAttributeKey:value:on: storeAttributesOn: storeDataOn: storeHtmlPageIn: storeManifestFileIn: storeOnServer storeOnServerAssumingNameValid storeOnServerInnards storeOnServerShowProgressOn:forgetURL: storeOnServerWithProgressInfo storeOnServerW ithProgr essInfoOn: storeSegment storeSegmentNoFile storeSomeSegment storeToMakeRoom tryToFindAServerWithMe url urlForLoading versionForFileName versionFrom: versionedFileName writeFileNamed:fromDirectory:toServer: writeStackText:in:registerIn:) ('flaps support' flapsSuppressed flapsSuppressed: showSharedFlaps) ('initialization' initialExtent initialProject initialize installNewDisplay:depth: openProject: resetTranscript setChangeSet: setServer windowActiveOnFirstClick windowReqNewLabel:) ('language' chooseNaturalLanguage localeChanged localeID naturalLanguage updateLocaleDependents) ('menu messages' assureNavigatorPresenceMatchesPreference doWeWantToRename exit fileOut installProjectPreferences makeThumbnail saveProjectPreferences validateProjectNameIfOK:) ('printing' addSubProjectNamesTo:indentation: printOn:) ('project parameters' initializeProjectParameters initializeProjectPreferences noteThatParameter:justChangedTo: parameterAt: parameterAt:ifAbsent: projectParameterAt: projectParameterAt:ifAbsent: projectParameterAt:ifAbsentPut: projectParameterAt:put: projectParameters projectPreferenceAt: projectPreferenceAt:ifAbsent: projectPreferenceFlagDictionary rawParameters removeParameter:) ('release' addDependent: canDiscardEdits close delete deletingProject: forget okToChange prepareForDelete release removeChangeSetIfPossible windowIsClosing) ('resources' abortResourceLoading resourceDirectoryName resourceManager resourceManager: resourceUrl startResourceLoading storeResourceList:in:) ('SuperSwiki' tellAFriend tellAFriend:) ('*sound' beep) ('enter' enter enter: enter:revert:saveForRevert: finalEnterActions: finalExitActions: loadState saveState scheduleProcessForEnter shutDownActions startUpActions terminateProcessForLeave wakeUpTopWindow) ('utilities' addItem:toMenu:selection:color:thumbnail: buildJumpToMenu: composeDisplayTextIntoForm: do:withProgressInfoOn:label: findAFolderForProject:label: jumpToProject jumpToSelection: offerMenu:from:shifted: pointerMoved setAsBackground: showImage:named: textWindows) ('squeaklet on server' enterIfThereOrFind: openBlankProjectNamed:) ('futures' future:do:at:args: future:send:at:args:) ('editors' bitEdit: bitEdit:at:scale: editCharacter:ofFont: formEdit: formViewClass openImage:name:saveResource:) ('transcripter' displayTranscripter: initializeParagraphForTranscripter:) ('sub-projects & hierarchy' addProject: beTopProject children isTopProject liftSubProjects parent setParent: subProjects withChildrenDo:) ('enter - recovery' enterForEmergencyRecovery suspendProcessForDebug) ('testing' isCurrentProject isIncompletelyLoaded isMorphic) ('shrinking' removeAllOtherProjects) ('*ST80-Testing' isMVC) ('*60Deprecated-accessing' setThumbnail: setViewSize:) ('scheduling & debugging' addDeferredUIMessage: debugProcess:inDialog: debugProcess:inWindow: guardRecursiveError:during: interruptCleanUpFor: interruptName: interruptName:message: interruptName:message:preemptedProcess: interruptName:preemptedProcess: lastDeferredUIMessage openDebuggerWindow: prepareProcessForDebugger: primitiveError: recursiveError: resumeProcessSafely: suspendProcessSafely:) ('*MorphicExtras-accessing' useOwnChangeSetWithCurrentName useParentChangeSetButSetProjectName:) ('protocols' currentVocabulary) !
Preferences class removeSelector: #annotationEditingWindow! Preferences class removeSelector: #automaticViewerPlacement! Preferences class removeSelector: #batchPenTrails! Preferences class removeSelector: #capitalizedReferences! Preferences class removeSelector: #cautionBeforeClosing! Preferences class removeSelector: #chooseEToysFont! Preferences class removeSelector: #chooseEToysTitleFont! Preferences class removeSelector: #classicTilesSettingToggled! Preferences class removeSelector: #compactViewerFlaps! Preferences class removeSelector: #debugMenuItemsInvokableFromScripts! Preferences class removeSelector: #defaultPaintingExtent! Preferences class removeSelector: #dropProducesWatcher! Preferences class removeSelector: #eToyFriendly! Preferences class removeSelector: #eToyFriendlyChanged! Preferences class removeSelector: #eToyLoginEnabled! Preferences class removeSelector: #editAnnotations! Preferences class removeSelector: #enableLocalSave! Preferences class removeSelector: #expandedPublishing! Preferences class removeSelector: #fenceEnabled! Preferences class removeSelector: #fenceSoundEnabled! Preferences class removeSelector: #fenceSoundEnabled:! Preferences class removeSelector: #haloTransitions! Preferences class removeSelector: #includeSoundControlInNavigator! Preferences class removeSelector: #keepTickingWhilePainting! Preferences class removeSelector: #largeTilesSettingToggled! Preferences class removeSelector: #magicHalos! Preferences class removeSelector: #menuColorFromWorld! Preferences class removeSelector: #menuColorString! Preferences class removeSelector: #messengersInViewers! Preferences class removeSelector: #mouseOverHalos! Preferences class removeSelector: #mouseOverHalosChanged! Preferences class removeSelector: #mvcProjectsAllowed! Preferences class removeSelector: #navigatorOnLeftEdge! Preferences class removeSelector: #noviceMode! Preferences class removeSelector: #noviceModeSettingChanged! Preferences class removeSelector: #okToReinitializeFlaps! Preferences class removeSelector: #oliveHandleForScriptedObjects! Preferences class removeSelector: #propertySheetFromHalo! Preferences class removeSelector: #selectiveHalos! Preferences class removeSelector: #setEToysFontTo:! Preferences class removeSelector: #setEToysTitleFontTo:! Preferences class removeSelector: #showAdvancedNavigatorButtons! Preferences class removeSelector: #showFlapsWhenPublishing! Preferences class removeSelector: #simpleMenus! Preferences class removeSelector: #standardEToysFont! Preferences class removeSelector: #standardEToysTitleFont! Preferences class removeSelector: #tabAmongFields! Preferences class removeSelector: #tileTranslucentDrag! Preferences class removeSelector: #typeCheckingInTileScripting! Preferences class removeSelector: #uniTilesClassic! Preferences class removeSelector: #universalTiles! Preferences class removeSelector: #universalTilesSettingToggled! Preferences class removeSelector: #unlimitedPaintArea! Preferences class removeSelector: #useCategoryListsInViewers! Preferences class removeSelector: #useVectorVocabulary! Preferences class removeSelector: #vectorVocabularySettingChanged! Preferences class removeSelector: #viewersInFlaps!
!Preferences class reorganize! ('accessing' allPreferences atomicUpdatePreferences: dictionaryOfPreferences pragmaIdFor:getter: pragmaPreferenceFor:getter: preferenceAt: preferenceAt:ifAbsent:) ('class initialization' initialize unload) ('get/set' doesNotUnderstand: setPreference:toValue: setPreference:toValue:during: valueOfPreference: valueOfPreference:ifAbsent:) ('initialization' chooseInitialSettings cleanUp: cleanUpPragmaPreferences initializeDictionaryOfPreferences registerForEvents removeObsolete resetDefaultValues setPreferencesFrom:) ('parameters' expungeParameter: initializeParameters inspectParameters parameterAt: parameterAt:ifAbsentPut: parameterAt:ifAbsent: parameters setParameter:to:) ('reacting to change' isChangeSelector:) ('standard queries' alphabeticalProjectMenu alternateHandlesLook alternativeBrowseIt alternativeWindowBoxesLook alwaysHideHScrollbar alwaysShowHScrollbar alwaysShowVScrollbar annotationPanes areaFillsAreTolerant areaFillsAreVeryTolerant autoIndent automaticFlapLayout automaticKeyGeneration balloonHelpEnabled balloonHelpInMessageLists biggerHandles caseSensitiveFinds changeSetVersionNumbers checkForSlips checkForUnsavedProjects classicNavigatorEnabled cmdDotEnabled cmdGesturesEnabled collapseWindowsInPlace confirmFirstUseOfStyle conversionMethodsAtFileOut debugHaloHandle debugLogTimestamp debugPrintSpaceLog debugShowDamage decorateBrowserButtons diffsInChangeList diffsWithPrettyPrint dismissAllOnOptionClose easySelection extraDebuggerButtons fastDragWindowForMorphic fullScreenLeavesDeskMargins generalizedYellowButtonMenu haloEnclosesFullBounds higherPerformance honorDesktopCmdKeys infiniteUndo logDebuggerStackToFile maintainHalos menuAppearance3d menuKeyboardControl menuWithIc ons moda lColorPickers mouseOverForKeyboardFocus optionalButtons passwordsOnPublish personalizedWorldMenu postscriptStoredAsEPS projectsSentToDisk projectViewsInWindows projectZoom purgeUndoOnQuit readDocumentAtStartup readDocumentAtStartup: restartAlsoProceeds reverseWindowStagger scrollBarsNarrow scrollBarsOnRight securityChecksEnabled serverMode showBoundsInHalo showDirectionForSketches showDirectionHandles showProjectNavigator showSecurityStatus showSharedFlaps showSplitterHandles signProjectFiles smartUpdating standaloneSecurityChecksEnabled startInUntrustedDirectory swapMouseButtons systemWindowEmbedOK timeStampsInMenuTitles tinyDisplay traceMessages turnOffPowerManager twentyFourHourFileStamps uniqueNamesInHalos useButtonPropertiesToFire useUndo visualExplorer warnAboutInsecureContent warnIfNoChangesFile warnIfNoSourcesFile wordStyleCursorMovement) ('themes' outOfTheBox personal) ('*PreferenceBrowser' addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:viewRegistry:) ('private' compileAccessorForPreference: compileAccessorForPreferenceNamed:value: preference:category:description:type: preference:categoryList:description:type:) ('prefs - fonts' aaFontsColormapDepth chooseBalloonHelpFont chooseCodeFont chooseFixedFont chooseFlapsFont chooseFontWithPrompt:andSendTo:withSelector:highlightSelector: chooseHaloLabelFont chooseListFont chooseMenuFont chooseStandardButtonFont chooseSystemFont chooseWindowTitleFont decreaseFontSize fontConfigurationMenu fontConfigurationMenu: increaseFontSize printStandardSystemFonts refreshFontSettings restoreDefaultFonts restoreDefaultFontsForJapanese restoreFontsAfter: setBalloonHelpFontTo: setButtonFontTo: setCodeFontTo: setDemoFonts setFixedFontTo: setFlapFontTo: setFlapsFontTo: setHaloLabelFontTo: setListFontTo: setMenuFontTo: setPaintBoxButtonFontTo: setSystemFontTo: setWindowTitleFontTo: standardBalloonHelpFont standardButtonFont standardCodeFont standardDefaultTextFont standardFixedFont standardFlapFont standardHaloLabelFont standardListFont standardMenuFont standardPaintBoxButtonFont standardSystemFont standardWindowTitleFont subPixelRenderColorFonts subPixelRender Fonts wi ndowTitleFont windowTitleStyle) ('support - misc' acceptAnnotationsFrom: addModelItemsToWindowMenu: automaticFlapLayoutString initialExtent inspectPreferences letUserPersonalizeMenu navigatorShowingString personalizeUserMenu: setArrowheads staggerPolicyString wantsChangeSetLogging) ('add/remove - specific' addBooleanPreference:categories:default:balloonHelp: addBooleanPreference:category:default:balloonHelp: addColorPreference:categories:default:balloonHelp: addColorPreference:category:default:balloonHelp: addFontPreference:categories:default:balloonHelp: addFontPreference:category:default:balloonHelp: addNumericPreference:categories:default:balloonHelp: addNumericPreference:category:default:balloonHelp: addTextPreference:categories:default:balloonHelp: addTextPreference:category:default:balloonHelp:) ('add/remove' addPragmaPreference: addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:type: removeAllPreferencesSuchThat: removePreference:) ('add/remove - convenience' addPreference:categories:default:balloonHelp: addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: addPreference:category:default: addPreference:category:default:balloonHelp: addPreference:default:) ('prefs - annotations' annotationInfo defaultAnnotationInfo defaultAnnotationRequests defaultAnnotationRequests:) ('updating - system' annotationPanesChanged displaySizeChanged infiniteUndoChanged optionalButtonsChanged roundedWindowCornersChanged sharedFlapsSettingChanged showProjectNavigatorChanged smartUpdatingChanged) ('prefs - misc' balloonHelpDelayTime borderColorWhenRunning cmdKeysInText defaultAuthorName defaultWorldColor desktopColor desktopColor: desktopMenuTitle enableProjectNavigator maxBalloonHelpLineLength maxBalloonHelpLineLength: metaMenuDisabled preserveCommandExcursions scrollBarColor scrollBarWidth suppressWindowTitlesInInstanceBrowsers useFormsInPaintBox:) ('themes - tools' browseThemes installTheme: offerThemesMenu themeChoiceButtonOfColor:font:) ('support' categoryList categoryListOfPreference: giveHelpWithPreferences okayToChangeProjectLocalnessOf: preferencesInCategory: typeForValue:) ('prefs - halos' classicHaloSpecs classicHalosInForce customHaloSpecs customHalosInForce editCustomHalos haloSpecifications haloSpecificationsForWorld haloTheme iconicHaloSpecifications iconicHalosInForce installClassicHaloSpecs installCustomHaloSpecs installHaloSpecsFromArray: installHaloTheme: installIconicHaloSpecs installSimpleHaloSpecs resetHaloSpecifications showChooseGraphicHaloHandle simpleFullHaloSpecifications simpleHalosInForce) ('defaults' defaultValueTableForCurrentRelease unclassifiedCategory) ('get/set - flags' disable: enable: setFlag:toValue: setFlag:toValue:during: toggle: valueOfFlag: valueOfFlag:ifAbsent:) ('initialization - misc' disableProgrammerFacilities enableProgrammerFacilities setDefaultAnnotationInfo setNotificationParametersForStandardPreferences) ('support - file list services' fileReaderServicesForFile:suffix: serviceLoadPreferencesFromDisk services) ('initialization - save/load' loadPreferencesFrom: restorePersonalPreferences restorePreferencesFromDisk restorePreferencesFromDisk: savePersonalPreferences storePreferencesIn: storePreferencesToDisk) ('updating' localeChanged prefEvent:) ('*60Deprecated-menu colors' menuBorderColor menuBorderWidth menuColor menuLineColor menuSelectionColor menuTitleBorderColor menuTitleBorderWidth menuTitleColor) ('*morphicextras' rotationAndScaleHandlesInPaintBox) ('*60Deprecated-prefs-text' chooseInsertionPointColor chooseKeyboardFocusColor chooseTextHighlightColor initializeTextHighlightingParameters insertionPointColor insertionPointColor: keyboardFocusColor keyboardFocusColor: textHighlightColor textHighlightColor:) ('*60Deprecated-Etoys-Squeakland-window colors' windowColorHelp windowSpecificationPanel) ('*60Deprecated-parameters' parameterAt:default:) !
!PolygonMorph reorganize! ('access' isClosed isCurve isOpen makeOpenOrClosed midVertices openOrClosePhrase smoothOrSegmentedPhrase vertices) ('accessing' borderColor: borderDashSpec borderStyle: borderWidth: couldHaveRoundedCorners) ('caching' loadCachedState releaseCachedState) ('dashes' borderDashOffset dashedBorder dashedBorder: removeVertex: vertexAt:) ('debug and other' installModelIn: rotateTestFlip:) ('drawing' areasRemainingToFill: drawArrowOn:at:from: drawArrowsOn: drawBorderOn: drawBorderOn:usingEnds: drawClippedBorderOn:usingEnds: drawDashedBorderOn: drawDashedBorderOn:usingEnds: drawOnFormCanvas: drawOn:) ('editing' addHandles clickVertex:event:fromHandle: deleteVertexAt: dragVertex:event:fromHandle: dragVertex:fromHandle:vertIndex: dropVertex:event:fromHandle: dropVertex:fromHandle:vertIndex: handleColorAt: insertVertexAt:put: newVertex:event:fromHandle: newVertex:fromHandle:afterVert: updateHandles verticesAt:put:) ('event handling' handlesMouseDown: mouseDown:) ('geometry' arrowsContainPoint: bounds: closestPointTo: closestSegmentTo: extent: flipHAroundX: flipVAroundY: intersectionsWith: intersectionWithLineSegmentFromCenterTo: intersects: isBordered lineBorderColor lineBorderColor: lineBorderWidth lineBorderWidth: lineColor lineColor: lineWidth lineWidth: mergeDropThird:in:from: merge: nextDuplicateVertexIndex reduceVertices straighten transformedBy:) ('geometry testing' containsPoint:) ('initialization' beSmoothCurve beStraightSegments defaultBorderColor defaultColor initialize vertices:color:borderWidth:borderColor:) ('menu' addCustomMenuItems:hand: addPolyArrowMenuItems:hand: addPolyLIneCurveMenuItems:hand: addPolyShapingMenuItems:hand: arrowLength: arrowSpec: arrows customizeArrows: handlesShowingPhrase makeBackArrow makeBothArrows makeClosed makeForwardArrow makeNoArrows makeOpen quickFill: removeHandles setRotationCenterFrom: showingHandles showOrHideHandles specifyDashedLine standardArrows toggleHandles toggleSmoothing unrotatedLength unrotatedLength: unrotatedWidth unrotatedWidth:) ('objects from disk' convertToCurrentVersion:refStream:) ('rotate scale and flex' addFlexShellIfNecessary heading heading: referencePosition rotationCenter rotationCenter: rotationDegrees rotationDegrees:) ('smoothing' coefficients computeNextToEndPoints derivs:first:second:third: lineSegmentsDo: nextToFirstPoint nextToLastPoint slopes: straightLineSegmentsDo:) ('stepping' step stepTime wantsSteps) ('testing' hasArrows isCurvier isCurvy isLineMorph) ('visual properties' canHaveFillStyles fillStyle fillStyle:) ('*MorphicExtras-geometry eToy' scale:) ('private' arrowBoundsAt:from: arrowForms borderForm computeArrowFormAt:from: computeBounds curveBounds filledForm getVertices includesHandle: lineSegments privateMoveBy: setVertices: transformVerticesFrom:to:) ('shaping' diamondOval rectOval) ('attachments' defaultAttachmentPointSpecs endShapeColor: endShapeWidth: firstVertex lastVertex midpoint nudgeForLabel: totalLength) ('rounding' cornerStyle:) ('*MorphicExtras-Postscript Canvases' drawPostscriptOn:) !
PluggableTextMorph removeSelector: #tileForIt! PasteUpMorphTest removeSelector: #testCursorWrapped! PasteUpMorphTest removeSelector: #testCursorWrappedWithFraction! PasteUpMorphTest removeSelector: #testGridToGradient! PasteUpMorph initialize! PasteUpMorph class removeSelector: #supplementaryPartsDescriptions!
!PasteUpMorph class reorganize! ('printing' defaultNameStemForInstances) ('project' newWorldForProject:) ('scripting' authoringPrototype) ('preferences' globalCommandKeysEnabled globalCommandKeysEnabled:) ('recompilation' postRecompileAction) ('*MorphicExtras-class initialization' initialize registerInFlapsRegistry unload) ('*MorphicExtras-project' newWorldTesting) ('*MorphicExtras-parts bin') ('parts bin' descriptionForPartsBin) !
PartsBin removeSelector: #morphToDropFrom:! PasteUpMorph removeSelector: #abandonCostumeHistory! PasteUpMorph removeSelector: #abandonVocabularyPreference! PasteUpMorph removeSelector: #adaptedToWorld:! PasteUpMorph removeSelector: #addPenMenuItems:hand:! PasteUpMorph removeSelector: #addPenTrailsMenuItemsTo:! PasteUpMorph removeSelector: #addPlayfieldMenuItems:hand:! PasteUpMorph removeSelector: #addStackMenuItems:hand:! PasteUpMorph removeSelector: #allScriptEditors! PasteUpMorph removeSelector: #allScriptors! PasteUpMorph removeSelector: #allTileScriptingElements! PasteUpMorph removeSelector: #assureNotPaintingEvent:! PasteUpMorph removeSelector: #automaticPhraseExpansion! PasteUpMorph removeSelector: #automaticViewing! PasteUpMorph removeSelector: #behaveLikeHolder! PasteUpMorph removeSelector: #behaveLikeHolder:! PasteUpMorph removeSelector: #behavingLikeAHolder! PasteUpMorph removeSelector: #browseAllScriptsTextually! PasteUpMorph removeSelector: #buildDebugMenu:! PasteUpMorph removeSelector: #closedViewerFlapTabs! PasteUpMorph removeSelector: #couldMakeSibling! PasteUpMorph removeSelector: #cursor! PasteUpMorph removeSelector: #cursor:! PasteUpMorph removeSelector: #cursorWrapped:! PasteUpMorph removeSelector: #detachableScriptingSpace! PasteUpMorph removeSelector: #drawOn:! PasteUpMorph removeSelector: #dumpPresenter! PasteUpMorph removeSelector: #hideViewerFlaps! PasteUpMorph removeSelector: #hideViewerFlapsOtherThanFor:! PasteUpMorph removeSelector: #indicateCursor! PasteUpMorph removeSelector: #indicateCursor:! PasteUpMorph removeSelector: #indicateCursorString! PasteUpMorph removeSelector: #installVectorVocabulary! PasteUpMorph removeSelector: #isPlayfieldLike! PasteUpMorph removeSelector: #makeNewDrawing:! PasteUpMorph removeSelector: #makeNewDrawing:at:! PasteUpMorph removeSelector: #makeNewDrawingWithin! PasteUpMorph removeSelector: #makeVectorUseConformToPreference! PasteUpMorph removeSelector: #mouseOverHalosString! PasteUpMorph removeSelector: #newDrawingFromMenu:! PasteUpMorph removeSelector: #numberAtCursor! PasteUpMorph removeSelector: #openScrapsBook:! PasteUpMorph removeSelector: #paintArea! PasteUpMorph removeSelector: #paintAreaFor:! PasteUpMorph removeSelector: #paintingBoundsAround:! PasteUpMorph removeSelector: #paintingFlapTab! PasteUpMorph removeSelector: #prepareToBeSaved! PasteUpMorph removeSelector: #prepareToPaint! PasteUpMorph removeSelector: #prepareToPaint:! PasteUpMorph removeSelector: #presentCardAndStackMenu! PasteUpMorph removeSelector: #presentPlayfieldMenu! PasteUpMorph removeSelector: #presenter! PasteUpMorph removeSelector: #printScriptSummary! PasteUpMorph removeSelector: #putUpPenTrailsSubmenu! PasteUpMorph removeSelector: #reasonablePaintingExtent! PasteUpMorph removeSelector: #rectifyCursor! PasteUpMorph removeSelector: #referencePlayfield! PasteUpMorph removeSelector: #referencePool! PasteUpMorph removeSelector: #releaseViewers! PasteUpMorph removeSelector: #removeAllViewers! PasteUpMorph removeSelector: #restoreBoundsOfSubmorphs! PasteUpMorph removeSelector: #resumeScriptsPausedByPainting! PasteUpMorph removeSelector: #roundUpStrays! PasteUpMorph removeSelector: #saveBoundsOfSubmorphs! PasteUpMorph removeSelector: #selectedRect! PasteUpMorph removeSelector: #sendTextContentsBackToDonor! PasteUpMorph removeSelector: #showStatusOfAllScripts! PasteUpMorph removeSelector: #showingListView! PasteUpMorph removeSelector: #sortSubmorphsBy:! PasteUpMorph removeSelector: #standardPlayerHit! PasteUpMorph removeSelector: #startRunningAll! PasteUpMorph removeSelector: #stepAll! PasteUpMorph removeSelector: #stopRunningAll! PasteUpMorph removeSelector: #toggleAutoLineLayout! PasteUpMorph removeSelector: #toggleClassicNavigatorIfAppropriate! PasteUpMorph removeSelector: #toggleMouseOverHalos! PasteUpMorph removeSelector: #triggerClosingScripts! PasteUpMorph removeSelector: #triggerOpeningScripts! PasteUpMorph removeSelector: #updateStatusForAllScriptEditors! PasteUpMorph removeSelector: #valueAtCursor! PasteUpMorph removeSelector: #valueAtCursor:! PasteUpMorph removeSelector: #viewingNormally! PasteUpMorph removeSelector: #wantsHaloFor:! PasteUpMorph removeSelector: #wantsMouseOverHalos! PasteUpMorph removeSelector: #wantsMouseOverHalos:! BorderedMorph subclass: #PasteUpMorph instanceVariableNames: 'model padding isPartsBin worldState' classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler' poolDictionaries: '' category: 'Morphic-Worlds'!
!PasteUpMorph reorganize! ('accessing' assureFlapWidth: flapTab lastKeystroke lastKeystroke: modelOrNil useRoundedCorners) ('alarms-scheduler' addAlarm:withArguments:for:at: removeAlarm:for:) ('caching' releaseCachedState) ('change reporting' invalidRect:from:) ('classification' isWorldMorph) ('copying' veryDeepCopyWith:) ('display' gradientFillColor: setGradientColor:) ('dropping/grabbing' acceptDroppingMorph:event: dropEnabled hasTransferMorphConverter justDroppedInto:event: morphToDropForTransferMorph: morphToDropFrom: originAtCenter positionNear:forExtent:adjustmentSuggestion: repelsMorph:event: resetTransferMorphConverter transferMorphConverter transferMorphConverter: wantsDroppedMorph:event: wantsDroppedTransferMorph:) ('event handling' dropExplorerField:from:event: dropFiles:event: dropInspectorField:event: dropSourceCode:event: handleDroppedItem:event: handlesKeyboard: handlesMouseDown: keyStroke: morphToGrab: mouseDown: mouseUp: wantsEasySelection wantsKeyboardFocusFor: wantsWindowEvent: windowEvent: windowEventHandler windowEventHandler:) ('events-processing' filterEvent:for: processEvent:using: tryInvokeHalo: tryInvokeKeyboardShortcut: tryInvokeMetaMenu:) ('geometry' bringTopmostsToFront extent: position:) ('geometry testing' fullContainsPoint:) ('halos and balloon help' defersHaloOnClickTo: wantsDirectionHandles wantsHaloFromClick) ('initialization' addKeyboardShortcuts addMouseShortcuts becomeActiveDuring: defaultBorderColor defaultBorderWidth defaultColor initialize initializeKeyboardShortcuts initializeMouseShortcuts newResourceLoaded removeKeyboardShortcuts) ('interaction loop' doOneCycleNow) ('layout' addCenteredAtBottom:offset: convertAlignment laySubpartsOutInOneRow layoutChanged) ('menu & halo' addCustomMenuItems:hand: addScalingMenuItems:hand: addWorldHaloMenuItemsTo:hand: addWorldToggleItemsToHaloMenu: autoLineLayoutString currentlyUsingVectorVocabulary defineApplicationView defineFactoryView deleteBalloonTarget: isPartsBinString originAtCenterString reformulateUpdatingMenus showApplicationView showExpandedView showFactoryView showFullView showReducedView showThumbnailString showWorldMainDockingBarString toggleShowWorldMainDockingBar transformToShow:) ('misc' alwaysShowThumbnail cachedOrNewThumbnailFrom: cartesianOrigin heightForThumbnails hideFlapsOtherThan:ifClingingTo: innocuousName maxHeightToAvoidThumbnailing maximumThumbnailWidth mouseX mouseY nameForCopyIfAlreadyNamed: padding: smallThumbnailForPageSorter thumbnailForPageSorter unhideHiddenObjects) ('model' createCustomModel model setModel:) ('name' unusedMorphNameLike:) ('objects from disk' convertToCurrentVersion:refStream: fixUponLoad:seg: saveOnFile) ('options' autoLineLayout autoLineLayout: isPartsBin: replaceTallSubmorphsByThumbnails resizeToFit resizeToFitString setPartsBinStatusTo: toggleIsPartsBin toggleResizeToFit) ('parts bin' initializeToStandAlone isPartsBin residesInPartsBin) ('printing' printOn:) ('project' project releaseSqueakPages storeProjectsAsSegments) ('project state' canvas canvas: firstHand hands handsDo: handsReverseDo: isStepping: isStepping:selector: listOfSteppingMorphs stepListSize stepListSummary steppingMorphsNotInWorld viewBox viewBox:) ('stepping' cleanseStepList runLocalStepMethods runStepMethods startStepping: startStepping:at:selector:arguments:stepTime: step stepTime stopStepping: stopStepping:selector:) ('structure' primaryHand world) ('testing' isEasySelecting) ('undo' clearCommandHistory commandHistory onceAgainDismiss: reintroduceIntoWorld:) ('update cycle' startBackgroundProcess) ('user interface' modelWakeUp) ('naming' defaultNameStemForInstances) ('visual properties' canHaveFillStyles fillStyle: setAsBackground:) ('WiW support' addMorphInLayer: installAsActiveSubprojectIn:at:titled: installAsActiveSubprojectIn:titled: restartWorldCycleWithEvent: shouldGetStepsFrom: validateMouseEvent:) ('world menu' activateObjectsTool addUndoItemsTo: bringWindowsFullOnscreen buildWorldMenu: closeUnchangedWindows collapseAll collapseNonWindows commandKeySelectors connectRemoteUser connectRemoteUserWithName:picture:andIPAddress: delayedInvokeWorldMenu: deleteNonWindows disconnectAllRemoteUsers disconnectRemoteUser dispatchCommandKeyInWorld:event: drawingClass expandAll extractScreenRegion:andPutSketchInHand: findAChangeSorter: findAFileList: findAMessageNamesWindow: findAPreferencesPanel: findATranscript: findAWindowSatisfying:orMakeOneUsing: findDirtyBrowsers: findDirtyWindows: findWindow: getWorldMenu: grabDrawingFromScreen: grabFloodFromScreen: grabLassoFromScreen: grabRubberBandFromScreen: initializeDesktopCommandKeySelectors invokeWorldMenu: keyboardNavigationHandler keyboardNavigationHandler: keystrokeInWorld: putUpNewMorphMenu putUpWorldMenu: putUpWorldMenuFromEscapeKey reportLocalAddress respondToCommand:bySending:to: undoOrRedoCommand yellowButtonClickOnDesktopWithE vent:) ('world state' abandonAllHalos addHand: addMorph:centeredNear: addMorphsAndModel: allNonFlapRelatedSubmorphs allNonWindows assureNotPaintingElse: assuredCanvas beWorldForProject: checkCurrentHandForObjectToPaste checkCurrentHandForObjectToPaste2 chooseClickTarget colorAt:belowMorph: deEmphasizeViewMVC: deleteAllHalos displayWorld displayWorldAsTwoTone displayWorldNonIncrementally displayWorldSafely doOneCycle doOneCycleInBackground doOneSubCycle dragThroughOnDesktop: embeddedProjectDisplayMode endDrawing: exit flashRects:color: fullRepaintNeeded goBack haloMorphs initForProject: install installFlaps jumpToProject nextPage noDisplayDuring: optimumExtentFromAuthor paintBox paintBoxOrNil patchAt:without:andNothingAbove: pauseEventRecorder previousPage privateOuterDisplayWorld removeHand: repairEmbeddedWorlds repositionFlapsAfterScreenSizeChange restoreFlapsDisplay restoreMainDockingBarDisplay restoreMorphicDisplay saveAsWorld sketchEditorOrNil sleep someHalo specialNameInModelFo r: start SteppingSubmorphsOf:) ('*Tools' defaultDesktopCommandKeyTriplets findAMonticelloBrowser) ('private' privateFullMoveBy: privateMoveBy:) ('thumbnail' icon) ('polymorph' modalLockTo: modalUnlockFrom:) ('recompilation' updateStatePostRecompile) ('submorphs - add/remove' addAllMorphs: addMorphFront:) ('submorphs - accessing' allMorphsDo: morphsInFrontOf:overlapping:do:) ('flaps' accommodateFlap: addGlobalFlaps assureFlapTabsFitOnScreen correspondingFlapTab deleteGlobalFlapArtifacts enableGlobalFlaps flapTabs localFlapTabs offsetForAccommodating:onEdge: removeAccommodationForFlap:) ('Nebraska' addRemoteClient: convertRemoteClientToBuffered: hasRemoteServer releaseRemoteServer remoteServer remoteServer: removeRemoteClient: transferRemoteServerFrom:) ('*60Deprecated-menu & halo' isOpenForDragNDropString) ('*services-base' focusedRequestor openWorldMenu requestor worldMenu) ('*60Deprecated-accessing' modalWindow: removeModalWindow) ('*MorphicExtras-flaps' deleteAllFlapArtifacts) ('*ST80-Support' standardSystemController) ('*Protocols' currentVocabulary) !
ParagraphEditor class removeSelector: #yellowButtonExpertMenu! ParagraphEditor class removeSelector: #yellowButtonNoviceMenu! PackageDependencyTest removeSelector: #testEtoys! ObjectlandMorph removeSelector: #createEtoysProject! ObjectExplorer removeSelector: #viewerForValue! NativeImageSegment removeSelector: #findRogueRootsAllMorphs:! NativeImageSegment removeSelector: #rootsIncludingPlayers! NativeImageSegment removeSelector: #savePlayerReferences:! MorphicModel removeSelector: #addModelYellowButtonMenuItemsTo:forMorph:hand:!
!MorphicModel reorganize! ('accessing' model modelOrNil slotName wantsSlot) ('caching' releaseCachedState) ('classification' isMorphicModel) ('compilation' addPartNameLike:withValue: compileAccessForSlot: compilePropagationMethods nameFor: propagate:as: removeAll slotSelectorFor: use:orMakeModelSelectorFor:in:) ('debug and other' installModelIn:) ('drag and drop' allowSubmorphExtraction isOpen) ('geometry' charactersOccluded newBounds: recomputeBounds) ('initialization' defaultBorderColor defaultBounds defaultColor duplicate:from: initialize model: model:slotName:) ('menu' addCustomMenuItems:hand: closeToEdits openToEdits) ('naming' choosePartName) ('printing' initString) ('submorphs - accessing' allKnownNames) ('submorphs - add/remove' delete) ('*MorphicExtras-compilation' compileInitMethods) !
MorphExtension removeSelector: #player! MorphExtension removeSelector: #player:! Object subclass: #MorphExtension instanceVariableNames: 'locked visible sticky balloonText balloonTextSelector externalName isPartsDonor actorState eventHandler otherProperties' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Kernel'!
!MorphExtension reorganize! ('accessing' actorState actorState: balloonText balloonTextSelector balloonTextSelector: balloonText: eventHandler eventHandler: externalName: locked locked: sticky sticky: visible visible:) ('accessing - layout properties' layoutFrame layoutFrame: layoutPolicy layoutPolicy: layoutProperties layoutProperties:) ('accessing - other properties' assureOtherProperties hasOtherProperties hasProperty: initializeOtherProperties otherProperties privateOtherProperties: removeOtherProperties removeProperty: setProperty:toValue: sortedPropertyNames valueOfProperty: valueOfProperty:ifAbsentPut: valueOfProperty:ifAbsent:) ('connectors-copying' copyWeakly propertyNamesNotCopied veryDeepFixupWith: veryDeepInner:) ('initialization' initialize) ('objects from disk' comeFullyUpOnReload:) ('other' isDefault) ('printing' printOn:) ('viewer' externalName) ('*MorphicExtras-copying' updateReferencesUsing:) ('*MorphicExtras-Undo' removeUndoCommands) ('parts bin' isPartsDonor isPartsDonor:) ('*60Deprecated-other' inspectElement) !
ImageMorph class removeSelector: #descriptionForPartsBin!
!ImageMorph class reorganize! ('accessing' defaultForm) ('class initialization' initialize registerInFlapsRegistry unload) ('instance creation' fromString: fromString:font:) ('scripting' authoringPrototype) !
Morph class removeSelector: #selectionBackground!
!Morph class reorganize! ('class initialization' initialize) ('fileIn/Out' fileReaderServicesForFile:suffix: fromFileName: serviceLoadMorphFromFile services) ('initialize-release' unload) ('instance creation' initializedInstance newBounds: newBounds:color: newSticky) ('misc' morphsUnknownToTheirOwners) ('new-morph participation' includeInNewMorphMenu newStandAlone partName:categories:documentation: partName:categories:documentation:sampleImageForm:) ('scripting' authoringPrototype) ('testing' allSketchMorphClasses allSketchMorphForms isSketchMorphClass) ('preferences' haloForAll haloForAll: indicateKeyboardFocus indicateKeyboardFocus: metaMenuForAll metaMenuForAll: preferredCornerRadius preferredCornerRadius: themeProperties useSoftDropShadow useSoftDropShadow:) ('*Tools-icons' toolIcon) ('defaults') ('layer names' backmostLayer balloonLayer defaultLayer dialogLayer frontmostLayer haloLayer menuLayer navigatorLayer progressLayer windowLayer) ('*MorphicExtras-arrow head size' defaultArrowheadSize obtainArrowheadFor:defaultValue:) ('*MorphicExtras-parts bin' supplementaryPartsDescriptions) ('*MorphicExtras-new-morph participation' addPartsDescriptorQuadsTo:if:) !
MenuMorph removeSelector: #allWordings! MenuMorph removeSelector: #allWordingsNotInSubMenus:! MenuMorph removeSelector: #undoGrabCommand!
!MenuMorph reorganize! ('accessing' addBlankIconsIfNecessary: commandKeyHandler commandKeyHandler: defaultTarget hasItems hasSubMenu: itemWithWording: items lastItem lastSelection matchString matchString: popUpOwner popUpOwner: rootMenu stayUp stayUp:) ('construction' add:action: add:help:action: add:icon:help:subMenu: add:icon:subMenu: add:selector:argument: add:subMenu: add:subMenu:target:selector:argumentList: add:target:action: add:target:selector: add:target:selector:argument: add:target:selector:argumentList: addAllFrom: addItem: addLine addList: addMenuItem: addService:for: addServices2:for:extraLines: addServices:for:extraLines: addStayUpIcons addStayUpItem addStayUpItemSpecial addTitle: addTitle:icon: addTitle:icon:updatingSelector:updateTarget: addTitle:updatingSelector:updateTarget: addTranslatedList: addUpdating:action: addUpdating:enablement:action: addUpdating:enablementSelector:target:selector:argumentList: addUpdating:target:action: addUpdating:target:selector:argumentList: addUpdatingItem: addWithLabel:enablement:action: addWithLabel:enablementSelector:target:selector:argumentList: balloonTextForLastItem: defaultTarget: labels:lines:selections: title:) ('control' activeSubmenu: deleteIfPopUp deleteIfPopUp: popUpAdjacentTo:forHand:from: popUpAt:forHand:in: popUpAt:forHand:in:allowKeyboard: popUpEvent:in: popUpForHand:in: popUpInWorld popUpInWorld: popUpNoKeyboard selectItem:event: updateColor wantsToBeDroppedInto:) ('copying' veryDeepFixupWith: veryDeepInner:) ('dropping/grabbing' justDroppedInto:event:) ('events' activate: deactivate: handlesMouseDown: handlesMouseOver: mouseDown: mouseLeave: mouseMove: mouseUp: processFocusEvent:using: wantsEveryMouseMove) ('initialization' delete initialize setDefaultParameters setTitleParameters setTitleParametersFor:) ('keyboard control' displayFiltered: handlesKeyboard: keyStroke: matchString:event: moveSelectionDown:event: removeMatchString removeMatchString: selectCurrentItem: selectMoreItem:) ('menu' addCustomMenuItems:hand: addItem addTitle detachSubMenu: doButtonAction removeStayUpBox removeStayUpItems setInvokingView: setTarget: target: toggleStayUp: toggleStayUpIgnore:evt: updateItemsWithTarget:orWithHand:) ('modal control' informUserAt:during: invokeAt:in:allowKeyboard: invokeModal invokeModal: invokeModalAt:in: invokeModalAt:in:allowKeyboard: isModalInvokationDone isModalInvokationDone: modalSelection modalSelection:) ('private' invokeMetaMenu: positionAt:relativeTo:inWorld: selectedItem) ('update' applyUserInterfaceTheme updateMenu) ('keystroke helpers' handleCRStroke: handleCommandKeyPress: handleDelStroke: handleDownStroke: handleEscStroke: handleFiltering: handleLeftStroke: handlePageDownStroke: handlePageUpStroke: handleRightStroke: handleUpStroke: hideKeyboardHelp keyStrokeHandlers noteRootMenuHasUsedKeyboard showKeyboardHelp stepIntoSubmenu:) ('rounding' wantsRoundedCorners) ('testing' indicateKeyboardFocus) ('*ToolBuilder-Morphic-opening' openAsTool) ('*MorphicExtras-accessing') ('*60Deprecated-keyboard control' filterListWith: unfilterOrEscape:) !
MenuItemMorph removeSelector: #adaptToWorld:! MenuItemMorph removeSelector: #allWordingsNotInSubMenus:!
!MenuItemMorph reorganize! ('accessing' action: addSubMenu: addUpdatingSubMenu: arguments arguments: colorToUse contentString contentString: contents: contents:withMarkers: contents:withMarkers:inverse: hasIcon hasIconOrMarker hasMarker hasSubMenu hasSubMenu: help: icon icon: isEnabled isEnabled: isStayUpItem itemWithWording: selector selector: subMenu subMenu: subMenuUpdater:selector: subMenuUpdater:selector:arguments: target target:) ('copying' veryDeepFixupWith: veryDeepInner:) ('drawing' drawBackgroundOn: drawIconOn: drawLabelOn: drawOn: drawSubMenuMarkerOn:) ('events' activateOwnerMenu: activateSubmenu: doButtonAction handleMouseUp: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: invokeWithEvent: mouseDown: mouseEnter: mouseEnterDragging: mouseUp:) ('grabbing' aboutToBeGrabbedBy: duplicateMorph:) ('initialization' defaultBounds deleteIfPopUp: initialize) ('layout' doLayoutIn: minHeight minWidth stringMargin) ('selecting' adjacentTo deselect: isSelected isSelected: select:) ('private' bottomArrow createSubmenu createUpdatingSubmenu deselectItem iconForm leftArrow offImage onImage rightArrow selectionFillStyle subMenuMarker upArrow updateLayoutInDockingBar) ('browse' browseImplementationOfActionSelector buildDebugMenu: debugAction effectiveActionSelector effectiveActionTarget) ('testing' isMenuItemMorph) ('updating' applyUserInterfaceTheme) !
!LassoPatchMorph reorganize! ('dropping' justDroppedInto:event: wantsToBeDroppedInto:) ('initialization' initialize initializeToStandAlone) !
!GrabPatchMorph reorganize! ('dropping' justDroppedInto:event: wantsToBeDroppedInto:) ('initialization' initialize initializeToStandAlone) !
!ImageMorph reorganize! ('accessing' borderStyle: borderWidth: color: form image image: isOpaque isOpaque: preferredExtent setNewImageFrom: wantsRecolorHandle withSnapshotBorder) ('caching' releaseCachedState) ('drawing' drawOn:) ('geometry' extent:) ('initialization' initialize) ('menu' changeOpacity opacityString) ('menu commands' grabFromScreen readFromFile) ('menus' addCustomMenuItems:hand:) ('other' newForm:) ('parts bin' initializeToStandAlone) ('testing' isImageMorph) ('*MorphicExtras-Postscript Canvases' drawPostscriptOn:) !
HandMorph removeSelector: #removePendingHaloFor:! HandMorph removeSelector: #spawnMagicHaloFor:! HandMorph removeSelector: #triggerHaloFor:after:!
!HandMorph reorganize! ('accessing' anyButtonPressed colorForInsets lastEvent mouseOverHandler noButtonPressed targetOffset targetPoint userInitials userPicture userPicture:) ('balloon help' addBalloonHelp: balloonHelpList deleteBalloonTarget: removePendingBalloonFor: resetBalloonHelp: spawnBalloonFor: triggerBalloonFor:after:) ('caching' releaseCachedState) ('change reporting' invalidRect:from:) ('classification' isHandMorph) ('copying' veryDeepCopyWith:) ('cursor' cursorBounds showTemporaryCursor: showTemporaryCursor:hotSpotOffset: temporaryCursor) ('double click support' resetClickState waitForClicksOrDrag:event: waitForClicksOrDrag:event:selectors:threshold:) ('drawing' drawOn: fullDrawOn: hasChanged hasUserInformation needsToBeDrawn nonCachingFullDrawOn: restoreSavedPatchOn: savePatchFrom: shadowForm showHardwareCursor: updateCacheCanvas: visible:) ('drop shadows' shadowOffset) ('event handling' cursorPoint flushEvents noticeMouseOver:event: processEvents) ('events-processing' handleEvent: isCapturingGesturePoints sendFilterEventCaptureAgain:for:) ('focus handling' keyboardFocus keyboardFocus: mouseFocus mouseFocus: newKeyboardFocus: newMouseFocus: newMouseFocus:event: releaseAllFoci releaseKeyboardFocus releaseKeyboardFocus: releaseMouseFocus releaseMouseFocus:) ('genie-stubs' autoFocusRectangleBoundsFor: disableGenieFocus enableGenie focusStartEvent genieGestureProcessor isGenieAvailable isGenieEnabled isGenieFocused) ('geometry' position position: userInitials:andPicture:) ('grabbing/dropping' attachMorph: dropMorphs dropMorphs: dropMorph:event: grabMorph:from: targetOffset:) ('halo handling' halo: obtainHalo: releaseHalo: removeHalo removeHaloFromClick:on:) ('halos and balloon help' halo) ('initialization' becomeActiveDuring: initForEvents initialize interrupted resourceJustLoaded) ('layout' fullBounds) ('meta-actions' copyToPasteBuffer: grabMorph:) ('multilingual' clearKeyboardInterpreter keyboardInterpreter) ('objects from disk' objectForDataStream:) ('paste buffer' objectToPaste pasteBuffer pasteBuffer: pasteMorph) ('updating' applyUserInterfaceTheme changed) ('private events' generateDropFilesEvent: generateKeyboardEvent: generateMouseEvent: generateMouseWheelEvent: generateMouseWheelEvent:direction: generateWindowEvent: mouseDragTrailFrom: mouseTrailFrom: moveToEvent: sendEvent:focus: sendEvent:focus:clear: sendFocusEvent:to:clear: sendKeyboardEvent: sendListenEvent:to: sendListenEvents: sendMouseEvent:) ('selected object' selectedObject) ('*MorphicExtras-event handling' pauseEventRecorderIn:) ('gridded cursor' gridPointRaw gridTo:origin: griddedPoint: griddingOn turnOffGridding turnOnGridding) ('events-listening' addEventListener: addKeyboardListener: addListener:to: addMouseListener: eventListeners eventListeners: keyboardListeners keyboardListeners: mouseListeners mouseListeners: removeEventListener: removeKeyboardListener: removeListener:from: removeMouseListener:) ('events-filtering-bubbling' eventBubbleFilters keyboardBubbleFilters mouseBubbleFilters) ('events-filtering-capturing' eventCaptureFilters eventCaptureFilters: keyboardCaptureFilters keyboardCaptureFilters: mouseCaptureFilters mouseCaptureFilters:) ('events-debugging' logEvent: showEvent:) ('events-filtering' filterEvent:for: ignoreEvent:) ('Multilingual-ImmPlugin' compositionWindowManager) ('initialize-release' cleanUp:) !
!GraphMorph reorganize! ('accessing' color: cursor cursor: cursorAtEnd cursorColor cursorColor: cursorColorAtZeroCrossing cursorColorAtZeroCrossings: cursorWrapped: data data: dataColor dataColor: interpolatedValueAtCursor lastValue lastValue: startIndex startIndex: valueAtCursor valueAtCursor:) ('commands' appendValue: centerCursor clear loadSineWave loadSound: loadSoundData: playOnce reverse) ('drawing' drawOn:) ('event handling' handlesMouseDown: mouseMove:) ('initialization' defaultColor initialize) ('layout' layoutChanged) ('objects from disk' convertToCurrentVersion:refStream:) ('stepping' step) ('private' asNumber: drawCursorOn: drawDataOn: flushCachedForm keepIndexInView:) ('sound' addCustomMenuItems:hand: openWaveEditor readDataFromFile) !
DockingBarMorph removeSelector: #isSticky! DockingBarMorph removeSelector: #resistsRemoval! BookMorph removeSelector: #goToPage:transitionSpec:runTransitionScripts:! BookMorph removeSelector: #goToPageMorph:runTransitionScripts:! BookMorph removeSelector: #goToPageMorph:transitionSpec:runTransitionScripts:! BookMorph removeSelector: #goto:! BookMorph removeSelector: #keepTogether! BooklikeMorph removeSelector: #currentPlayerDo:!
!BooklikeMorph reorganize! ('menu commands' clearNewPagePrototype firstPage insertPage sortPages) ('menus' addCustomMenuItems:hand:) ('misc' addBookMenuItemsTo:hand: move pageSize pageSize: playPageFlipSound: showingFullScreenString showingPageControlsString) ('page controls' addPageControlMorph: fewerPageControls fullControlSpecs hidePageControls indexForPageControls makeDescriptionViewer makePageControlsFrom: makePageNumberItem setEventHandlerForPageControls: shortControlSpecs showPageControls showPageControls:) !
!BookPageSorterMorph reorganize! ('copying' veryDeepFixupWith: veryDeepInner:) ('dropping/grabbing' wantsToBeDroppedInto:) ('initialization' addControls book:morphsToSort: defaultBorderWidth defaultColor initialize) ('buttons' acceptSort getPartsBinStatus togglePartsBinStatus) ('private' changeExtent: closeButtonOnly columnWith: rowWith: wrapperFor:) ('accessing' pageHolder) !
!AlignmentMorph reorganize! ('classification' isAlignmentMorph) ('event handling' wantsKeyboardFocusFor:) ('geometry' addTransparentSpacerOfSize:) ('initialization' defaultBorderWidth defaultColor initialize openInWindowLabeled:inWorld:) ('object fileIn' convertOldAlignmentsNov2000:using:) ('objects from disk' convertToCurrentVersion:refStream:) ('visual properties' canHaveFillStyles) ('*MorphicExtras-initialization' basicInitialize) !
!BorderedMorph reorganize! ('accessing' borderColor: borderStyle: borderWidth: hasTranslucentColor useRoundedCorners useSquareCorners) ('drawing' areasRemainingToFill:) ('geometry' acquireBorderWidth: closestPointTo: intersectionWithLineSegmentFromCenterTo:) ('initialization' borderInitialize borderInset borderRaised borderSimple defaultBorderColor defaultBorderStyle defaultBorderWidth initialize) ('menu' addBorderStyleMenuItems:hand: changeBorderColor: changeBorderWidth:) ('resize handling' addCellGapToLayoutFrames addCornerGrips addEdgeGrips addGrips addMorph:fullFrame: addPaneHSplitterAtBottomOfRow: addPaneHSplitters addPaneSplitters addPaneVSplitterAtRightOfColumn: addPaneVSplitters changeCellGapOfLayoutFrames: cornerGrips doFastWindowReframe: edgeGrips fastFramingOn grips linkSubmorphsToSplitters paneMorphs removeCellGapFromLayoutFrames removeCornerGrips removeEdgeGrips removeGrips removePaneSplitters splitters wantsGrips wantsGrips: wantsPaneSplitters wantsPaneSplitters:) ('printing' fullPrintOn:) ('layout properties' cellGap:) ('display scale' displayScaleChangedBy: handlesDisplayScaleChangedBy:) ('*MorphicExtras-initialization' basicInitialize) ('*60Deprecated-private' setBorderWidth:borderColor: setColor:borderWidth:borderColor:) ('*60Deprecated-accessing' doesBevels) !
Morph removeSelector: #adaptToWorld:! Morph removeSelector: #addMagicHaloFor:! Morph removeSelector: #addMorphNearBack:! Morph removeSelector: #addPaintingItemsTo:hand:! Morph removeSelector: #allMenuWordings! Morph removeSelector: #allMorphsAndBookPagesInto:! Morph removeSelector: #allMorphsWithPlayersDo:! Morph removeSelector: #applyStatusToAllSiblings:! Morph removeSelector: #asNumber:! Morph removeSelector: #automaticViewing! Morph removeSelector: #bringAllSiblingsToMe:! Morph removeSelector: #chooseNewGraphic! Morph removeSelector: #chooseNewGraphicCoexisting:! Morph removeSelector: #chooseNewGraphicFromHalo! Morph removeSelector: #couldMakeSibling! Morph removeSelector: #currentPlayerDo:! Morph removeSelector: #cursor! Morph removeSelector: #cursor:! Morph removeSelector: #decimalPlacesForGetter:! Morph removeSelector: #defaultValueOrNil! Morph removeSelector: #demandsBoolean! Morph removeSelector: #demandsThumbnailing! Morph removeSelector: #doMenuItem:! Morph removeSelector: #embedInWindow! Morph removeSelector: #embeddedInMorphicWindowLabeled:! Morph removeSelector: #getNumericValue! Morph removeSelector: #gridFormOrigin:grid:background:line:! Morph removeSelector: #handUserASibling! Morph removeSelector: #indicateAllSiblings! Morph removeSelector: #inspectArgumentsPlayerInMorphic:! Morph removeSelector: #isAViewer! Morph removeSelector: #isCompoundTileMorph! Morph removeSelector: #isKedamaMorph! Morph removeSelector: #isLikelyRecipientForMouseOverHalos! Morph removeSelector: #isModalShell! Morph removeSelector: #isNumericReadoutTile! Morph removeSelector: #isPhraseTileMorph! Morph removeSelector: #isPlayfieldLike! Morph removeSelector: #isSoundTile! Morph removeSelector: #isStandardViewer! Morph removeSelector: #isStickySketchMorph! Morph removeSelector: #isSyntaxMorph! Morph removeSelector: #isTileEditor! Morph removeSelector: #isTileMorph! Morph removeSelector: #isTilePadMorph! Morph removeSelector: #isViewer! Morph removeSelector: #makeGraphPaper! Morph removeSelector: #makeGraphPaperGrid:background:line:! Morph removeSelector: #makeMultipleSiblings:! Morph removeSelector: #makeNascentScript! Morph removeSelector: #makeNewPlayerInstance:! Morph removeSelector: #makeSiblings:! Morph removeSelector: #makeSiblingsLookLikeMe:! Morph removeSelector: #menuItemAfter:! Morph removeSelector: #menuItemBefore:! Morph removeSelector: #methodCommentAsBalloonHelp! Morph removeSelector: #mustBeBackmost! Morph removeSelector: #noteDecimalPlaces:forGetter:! Morph removeSelector: #objectViewed! Morph removeSelector: #offerCostumeViewerMenu:! Morph removeSelector: #openAPropertySheet! Morph removeSelector: #openViewerForArgument! Morph removeSelector: #overlapsShadowForm:bounds:! Morph removeSelector: #pasteUpMorphHandlingTabAmongFields! Morph removeSelector: #player! Morph removeSelector: #player:! Morph removeSelector: #playerRepresented! Morph removeSelector: #preferredDuplicationHandleSelector! Morph removeSelector: #presenter! Morph removeSelector: #readoutForField:! Morph removeSelector: #referencePlayfield! Morph removeSelector: #renameInternal:! Morph removeSelector: #rotationStyle! Morph removeSelector: #rotationStyle:! Morph removeSelector: #roundUpStrays! Morph removeSelector: #saveDocPane! Morph removeSelector: #screenLocation! Morph removeSelector: #screenRectangle! Morph removeSelector: #setAsActionInButtonProperties:! Morph removeSelector: #setNumericValue:! Morph removeSelector: #setStandardTexture! Morph removeSelector: #shouldRememberCostumes! Morph removeSelector: #shuffleSubmorphs! Morph removeSelector: #standardPalette! Morph removeSelector: #tabAmongFields! Morph removeSelector: #textureParameters! Morph removeSelector: #unlockOneSubpart! Morph removeSelector: #updateAllScriptingElements! Morph removeSelector: #usableSiblingInstance! Morph removeSelector: #viewMorphDirectly! Morph removeSelector: #wantsHalo! Morph removeSelector: #wantsHaloFor:! Morph removeSelector: #wantsScriptorHaloHandle! Morph removeSelector: #wouldAcceptKeyboardFocusUponTab! Morph removeSelector: #wrappedInWindow:! Morph removeSelector: #wrappedInWindowWithTitle:!
!Morph reorganize! ('accessing' actorState: actorStateOrNil adoptPaneColor: balloonText balloonText: balloonTextSelector balloonTextSelector: beFlap: beSticky beTransparent beUnsticky borderColor borderColor: borderStyle borderStyle: borderStyleForSymbol: borderWidth borderWidth: borderWidthForRounding clearArea color color: colorForInsets couldHaveRoundedCorners defaultNameStemForInstances eventHandler eventHandler: hasTranslucentColor highlight highlightColor highlightColor: insetColor isFlap isLocked isShared isSticky lock lock: modelOrNil raisedColor regularColor regularColor: rememberedColor rememberedColor: resistsRemoval resistsRemoval: scaleFactor setBorderStyle: sqkPage sticky: toggleLocked toggleResistsRemoval toggleStickiness unHighlight unlock unlockContents url userString viewBox visibleClearArea wantsToBeCachedByHand) ('accessing - extension' assureExtension extension hasExtension initializeExtension privateExtension: resetExtension) ('accessing - properties' hasProperty: otherProperties removeProperty: setProperties: setProperty:toValue: valueOfProperty: valueOfProperty:ifAbsent: valueOfProperty:ifAbsentPut: valueOfProperty:ifPresentDo:) ('caching' fullLoadCachedState fullReleaseCachedState loadCachedState releaseCachedState) ('change reporting' addedMorph: colorChangedForSubmorph: invalidRect: invalidRect:from: privateInvalidateMorph: userSelectedColor:) ('classification' isAlignmentMorph isBalloonHelp isButton isFlapOrTab isFlapTab isFlexMorph isHandMorph isRenderer isTextMorph isWorldMorph isWorldOrHandMorph) ('connectors-scripting' wantsConnectorVocabulary) ('converting' asSnapshotThumbnail) ('copying' copy deepCopy duplicate duplicateMorphCollection: okayToDuplicate updateReferencesUsing: veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:) ('creation' asMorph) ('debug and other' addDebuggingItemsTo:hand: addMouseActionIndicatorsWidth:color: addMouseUpAction addMouseUpActionWith: addViewingItemsTo: allStringsAfter: allStringsAfter:do: altSpecialCursor0 altSpecialCursor1 altSpecialCursor2 altSpecialCursor3 altSpecialCursor3: buildDebugMenu: defineTempCommand deleteAnyMouseActionIndicators hasStrings inspectOwnerChain installModelIn: mouseUpCodeOrNil ownerChain programmedMouseDown:for: programmedMouseEnter:for: programmedMouseLeave:for: programmedMouseUp:for: removeMouseUpAction resumeAfterDrawError resumeAfterLayoutError resumeAfterStepError tempCommand) ('dispatching' disableSubmorphFocusForHand:) ('drawing' areasRemainingToFill: boundingBoxOfSubmorphs boundsWithinCorners changeClipSubmorphs clipLayoutCells clipLayoutCells: clipSubmorphs clipSubmorphs: clippingBounds doesOwnRotation drawDropHighlightOn: drawDropShadowOn: drawErrorOn: drawKeyboardFocusIndicationOn: drawMouseDownHighlightOn: drawOn: drawOverlayOn: drawRolloverBorderOn: drawSubmorphsOn: expandFullBoundsForDropShadow: expandFullBoundsForRolloverBorder: flashBounds fullDrawOn: hasClipSubmorphsString hide highlightedForMouseDown highlightedForMouseDown: imageForm imageForm:backgroundColor:forRectangle: imageForm:forRectangle: imageFormDepth: imageFormForRectangle: imageFormWithout:andStopThere: keyboardFocusColor keyboardFocusWidth refreshWorld shadowForm show updateDropShadowCache visible visible:) ('drop shadows' addDropShadow addDropShadowMenuItems:hand: changeShadowColor hasDropShadow hasDropShadow: hasDropShadowString hasRolloverBorder hasRolloverBorder: removeDropShadow setShadowOffset: shadowColor shadowColor: shadowOffset shadowOffset: shadowPoint: toggleDropShadow useSoftDropShadow useSoftDropShadow:) ('dropping/grabbing' aboutToBeGrabbedBy: acceptDroppingMorph:event: disableDragNDrop dragEnabled dragEnabled: dragNDropEnabled dragSelectionColor dropEnabled dropEnabled: dropHighlightColor dropSuccessColor enableDrag: enableDragNDrop enableDragNDrop: enableDrop: formerOwner formerOwner: formerPosition formerPosition: grabTransform handledOwnDraggingBy:on: highlightForDrop highlightForDrop: highlightedForDrop justDroppedInto:event: justGrabbedFrom: morphToDropInPasteUp: nameForUndoWording rejectDropMorphEvent: repelsMorph:event: resetHighlightForDrop separateDragAndDrop slideBackToFormerSituation: slideToTrash: startDrag:with: transportedMorph undoGrabCommand vanishAfterSlidingTo:event: wantsDroppedMorph:event: wantsToBeDroppedInto: wantsToBeOpenedInWorld willingToBeDiscarded) ('event handling' click click: cursorPoint doubleClick: doubleClickTimeout: firstClickTimedOut: handlerForMouseDown: handlerForYellowButtonDown: handlesKeyboard: handlesKeyboardOnlyOnFocus handlesKeyboardOnlyOnFocus: handlesMouseDown: handlesMouseMove: handlesMouseOver: handlesMouseOverDragging: handlesMouseStillDown: handlesMouseWheel: hasFocus hasKeyboardFocus hasKeyboardFocus: hasMouseFocus hasMouseFocus: keyDown: keyStroke: keyUp: keyboardFocusChange: keyboardFocusDelegate mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: mouseMove: mouseStillDown: mouseStillDownThreshold mouseUp: mouseWheel: moveOrResizeFromKeystroke: on:send:to: on:send:to:withValue: removeLink: restoreSuspendedEventHandler startDrag: suspendEventHandler transformFrom: transformFromOutermostWorld transformFromWorld wantsEveryMouseMove wantsKeyboardFocus wantsKeyboardFocusFor: wantsWindowEvents: windowEvent: wouldAcceptKeyboardFocus yellowButtonActivity:) ('events-accessing' actionMap updateableActionMap) ('events-alarms' addAlarm:after: addAlarm:at: addAlarm:with:after: addAlarm:with:at: addAlarm:with:with:after: addAlarm:with:with:at: addAlarm:withArguments:after: addAlarm:withArguments:at: alarmScheduler removeAlarm: removeAlarm:at:) ('events-processing' containsPoint:event: defaultEventDispatcher handleDropMorph: handleEvent: handleFocusEvent: handleKeyDown: handleKeyUp: handleKeystroke: handleListenEvent: handleMouseDown: handleMouseEnter: handleMouseLeave: handleMouseMove: handleMouseOver: handleMouseStillDown: handleMouseUp: handleMouseWheel: handleUnknownEvent: handleWindowEvent: mouseDownPriority mouseDownPriority: processEvent: processEvent:using: processFocusEvent: processFocusEvent:using: rejectDropEvent: rejectsEvent: sendFilterEvent:for:to: sendFilterEventBubble:for: sendFilterEventBubbleAgain:for: sendFilterEventCapture:for: sendFilterEventCaptureAgain:for: transformedFrom:) ('events-removing' releaseActionMap) ('fileIn/out' attachToResource prepareToBeSaved reserveUrl: saveAsResource saveOnFile saveOnURL saveOnURL: saveOnURLbasic updateAllFromResources updateFromResource) ('filter streaming' drawOnCanvas:) ('geometry' bottom bottom: bottomCenter bottomLeft bottomLeft: bottomRight bottomRight: bounds bounds: center center: extent extent: height height: left left: leftCenter pointAtFraction: position position: right right: rightCenter top top: topCenter topLeft topLeft: topRight topRight: width width:) ('geometry testing' containsPoint: fullContainsPoint: obtrudesBeyondContainer) ('halos and balloon help' addHalo addHalo: addHandlesTo:box: addOptionalHandlesTo:box: addSimpleHandlesTo:box: addWorldHandlesTo:box: balloonColor balloonColor: balloonFont balloonFont: balloonHelpAligner balloonHelpDelayTime balloonHelpTextForHandle: balloonMorphClass boundsForBalloon comeToFrontAndAddHalo createHalo defaultBalloonColor defaultBalloonFont defaultHaloDispatcher defersHaloOnClickTo: deleteBalloon editBalloonHelpContent: editBalloonHelpText halo haloClass haloDelayTime hasHalo hasHalo: mouseDownOnHelpHandle: noHelpString okayToAddDismissHandle okayToAddGrabHandle okayToBrownDragEasily okayToExtractEasily okayToResizeEasily okayToRotateEasily removeHalo setBalloonText: setBalloonText:maxLineLength: setCenteredBalloonText: showBalloon showBalloon: showBalloon:at: showBalloon:hand: transferHalo: transferHalo:using: wantsBalloon wantsDirectionHandles wantsDirectionHandles: wantsHaloFromClick wantsHaloFromClick: wantsHaloHandleWithSelector:inHalo: wantsRecolorHandle wantsSi mpleSketchMorphHandles) ('initialization' basicInitialize defaultBounds defaultColor inAScrollPane initialize openCenteredInWorld openInHand openInWindow openInWindowLabeled: openInWindowLabeled:inWorld: openInWorld openInWorld: openNear: openNear:in: openNearMorph: resourceJustLoaded) ('layout' adjustLayoutBounds checkCellSpacingProperty: checkListSpacingProperty: checkResizingProperty: doLayout doLayoutIn: doLayoutSafely fullBounds layoutChanged layoutComputed layoutInBounds: layoutInBounds:positioning: layoutProportionallyIn: layoutProportionallyInBounds:positioning: minExtent minExtent: minHeight minHeight: minWidth minWidth: ownerChanged ownerChangedHandler ownerChangedHandler: privateFullBounds privateFullBoundsForRedraw setExtentFromLayout: setLayoutBoundsFromLayout: setPositionFromLayout: submorphBounds submorphBoundsForShrinkWrap) ('layout-menu' addCellLayoutMenuItems:hand: addLayoutMenuItems:hand: addTableLayoutMenuItems:hand: cellPositioningString: cellSpacingString: changeCellGap: changeCellInset: changeClipLayoutCells changeDisableTableLayout changeHeightForWidth changeLayoutInset: changeListDirection: changeMaxCellSize: changeMinCellSize: changeNoLayout changeProportionalLayout changeReverseCells changeRubberBandCells changeTableLayout changeWidthForHeight changesHeightForWidth changesWidthForHeight hResizingString: hasClipLayoutCellsString hasDisableTableLayoutString hasNoLayoutString hasProportionalLayoutString hasReverseCellsString hasRubberBandCellsString hasTableLayoutString layoutMenuPropertyString:from: listCenteringString: listDirectionString: listSpacingString: vResizingString: wrapCenteringString: wrapDirectionString:) ('macpal' flash) ('menu' addBorderStyleMenuItems:hand: addGestureMenuItems:hand: addGraphModelYellowButtonItemsTo:event: addModelYellowButtonItemsTo:event: addMyYellowButtonMenuItemsToSubmorphMenus addNestedYellowButtonItemsTo:event: addTitleForHaloMenu: addYellowButtonMenuItemsTo:event: buildYellowButtonMenu: hasYellowButtonMenu outermostOwnerWithYellowButtonMenu startWiring wantsMetaMenu wantsMetaMenu: wantsYellowButtonMenu wantsYellowButtonMenu:) ('menus' absorbStateFromRenderer: addAddHandMenuItemsForHalo:hand: addCopyItemsTo: addCustomHaloMenuItems:hand: addCustomMenuItems:hand: addExportMenuItems:hand: addFillStyleMenuItems:hand: addHaloActionsTo: addMiscExtrasTo: addStandardHaloMenuItemsTo:hand: addToggleItemsToHaloMenu: addWorldTargetSightingItems:hand: adhereToEdge adhereToEdge: adjustedCenter adjustedCenter: changeColor changeDirectionHandles changeDrag changeDragAndDrop changeDrop collapse defaultArrowheadSize exploreInMorphic exploreInMorphic: exportAsBMP exportAsBMPNamed: exportAsGIF exportAsGIFNamed: exportAsJPEG exportAsJPEGNamed: exportAsPNG exportAsPNGNamed: hasDirectionHandlesString hasDragAndDropEnabledString hasDragEnabledString hasDropEnabledString helpButton inspectInMorphic inspectInMorphic: lockUnlockMorph lockedString maybeAddCollapseItemTo: model presentHelp reasonableBitmapFillForms reasonableForms resetForwardDirection resistsRemovalString setArrowheads setRotationCenter setRotationCenterFrom: setToAd hereToEdge: snapToEdgeIfAppropriate stickinessString transferStateToRenderer: uncollapseSketch) ('meta-actions' addEmbeddingMenuItemsTo:hand: beThisWorldsModel buildHandleMenu: buildMetaMenu: changeColorTarget:selector:originalColor:hand: copyToPasteBuffer: dismissMorph dismissMorph: duplicateMorph: duplicateMorphImage: embedInto: grabMorph: inspectAt:event: invokeMetaMenu: invokeMetaMenuAt:event: maybeDuplicateMorph maybeDuplicateMorph: openATextPropertySheet potentialEmbeddingTargets potentialTargets potentialTargetsAt: resizeFromMenu resizeMorph: saveAsPrototype showActions showHiders sightTargets: sightWorldTargets: subclassMorph targetFromMenu: targetWith:) ('miscellaneous' setExtentFromHalo: setFlexExtentFromHalo:) ('naming' assureExternalName downshiftedNameOfObjectRepresented externalName innocuousName knownName name: nameForFindWindowFeature nameInModel nameOfObjectRepresented renameTo: setNamePropertyTo: setNameTo: specialNameInModel tryToRenameTo:) ('objects from disk' objectForDataStream: storeDataOn:) ('other events' menuButtonMouseEnter: menuButtonMouseLeave:) ('parts bin' inPartsBin initializeToStandAlone isPartsBin isPartsDonor isPartsDonor: markAsPartsDonor partRepresented residesInPartsBin) ('printing' clipText colorString: constructorString fullPrintOn: initString morphReport morphReportFor: morphReportFor:on:indent: pagesHandledAutomatically printConstructorOn:indent: printConstructorOn:indent:nodeDict: printOn: printSpecs printSpecs: printStructureOn:indent: reportableSize structureString textToPaste) ('rotate scale and flex' addFlexShell addFlexShellIfNecessary assureFlexShell forwardDirection forwardDirection: heading heading: keepsTransform newTransformationMorph referencePosition referencePosition: referencePositionInWorld referencePositionInWorld: removeFlexShell rotationCenter rotationCenter: rotationDegrees rotationDegrees: setDirectionFrom:) ('rounding' cornerRadius cornerRadius: cornerStyle cornerStyle: roundedCorners roundedCornersString toggleCornerRounding wantsRoundedCorners) ('stepping' arrangeToStartStepping arrangeToStartSteppingIn: isStepping isSteppingSelector: start startStepping startStepping:at:arguments:stepTime: startSteppingIn: startSteppingSelector: step stepAt: stepTime stop stopStepping stopSteppingSelector: stopSteppingSelfAndSubmorphs wantsSteps) ('structure' activeHand allOwners allOwnersDo: containingWindow firstOwnerSuchThat: hasOwner: isInDockingBar isInSystemWindow isInWorld morphPreceding: nearestOwnerThat: orOwnerSuchThat: outermostMorphThat: outermostWorldMorph owner ownerThatIsA: ownerThatIsA:orA: pasteUpMorph primaryHand renderedMorph root rootAt: topPasteUp topRendererOrSelf withAllOwners withAllOwnersDo: world) ('testing' canDrawAtHigherResolution canDrawBorder: completeModificationHash indicateKeyboardFocus isDockingBar isFlexed isFullOnScreen isImageMorph isLineMorph isMenuItemMorph isMorph isSafeToServe isSelectionMorph isSketchMorph isTransferMorph modificationHash shouldDropOnMouseUp) ('text-anchor' addTextAnchorMenuItems:hand: asTextAnchor textAnchorProperties) ('thumbnail' icon iconOrThumbnail iconOrThumbnailOfSize: morphRepresented permitsThumbnailing representativeNoTallerThan:norWiderThan:thumbnailHeight: thumbnail updateThumbnailUrl updateThumbnailUrlInBook:) ('undo' commandHistory undoMove:redo:owner:bounds:predecessor:) ('updating' applyUserInterfaceTheme changed) ('user interface' defaultLabelForInspector doCancel initialExtent playSoundNamed:) ('visual properties' canApplyUserInterfaceTheme canHaveFillStyles defaultBitmapFillForm fillStyle fillStyle: fillWithRamp:oriented: useBitmapFill useDefaultFill useGradientFill useSolidFill) ('WiW support' eToyRejectDropMorph:event: randomBoundsFor: shouldGetStepsFrom:) ('private' canBeEncroached privateAddAllMorphs:atIndex: privateAddMorph:atIndex: privateBounds: privateColor: privateDeleteWithAbsolutelyNoSideEffects privateFullBounds: privateFullMoveBy: privateMoveBy: privateOwner: privateRemove: privateRemoveMorphWithAbsolutelyNoSideEffects: privateSubmorphs privateSubmorphs:) ('accessing-backstop' target:) ('geniestubs' allowsGestureStart: isGestureStart: mouseStillDownStepRate redButtonGestureDictionaryOrName: yellowButtonGestureDictionaryOrName:) ('*morphic-Postscript Canvases' asPostscript clipPostscript drawPostscriptOn: fullDrawPostscriptOn: printPSToFile) ('button' doButtonAction) ('model access' models) ('other' removeAllButFirstSubmorph) ('selected object' selectedObject) ('polymorph' modalLockTo: modalUnlockFrom: openModal:) ('*Morphic-Sound-piano rolls' addMorphsTo:pianoRoll:eventTime:betweenTime:and: encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: justDroppedIntoPianoRoll:event: pauseFrom: resetFrom: resumeFrom: triggerActionFromPianoRoll) ('events-filtering-bubbling' addEventBubbleFilter: addKeyboardBubbleFilter: addMouseBubbleFilter: eventBubbleFilters eventBubbleFilters: keyboardBubbleFilters keyboardBubbleFilters: mouseBubbleFilters mouseBubbleFilters: removeEventBubbleFilter: removeKeyboardBubbleFilter: removeMouseBubbleFilter:) ('events-filtering-capturing' addEventCaptureFilter: addKeyboardCaptureFilter: addMouseCaptureFilter: eventCaptureFilters eventCaptureFilters: keyboardCaptureFilters keyboardCaptureFilters: mouseCaptureFilters mouseCaptureFilters: removeEventCaptureFilter: removeKeyboardCaptureFilter: removeMouseCaptureFilter:) ('events-filtering' addFilter:to: eventFilterDocumentation removeFilter:from:) ('*ToolBuilder-Morphic-opening' buildWith: openAsTool) ('geometry - misc' align:with: positionSubmorphs setConstrainedPosition:hangOut: shiftSubmorphsOtherThan:by: transformedBy: worldBounds worldBoundsForHalo) ('geometry - local/global' bounds:from: bounds:in: boundsIn: boundsInWorld fullBoundsInWorld globalPointToLocal: intersects: localPointToGlobal: point:from: point:in: pointFromWorld: pointInWorld: positionInWorld) ('geometry - layout' innerBounds innerBounds: innerExtent innerExtent: innerPosition innerPosition: layoutBounds layoutBounds: layoutExtent layoutExtent: layoutPosition layoutPosition: minimumExtent minimumExtent: minimumHeight minimumHeight: minimumWidth minimumWidth: outerBounds outerBounds: outerExtent outerExtent: outerPosition outerPosition:) ('Multilingual-ImmPlugin' preferredKeyboardBounds preferredKeyboardPosition) ('*ToolBuilder-Morphic' inspectorClass) ('submorphs - add/remove' abandon addAllMorphs: addAllMorphs:after: addAllMorphs:behind: addAllMorphs:inFrontOf: addAllMorphsBack: addAllMorphsFront: addMorph: addMorph:after: addMorph:asElementNumber: addMorph:atIndex: addMorph:behind: addMorph:inFrontOf: addMorphBack: addMorphFront: comeToFront delete goBehind privateDelete removeAllMorphs removeAllMorphsIn: removeMorph:) ('submorphs - misc' actWhen actWhen: addMorph:fullFrame: addMorphCentered: addMorphFront:fromWorldPosition: addMorphFrontFromWorldPosition: allNonSubmorphMorphs copyWithoutSubmorph: deleteDockingBars deleteSubmorphsWithProperty: deleteUnlessHasFocus dismissViaHalo dockingBars findA: findDeepSubmorphThat:ifAbsent: findDeeplyA: findSubmorphBinary: hasSubmorphWithProperty: indexOfMorphAbove: mainDockingBars morphsAt:behind:unlocked: morphsInFrontOf:overlapping:do: morphsInFrontOverlapping: morphsInFrontOverlapping:do: replaceSubmorph:by: rootMorphsAt: rootMorphsAtGlobal: submorphAfter submorphBefore submorphOfClass: submorphWithProperty:) ('submorphs - layers' addAllMorphsBackInLayers: addAllMorphsFrontInLayers: addAllMorphsInLayers: addMorphBackInLayer: addMorphFrontInLayer: addMorphInLayer: morphicLayerNumber morphicLayerNumber: reorderSubmorphsInLayers wantsToBeTopmost) ('submorphs - accessing' allKnownNames allMorphs firstSubmorph lastSubmorph morphsAt: morphsAt:unlocked: morphsAt:unlocked:useFullBounds: submorphCount submorphIndexOf: submorphNamed: submorphNamed:ifNone: submorphThat:ifNone: submorphs submorphsSatisfying:) ('submorphs - enumerating' allMorphsBreadthFirstDo: allMorphsBreadthFirstDo:sorted: allMorphsDepthFirstDo: allMorphsDo: allSubmorphNamesDo: morphsAt:unlocked:do: morphsAt:unlocked:useFullBounds:do: submorphsBehind:do: submorphsDo: submorphsInFrontOf:do: submorphsReverseDo:) ('layout properties' assureGridLayoutProperties assureLayoutProperties assureTableLayoutProperties copyLayoutProperties disableLayout disableLayout: disableTableLayout disableTableLayout: hResizing hResizing: layoutInset layoutInset: layoutPolicy layoutPolicy: layoutProperties layoutProperties: vResizeToFit: vResizing vResizing:) ('layout properties - table' cellGap cellGap: cellInset cellInset: cellPositioning cellPositioning: cellSpacing cellSpacing: listCentering listCentering: listDirection listDirection: listSpacing listSpacing: maxCellSize maxCellSize: minCellSize minCellSize: reverseTableCells reverseTableCells: rubberBandCells rubberBandCells: spaceFillWeight spaceFillWeight: wrapCentering wrapCentering: wrapDirection wrapDirection:) ('layout properties - grid' gridModulus gridModulus: gridOrigin gridOrigin:) ('submorphs - testing' hasSubmorphs) ('submorphs - callbacks' intoWorld: noteNewOwner: outOfWorld: removedMorph:) ('layout properties - proportional' layoutFrame layoutFrame:) ('halo notification' aboutToBeDraggedViaHalo aboutToBeGrownViaHalo aboutToBeRotatedViaHalo aboutToBeScaledViaHalo changedViaHalo:) ('display scale' displayScaleChangedBy: handlesDisplayScaleChangedBy:) ('*60Deprecated-events-processing' handleDropFiles:) ('*MorphicExtras-menus' dismissButton printPSToFileNamed:) ('*60Deprecated-rotate scale and flex' degreesOfFlex) ('*60Deprecated-text-anchor' changeDocumentAnchor changeInlineAnchor changeParagraphAnchor hasDocumentAnchorString hasInlineAnchorString hasParagraphAnchorString relativeTextAnchorPosition relativeTextAnchorPosition: textAnchorType textAnchorType:) ('*MorphicExtras' nextOwnerPage previousOwnerPage) ('*60Deprecated-event handling' dropFiles: wantsDropFiles:) ('*60Deprecated-geometry' gridPoint: griddedPoint:) ('*services-base' requestor) ('*60Deprecated-accessing' doesBevels) ('*60Deprecated-meta-actions' blueButtonDown: blueButtonUp: handlerForBlueButtonDown: handlerForMetaMenu:) ('*60Deprecated-user-interface' becomeModal) ('*MorphicExtras-books' updateCachedThumbnail) ('*60Deprecated-initialization' inATwoWayScrollPane) ('*MorphicExtras-geometry' shiftSubmorphsBy:) ('*60Deprecated-dropping/grabbing' toggleDragNDrop) ('*60Deprecated-copying' fullCopy) ('*MorphicExtras-postscript' asEPS asPostscriptPrintJob exportAsEPS exportAsEPSNamed:) ('*60Deprecated-WiW support' addMorphInFrontOfLayer: morphicLayerNumberWithin:) ('*60Deprecated-MorphicExtras-accessing' highlightOnlySubmorph:) ('*61Deprecated-drawing' highlightForMouseDown highlightForMouseDown:) !
InstanceBrowser removeSelector: #viewViewee!
!Lexicon reorganize! ('basic operation' annotation displaySelector: messageListIndex:) ('category list' categoriesPane categoryDefiningSelector: categoryList categoryListIndex categoryListIndex: categoryListKey:from: categoryListMenu:shifted: categoryListMenuTitle categoryWithNameSpecifiedBy: chooseCategory: mainCategoryListMenu: newCategoryPane reformulateCategoryList selectCategoryAll selectWithinCurrentCategoryIfPossible: selectedCategoryName selectorsReferringToClassVar showCategoriesPane) ('contents' contents) ('control buttons' customButtonSpecs) ('history' navigateToNextMethod navigateToPreviousMethod navigateToRecentMethod removeFromSelectorsVisited removeFromSelectorsVisited: selectorsVisited updateSelectorsVisitedfrom:to:) ('initialization' customButtonsFrame: initListFrom:highlighting: listFrame:fromLeft:width:) ('limit class' chooseLimitClass initialLimitClass limitClass limitClass: limitClassString setLimitClass:) ('menu commands' offerMenu removeMessage showCategory showHomeCategory showMainCategory) ('message category functions' canShowMultipleMessageCategories) ('message list menu' messageListKey:from:) ('model glue' doItReceiver okayToAccept targetObject) ('new-window queries' browseVariableAssignments browseVariableReferences) ('search' hasSearchPane lastSearchString lastSearchString: lastSendersSearchSelector methodListFromSearchString: obtainNewSearchString selectorsMatching setMethodListFromSearchString showSearchPane toggleSearch) ('selection' categoryOfSelector: selectImplementedMessageAndEvaluate: selectSelectorItsNaturalCategory: selectWithinCurrentCategory: selectedClassOrMetaClass selectedMessage setToShowSelector:selectCategory:) ('senders' navigateToASender selectorsSendingSelectedSelector setSendersSearch) ('transition' maybeReselectClass:selector: noteAcceptanceOfCodeFor: preserveSelectorIfPossibleSurrounding: reformulateList reformulateListNoting: retainMethodSelectionWhileSwitchingToCategory:) ('vocabulary' chooseVocabulary switchToVocabulary: useVocabulary:) ('window title' addModelItemsToWindowMenu: adjustWindowTitle startingWindowTitle) ('within-tool queries' currentQueryParameter methodsWithInitials methodsWithInitials: queryCharacterization seeAlso seeAlso: selectorsChanged selectorsDefiningInstVar selectorsReferringToInstVar selectorsRetrieved setLocalClassVarRefs setLocalInstVarDefs setLocalInstVarRefs showMethodsInCurrentChangeSet showMethodsWithInitials showMethodsWithInitials: showQueryResultsCategory) ('toolbuilder' addSpecialButtonsTo:with: buildCategoryListWith: buildCustomButtonsWith: buildWith: openOnClass:inWorld:showingSelector: openOnClass:showingSelector: wantsAnnotationPane) ('morphic' representsSameBrowseeAs: targetClass) ('message list' formattedLabel:forSelector:inClass: messageHelpAt: messageIconAt:) ('user interface' defaultWindowColor) ('private' contents:notifying: contents:oldSelector:in:classified:notifying: targetForContents:) !
Object subclass: #MenuIcons instanceVariableNames: '' classVariableNames: 'Icons ScriptingIcons TranslatedIcons TranslationLocale' poolDictionaries: '' category: 'Morphic-Menus'! Inspector removeSelector: #addEtoysItemsTo:!
!Inspector reorganize! ('accessing' context context: customFields doItContext doItReceiver fields object object: selectionIndex selectionIndex:) ('private' allInstVarsTranslated) ('toolbuilder' buildCodePaneWith: buildExploreButtonWith: buildFieldListWith: buildValuePaneWith: buildWith: replaceInspectorWithExplorer) ('*Protocols-Tools' browseFullProtocol spawnFullProtocol spawnProtocol) ('*60Deprecated-selecting' selectedSlotName) ('user interface - styling' aboutToStyle:requestor: fieldListStyler typeValue: updateStyler: updateStyler:requestor:) ('menu - construction' addClassItemsTo: addCollectionItemsTo: addFieldItemsTo: addInstVarItemsTo: addObjectItemsTo:) ('fields - custom' addCustomField addCustomField: hasCustomFields newCustomField removeCustomField: requestCustomFieldOrCancel:) ('user interface' applyUserInterfaceTheme defaultIntegerBase fieldList getContents representsSameBrowseeAs: textColorForError valuePane) ('menu - commands' browseClass browseClassHierarchy browseVariableAssignments browseVariableReferences chaseSelectionPointers copyExpression copyName exploreSelection exploreSelectionPointers inspectOne inspectOneOf: inspectOneOfFrom:to: inspectSelection inspectSelectionBasic objectReferencesToSelection removeSelection) ('selection - convenience' classOfSelection selectedClass selectedInstVarName selectionIsReadOnly selectionOrObject typeOfSelection) ('accessing - contents' contents:notifying: contentsTyped contentsTyped: expression expression:) ('fields - error handling' contentsForErrorDoing: emphasizeError: streamError:on: streamErrorDoing:on:) ('fields - truncation' contentsForTruncationOf: streamOn:truncate:collectFields: streamOn:truncate:collectFields:ellipsisFrom: truncationLimit truncationTail) ('fields - drag and drop' dragFromFieldList: dragTypeInFieldListAt: dropOnFieldList:at:shouldCopy:) ('selection' ensureSelectedField hasSelection noteSelectionIndex:for: replaceSelectionValue: selectField: selectFieldNamed: selectFieldSuchThat: selectedField selectedFieldName selection) ('fields' expressionForField: fieldAllInstVars fieldSelf newFieldForType: newFieldForType:key:) ('initialization' fieldClass initialExtent initialize inspect: resetContents resetFields setContents: setContentsTyped: setExpression:) ('menu' fieldListMenu: fieldListMenu:shifted: inspectorKey:from: mainFieldListMenu: metaFieldListMenu:) ('user interface - window' labelString objectOkToClose okToClose okToDiscardCustomFields) ('updating - steps' modelWakeUpIn: stepAt:in: stepTimeIn: updateListsAndCodeIn: wantsStepsIn:) ('fields - streaming' streamBaseFieldsOn: streamCustomFieldsOn: streamFieldsOn: streamIndexedVariablesOn: streamInstanceVariablesOn: streamVariableFieldsOn:) ('updating' update update: update:with: updateContentsSafely updateFieldList updateFields) ('*60Deprecated-menu' classHierarchy) ('*60Deprecated-toolbuilder' exploreObject) ('copying' veryDeepInner:) ('private - collections' elementAt: elementGetterAt:) ('user edits' okToRevertChanges:) !
!ImageSegment reorganize! ('access' allObjectsDo: arrayOfRoots arrayOfRoots:) ('read/write segment' install loadSegmentFrom:outPointers: localName readFromFile) ('error checking' checkAndReportLoadError) ('fileIn' comeFullyUpOnReload: declare: declareAndPossiblyRename: dependentsCancel: dependentsRestore: fixCapitalizationOfSymbols processRoots rehashDictionaries: reshapeClasses:refStream: restoreEndianness:) ('fileIn/Out' acceptSingleMethodSource: endianness restoreEndianness scanFrom: scanFrom:environment:) ('testing' errorWrongState forFile:outPointers:) ('private' forgetDoItsInClass: segmentFormatFrom:) !
Form removeSelector: #graphicForViewerTab!
!Form reorganize! ('accessing' bits bitsSize bits: defaultCanvasClass depth depth: extent form getCanvas hasBeenModified hasBeenModified: nativeDepth offset offset: size) ('analyzing' cgForPixelValue:orNot: colorsUsed dominantColor innerPixelRectFor:orNot: pixelCompare:with:at: primCountBits rectangleEnclosingPixelsNotOfColor: tallyPixelValues tallyPixelValuesInRect:into: xTallyPixelValue:orNot: yTallyPixelValue:orNot:) ('bordering' borderFormOfWidth:sharpCorners: borderWidth: borderWidth:color: borderWidth:fillColor: border:width:rule:fillColor: shapeBorder:width: shapeBorder:width:interiorPoint:sharpCorners:internal:) ('color mapping' balancedPatternFor: bitPatternFor: colormapFromARGB colormapIfNeededForDepth: colormapIfNeededFor: colormapToARGB makeBWForm: mapColors:to: mapColor:to: maskingMap newColorMap pixelValueFor: pixelWordFor: reducedPaletteOfSize: rgbaBitMasks) ('converting' adjustBrightness: adjustSaturation: as8BitColorForm asCursorForm asFormOfDepth: asGrayScale asSourceForm asTextAnchor blendColor: collectColors: collectPixels: colorReduced copyWithColorsReducedTo: darker dimmed dyed: flipVertically lighter orderedDither32To16) ('copying' blankCopyOf:scaledBy: contentsOfArea: contentsOfArea:into: copyBits:at:translucent: copyBits:from:at:clippingBox:rule:fillColor: copyBits:from:at:clippingBox:rule:fillColor:map: copyBits:from:at:colorMap: copy: copy:from:in:rule: copy:from:to:rule: deepCopy postCopy veryDeepCopyWith:) ('display box access' boundingBox center computeBoundingBox height width) ('displaying' displayInterpolatedIn:on: displayInterpolatedOn: displayOnPort:at: displayOn:at:clippingBox:rule:fillColor: displayOn:transformation:clippingBox:align:with:rule:fillColor: displayResourceFormOn: displayScaledOn: drawLine:from:to:clippingBox:rule:fillColor: paintBits:at:translucent:) ('editing' bitEdit bitEditAt:scale: edit) ('fileIn/Out' comeFullyUpOnReload: hibernate objectForDataStream: printOn: readAttributesFrom: readBitsFrom: readFromOldFormat: readFrom: replaceByResource: storeBitsOn:base: storeOn: storeOn:base: unhibernate writeAttributesOn: writeBitsOn: writeBMPfileNamed: writeJPEGfileNamed: writeJPEGfileNamed:progressive: writeOnMovie: writeOn: writePNGfileNamed: writeUncompressedOn:) ('filling' anyShapeFill bitPatternForDepth: convexShapeFill: eraseShape: fillFromXColorBlock: fillFromXYColorBlock: fillFromYColorBlock: fill:rule:fillColor: findShapeAroundSeedBlock: floodFill2:at: floodFillMapFrom:to:mappingColorsWithin:to: floodFill:at: floodFill:at:tolerance: shapeFill:interiorPoint: shapeFill:seedBlock:) ('image manipulation' replaceColor:withColor: smear:distance: trimBordersOfColor:) ('initialize-release' allocateForm: finish flush fromDisplay: shutDown swapEndianness) ('other' fillAlpha: fixAlpha formForColorCount: preMultiplyAlpha primPrintHScale:vScale:landscape: relativeTextAnchorPosition setAsBackground) ('pixel access' colorAt: colorAt:put: isTransparentAt: pixelValueAt: pixelValueAt:put: primPixelValueAtX:y: primPixelValueAtX:y:put:) ('postscript generation' bitsPerComponent bytesPerRow decodeArray numComponents paddedWidth printPostscript:operator: rowPadding setColorspaceOn: store15To24HexBitsOn: store32To24HexBitsOn: storeBits:to:on: storeHexBitsOn: storePostscriptHexOn:) ('resources' readNativeResourceFrom: readResourceFrom: resourceTag storeResourceOn:) ('scaling, rotation' clippedToSize: flipBy:centerAt: magnifyBy: magnify:by: magnify:by:smoothing: rotateBy: rotateBy:centerAt: rotateBy:magnify:smoothing: rotateBy:smoothing: scaledToHeight: scaledToSize: scaledToSize:smoothing: scaledToWidth: shrink:by:) ('testing' hasNonStandardPalette isAllWhite isBigEndian isDisplayScreen isForm isGrayScale isLittleEndian isStatic isTranslucent isVirtualScreen shouldPreserveContents) ('transitions' fadeImageCoarse:at: fadeImageFine:at: fadeImageHorFine:at: fadeImageHor:at: fadeImageSquares:at: fadeImageVert:at: fadeImage:at:indexAndMaskDo: pageImage:at:corner: pageWarp:at:forward: slideImage:at:delta: wipeImage:at:clippingBox:rectForIndex: wipeImage:at:delta: wipeImage:at:delta:clippingBox: zoomInTo:at: zoomIn:orOutTo:at:vanishingPoint: zoomOutTo:at:) ('*MorphicExtras-postscript generation' encodePostscriptOn:) ('*nebraska-encoding' addDeltasFrom: deltaFrom: deltaFrom:at: encodeForRemoteCanvas) ('private' hackBits: initFromArray: privateFloodFillValue: setExtent:depth: setExtent:depth:bits: setResourceBits:) ('*Morphic' asMorph blankCopyOf: iconOrThumbnailOfSize: scaledIntoFormOfSize: scaledIntoFormOfSize:smoothing:) ('*Morphic-Support-image manipulation' stencil) ('processing' approxGaussianBlur at:bias: dither: edgeDetect emboss processUsingKernel: processUsingKernel:factor:bias: sharpen) ('*System-icon scaling' scaleIconToDisplay) ('*Morphic-Text Support' textAnchorProperties) ('*Tools-Inspector' inspectorClass) ('*TrueType-displaying' advanceWidth) !
Flaps class removeSelector: #addAndEnableEToyFlaps! Flaps class removeSelector: #defaultsQuadsDefiningPlugInSuppliesFlap! Flaps class removeSelector: #defaultsQuadsDefiningScriptingFlap! Flaps class removeSelector: #enableEToyFlaps! Flaps class removeSelector: #newLoneSuppliesFlap! Flaps class removeSelector: #newPaintingFlap! Flaps class removeSelector: #paintFlapButton! Flaps class removeSelector: #possiblyReplaceEToyFlaps! Flaps class removeSelector: #setUpSuppliesFlapOnly!
!Flaps class reorganize! ('class initialization' initialize) ('construction support' addMorph:asElementNumber:inGlobalFlapSatisfying: addMorph:asElementNumber:inGlobalFlapWithID: addToSuppliesFlap:asElementNumber: deleteMorphsSatisfying:fromGlobalFlapSatisfying:) ('flap mechanics' clobberFlapTabList freshFlapsStart reinstateDefaultFlaps removeFlapTab:keepInList:) ('flaps registry' defaultsQuadsDefiningStackToolsFlap defaultsQuadsDefiningSuppliesFlap defaultsQuadsDefiningToolsFlap defaultsQuadsDefiningWidgetsFlap initializeFlapsQuads registeredFlapsQuads registeredFlapsQuadsAt: registerQuad:forFlapNamed: unregisterQuadsWithReceiver: unregisterQuadsWithReceiver:fromFlapNamed: unregisterQuad:forFlapNamed:) ('menu commands' disableGlobalFlaps disableGlobalFlaps: disableGlobalFlapWithID: enableDisableGlobalFlapWithID: enableGlobalFlapWithID: explainFlaps explainFlapsText) ('menu support' addIndividualGlobalFlapItemsTo: enableGlobalFlaps globalFlapWithIDEnabledString: showSharedFlaps suppressFlapsString) ('miscellaneous' automaticFlapLayoutChanged doAutomaticLayoutOfFlapsIfAppropriate enableClassicNavigatorChanged fileOutChanges makeNavigatorFlapResembleGoldenBar orientationForEdge: removeFromGlobalFlapTabList:) ('new flap' addLocalFlap addLocalFlap: addLocalFlap:titled:onEdge: askForEdgeOfNewFlap defaultColorForFlapBackgrounds newFlapTitled:onEdge: newFlapTitled:onEdge:inPasteUp:) ('predefined flaps' addNewDefaultSharedFlaps addStandardFlaps initializeStandardFlaps newNavigatorFlap newObjectsFlap newSqueakFlap newStackToolsFlap newSuppliesFlap newSuppliesFlapFromQuads:positioning: newToolsFlap newWidgetsFlap quadsDefiningPlugInSuppliesFlap quadsDefiningStackToolsFlap quadsDefiningSuppliesFlap quadsDefiningToolsFlap quadsDefiningWidgetsFlap quadsDeiningScriptingFlap twiddleSuppliesButtonsIn:) ('replacement' replaceGlobalFlapwithID: replacePartSatisfying:inGlobalFlapSatisfying:with: replacePartSatisfying:inGlobalFlapWithID:with: replaceToolsFlap) ('shared flaps' addGlobalFlap: enableOnlyGlobalFlapsWithIDs: globalFlapTabOrDummy: globalFlapTabs globalFlapTabsIfAny globalFlapTabsWithID: globalFlapTabWithID: globalFlapTab: positionNavigatorAndOtherFlapsAccordingToPreference positionVisibleFlapsRightToLeftOnEdge:butPlaceAtLeftFlapsWithIDs: removeDuplicateFlapTabs sharedFlapsAllowed sharedFlapsAlongBottom) ('testing' anyFlapsVisibleIn:) !
EventHandler removeSelector: #adaptToWorld:! DeepCopier removeSelector: #mapUniClasses! DeepCopier removeSelector: #newUniClasses! DeepCopier removeSelector: #newUniClasses:! DeepCopier removeSelector: #uniClasses! Object subclass: #DeepCopier instanceVariableNames: 'references' classVariableNames: '' poolDictionaries: '' category: 'System-Object Storage'!
!DeepCopier reorganize! ('like fullCopy' checkBasicClasses checkClass: checkDeep checkVariables fixDependents initialize initialize: objInMemory: references warnIverNotCopiedIn:sel:) !
ChangeList removeSelector: #buildMorphicCodePaneWith:! CodeHolder removeSelector: #installTextualCodingPane! CodeHolder removeSelector: #restoreTextualCodingPane!
!CodeHolder reorganize! ('annotation' addPriorVersionsCountForSelector:ofClass:to: annotation annotation: annotationForClassCommentFor: annotationForClassDefinitionFor: annotationForHierarchyFor: annotationForSelector:ofClass: annotationPaneMenu:shifted: annotationRequests annotationSeparator) ('categories' categoryFromUserWithPrompt:for: categoryOfCurrentMethod changeCategory letUserReclassify:in: methodCategoryChanged selectedMessageCategoryName selectedSystemCategoryName) ('categories & search pane' listPaneWithSelector: newSearchPane searchTextMorph) ('commands' adoptMessageInCurrentChangeset browseImplementors browseSenders copyUpOrCopyDown offerMenu offerShiftedClassListMenu offerUnshiftedClassListMenu shiftedYellowButtonActivity spawn: spawnToClass: spawnToCollidingClass: unshiftedYellowButtonActivity) ('construction' buildClassBrowserEditString: buildMessageBrowserEditString: buildMessageCategoryBrowserForCategory:class:selector:editString: buildMorphicCodePaneWith:) ('contents' commentContents contents contentsChanged contentsSymbol contentsSymbol: editContents editContentsWithDefault: isModeStyleable) ('controls' codePaneProvenanceString contentsSymbolQuints decorateButtons optionalButtonPairs sourceAndDiffsQuintsOnly) ('diffs' defaultDiffsSymbol diffFromPriorSourceFor: showDiffs showDiffs: showPrettyDiffs: showRegularDiffs: showingAnyKindOfDiffs showingPrettyDiffs showingPrettyDiffsString showingRegularDiffs showingRegularDiffsString toggleDiffing togglePlainSource togglePrettyDiffing togglePrettyPrint toggleRegularDiffing wantsDiffFeedback) ('message category functions' canShowMultipleMessageCategories removeMessageCategory) ('message list' decompiledSourceIntoContents decompiledSourceIntoContentsWithTempNames: formattedLabel: formattedLabel:forSelector:inClass: messageHelpForMethod: messageHelpTruncated: selectedBytecodes selectedMessage sourceStringPrettifiedAndDiffed validateMessageSource:forSelector:inClass:) ('message list menu' messageListKey:from: messageListMenuMore: shiftedMessageListMore:) ('misc' addModelItemsToWindowMenu: getSelectorAndSendQuery:to: getSelectorAndSendQuery:to:with: informPossiblyCorruptSource isThereAnOverride isThisAnOverride modelWakeUpIn: okayToAccept priorSourceOrNil refreshAnnotation refusesToAcceptCode releaseCachedState sampleInstanceOfSelectedClass sendQuery:to: sendQuery:to:with: setClassAndSelectorIn: suggestCategoryToSpawnedBrowser: useSelector:orGetSelectorAndSendQuery:to:) ('self-updating' didCodeChangeElsewhere stepIn: updateCodePaneIfNeeded updateListsAndCodeIn: wantsStepsIn:) ('toolbuilder' annotationFrame annotationPaneHeight browseButtonEnabled buildAnnotationPaneWith: buildCodePaneWith: buildCodeProvenanceButtonWith: buildOptionalButtonsWith: buttonHeight hierarchyButtonEnabled inheritanceButtonColor inheritanceButtonEnabled optionalButtonsFrame receiverClass textFrame variablesButtonEnabled versionsButtonEnabled) ('traits' makeSampleInstance showUnreferencedClassVars showUnreferencedInstVars spawnHierarchy) ('what to show' offerWhatToShowMenu prettyPrintString setContentsToForceRefetch showByteCodes: showDecompile: showDocumentation: showingByteCodes showingByteCodesString showingDecompile showingDecompileString showingDocumentation showingDocumentationString showingEditContentsOption showingPlainSource showingPlainSourceString showingPrettyPrint showingSource toggleDecompile toggleShowDocumentation toggleShowingByteCodes wantsCodeProvenanceButton) ('*services-base' messageListMenuServices: requestor) ('*Protocols-Tools' spawnFullProtocol spawnProtocol) ('multi-window support' multiWindowState multiWindowState:) ('message functions' exploreMethod inspectMethod removeMessage) ('*SUnitTools-running' testAskToCreateNewTest: testBinarySelectorNames testBrowseClassNamed:possibleMessageNamed: testFindTest testFindTested testRunSuite: testSelectorFrom:) ('*SUnitTools-message list functions' testDebugTest testRunTest) ('*SUnitTools-menus' testsMessageListMenu: testsTestFindingMenu:) ('breakpoints' isBreakOnEntry toggleBreakOnEntry) ('code pane' aboutToStyle: compileMessage:notifying:) ('accessing' contents:notifying: doItReceiver metaClassIndicated selectedClass selectedClassOrMetaClass selectedMessageName systemOrganizer) ('initialize-release' defaultBrowserTitle labelString setClass:selector:) ('*monticello-revisions' classListMenuMonticello: messageListMenuMonticello:) ('class functions' removeClass) ('system category functions' removeSystemCategory) ('*60Deprecated-annotation' defaultAnnotationPaneHeight defaultButtonPaneHeight) ('*60Deprecated-categories & search pane' searchPane) !
Object removeSelector: #adaptedToWorld:! Object removeSelector: #beViewed! Object removeSelector: #belongsToUniClass! Object removeSelector: #costumes! Object removeSelector: #defaultFloatPrecisionFor:! Object removeSelector: #evaluateUnloggedForSelf:! Object removeSelector: #isPlayer! Object removeSelector: #isPrimitiveCostume! Object removeSelector: #isScriptEditorMorph! Object removeSelector: #isUniversalTiles! Object removeSelector: #methodInterfacesForCategory:inVocabulary:limitClass:! Object removeSelector: #methodInterfacesForInstanceVariablesCategoryIn:! Object removeSelector: #methodInterfacesForScriptsCategoryIn:! Object removeSelector: #presenter! Object removeSelector: #renameInternal:! Object removeSelector: #scriptPerformer! Object removeSelector: #selfWrittenAsIll! Object removeSelector: #selfWrittenAsIm! Object removeSelector: #selfWrittenAsMe! Object removeSelector: #selfWrittenAsMy! Object removeSelector: #selfWrittenAsThis! Object removeSelector: #slotInfo! Object removeSelector: #veryDeepCopySibling!
!Object reorganize! ('accessing' at: at:modify: at:put: basicAt: basicAt:put: basicSize bindWithTemp: enclosedSetElement in: readFromString: size yourself) ('associating' ->) ('binding' bindingOf:) ('casing' caseOf: caseOf:otherwise:) ('class membership' class inheritsFromAnyIn: isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass) ('comparing' = closeTo: hash identityHashPrintString literalEqual: ~=) ('converting' adaptToFloat:andCompare: adaptToFloat:andSend: adaptToFraction:andCompare: adaptToFraction:andSend: adaptToInteger:andCompare: adaptToInteger:andSend: adaptToScaledDecimal:andCompare: adaptToScaledDecimal:andSend: as: asOrderedCollection asSetElement asString asStringOrText changeClassTo: complexContents mustBeBoolean mustBeBooleanIn: printDirectlyToDisplay withoutListWrapper) ('copying' copy copyAddedStateFrom: copyFrom: copySameFrom: copyTwoLevel deepCopy initialDeepCopierSize postCopy shallowCopy veryDeepCopy veryDeepCopyUsing: veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:) ('debugging' evaluate:wheneverChangeIn: haltIf: haltOnceIf: meetsHaltCondition: needsWork) ('debugging-haltOnce' checkHaltCountExpired clearHaltOnce decrementAndCheckHaltCount decrementHaltCount doExpiredHaltCount doExpiredHaltCount: doExpiredInspectCount halt:onCount: haltIfNil haltOnCount: haltOnce haltOnce: haltOnceEnabled hasHaltCount inspectOnCount: inspectOnce inspectUntilCount: removeHaltCount setHaltCountTo: setHaltOnce toggleHaltOnce) ('dependents access' addDependent: breakDependents canDiscardEdits dependents hasUnacceptedEdits myDependents myDependents: release removeDependent:) ('drag and drop' acceptDroppingMorph:event:inMorph: dragPassengerFor:inMorph: dragStartedFor:transferMorph: dragTransferTypeForMorph: wantsDroppedMorph:event:inMorph:) ('error handling' assert: assert:description: assert:descriptionBlock: backwardCompatibilityOnly: caseError deprecated deprecated: deprecated:block: doesNotUnderstand: dpsTrace: dpsTrace:levels: dpsTrace:levels:withContext: error error: halt halt: handles: notify: notify:at: primitiveFailed primitiveFailed: shouldBeImplemented shouldNotImplement subclassResponsibility traitConflict) ('evaluating' value valueWithArguments:) ('filter streaming' byteEncode: drawOnCanvas: elementSeparator encodePostscriptOn: flattenOnStream: fullDrawPostscriptOn: putOn: writeOnFilterStream:) ('flagging' isThisEverCalled isThisEverCalled: logEntry logExecution logExit) ('graph model' addModelYellowButtonMenuItemsTo:forMorph:hand: hasModelYellowButtonMenuItems) ('macpal' codeStrippedOut: contentsChanged flash instanceVariableValues objectRepresented refusesToAcceptCode) ('message handling' executeMethod: perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:with:with:with:with: perform:with:with:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: perform:withEnoughArguments: with:executeMethod: with:with:executeMethod: with:with:with:executeMethod: with:with:with:with:executeMethod: withArgs:executeMethod:) ('objects from disk' comeFullyUpOnReload: convertToCurrentVersion:refStream: fixUponLoad:seg: objectForDataStream: readDataFrom:size: saveOnFile saveOnFileNamed: storeDataOn:) ('printing' fullPrintString isLiteral longPrintOn: longPrintOn:limitedTo:indent: longPrintString longPrintStringLimitedTo: nominallyUnsent: printOn: printString printStringLimitedTo: printWithClosureAnalysisOn: reportableSize storeOn: storeString stringForReadout stringRepresentation) ('system primitives' asOop become: becomeForward: becomeForward:copyHash: className creationStamp instVarAt: instVarAt:put: instVarNamed: instVarNamed:put: oopString primitiveChangeClassTo: rootStubInImageSegment: someObject) ('testing' isArray isBehavior isBlock isBoolean isCharacter isClassReference isClosure isCodeReference isCollection isColor isColorForm isCompiledCode isCompiledCodeClass isCompiledMethod isComplex isContext isDictionary isFloat isForm isFraction isHeap isInteger isInterval isMessageSend isMethodContext isMethodProperties isMethodReference isMorph isMorphicEvent isMorphicModel isNumber isPoint isPromise isRectangle isScaledDecimal isSketchMorph isStream isString isSymbol isSystemWindow isText isTextView isTrait isTransparent isVariableBinding isWebBrowser isWindowForModel: knownName name nameForViewer renameTo: shouldBePrintedAsLiteral shouldBePrintedAsLiteralVisiting: showDiffs stepAt:in: stepIn: stepTime stepTimeIn: vocabularyDemanded wantsDiffFeedback wantsSteps wantsStepsIn:) ('updating' changed changed: changed:with: handledListVerification noteSelectionIndex:for: okToChange okToClose update: update:with: updateListsAndCodeIn: windowIsClosing) ('user interface' addModelItemsToWindowMenu: addModelMenuItemsTo:forMorph:hand: asExplorerString defaultLabelForInspector launchPartVia: launchPartVia:label: launchTileToRefer modelSleep modelWakeUp modelWakeUpIn: mouseUpBalk: notYetImplemented windowActiveOnFirstClick windowReqNewLabel:) ('*monticello' isConflict) ('*system-support' isPrimitiveError systemNavigation) ('*Tools-Explorer' explore exploreWithLabel:) ('*tools-browser' browseHierarchy) ('private' errorImproperStore errorNonIntegerIndex errorNotIndexable errorSubscriptBounds: setPinned: species storeAt:inTempFrame:) ('thumbnail' iconOrThumbnailOfSize:) ('*Morphic-Explorer' explorerContents hasContentsInExplorer) ('futures' future future: futureDo:at:args: futureSend:at:args:) ('*Tools-MessageSets' browseAllCallsOn: browseAllCallsOn:requestor: browseAllImplementorsOf: browseAllImplementorsOf:requestor:) ('*Tools-multi-window support' canHaveUnacceptedEdits) ('*morphic' asMorph asStringMorph asTextMorph isPluggableListMorph openAsMorph) ('tracing' inboundPointers inboundPointersExcluding: outboundPointers outboundPointersDo:) ('*Tools-Debugger' canonicalArgumentName chasePointers explorePointers shouldFollowOutboundPointers) ('*System-Object Events-accessing' actionForEvent: actionForEvent:ifAbsent: actionMap actionSequenceForEvent: actionsDo: createActionMap hasActionForEvent: setActionSequence:forEvent: updateableActionMap) ('*System-Change Notification-events' actionsWithReceiver:forEvent: renameActionsWithReceiver:forEvent:toEvent:) ('*System-Change Notification-converting' asActionSequence asActionSequenceTrappingErrors) ('*System-Tools-breakpoint' break) ('*ToolBuilder-Kernel-error handling' confirm: confirm:orCancel:) ('*ToolBuilder-Kernel-user interface' inform:) ('*System-Support-user interface' initialExtent) ('*System-Localization-locales' localeChanged localeChangedGently translatedNoop) ('*System-Object Events-accessing-removing' releaseActionMap removeAction:forEvent: removeActionsForEvent: removeActionsSatisfying: removeActionsSatisfying:forEvent: removeActionsWithReceiver: removeActionsWithReceiver:forEvent:) ('*System-Object Events-accessing-triggering' triggerEvent: triggerEvent:ifNotHandled: triggerEvent:with: triggerEvent:with:ifNotHandled: triggerEvent:withArguments: triggerEvent:withArguments:ifNotHandled:) ('*System-Object Events-accessing-registering' when:evaluate: when:send:to: when:send:to:with: when:send:to:withArguments:) ('*Traits' explicitRequirement requirement) ('*Graphics-KernelExtensions' fullScreenSize) ('*System-Finalization' actAsExecutor executor finalizationRegistry finalize hasMultipleExecutors retryWithGC:until: toFinalizeSend:to:with:) ('*collections' asLink compareSafely:) ('*Tools-Browsing' browse) ('*System-Recovery-error handling' primitiveError:) ('*SUnit-testing' isTestClass) ('*Morphic-Events-Filtering' filterEvent:for:) ('*System-Preferences' applyUserInterfaceTheme canApplyUserInterfaceTheme userInterfaceTheme) ('*Tools' environment) ('pinning' isPinned pin unpin) ('literals' allLiteralsDo: hasLiteral: hasLiteralSuchThat:) ('write barrier' attemptToAssign:withIndex: beReadOnlyObject beWritableObject isReadOnlyObject setIsReadOnlyObject:) ('*Tools-Inspector' basicInspect inspect inspectWithLabel: inspectorClass) ('*Morphic-Kernel-accessing' currentEvent currentHand currentWorld) ('*Monticello-Patching-testing' isMCPatchOperation) ('*JSON' asJsonString) ('*60Deprecated-accessing' ifNil:ifNotNilDo: ifNotNilDo: ifNotNilDo:ifNil:) ('*MorphicExtras-Undo' capturedState commandHistory purgeAllCommands redoFromCapturedState: refineRedoTarget:selector:arguments:in: refineUndoTarget:selector:arguments:in: rememberCommand: rememberUndoableAction:named: undoFromCapturedState:) ('*Protocols' currentVocabulary haveFullProtocolBrowsed haveFullProtocolBrowsedShowingSelector:) ('*services-base' requestor) ('*60Deprecated-copying' clone) ('*60Deprecated-Tools' exploreAndYourself notifyWithLabel:) ('*MorphicExtras-PartsBin' descriptionForPartsBin) !
| currentChanges | currentChanges := ChangeSet current.
Smalltalk globals removeKey: #References. Smalltalk globals removeKey: #CustomEventsRegistry. Smalltalk globals removeKey: #ScriptingSystem.
ChangeSet newChanges: (ChangeSet new name: 'unload-etoys-more'). (Smalltalk classNamed: #StandardScriptingSystem) removeFromSystem. (Smalltalk classNamed: #Presenter) removeFromSystem. (Smalltalk classNamed: #MethodHolder) removeFromSystem. (Smalltalk classNamed: #PaintInvokingMorph) removeFromSystem. (Smalltalk classNamed: #ViewerFlapTab) removeFromSystem. (Smalltalk classNamed: #AcceptableCleanTextMorph) removeFromSystem. (Smalltalk classNamed: #BrowserCommentTextMorph) removeFromSystem. (Smalltalk classNamed: #BorderedSubpaneDividerMorph) removeFromSystem. (Smalltalk classNamed: #TextFieldMorph) removeFromSystem. (Smalltalk classNamed: #KeyboardBuffer) removeFromSystem. (Smalltalk classNamed: #PluggableTabButtonMorph) removeFromSystem. (Smalltalk classNamed: #MorphWithSubmorphsWrapper) removeFromSystem. (Smalltalk classNamed: #TwoWayScrollPane) removeFromSystem. Preferences removePreference: #noviceMode. Preferences removePreference: #eToyFriendly. Preferences removePreference: #universalTiles. Preferences removePreference: #uniTilesClassic. Preferences removePreference: #tileTranslucentDrag. Preferences removePreference: #typeCheckingInTileScripting. Preferences removePreference: #compactViewerFlaps. Preferences removePreference: #viewersInFlaps. Preferences removePreference: #batchPenTrails. Preferences removePreference: #keepTickingWhilePainting. Preferences removePreference: #unlimitedPaintArea. Preferences removePreference: #mvcProjectsAllowed. Preferences removePreference: #eToyLoginEnabled. Preferences removePreference: #oliveHandleForScriptedObjects. Preferences removePreference: #dropProducesWatcher. Preferences removePreference: #automaticViewerPlacement. Preferences removePreference: #capitalizedReferences. Preferences removePreference: #fenceEnabled. Preferences removePreference: #fenceSoundEnabled. Preferences removePreference: #haloTransitions. Preferences removePreference: #selectiveHalos. Preferences removePreference: #useVectorVocabulary. Preferences removePreference: #simpleMenus. Preferences removePreference: #propertySheetFromHalo. Preferences removePreference: #menuColorFromWorld. Preferences removePreference: #enableVirtualOLPCDisplay. Preferences removePreference: #enablePortraitMode. Preferences removePreference: #magicHalos. Preferences removePreference: #tabAmongFields. Preferences removePreference: #sugarAutoSave. Preferences removePreference: #showAdvancedNavigatorButtons. FileServices removeObsolete. ChangeSet newChanges: currentChanges.
ChangeSet newChanges: (ChangeSet new name: 'clean-up-categories'). SystemChangeNotifier uniqueInstance doSilently: [ Smalltalk allClassesDo: [:cls | cls organization renameCategory: 'stepping and presenter' toBe: 'stepping']]. Smalltalk removeEmptyMessageCategories. ChangeSet newChanges: currentChanges.
Preferences resetHaloSpecifications. TheWorldMainDockingBar updateInstances. Flaps initializeFlapsQuads; initializeStandardFlaps. Vocabulary initializeStandardVocabularies. UserInterfaceTheme cleanUpAndReset.
"Next: Remove Etoys package from update map."!
Hi all --
PLEASE take a look at the change-set I provided BEFORE answering here.
There is a reason I did not just ask a question but invested SEVERAL WEEKS of effort to better understand the complications Etoys represents in the basic Squeak system. We are a small community and such HIGH MAINTENANCE projects pose a serious challenge for Squeaks onward development. People keep on complaining that things do not work anymore but have no idea why and how.
Removing Etoys might be an opportunity to better focus in the features that are actually used in Squeak today. This includes, of course, object storage and rich media content creation. Not just code. Not just text.
I understand, that this might feel like "the end of an era" to some. That's why I started this discussion. To let people share their thoughts on this. Here are more questions that might help you think about this:
Why do you use Etoys in Squeak 6.0 and not an earlier version of Squeak? Why is the last official Etoys version not sufficient anymore? What are your recent Etoys projects and how is Squeak 6.0 performing in this regard?
Thank you.
Best, Marcel
Am 29.08.2023 15:47:19 schrieb Marcel Taeumel marcel.taeumel@hpi.de: Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras: - Games - Sketches and PaintBox - Flaps - CalendarMorph - SpectrumAnalyzerMorph
Here is what would still "work" through the package System: - Object storage (ImageSegment etc.) - ProjectLoading
Here is what would still work through the package Protocols: - Lexicon tool - Vocabulary framework
Here is what would be gone: - Tiles, viewers, and scripts - Players and costumes - Pen trails, Turtles, ... - References, CustomEventsRegistry, ScriptingSystem - Siblings for (Player-only) uni-classes - DeepCopier support for (Player-only) uni-classes - Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
So...should we remove Etoys from Trunk at this point?
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel
Hi Marcel, hi all,
thanks a lot for raising that question! This looks indeed like a major work of clean-up.
Personally, I have no relationship to Etoys - I contributed source-to-tile conversion a few years ago, and I (re)worked the "Race Car" tutorial for Objectland, but I never actually used Etoys nor I can tell that I really enjoyed working with what I met, much of it feels a bit old and clumsy to me - older and clumsier than the rest of the trunk. :-) Thus, I don't have a strong opinion on this topic. I will nevertheless try to share my humble and naive thinking out aloud on this discussion. If you don't like an argument, please ignore it, or better, take me as the devil's advocate and contradict it. Strong language does not indicate strong feeling or offense in the following; as long as we have a nice discussion on this topic, I will be happy with either decision from what I have heard so far. :-)
What does it mean to "remove Etoys"? Does this mean: define a clear path to unload Etoys from your image? Or: Make Etoys opt-in during the download/installation process? Are we cancelling the responsibility for further maintenaning it and its support in the Trunk? Or at least reverting the burden and treating it like any other third-party package where its own maintainers, not the Trunk developers, are responsible for finding ways to keep it compatible with Trunk? (In other words, will I as a core developer be still responsible for testing my future changes with Etoys?) Or will we later say: "Etoys is/was supported up to Squeak 6.0"?
What is the value of supporting Etoys in a recent Squeak version? I think it looked pretty much the same in Squeak 6.0, 5.3, 5.2 - if at all, with more maintenance bugs from time to time; and we have been? were able to? shipping separate Etoys images for some time. (Correction of my previous statement: In fact, high-dpi mode is probably the most visible change to Etoys. But other than that?) So, is it to provide Etoys users with new capabilities of Squeak such as better fonts/richer programming interfaces/...? I can't imagine many points here where I would be confident that ongoing development does more good than harm to Etoys due to compatibility issues, given the missing awareness (at least from my personal side) of what kind of things it does and what kinds of things it requires for that. Senders/implementors is a helpful indicator but does not cover it all. Is it to allow people to do a smooth transition from Etoys to real, modern Squeak? How many users are going this path? Is it to preserve the experiencing of a "living museum" where exploring decades-old (decades? I don't even know how old Etoys is) work is just two clicks away from your modern tools? Is it a good/inspiring/pleasant demonstration of Squeak's and Smalltalk's capabilities? Is it just politics/marketing/a pledge that Squeak cares about backward compatibility, maybe even as a counterstatement to forks such as Pharo?
Why should we remove (or: make optional) Etoys from the Trunk? This one is simpler for me to answer, which is why I tried to disprove it above. :-) Etoys is awkwardly coupled to the Trunk, as illustrated just by the large size and high revision number of this changeset. As Trunk maintainers, we are frequently stumbling upon code that is bad, hardly comprehensible, of unclear relevance, or possible already dead -- much of this located in or related to the Etoys package. This can slow down maintenance and development of new features significantly. Uncertainty causes reluctance to changes. To some degree, etoys is (probably) the prime illustration of technical debt and big balls of mud in Squeak. (To clarify this point, very much of my antipathy against Etoys comes from its 1613 extension methods to other packates.) When browsing code in browser/senders/... and discovering (unexpected) Etoys code, your WTF counter often strikes out, it dissatifies you, and it distracts you. (Then again, these moments might even be a traditional emotional part of working in Squeak, telling you a story of earlier experiments, other developer's opinions, and demonstrating the diversity of past mindset on design ... melancholy.) Hiding all such code from the default code graph and code browsing tools would often feel relieving. (Then again, there might be more or fewer concepts that only get clear by the example of a single sender from Etoys.) Removing Etoys from the Trunk might set off an avalanche of further (potential for) clean-up by simplifying or removing many other things and improve the overall readability/coherence/coupling of the system (then again, we also would have to work on this avalanche). Still, speaking quite generically about that due to my lack of concrete examples. Marcel obviously has to offer more (e.g., Morphic and Object-Storage). With regard to code and bundle sizes, I can't tell much, in my case the default image grew from 52 MB to 62 MB after installing the changeset, surely this is not expected.
Is removing Etoys from the Trunk worth the effort? I don't have enough overview of open construction sites and feature requests to answer that question, so this paragraph may contain especially many hallucinations. :-) Personally, I was always able to work around the burden and manifestations of Etoys, and from a naive perspective this always felt simpler or more attractive than reverse engineering the big ball of mud to a degree sufficient for eliminating it. However, I'm likely missing the big picture. Much more importantly, Marcel seems to already have done significant progress on this issue enough so that this question ultimately becomes irrelevant.
What are the alternatives? In an ideal world, Etoys would just be another package that uses public interfaces and hooks from the core packages to deliver its functionality, that does not require hacks or downstream dependencies in other package, and that prefixes every extension method with "etoys". In that case, I would happily keep it in the Trunk forever. However, I don't have enough hope that Etoys wil reach that level of code quality. :-)
What else could happen if we remove Etoys from the Trunk? Definitely playing the devil's advocate now. :-) Unless some people commit to maintenance of the third party package Etoys, compatibility will slower of faster fade away. Etoys might not even be loadable again in Squeak 6.1 RC. People with an Etoys background will be dissatisfied. People who are there because of Etoys will renounce from Squeak. Maybe there will even be a fork SqueakWithEtoys. Public image of Squeak will be damaged ("neither open to the world and (breaking) changes like Pharo, nor faithful to its history like SqueakWithEtoys"). Fewer newbies will elect Squeak as their choice of distribution due to this, our specific community will shrink, separate communities will reundantly reinvent future wheels, Smalltalk as a whole will loose further reputation from the mainstream community for being divided and disunited.
TL;DR: Should we remove/make optional Etoys from Squeak? I don't know, or at least don't have strong opinions. By myself, I would most likely not initiate this change due to high assumed cost and unclear negative consequences for the community and its solidarity. But if a waste majority of contributors and users opt for it, I will not be worried but feel very relieved to work with a lighter and easier-to-change image.
Best, Christoph
PS: Again, no one shall feel offended by my previous arguments. Etoys was surely a milestone in the past and a great thing for many children (at least it seems to have the potential), it's just nothing for me myself and doesn't seem to be a prime example of good code quality and maintenance.
--- Sent from Squeak Inbox Talk
On 2023-08-30T09:38:49+02:00, marcel.taeumel@hpi.de wrote:
Hi all --
PLEASE take a look at the change-set I provided BEFORE answering here.
There is a reason I did not just ask a question but invested SEVERAL WEEKS of effort to better understand the complications Etoys represents in the basic Squeak system. We are a small community and such HIGH MAINTENANCE projects pose a serious challenge for Squeaks onward development. People keep on complaining that things do not work anymore but have no idea why and how.
Removing Etoys might be an opportunity to better focus in the features that are actually used in Squeak today. This includes, of course, object storage and rich media content creation. Not just code. Not just text.
I understand, that this might feel like "the end of an era" to some. That's why I started this discussion. To let people share their thoughts on this. Here are more questions that might help you think about this:
Why do you use Etoys in Squeak 6.0 and not an earlier version of Squeak? Why is the last official Etoys version not sufficient anymore? What are your recent Etoys projects and how is Squeak 6.0 performing in this regard?
Thank you.
Best, Marcel
Am 29.08.2023 15:47:19 schrieb Marcel Taeumel <marcel.taeumel(a)hpi.de>: Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras:
- Games
- Sketches and PaintBox
- Flaps
- CalendarMorph
- SpectrumAnalyzerMorph
Here is what would still "work" through the package System:
- Object storage (ImageSegment etc.)
- ProjectLoading
Here is what would still work through the package Protocols:
- Lexicon tool
- Vocabulary framework
Here is what would be gone:
- Tiles, viewers, and scripts
- Players and costumes
- Pen trails, Turtles, ...
- References, CustomEventsRegistry, ScriptingSystem
- Siblings for (Player-only) uni-classes
- DeepCopier support for (Player-only) uni-classes
- Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
So...should we remove Etoys from Trunk at this point?
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel
Hi Christoph --
With regard to code and bundle sizes, I can't tell much, in my case the default image grew from 52 MB to 62 MB after installing the changeset, surely this is not expected.
Here it was 48.7 MiB down to 48.6 MiB. :-)
Best, Marcel Am 30.08.2023 11:58:04 schrieb christoph.thiede@student.hpi.uni-potsdam.de christoph.thiede@student.hpi.uni-potsdam.de: Hi Marcel, hi all,
thanks a lot for raising that question! This looks indeed like a major work of clean-up.
Personally, I have no relationship to Etoys - I contributed source-to-tile conversion a few years ago, and I (re)worked the "Race Car" tutorial for Objectland, but I never actually used Etoys nor I can tell that I really enjoyed working with what I met, much of it feels a bit old and clumsy to me - older and clumsier than the rest of the trunk. :-) Thus, I don't have a strong opinion on this topic. I will nevertheless try to share my humble and naive thinking out aloud on this discussion. If you don't like an argument, please ignore it, or better, take me as the devil's advocate and contradict it. Strong language does not indicate strong feeling or offense in the following; as long as we have a nice discussion on this topic, I will be happy with either decision from what I have heard so far. :-)
What does it mean to "remove Etoys"? Does this mean: define a clear path to unload Etoys from your image? Or: Make Etoys opt-in during the download/installation process? Are we cancelling the responsibility for further maintenaning it and its support in the Trunk? Or at least reverting the burden and treating it like any other third-party package where its own maintainers, not the Trunk developers, are responsible for finding ways to keep it compatible with Trunk? (In other words, will I as a core developer be still responsible for testing my future changes with Etoys?) Or will we later say: "Etoys is/was supported up to Squeak 6.0"?
What is the value of supporting Etoys in a recent Squeak version? I think it looked pretty much the same in Squeak 6.0, 5.3, 5.2 - if at all, with more maintenance bugs from time to time; and we have been? were able to? shipping separate Etoys images for some time. (Correction of my previous statement: In fact, high-dpi mode is probably the most visible change to Etoys. But other than that?) So, is it to provide Etoys users with new capabilities of Squeak such as better fonts/richer programming interfaces/...? I can't imagine many points here where I would be confident that ongoing development does more good than harm to Etoys due to compatibility issues, given the missing awareness (at least from my personal side) of what kind of things it does and what kinds of things it requires for that. Senders/implementors is a helpful indicator but does not cover it all. Is it to allow people to do a smooth transition from Etoys to real, modern Squeak? How many users are going this path? Is it to preserve the experiencing of a "living museum" where exploring decades-old (decades? I don't even know how old Etoys is) work is just two clicks away from your modern tools? Is it a good/inspiring/pleasant demonstration of Squeak's and Smalltalk's capabilities? Is it just politics/marketing/a pledge that Squeak cares about backward compatibility, maybe even as a counterstatement to forks such as Pharo?
Why should we remove (or: make optional) Etoys from the Trunk? This one is simpler for me to answer, which is why I tried to disprove it above. :-) Etoys is awkwardly coupled to the Trunk, as illustrated just by the large size and high revision number of this changeset. As Trunk maintainers, we are frequently stumbling upon code that is bad, hardly comprehensible, of unclear relevance, or possible already dead -- much of this located in or related to the Etoys package. This can slow down maintenance and development of new features significantly. Uncertainty causes reluctance to changes. To some degree, etoys is (probably) the prime illustration of technical debt and big balls of mud in Squeak. (To clarify this point, very much of my antipathy against Etoys comes from its 1613 extension methods to other packates.) When browsing code in browser/senders/... and discovering (unexpected) Etoys code, your WTF counter often strikes out, it dissatifies you, and it distracts you. (Then again, these moments might even be a traditional emotional part of working in Squeak, telling you a story of earlier experiments, other developer's opinions, and demonstrating the diversity of past mindset on design ... melancholy.) Hiding all such code from the default code graph and code browsing tools would often feel relieving. (Then again, there might be more or fewer concepts that only get clear by the example of a single sender from Etoys.) Removing Etoys from the Trunk might set off an avalanche of further (potential for) clean-up by simplifying or removing many other things and improve the overall readability/coherence/coupling of the system (then again, we also would have to work on this avalanche). Still, speaking quite generically about that due to my lack of concrete examples. Marcel obviously has to offer more (e.g., Morphic and Object-Storage). With regard to code and bundle sizes, I can't tell much, in my case the default image grew from 52 MB to 62 MB after installing the changeset, surely this is not expected.
Is removing Etoys from the Trunk worth the effort? I don't have enough overview of open construction sites and feature requests to answer that question, so this paragraph may contain especially many hallucinations. :-) Personally, I was always able to work around the burden and manifestations of Etoys, and from a naive perspective this always felt simpler or more attractive than reverse engineering the big ball of mud to a degree sufficient for eliminating it. However, I'm likely missing the big picture. Much more importantly, Marcel seems to already have done significant progress on this issue enough so that this question ultimately becomes irrelevant.
What are the alternatives? In an ideal world, Etoys would just be another package that uses public interfaces and hooks from the core packages to deliver its functionality, that does not require hacks or downstream dependencies in other package, and that prefixes every extension method with "etoys". In that case, I would happily keep it in the Trunk forever. However, I don't have enough hope that Etoys wil reach that level of code quality. :-)
What else could happen if we remove Etoys from the Trunk? Definitely playing the devil's advocate now. :-) Unless some people commit to maintenance of the third party package Etoys, compatibility will slower of faster fade away. Etoys might not even be loadable again in Squeak 6.1 RC. People with an Etoys background will be dissatisfied. People who are there because of Etoys will renounce from Squeak. Maybe there will even be a fork SqueakWithEtoys. Public image of Squeak will be damaged ("neither open to the world and (breaking) changes like Pharo, nor faithful to its history like SqueakWithEtoys"). Fewer newbies will elect Squeak as their choice of distribution due to this, our specific community will shrink, separate communities will reundantly reinvent future wheels, Smalltalk as a whole will loose further reputation from the mainstream community for being divided and disunited.
TL;DR: Should we remove/make optional Etoys from Squeak? I don't know, or at least don't have strong opinions. By myself, I would most likely not initiate this change due to high assumed cost and unclear negative consequences for the community and its solidarity. But if a waste majority of contributors and users opt for it, I will not be worried but feel very relieved to work with a lighter and easier-to-change image.
Best, Christoph
PS: Again, no one shall feel offended by my previous arguments. Etoys was surely a milestone in the past and a great thing for many children (at least it seems to have the potential), it's just nothing for me myself and doesn't seem to be a prime example of good code quality and maintenance.
--- Sent from Squeak Inbox Talk [https://github.com/hpi-swa-lab/squeak-inbox-talk]
On 2023-08-30T09:38:49+02:00, marcel.taeumel@hpi.de wrote:
Hi all --
PLEASE take a look at the change-set I provided BEFORE answering here.
There is a reason I did not just ask a question but invested SEVERAL WEEKS of effort to better understand the complications Etoys represents in the basic Squeak system. We are a small community and such HIGH MAINTENANCE projects pose a serious challenge for Squeaks onward development. People keep on complaining that things do not work anymore but have no idea why and how.
Removing Etoys might be an opportunity to better focus in the features that are actually used in Squeak today. This includes, of course, object storage and rich media content creation. Not just code. Not just text.
I understand, that this might feel like "the end of an era" to some. That's why I started this discussion. To let people share their thoughts on this. Here are more questions that might help you think about this:
Why do you use Etoys in Squeak 6.0 and not an earlier version of Squeak? Why is the last official Etoys version not sufficient anymore? What are your recent Etoys projects and how is Squeak 6.0 performing in this regard?
Thank you.
Best, Marcel
Am 29.08.2023 15:47:19 schrieb Marcel Taeumel <marcel.taeumel(a)hpi.de>: Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras:
- Games
- Sketches and PaintBox
- Flaps
- CalendarMorph
- SpectrumAnalyzerMorph
Here is what would still "work" through the package System:
- Object storage (ImageSegment etc.)
- ProjectLoading
Here is what would still work through the package Protocols:
- Lexicon tool
- Vocabulary framework
Here is what would be gone:
- Tiles, viewers, and scripts
- Players and costumes
- Pen trails, Turtles, ...
- References, CustomEventsRegistry, ScriptingSystem
- Siblings for (Player-only) uni-classes
- DeepCopier support for (Player-only) uni-classes
- Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
So...should we remove Etoys from Trunk at this point?
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel
On Wed, Aug 30, 2023 at 12:39 AM Marcel Taeumel via Squeak-dev < squeak-dev@lists.squeakfoundation.org> wrote:
Why is the last official Etoys version not sufficient anymore?
Maybe because it has not worked on Macs for 5 years now, because nobody has had the time to build and maintain a 64 bit VM that can run the old image format. I also saw a few weeks ago that it has been removed from Debian for lack of maintenance.
At this point I'm neither for nor against removing it from current Squeak because I see both the value of keeping it and the cost associated with that. In a way it would only be worth keeping if someone stepped up to really fix it and make old projects work again (like Tim did a few years ago), and I don't see that happening. I certainly don't have the time.
Vanessa
On Aug 29, 2023, at 6:48 AM, Marcel Taeumel via Squeak-dev squeak-dev@lists.squeakfoundation.org wrote:
Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras:
- Games
- Sketches and PaintBox
- Flaps
- CalendarMorph
- SpectrumAnalyzerMorph
Here is what would still "work" through the package System:
- Object storage (ImageSegment etc.)
- ProjectLoading
Here is what would still work through the package Protocols:
- Lexicon tool
- Vocabulary framework
Here is what would be gone:
- Tiles, viewers, and scripts
- Players and costumes
- Pen trails, Turtles, ...
- References, CustomEventsRegistry, ScriptingSystem
- Siblings for (Player-only) uni-classes
- DeepCopier support for (Player-only) uni-classes
- Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
So...should we remove Etoys from Trunk at this point?
I would like to see EToys cleanly unloadable, but I would like it to remain in the standard distribution. Certain EToys functionality, such as the webcam support, should be separated from the core EToys package. A proper list of these elements that have broader use should be made.
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel <unload-etoys.33.cs>
Well i used the eToys when i worked t the Squeak Object-Oriented Design with Multimedia Applications book chapter 5 which taught me Why this non Smalltalk non model view presenter controller way this tree way this simple tree Qt way of the big ball of mud jam up of event thud way of getting a winblows up it’s so brittle looking HEY it’s Supposed To Look Brittle What Do You Think This Is SMALLTALK?? is way worse than model view presenter controller or VW etc because i forget but it was way convincing a fine read good family fun i liked it but i likes it a lot but i liked it a lot and vote for continued existing somewhere some way but just like the Squeak image with scroll flaps which i used want to use more but i want the text scroll flap widths to be a setting i guess i could set the screen resolution lower o BA i really want this well if it existed or i could be told how to make it happen quickly and easily i gave it a shot no luck i would be very happy for like an hour and with every re visiting up with Adel etc i hate the Steve Jobs scroll bar i hate it with a passion ah yes this should meet dim bulbs half way reduce tech support and w not put anyone through the 1.5 minutes of agony it might take to brighten up a bit ab ject agony a gon y well it is mine no well it was a thing it was a style make it look familiar to olds who never saw a computer to youngs who never s a c to everyone who n s a c w w everyone now 30 40 years later the new style is more like the old style the original Adel etc s which nobody remembers anymore it’s true i do and so it’s new up with Adel and the rest of the toy makers Alan et c TAKE YOUR TOYS AND SHOVE IT RIGHT UP YOUR ARREARS C THIS IS SERIOUS THIS IS SERIOUS BUSINESS MAKE $ Money m m WONKA NOOO NO MARKETING GET AWAY GET AWAY UP WITH C munism so i want to hook a Adel scroll flaps image up to a 5.3 eToys image up to a new 6+ image via socket or d-bus or http or etc and i don’t want to have to do it myself all 3 working together hmm maybe all three world menus show up in each ? or something and then that world pops up to the front or by short cut key chords which use 2 key prefixes instead of <Ctrl> <Alt> <Meta> but maybe two keys which do not occur in any English word or etc like xk or something so my pinkies can retire to the ass sisted living this idea that it has modularity but little could be maintained for the long now bugs me because i don’t care if a thing does anything i want it to be modular first of all because i am not one of these if this thing does not start flashing ding d d now or in 30 seconds i am going to have A cow parkers no i am more like to keep on sacrificing endlessly to the god of modularity in silence deep in the salt mines forever and never have a damm thing to show for it but a mathematical clean room i never get to the lights a flashing at all so which way is better damm the torpedoes get me a one armed bandit NOW that explodes like a disease of leprechaun cancer all over the architecture or a silent block of clean pure clean pure cure that never gets to Bomb Bay maybe both could be used at the same time by having a socket link between images or something whereby two or more images can work together the old 5.3 with the eToys and the new image without it and i believe Facebook backs me up on this with their library i forget inter language lib called something or this just remove it script could work does work if there could be a diagram a Roassal diagram or something which people could add to which tries to put this eToys design or anti design into a more solid form mat which people could add to some how if they ever see anything and gradually the 1600 methods the scatterlings in the architecture could get proposals and trials and removals to modular i guess the script does this to make eToys modular so no one guy has to well ok enough i know nothing little or nothing do not listen to me stop reading NOW i would like a image or a server a Smalltalk server image or GemStone which my image can hook up to by socket or d-bus or https or dcom or et cetera and i can see the other parkers on there twiddling digits like twitch or something no not like twitch that’s so dumm well what out of time what do i know a tree or something i know nothing maybe that the rest of the languages could steal and go and go look at this cool thing we thought up again once again huh what Smalltalk it’s so pathetic hey you look even d than i do now shut up so i liked eToys but i would like a similar scripting thing or maybe an eToys that is more general more less crippled that was also maybe graphical but more general which you could switch to because it is modular and you can do a graphical tree based version of Smalltalk like Smalltalk in a Roassal diagram or something or just forget i said anything eToys includes Smalltalk what i really wanted at the end was that each morph would have a detailed description of what it does what it could do what all the caveats are what things it likes to interact with or is all that on YouTube well if it is on YouTube then there should aught to be a help tree with all the links in it so you just klick on them and you go there or is that just too boring it’s too boring for me i can tell you just thinking about it just imagining ing the slog well maybe just do one single morph this way and each morph M has a link in it to YouTube to a video and which second you have to FF to to see this M in h vac action i believe there is a way to add FF to the link to auto FF or you can open the help tree page for M in one click which has all the links to all the videos that include it or if all the Morph Classes could just get a class comment not unlike the Pharo class comment template or something or with a suffix section or something which tells what the Morph does mostly what the Morph can could do some experiments to try any warnings which other Morphs it has relationships with special or otherwise and this all of this pops up in a big balloon or something else big really i feel like there could profitably be a whole nother book a Squeak Object-Oriented Design with Multimedia Applications Part II book chapter 5 part II you know like WWII which just lists all the Morphs as shown above and what you can do with them because otherwise i just kind of sit there and go ok now what
listen if you are not willing to spend hours in fruitless random experimenting HEY rebrand this fruitless random experimenting it is called Fun oh hours days weeks months years decades which of F and or code reading oh s until you hit Nirvana and break it into 15 pieces then you are not the kind of soldier we are looking for
well you may be able to get up a small army this way a small but dedicated army willing to go the distance the last jedi distance r of the j walker but what happens when they all die in battle will it all get packed away into a long now archive seed pod to be activated on rediscovered by some future small hive 1 hue anxious to get a glimpse back inti the good dold days hey what a find look no evidence of the incal anywhere oh wow let me see
byutte basically i know nothing i don’t know much but that hasn’t stopped me shooting my mouth off no about s i know little to nothing about why do you e listen to me do you hand me the same authority afforded the New York Times hey in this trigger happy slappy snappy crowd they call w man it haint hard to get such a thing handed to you so shut the f up loose lips sink ships remember what MacCarthy said Eugene you mean i come all this way with ma aunt Brittle Brax’s clothes line a bringin up my rear and there Hain’ta gonna be no HANGIN ?? What Kind Of A Trial Is That !!
banned fine so done wasting my time well why don’t you just don’t waste it easy for you to say hypergraphia way
On Thu, Aug 31, 2023 at 12:43 Eliot Miranda eliot.miranda@gmail.com wrote:
On Aug 29, 2023, at 6:48 AM, Marcel Taeumel via Squeak-dev < squeak-dev@lists.squeakfoundation.org> wrote:
Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras:
- Games
- Sketches and PaintBox
- Flaps
- CalendarMorph
- SpectrumAnalyzerMorph
Here is what would still "work" through the package System:
- Object storage (ImageSegment etc.)
- ProjectLoading
Here is what would still work through the package Protocols:
- Lexicon tool
- Vocabulary framework
Here is what would be gone:
- Tiles, viewers, and scripts
- Players and costumes
- Pen trails, Turtles, ...
- References, CustomEventsRegistry, ScriptingSystem
- Siblings for (Player-only) uni-classes
- DeepCopier support for (Player-only) uni-classes
- Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
*So...should we remove Etoys from Trunk at this point?*
I would like to see EToys cleanly unloadable, but I would like it to remain in the standard distribution. Certain EToys functionality, such as the webcam support, should be separated from the core EToys package. A proper list of these elements that have broader use should be made.
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel <unload-etoys.33.cs>
On Thu, Aug 31, 2023 at 12:43 Eliot Miranda eliot.miranda@gmail.com wrote:
On Aug 29, 2023, at 6:48 AM, Marcel Taeumel via Squeak-dev < squeak-dev@lists.squeakfoundation.org> wrote:
Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras:
- Games
- Sketches and PaintBox
- Flaps
- CalendarMorph
- SpectrumAnalyzerMorph
Here is what would still "work" through the package System:
- Object storage (ImageSegment etc.)
- ProjectLoading
Here is what would still work through the package Protocols:
- Lexicon tool
- Vocabulary framework
Here is what would be gone:
- Tiles, viewers, and scripts
- Players and costumes
- Pen trails, Turtles, ...
- References, CustomEventsRegistry, ScriptingSystem
- Siblings for (Player-only) uni-classes
- DeepCopier support for (Player-only) uni-classes
- Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
*So...should we remove Etoys from Trunk at this point?*
I would like to see EToys cleanly unloadable, but I would like it to remain in the standard distribution. Certain EToys functionality, such as the webcam support, should be separated from the core EToys package. A proper list of these elements that have broader use should be made.
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel <unload-etoys.33.cs>
On Tue, Aug 29, 2023 at 03:47:19PM +0200, Marcel Taeumel via Squeak-dev wrote:
Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
I used Monticello tools to take a closer look at the differences in a trunk image after running Marcel's Etoys removal script. I saved all of the changed packages in a local repository so I could take a closer look, then ran the following snippet in an inspector on the MCPatchBrowser for each dirty package:
(self items select: [ :e | (e isModification and: [ e modification isOrganizationDefinition not]) and: [ ('*only recat*' match: e summarySuffix) not]] thenCollect: [ :e | e modification summary ]) in: [ :collection | String streamContents: [:strm | collection do: [:e | strm nextPutAll: e; cr]]]
The results show all of the class and method changes, excluding straightforward additions and removals (which are easily managed in packages), and excluding all of the changes that are only for recategorization (also easy to manage).
This leaves all the the changes that are messy to manage.
This exercise is motivated in part by my hobby project experience in maintaining a Monticello update for Squeak trunk on the old V3 image format. I have found this to be easy to do as long as the conflicting changes are limited to a small number of packages. That in turn suggests to me that if the messy Etoys differences are maintained in a separate package, then it might be possible to maintain update streams for Squeak trunk with and without Etoys.
Results:
--- 60Deprecated --- FontSubstitutionDuringLoading>>defaultAction
--- GetText --- GetTextExporter class>>listAllHelp
--- Graphics --- MissingFont>>defaultAction
--- Help-Squeak-CorePackages --- "empty"
--- Help-Squeak-Project --- SqueakToolsDebuggerHelp class>>showForm:
--- Kernel --- Class>>objectForDataStream: Class>>officialClass Object>>knownName Object>>veryDeepCopy Object>>veryDeepCopyUsing: Object>>veryDeepCopyWith:
--- Morphic --- "note class structure changes MenuIcons, MorphExtension, PasteUpMorph" ColorPickerMorph>>mouseUp: ColorPickerMorph>>pickColorAt: ColorPickerMorph>>pickUpColorFor: DockingBarMorph>>wantsYellowButtonMenu HaloMorph>>addDismissHandle: HaloMorph>>addDupHandle: HaloMorph>>addGraphicalHandleFrom:at: HaloMorph>>createHandleAt:color:iconName: HaloMorph>>delete HaloMorph>>doRecolor:with: HaloMorph>>endInteraction: HaloMorph>>maybeDismiss:with: HaloMorph>>popUpFor:at:hand: HaloMorph>>startDrag:with: HaloMorph>>startRot:with: HaloMorph>>startScale:with: HandMorph>>pasteMorph IconicButton>>initializeWithThumbnail:withLabel:andColor:andSend:to: IconicButton>>setDefaultLabel ImageMorph class>>authoringPrototype ImageMorph>>setNewImageFrom: MenuIcons Morph class>>fromFileName: Morph>>absorbStateFromRenderer: Morph>>addHaloActionsTo: Morph>>addHandlesTo:box: Morph>>addMiscExtrasTo: Morph>>addStandardHaloMenuItemsTo:hand: Morph>>addToggleItemsToHaloMenu: Morph>>addYellowButtonMenuItemsTo:event: Morph>>balloonHelpTextForHandle: Morph>>balloonText Morph>>buildDebugMenu: Morph>>buildHandleMenu: Morph>>delete Morph>>deleteAnyMouseActionIndicators Morph>>duplicate Morph>>eToyRejectDropMorph:event: Morph>>goBehind Morph>>handleMouseDown: Morph>>handleMouseEnter: Morph>>handleMouseLeave: Morph>>justDroppedInto:event: Morph>>privateMoveBy: Morph>>renameTo: Morph>>representativeNoTallerThan:norWiderThan:thumbnailHeight: Morph>>step Morph>>stepAt: Morph>>stepTime Morph>>transferStateToRenderer: Morph>>wantsSteps Morph>>wantsYellowButtonMenu MorphExtension MorphExtension>>isDefault MorphExtension>>printOn: MorphExtension>>sortedPropertyNames MorphExtension>>veryDeepInner: MorphHierarchy class>>openOrDelete MorphListItemWrapper>>contents MorphicModel>>allKnownNames MorphicProject>>chooseNaturalLanguage MorphicProject>>enterAsActiveSubprojectWithin: MorphicProject>>exportSegmentWithChangeSet:fileName:directory:withoutInteraction: MorphicProject>>finalEnterActions: MorphicProject>>finalExitActions: MorphicProject>>initialize MorphicProject>>interruptCleanUpFor: MorphicProject>>prepareForDelete MorphicProject>>storeSegment MorphicProject>>storeSegmentNoFile MorphicProject>>updateLocaleDependents NewHandleMorph>>initialize PasteUpMorph PasteUpMorph class>>authoringPrototype PasteUpMorph>>acceptDroppingMorph:event: PasteUpMorph>>addCustomMenuItems:hand: PasteUpMorph>>addGlobalFlaps PasteUpMorph>>addWorldHaloMenuItemsTo:hand: PasteUpMorph>>autoLineLayout: PasteUpMorph>>beWorldForProject: PasteUpMorph>>findWindow: PasteUpMorph>>flapTab PasteUpMorph>>handlesKeyboard: PasteUpMorph>>initForProject: PasteUpMorph>>initialize PasteUpMorph>>install PasteUpMorph>>invokeWorldMenu: PasteUpMorph>>keyStroke: PasteUpMorph>>keystrokeInWorld: PasteUpMorph>>morphToDropFrom: PasteUpMorph>>mouseDown: PasteUpMorph>>paintBox PasteUpMorph>>putUpNewMorphMenu PasteUpMorph>>putUpWorldMenuFromEscapeKey PasteUpMorph>>reintroduceIntoWorld: PasteUpMorph>>releaseCachedState PasteUpMorph>>tryInvokeHalo: PasteUpMorph>>tryInvokeMetaMenu: PasteUpMorph>>wantsHaloFromClick PasteUpMorph>>windowEvent: PolygonMorph>>stepTime SelectionMorph>>duplicate SketchMorph>>addToggleItemsToHaloMenu: SketchMorph>>editDrawingIn:forBackground: SketchMorph>>initialize SketchMorph>>initializeToStandAlone SketchMorph>>setNewFormFrom: SystemWindow>>comeToFront SystemWindow>>delete SystemWindow>>initializeLabelArea SystemWindow>>sendToBack SystemWindow>>stepAt: SystemWindow>>wantsSteps TextMorph class>>fancyPrototype TextMorph>>addCustomMenuItems:hand: TextMorph>>getMenu: TextMorph>>handleKeystroke: TheWorldMainDockingBar>>extrasMenuOn: TheWorldMainDockingBar>>themesAndWindowColorsOn: TheWorldMenu>>addObjectsAndTools: TheWorldMenu>>addPrintAndDebug: TheWorldMenu>>addUtilities: TheWorldMenu>>appearanceMenu TheWorldMenu>>helpMenu TheWorldMenu>>newMorph TheWorldMenu>>openMenu TheWorldMenu>>projectMenu ThreePhaseButtonMorph class>>initialize TransformationMorph>>adjustAfter: TransformationMorph>>removeFlexShell TranslucentProgessMorph>>drawOn: UpdatingStringMorph>>decimalPlaces: UpdatingStringMorph>>readFromTarget UpdatingStringMorph>>target: UpdatingStringMorph>>valueFromContents
--- MorphicExtras --- BookMorph>>addBookMenuItemsTo:hand: BookMorph>>goToPageMorph: BookMorph>>goToPageMorph:transitionSpec: BookMorph>>invokeBookMenu BookMorph>>saveAsNumberedURLs BookMorph>>saveOnUrlPage: BookMorph>>savePagesOnURL BookPageSorterMorph>>addControls BookPageSorterMorph>>initialize BooklikeMorph>>playPageFlipSound: Command class>>undoRedoButtons FlapTab>>showFlap Flaps class>>addLocalFlap:titled:onEdge: Flaps class>>addStandardFlaps Flaps class>>defaultsQuadsDefiningStackToolsFlap Flaps class>>defaultsQuadsDefiningSuppliesFlap Flaps class>>defaultsQuadsDefiningToolsFlap Flaps class>>defaultsQuadsDefiningWidgetsFlap Flaps class>>initializeFlapsQuads Flaps class>>newSqueakFlap Flaps class>>newSuppliesFlapFromQuads:positioning: Flaps class>>replaceGlobalFlapwithID: GrabPatchMorph class>>authoringPrototype GrabPatchMorph>>initialize GrabPatchMorph>>initializeToStandAlone GrabPatchMorph>>wantsToBeDroppedInto: GraphicalDictionaryMenu class>>example GraphicalDictionaryMenu>>initializeFor:fromDictionary: GraphicalDictionaryMenu>>repaintEntry HandMorphForReplay>>processEvents InternalThreadNavigationMorph>>insertNewProject InternalThreadNavigationMorph>>moreCommands LassoPatchMorph class>>authoringPrototype LassoPatchMorph>>initialize LassoPatchMorph>>initializeToStandAlone Morph class>>supplementaryPartsDescriptions ObjectlandMorph>>fillObjectlandProject ObjectsTool>>newSearchPane PaintBoxMorph class>>new PaintBoxMorph>>addLabels PaintBoxMorph>>beSupersized PaintBoxMorph>>offsetFromMaxBounds PasteUpMorph class>>initialize ProgressMorph>>fontOfPointSize: ProjectNavigationMorph>>doPublishButtonMenuEvent: ProjectNavigationMorph>>makeTheAdvancedButtons ProjectNavigationMorph>>makeTheButtons ProjectSorterMorph>>addControls ProjectSorterMorph>>initialize ProjectSorterMorph>>insertNewProject: RecordingControlsMorph>>makeTile ReferenceMorph>>changeTabGraphic ReferenceMorph>>graphicalMorphForTab RemoteHandMorph>>transmitEvent: ScrollableField>>getMenu: SketchEditorMorph>>cancelOutOfPainting SketchEditorMorph>>deliverPainting:evt: SketchEditorMorph>>initializeFor:inBounds:pasteUpMorph: TabMorph>>tabSelected TabSorterMorph>>addControls TabSorterMorph>>initialize TabbedPalette class>>authoringPrototype TabbedPalette>>addBookMenuItemsTo:hand: TabbedPalette>>addMenuTab TabbedPalette>>selectTab: TheWorldMenu>>formulateFlapsMenu: ThumbnailMorph>>actualViewee ThumbnailMorph>>formOrMorphToView ThumbnailMorph>>morphToView ThumbnailMorph>>stepTime TrashCanMorph>>doubleClick: UpdatingRectangleMorph>>valueProvider WaveEditor>>addControls WaveEditor>>addLoopPointControls
--- MorpicTests --- "no changes except recategorization"
--- Nebraska --- NebraskaChatMorph>>acceptTo:forMorph: NebraskaChatMorph>>appendMessage: NebraskaChatMorph>>improveText:forMorph: NebraskaChatMorph>>reportError: NebraskaCommunicatorMorph>>textEntryFieldNamed:with:help: NebraskaFridgeMorph>>acceptDroppingMorph:event: NebraskaMorphsWelcomeMorph>>initialize NebraskaMultiChatMorph>>acceptTo:forMorph: NebraskaSenderMorph>>acceptDroppingMorph:event: NebraskaSenderMorph>>sendStatusReply NebraskaServerMorph>>rebuild NebraskaServerMorph>>setColorsAndBorder NetworkTerminalMorph>>acceptDroppingMorph:event: NetworkTerminalMorph>>handleMouseDown:
--- Network --- "note class change ServerDirectory" ServerDirectory ServerDirectory class>>parseServerEntryFrom: ServerDirectory class>>projectDefaultDirectory
--- Protocols --- InstanceBrowser>>offerMenu Lexicon>>addSpecialButtonsTo:with: MethodCall>>receiver:methodInterface:
--- ReleaseBuider --- ReleaseBuilder class>>configureTools ReleaseBuilder class>>discardUserObjects
--- ST80 --- ParagraphEditor class>>initializeCmdKeyShortcuts ParagraphEditor class>>initializeShiftCmdKeyShortcuts ParagraphEditor class>>yellowButtonMenu ParagraphEditor>>changeEmphasis: ScreenController>>helpMenu
--- Services-Base --- PasteUpMorph>>openWorldMenu PasteUpMorph>>worldMenu
--- System --- "note class change DeepCopier ProjectLauncher SmartRefStream" CommunityTheme class>>addDarkWindowColors: DeepCopier DeepCopier>>checkBasicClasses DeepCopier>>initialize: ExtendedClipboardUnixInterface>>readHTMLClipboardData ImageSegment class>>copyFromRootsLocalFileFor:sizeHint: ImageSegment>>declareAndPossiblyRename: MonokaiTheme class>>addDarkWindowColors: NativeImageSegment>>copyFromRootsForExport: NativeImageSegment>>copyFromRootsLocalFileFor:sizeHint: NativeImageSegment>>copySmartRootsExport: NativeImageSegment>>findRogueRootsImSeg: NativeImageSegment>>findRogueRootsPrep NativeImageSegment>>smartFillRoots: Preferences class>>classicHaloSpecs Preferences class>>customHaloSpecs Preferences class>>defaultValueTableForCurrentRelease Preferences class>>disableProgrammerFacilities Preferences class>>enableProgrammerFacilities Preferences class>>haloSpecificationsForWorld Preferences class>>iconicHaloSpecifications Preferences class>>loadPreferencesFrom: Preferences class>>personalizeUserMenu: Preferences class>>printStandardSystemFonts Preferences class>>refreshFontSettings Preferences class>>restoreFontsAfter: Preferences class>>setNotificationParametersForStandardPreferences Preferences class>>simpleFullHaloSpecifications Project class>>removeAll: Project>>displayZoom: Project>>exportSegmentFileName:directory:withoutInteraction: Project>>validateProjectNameIfOK: ProjectLauncher ProjectLauncher>>setupFlaps ProjectLauncher>>startUp ProjectLoading class>>openName:stream:fromDirectory:withProjectView:clearOriginFlag: ProjectLoading class>>projectStreamFromArchive: ReferenceStream class>>versionCode ResourceCollector>>initialize SmartRefStream SmartRefStream>>initKnownRenames SmartRefStream>>restoreClassInstVars SolarizedTheme class>>addDarkWindowColors: SolarizedTheme class>>addLightWindowColors: SqueakTheme class>>addDullerWindowColors: SqueakTheme class>>addWindowColors: TrimTheme class>>addWindowColors: UserInterfaceTheme>>installSystemFont: Utilities class>>initializeCommonRequestStrings
--- Tests --- PackageDependencyTest>>expectedFailures PackageDependencyTest>>testMorphic
--- Tools ---- CodeHolder>>refusesToAcceptCode CodeHolder>>toggleDecompile CodeHolder>>toggleDiffing CodeHolder>>togglePlainSource CodeHolder>>togglePrettyDiffing CodeHolder>>togglePrettyPrint CodeHolder>>toggleRegularDiffing CodeHolder>>toggleShowDocumentation CodeHolder>>toggleShowingByteCodes Debugger>>buildNotifierWith:label:message: Debugger>>preDebugButtonQuads FileList2 class>>morphicViewGeneralLoaderInWorld: FileList2 class>>morphicViewProjectLoader2InWorld:reallyLoad:dirFilterType: FileList2 class>>morphicViewProjectSaverFor: FileList2>>listForPattern: Inspector>>inspectorKey:from: Inspector>>mainFieldListMenu: MessageSet>>filterMessageList MethodFinder>>initialize ObjectExplorer>>explorerKey:from:event: PasteUpMorph>>defaultDesktopCommandKeyTriplets
Hi all --
Thank you all for sharing your thoughts in this matter. :-)
While people seem to be undecided on whether to keep or remove Etoys at this point, they all agree on that we should work on its modular structure to be able to reload and/or unload it if desired.
So, let us take this change set as an artifact of documentation and to-do list. Anyone can use it to further untangle Etoys from the base system. There are smaller tasks, there are bigger tasks. Use the inbox if necessary or share change sets here on the list if too many packages are affected.
We can surely improve the status quo.
Best, Marcel
Am 29.08.2023 15:47:19 schrieb Marcel Taeumel marcel.taeumel@hpi.de: Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras: - Games - Sketches and PaintBox - Flaps - CalendarMorph - SpectrumAnalyzerMorph
Here is what would still "work" through the package System: - Object storage (ImageSegment etc.) - ProjectLoading
Here is what would still work through the package Protocols: - Lexicon tool - Vocabulary framework
Here is what would be gone: - Tiles, viewers, and scripts - Players and costumes - Pen trails, Turtles, ... - References, CustomEventsRegistry, ScriptingSystem - Siblings for (Player-only) uni-classes - DeepCopier support for (Player-only) uni-classes - Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
So...should we remove Etoys from Trunk at this point?
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel
Hi Marcel
Thank you for providing a script which unloads Etoys and for bringing up this discussion. I have not used Etoys for a long time and I think as it is now it is a historical artefact, a valuable one indeed. For a future version of Etoys a lot of effort have to be put into it (better fonts, antialiasing etc). For more than 8 years there is no activity on https://lists.squeakfoundation.org/archives/list/etoys-dev@lists.squeakfound...
I suggest that a script like this which _safely_ removes Etoys should be included in the release of Squeak 6.1. Etoys as such should stay so that people who want to still use it can do so for the next 5 years just by using Squeak 6.1
I am aware that a script which removes Etoys safely means some rearrangements of the Etoys code as Dave Lewis points out in his mail in the same thread.
In 6.2 it probably should be removed.
When is it planned that Squeak 6.1alpha will go to beta?
Kind regards Hannes
On Wed, Sep 6, 2023 at 12:43 PM Marcel Taeumel via Squeak-dev < squeak-dev@lists.squeakfoundation.org> wrote:
Hi all --
Thank you all for sharing your thoughts in this matter. :-)
While people seem to be undecided on whether to keep or remove Etoys at this point, they all agree on that we should work on its modular structure to be able to reload and/or unload it if desired.
So, let us take this change set as an artifact of documentation and to-do list. Anyone can use it to further untangle Etoys from the base system. There are smaller tasks, there are bigger tasks. Use the inbox if necessary or share change sets here on the list if too many packages are affected.
We can surely improve the status quo.
Best, Marcel
Am 29.08.2023 15:47:19 schrieb Marcel Taeumel marcel.taeumel@hpi.de: Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras:
- Games
- Sketches and PaintBox
- Flaps
- CalendarMorph
- SpectrumAnalyzerMorph
Here is what would still "work" through the package System:
- Object storage (ImageSegment etc.)
- ProjectLoading
Here is what would still work through the package Protocols:
- Lexicon tool
- Vocabulary framework
Here is what would be gone:
- Tiles, viewers, and scripts
- Players and costumes
- Pen trails, Turtles, ...
- References, CustomEventsRegistry, ScriptingSystem
- Siblings for (Player-only) uni-classes
- DeepCopier support for (Player-only) uni-classes
- Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
*So...should we remove Etoys from Trunk at this point?*
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel
On Tue, Aug 29, 2023 at 03:47:19PM +0200, Marcel Taeumel via Squeak-dev wrote:
Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
I have been working with Marcel's excellent Etoys removal script and trying to figure out if it might be possible to maintain images with and without Etoys over time. I have been using Monticello with a local disk based repository to look at the differences between trunk images with and without the Etoys removal.
Just for the record, and in case anyone else is playing around with similar ideas, I am attaching RecategorizeExtensionsForEtoys.st which I have been using to move methods that are different into a separate 'Extensions' package. This separates out the methods that are necessarily different between images with and without Etoys. I don't (yet?) see how this helps with maintainability but it does give a view of the methods that could potentially be refactored in better ways. Basically I think the idea would be to make the 'Extensions' package be as small a possible (right now it is rather large).
I was hoping to find that moving these conflicting methods into a separate package would leave the rest of the packages reasonable similar between the full trunk image and the no-Etoys trunk image. But of course it is not quite that simple.
One encouraging thing is that, after moving the conflicting methods (Etoys image versus no-Etoys) I find a large number of methods in other packages that are referenced only by Etoys, even though that would not be obvious just from looking at those methods in the full image. I think that there is a lot of stuff that could be safely moved to the 'EToys' package without impacting the base image.
Just a few observations that may be of interest, hopefully more to follow.
Dave
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras:
- Games
- Sketches and PaintBox
- Flaps
- CalendarMorph
- SpectrumAnalyzerMorph
Here is what would still "work" through the package System:
- Object storage (ImageSegment etc.)
- ProjectLoading
Here is what would still work through the package Protocols:
- Lexicon tool
- Vocabulary framework
Here is what would be gone:
- Tiles, viewers, and scripts
- Players and costumes
- Pen trails, Turtles, ...
- References, CustomEventsRegistry, ScriptingSystem
- Siblings for (Player-only) uni-classes
- DeepCopier support for (Player-only) uni-classes
- Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
So...should we remove Etoys from Trunk at this point?
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel ???'From Squeak6.1alpha of 26 July 2023 [latest update: #22682] on 29 August 2023 at 3:33:41 pm'!
| currentChanges | currentChanges := ChangeSet current.
MenuIcons addClassVarName: #ScriptingIcons. MenuIcons classPool at: #ScriptingIcons put: ( (Smalltalk globals at: #ScriptingSystem) formDictionary associationsSelect: [:assoc | true "keep all for now" "(assoc key beginsWith: 'Halo-') or: [assoc key beginsWith: 'Debugger']"]).
ChangeSet newChanges: (ChangeSet new name: 'move-etoys-games-to-morphicextras'). #( "Keep the games as standalone example applications" 'Etoys-Squeakland-Morphic-Games' 'MorphicExtras-Games' 'Etoys-Squeakland-Morphic-Games-Chess' 'MorphicExtras-Games-Chess' 'Etoys-Squeakland-Morphic-Games-Chess960' 'MorphicExtras-Games-Chess960' 'Etoys-Squeakland-Morphic-Demo' 'MorphicExtras-Demo' ) pairsDo: [:oldCat :newCat | (SystemOrganization listAtCategoryNamed: oldCat) do: [:className | (self environment classNamed: className) category: newCat]]. "Rescue more examples from Etoys over to MorphicExtras" (Smalltalk classNamed: #CalendarMorph) category: 'MorphicExtras-Demo'. (Smalltalk classNamed: #SpectrumAnalyzerMorph) category: 'MorphicExtras-SoundInterface'. ChangeSet newChanges: currentChanges.
(MCPackage named: #EToys) unload.!
Object subclass: #DeepCopier instanceVariableNames: 'references uniClasses newUniClasses ' classVariableNames: '' poolDictionaries: '' category: 'System-Object Storage'!
!DeepCopier commentStamp: 'mt 8/28/2023 15:05' prior: 0! DeepCopier does a veryDeepCopy.
It is a complete tree copy using a dictionary. Any object that is 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. See Object|veryDeepCopy which calls (self veryDeepCopyWith: aDeepCopier).
When a tree of morphs points at a morph outside of itself, that morph should not be copied. Use our own kind of weak pointers for the 'potentially outside' morphs. Default is that any new class will have all of its fields deeply copied. If a field needs to be weakly copied, define veryDeepInner: and veryDeepFixupWith:. veryDeepInner: has the loop that actually copies the fields. If a class defines its own copy of veryDeepInner: (to leave some fields out), then veryDeepFixupWith: will be called on that object at the end. veryDeepInner: can compute an alternate object to put in a field. (Object veryDeepCopyWith: discovers which superclasses did not define veryDeepInner:, and very deeply copies the variables defined in those classes). To decide if a class needs veryDeepInner: and veryDeepFixupWith:, ask this about an instance: If I duplicate this object, does that mean that I also want to make duplicates of the things it holds onto? If yes, (i.e. a Paragraph does want a new copy of its Text) then do nothing. If no, (i.e. an undo command does not want to copy the objects it acts upon), then define veryDeepInner: and veryDeepFixupWith:. Here is an analysis for the specific case of a morph being held by another morph. Does field X contain a morph? If not, no action needed. Is the morph in field X already a submorph of the object? Is it down lower in the submorph tree? If so, no action needed. Could the morph in field X every appear on the screen (be a submorph of some other morph)? If not, no action needed. If it could, you must write the methods veryDeepFixupWith: and veryDeepInner:, and in them, refrain from sending veryDeepCopyWith: to the contents of field X.
----- Things Ted is still considering ----- Rule: If object A has object C in a field, and A says (^ C) for the copy, but object B has A in a normal field and it gets deepCopied, and A in encountered first, then there will be two copies of C. (just be aware of it)
Dependents are now fixed up. Suppose a model has a dependent view. In the DependentFields dictionary, model -> (view ...). If only the model is copied, no dependents are created (no one knows about the new model). If only the view is copied, it is inserted into DependentFields on the right side. model -> (view copiedView ...). If both are copied, the new model has the new view as its dependent. If additional things depend on a model that is copied, the caller must add them to its dependents.
August 2023: There is no support for uni-classes at this time!!!
Model subclass: #FancyMailComposition instanceVariableNames: 'messageText theLinkToInclude to subject' classVariableNames: '' poolDictionaries: '' category: 'Nebraska-Network-Mail'! Object subclass: #MenuIcons instanceVariableNames: '' classVariableNames: 'Icons TranslatedIcons TranslationLocale ScriptingIcons ' poolDictionaries: '' category: 'Morphic-Menus'! Object subclass: #MorphExtension instanceVariableNames: 'locked visible sticky balloonText balloonTextSelector externalName isPartsDonor actorState player eventHandler otherProperties ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Kernel'! BorderedMorph subclass: #PasteUpMorph instanceVariableNames: 'presenter model cursor padding turtleTrailsForm turtlePen lastTurtlePositions isPartsBin indicateCursor wantsMouseOverHalos worldState ' classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler ' poolDictionaries: '' category: 'Morphic-Worlds'! AbstractLauncher subclass: #ProjectLauncher instanceVariableNames: 'showSplash splashURL whichFlaps eToyAuthentificationServer ' classVariableNames: 'SplashMorph ' poolDictionaries: '' category: 'System-Download'! Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl eToyUserListUrl eToyUserList keepAlive encodingName ' classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers ' poolDictionaries: '' category: 'Network-RemoteDirectory'!
!SmartRefStream commentStamp: 'mt 8/28/2023 15:44' prior: 0! Ordinary ReferenceStreams assume that the names and order of instance variables is exactly the same when an object file is written and read. SmartRefStream allows object files to be read even after instance variables have changed or the entire class has been renamed.
When an object file is written, no one knows how the classes will change in the future. Therefore, all conversion must be done when the file is read. The key is to store enough information in the file about the names of the instance variables of all outgoing classes.
SmartRefStream works best with only one tree of objects per file. You can nextPut: more than once, but each object tree gets its own class structure description, which is big.
Conversion of old objects is done by a method in each class called (convertToCurrentVersion: varDict refStream: smartRefStrm). At fileOut time, ChangeSet>>checkForConversionMethods creates a prototype of this method (if Preference #conversionMethodsAtFileOut is true). The programmer must edit this method to (1) test if the incoming object needs conversion, (2) put non-nil values into any new inst vars that need them, and (3) save the data of any inst vars that are being deleted.
Determining which old version is represented by the incoming object can be done in several ways: - noticing that a current inst var is nil when it should have data, - noticing that there is an older inst var name in the variable dictionary (varDict), - checking kinds of objects in one or more inst vars, or - retrieving the classVersion of the incoming object from the ref stream.
If a class is renamed, a method goes into SmartRefStream telling the new name.
The conversion method of the new class must be prepared to accept instances of the old class also. If no inst var names have changed, the conversion method does nothing.
An example: Suppose we change the representation of class Rectangle from ('origin' 'corner') to ('origin' 'extent'). Suppose lots of Rectangle instances are already out on files (in .pr project files, especially).
The programmer changes the class definition, modifies all the methods, and filesOut. A series of dialogs appear, asking if instances Rectangle might be in an object file, if 'extent' needs to be non-nil (yes), and if the info in 'corner' needs to be preserved (yes). This method appears:
Rectangle >> convertToCurrentVersion: varDict refStream: smartRefStrm "These variables are automatically stored into the new instance: #('origin'). Test for this particular conversion. Get values using expressions like (varDict at: 'foo')."
"New variables: #('extent'). If a non-nil value is needed, please assign it." "These are going away #('corner'). Possibly store their info in some other variable?" "Move your code above the ^ super... Delete extra comments." ^ super convertToCurrentVersion: varDict refStream: smartRefStrm
The programmer modifies it to be:
Rectangle >> convertToCurrentVersion: varDict refStream: smartRefStrm
(varDict includesKey: 'extent') ifFalse: ["old version!!" "Create the new extent, and preserve the info from the old corner" extent := (varDict at: 'corner') - origin. ]. ^ super convertToCurrentVersion: varDict refStream: smartRefStrm
This conversion method stays in the system and is ready to convert the old format of Rectangle whenever one is encountered in an object file. Note that the subclasses of Rectangle, (B3DViewport, CharacterBlock, and Quadrangle) do not need conversion methods. Their instances will be converted by the code in Rectangle.
Files written by SmartRefStream are in standard fileout format. You can mix raw objects with code to be filed in. The file starts out in the normal fileOut format. Definitions of new classes on the front.
structures Dictionary of (#Rectangle -> #(<classVersionInteger> 'origin' 'corner')). Inst var names are strings. steady Set of Classes who have the same structure now as on the incoming file. Includes classes with same inst vars except for new ones added on the end. reshaped Dictionary of Classes who have a different structure now from the incoming file. Includes those with same inst vars but new version number. (old class name -> method selector to fill in data for version to version) renamed Dictionary of Classes who have a different name. Make an instance of the new class, and send it the conversion call. (old class name symbol -> new class name). renamedConv Dictionary of conversion selector for Classes who have a different name. (old class name symbol -> conversion selector). topCall Tells if next or nextPut: are working on the top object in the tree. nil if outside, the top object if deep inside.
See DataStream.typeIDFor: for where the tangle of objects is clipped, so the whole system will not be written on the file.
No object that is written on the file is ever a class. All class definitions are filed in. A class may be stored inside an ImageSegment that itself is stored in a SmartRefStream.
UniClasses are classes for the instance specific behavior of just one instance. See #newSubclass. When a UniClass is read in, and a class of the same name already exists, the incoming one is renamed. ObjectScanner converts the filed-in code.
Values in instance variables of UniClasses are stored in the array that tells the class structure. It is the fourth of the four top level objects. #(version (class-structure) the-object ((#Player25 scripts slotInfo costumeDictionary) (#Player26 scripts slotInfo costumeDictionary))).
There is a separate subclass for doing veryDeepCopy (in memory). Currently, any object for which objectToStoreOnDataStream return an object other than self, does this: The new object (a DiskProxy) is traced. When it comes time to go through the fields of the old object, they are not found as keys in references (DiskProxies are there instead). So the old field value is left in the new object. That is OK for StrikeFont, Class, MetaClass, DisplayScreen. But the DiskProxies are evaluated, which takes a lot of time.
Some metaclasses are put into the structures table. This is for when a block has a receiver that is a class. See checkFatalReshape:.
ImageSegments: A ReferenceStream is used to enumerate objects to put inside an ImageSegment. If an instance of a UniClass is seen, the class is put in also. A SmartRefStream is used to store the ImageSegment. Roots are nil, and the segment is a wordArray. We are encoding the outPointers. Structures contains all classes from both places. Must filter out UniClasses for some things, and do include them for putting source code at end of file. Do not write any class inst vars in file.
--Ted Kaehler and Bob Arning.
How are the selectors in the '*Morphic-conversion' protocol ending with something like
ttfclpomsswfpp0
constructed and what does it mean?
Answer: It is the initials of all instance variables followed by the class version integer. The initials allow to detect most changes to the instance variables, but if this is not sufficient (perhaps because the new var had the same initial, or the vars did not change in name at all) we still have the class version.
Most classes are still at version 0, but if you check implementers of classVersion you can find a few that were incremented to force a conversion on load.!
!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:05'! veryDeepCopy "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."
| copier new | copier := DeepCopier new: self initialDeepCopierSize. new := self veryDeepCopyWith: copier. copier references associationsDo: [:assoc | assoc value veryDeepFixupWith: copier]. copier fixDependents. ^ new! !
!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:05'! veryDeepCopyUsing: copier "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. Same as veryDeepCopy except copier (with dictionary) is supplied. ** do not delete this method, even if it has no callers **"
| new refs | new := self veryDeepCopyWith: copier. copier references associationsDo: [:assoc | assoc value veryDeepFixupWith: copier]. "Fix dependents" refs := copier references. DependentsFields associationsDo: [:pair | pair value do: [:dep | | newDep newModel | (newDep := refs at: dep ifAbsent: [nil]) ifNotNil: [ newModel := refs at: pair key ifAbsent: [pair key]. newModel addDependent: newDep]]]. ^ new! !
!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:07'! veryDeepCopyWith: deepCopier "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." | class index sub subAss new sup has mine | deepCopier references at: self ifPresent: [:newer | ^ newer]. "already did him" class := self class. class isMeta ifTrue: [^ self]. "a class" new := self shallowCopy. deepCopier references at: self put: new. "remember" (class isVariable and: [class isPointers]) ifTrue: [index := self basicSize. [index > 0] whileTrue: [sub := self basicAt: index. (subAss := deepCopier references associationAt: sub ifAbsent: [nil]) ifNil: [new basicAt: index put: (sub veryDeepCopyWith: deepCopier)] ifNotNil: [new basicAt: index put: subAss value]. index := index - 1]]. "Ask each superclass if it wants to share (weak copy) any inst vars" new veryDeepInner: deepCopier. "does super a lot"
"other superclasses want all inst vars deep copied" sup := class. index := class instSize. [has := sup compiledMethodAt: #veryDeepInner: ifAbsent: [nil]. has := has ifNil: [class isSystemDefined not "is a uniClass"] ifNotNil: [true]. mine := sup instVarNames. has ifTrue: [index := index - mine size] "skip inst vars" ifFalse: [1 to: mine size do: [:xx | sub := self instVarAt: index. (subAss := deepCopier references associationAt: sub ifAbsent: [nil]) "use association, not value, so nil is an exceptional value" ifNil: [new instVarAt: index put: (sub veryDeepCopyWith: deepCopier)] ifNotNil: [new instVarAt: index put: subAss value]. index := index - 1]]. (sup := sup superclass) == nil] whileFalse. new rehash. "force Sets and Dictionaries to rehash" ^ new ! !
!Object methodsFor: 'testing' stamp: 'mt 3/8/2023 10:43'! knownName ^ nil! !
!Class methodsFor: 'testing' stamp: 'mt 8/28/2023 14:56'! officialClass "I am not a UniClass. (See MorphicModel officialClass). Return the class you use to make new subclasses."
^ self! !
!Class methodsFor: 'fileIn/Out' stamp: 'mt 8/28/2023 14:56'! objectForDataStream: refStrm "I am about to be written on an object file. Write a reference to a class in Smalltalk instead."
refStrm insideASegment ifFalse: ["Normal use" ^ DiskProxy global: self theNonMetaClass name selector: #withClassVersion: args: {self classVersion}] ifTrue: ["recording objects to go into an ImageSegment" self isSystemDefined ifFalse: [^ self]. "do trace uni-classes" (refStrm rootObject includes: self) ifTrue: [^ self]. "is in roots, intensionally write out, ^ self" "A normal class. remove it from references. Do not trace." refStrm references removeKey: self ifAbsent: []. "already there" ^ nil] ! !
!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'! toggleDiffing "Toggle whether diffs should be shown in the code pane. If any kind of diffs were being shown, stop showing diffs. If no kind of diffs were being shown, start showing whatever kind of diffs are called for by default."
| wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingAnyKindOfDiffs. self showDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'! togglePlainSource "Toggle whether plain source shown in the code pane" | wasShowingPlainSource | self okToChange ifTrue: [wasShowingPlainSource := self showingPlainSource. wasShowingPlainSource ifTrue: [self showDocumentation: true] ifFalse: [contentsSymbol := #source]. self setContentsToForceRefetch. self changed: #contents]
! !
!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'! togglePrettyDiffing "Toggle whether pretty-diffing should be shown in the code pane"
| wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingPrettyDiffs. self showPrettyDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'! togglePrettyPrint "Toggle whether pretty-print is in effectin the code pane"
self okToChange ifTrue: [self showingPrettyPrint ifTrue: [contentsSymbol := #source] ifFalse: [contentsSymbol := #prettyPrint]. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'! toggleRegularDiffing "Toggle whether regular-diffing should be shown in the code pane"
| wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingRegularDiffs. self showRegularDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'misc' stamp: 'mt 3/23/2023 11:24'! refusesToAcceptCode "Answer whether receiver, given its current contentsSymbol, could accept code happily if asked to"
^ (#(byteCodes documentation) includes: self contentsSymbol)! !
!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'! toggleDecompile "Toggle the setting of the showingDecompile flag, unless there are unsubmitted edits that the user declines to discard"
| wasShowing | self okToChange ifTrue: [wasShowing := self showingDecompile. self showDecompile: wasShowing not. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'! toggleShowDocumentation "Toggle the setting of the showingDocumentation flag, unless there are unsubmitted edits that the user declines to discard"
| wasShowing | self okToChange ifTrue: [wasShowing := self showingDocumentation. self showDocumentation: wasShowing not. self setContentsToForceRefetch. self contentsChanged]
! !
!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'! toggleShowingByteCodes "Toggle whether the receiver is showing bytecodes"
self showByteCodes: self showingByteCodes not. self setContentsToForceRefetch. self contentsChanged! !
!Command class methodsFor: 'dog simple ui' stamp: 'mt 7/31/2023 11:10'! undoRedoButtons "Answer a morph that offers undo and redo buttons"
| wrapper | "self currentHand attachMorph: Command undoRedoButtons" wrapper := AlignmentMorph newColumn. wrapper color: Color veryVeryLightGray lighter; borderWidth: 0; layoutInset: 0; vResizing: #shrinkWrap; hResizing: #shrinkWrap. #((CrudeUndo undoLastCommand 'undo last command done' undoEnabled CrudeUndoDisabled CrudeUndoDisabled) (CrudeRedo redoNextCommand 'redo last undone command' redoEnabled CrudeRedoDisabled CrudeRedoDisabled)) do: [:tuple | | aButton | wrapper addTransparentSpacerOfSize: (8@0). aButton := UpdatingThreePhaseButtonMorph new. aButton onImage: (MenuIcons formAtKey: tuple first); offImage: (MenuIcons formAtKey: tuple fifth); pressedImage: (MenuIcons formAtKey: tuple sixth); getSelector: tuple fourth; color: Color transparent; target: self; actionSelector: tuple second; setNameTo: tuple second; setBalloonText: tuple third; extent: aButton onImage extent. wrapper addMorphBack: aButton. wrapper addTransparentSpacerOfSize: (8@0)]. ^ wrapper! !
!Debugger methodsFor: 'toolbuilder' stamp: 'mt 3/10/2023 11:26'! buildNotifierWith: builder label: label message: messageString | windowSpec listSpec textSpec panelSpec quads | windowSpec := builder pluggableWindowSpec new model: self; extent: self initialExtentForNotifier; label: label asString; children: OrderedCollection new.
panelSpec := builder pluggablePanelSpec new. panelSpec children: OrderedCollection new. quads := self preDebugButtonQuads. (self interruptedContext selector == #doesNotUnderstand:) ifTrue: [ quads := quads copyWith: { 'Create'. #createMethod. #magenta. 'create the missing method' } ]. (#(#notYetImplemented #shouldBeImplemented #requirement) includes: self interruptedContext selector) ifTrue: [ quads := quads copyWith: { 'Create'. #createImplementingMethod. #magenta. 'implement the marked method' } ]. (self interruptedContext selector == #subclassResponsibility) ifTrue: [ quads := quads copyWith: { 'Create'. #createOverridingMethod. #magenta. 'create the missing overriding method' } ]. quads do:[:spec| | buttonSpec | buttonSpec := builder pluggableButtonSpec new. buttonSpec model: self. buttonSpec label: spec first. buttonSpec action: spec second. buttonSpec help: spec fourth. spec size >= 5 ifTrue: [buttonSpec enabled: spec fifth]. panelSpec children add: buttonSpec. ]. panelSpec layout: #horizontal. "buttons" panelSpec frame: self preDebugButtonQuadFrame. windowSpec children add: panelSpec.
messageString notNil ifFalse:[ listSpec := builder pluggableListSpec new. listSpec model: self; list: #contextStackList; getIndex: #contextStackIndex; setIndex: #debugAt:; icon: #messageIconAt:; helpItem: #messageHelpAt:; frame: self contextStackFrame. windowSpec children add: listSpec. ] ifTrue:[ message := messageString. textSpec := builder pluggableTextSpec new. textSpec model: self; getText: #preDebugMessageString; setText: nil; selection: nil; menu: #debugProceedMenu:; frame: self contextStackFrame. windowSpec children add: textSpec. ].
^windowSpec! !
!Debugger methodsFor: 'initialize' stamp: 'mt 3/10/2023 11:26'! preDebugButtonQuads
^{ {'Proceed' translated. #proceed. #blue. 'continue execution' translated. #interruptedProcessShouldResume}. self class showTerminateButton ifTrue: [ {'Terminate' translated. #terminateProcess. #black. 'terminate this execution and close this window' translated}]. self class showAbandonButton ifTrue: [ {'Abandon' translated. #abandon. #black. 'terminate this execution aggressively and close this window' translated}]. {'Debug' translated. #debug. #red. 'bring up a debugger' translated}} reject: [:quad | quad isNil] ! !
!DeepCopier methodsFor: 'like fullCopy' stamp: 'mt 3/10/2023 15:37'! checkBasicClasses "Check that no indexes of instance vars have changed in certain classes. If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated. The idea is to catch a change while it is still in the system of the programmer who made it. DeepCopier new checkVariables "
| str objCls morphCls | str := '|veryDeepCopyWith: or veryDeepInner: is out of date.'. (objCls := self objInMemory: #Object) ifNotNil: [ objCls instSize = 0 ifFalse: [self error: 'Many implementers of veryDeepCopyWith: are out of date']]. (morphCls := self objInMemory: #Morph) ifNotNil: [ morphCls superclass == Object ifFalse: [self error: 'Morph', str]. (morphCls instVarNames copyFrom: 1 to: 6) = #('bounds' 'owner' 'submorphs' 'fullBounds' 'color' 'extension') ifFalse: [self error: 'Morph', str]]. "added ones are OK"! !
!DeepCopier methodsFor: 'like fullCopy' stamp: 'mt 8/28/2023 15:08'! initialize: size
references := IdentityDictionary new: size.! !
!ExtendedClipboardUnixInterface methodsFor: 'general-api-read' stamp: 'mt 8/11/2023 15:20'! readHTMLClipboardData | bytes source | "Answer a HTMLDocument object" bytes := self readClipboardData: 'text/html'. (bytes beginsWith: '<!!DOCTYPE' asByteArray) ifTrue: ["BAD HACK for Abiword" source := bytes asString convertFromWithConverter: UTF8TextConverter new] ifFalse: ["BAD HACK for mozilla" source := bytes asString convertFromWithConverter: (UTF16TextConverter new useLittleEndian: SmalltalkImage current isLittleEndian)]. ^ source asTextFromHtml! !
!FileList2 methodsFor: 'volume list and pattern' stamp: 'mt 8/16/2023 15:54'! listForPattern: pat "Make the list be those file names which match the pattern."
| sizePad newList entries | directory ifNil: [^#()]. entries := directory entries. (fileSelectionBlock isKindOf: MessageSend) ifTrue: [ fileSelectionBlock arguments: {entries}. newList := fileSelectionBlock value. fileSelectionBlock arguments: #(). ] ifFalse: [ newList := entries select: [:entry | fileSelectionBlock value: entry value: pat]. ]. newList := newList asArray sort: self sortBlock. sizePad := (newList inject: 0 into: [:mx :entry | mx max: entry fileSize]) asStringWithCommas size - 1. ^newList collect: [ :e | self fileNameFormattedFrom: e sizePad: sizePad ]! !
!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'! morphicViewGeneralLoaderInWorld: aWorld " FileList2 morphicViewGeneralLoaderInWorld: self currentWorld " | window aFileList buttons treePane textColor1 fileListPane pane2a pane2b fileTypeInfo fileTypeButtons fileTypeRow actionRow |
fileTypeInfo := self endingSpecs. window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new directory: FileDirectory default. aFileList fileSelectionBlock: self projectOnlySelectionBlock; modalView: window. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1 px; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners.
fileTypeButtons := fileTypeInfo collect: [ :each | (self blueButtonText: each first textColor: Color gray inWindow: window) setProperty: #enabled toValue: true; hResizing: #shrinkWrap; useSquareCorners ]. buttons := {{'OK'. Color lightGreen}. {'Cancel'. Color lightRed}} collect: [ :each | self blueButtonText: each first textColor: textColor1 color: each second inWindow: window ].
treePane := aFileList morphicDirectoryTreePane extent: 250 px @ 300 px; retractable: false; borderWidth: 0. fileListPane := aFileList morphicFileListPane extent: 350 px @ 300 px; retractable: false; borderWidth: 0. window addARow: {window fancyText: 'Find...' translated font: Preferences standardWindowTitleFont color: textColor1}. fileTypeRow := window addARowCentered: fileTypeButtons cellInset: 2 px. actionRow := window addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second } cellInset: 2 px. window addARow: { (window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2a fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). pane2b fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). " buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]. " fileTypeButtons do: [ :each | each on: #mouseUp send: #value:value: to: [ :evt :morph | self update: actionRow in: window fileTypeRow: fileTypeRow morphUp: morph. ] ]. buttons first on: #mouseUp send: #okHit to: aFileList. buttons second on: #mouseUp send: #cancelHit to: aFileList. aFileList postOpen. window position: aWorld topLeft + (aWorld extent - window extent // 2). aFileList directoryChangeBlock: [ :newDir | self update: actionRow in: window fileTypeRow: fileTypeRow morphUp: nil. self enableTypeButtons: fileTypeButtons info: fileTypeInfo forDir: newDir. ]. aFileList directory: aFileList directory. window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window openInWorld: aWorld.! !
!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'! morphicViewProjectLoader2InWorld: aWorld reallyLoad: aBoolean dirFilterType: aSymbol
| window aFileList buttons treePane textColor1 fileListPane pane2a pane2b treeExtent filesExtent |
window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new. aFileList optionalButtonSpecs: aFileList servicesForProjectLoader; fileSelectionBlock: ( aSymbol == #limitedSuperSwikiDirectoryList ifTrue: [ MessageSend receiver: Project current selector: #latestProjectVersionsFromFileEntries: ] ifFalse: [ self projectOnlySelectionBlock ] ); "dirSelectionBlock: self hideSqueakletDirectoryBlock;" modalView: window. aFileList directory: FileDirectory default. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1 px; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners. buttons := {{'OK'. Color lightGreen}. {'Cancel'. Color lightRed}} collect: [ :each | self blueButtonText: each first textColor: textColor1 color: each second inWindow: window ].
aWorld width < 800 px ifTrue: [ treeExtent := 150 px @ 300 px. filesExtent := 350 px @ 300 px. ] ifFalse: [ treeExtent := 350 px @ 500 px. filesExtent := 550 px @500 px. ]. (treePane := aFileList morphicDirectoryTreePaneFiltered: aSymbol) extent: treeExtent; retractable: false; borderWidth: 0. fileListPane := aFileList morphicFileListPane extent: filesExtent; retractable: false; borderWidth: 0. window addARow: { window fancyText: 'Load A Project' translated font: Preferences standardWindowTitleFont color: textColor1 }; addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second }; addARow: { window fancyText: 'Please select a project' translated font: Preferences standardButtonFont color: textColor1 }; addARow: { (window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2a fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). pane2b fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). " buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]. " buttons first on: #mouseUp send: (aBoolean ifTrue: [#okHitForProjectLoader] ifFalse: [#okHit]) to: aFileList. buttons second on: #mouseUp send: #cancelHit to: aFileList. aFileList postOpen. window position: aWorld topLeft + (aWorld extent - window extent // 2). window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window openInWorld: aWorld.! !
!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'! morphicViewProjectSaverFor: aProject " (FileList2 morphicViewProjectSaverFor: Project current) openInWorld " | window aFileList buttons treePane pane2 textColor1 option treeExtent buttonData buttonRow |
textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new directory: ServerDirectory projectDefaultDirectory. aFileList dirSelectionBlock: self hideSqueakletDirectoryBlock. window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. aFileList modalView: window. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners.
buttonData := Preferences enableLocalSave ifTrue: [{ {'Save'. #okHit. 'Save in the place specified below, and in the Squeaklets folder on your local disk'. Color lightGreen}. {'Save on local disk only'. #saveLocalOnlyHit. 'saves in the Squeaklets folder'. Color lightGreen}. {'Cancel'. #cancelHit. 'return without saving'. Color lightRed} }] ifFalse: [{ {'Save'. #okHit. 'Save in the place specified below, and in the Squeaklets folder on your local disk'. Color lightGreen}. {'Cancel'. #cancelHit. 'return without saving'. Color lightRed} }]. buttons := buttonData collect: [ :each | (self blueButtonText: each first textColor: textColor1 color: each fourth inWindow: window) setBalloonText: each third translated; hResizing: #shrinkWrap; on: #mouseUp send: each second to: aFileList ].
option := aProject world valueOfProperty: #SuperSwikiPublishOptions ifAbsent: [#initialDirectoryList]. aProject world removeProperty: #SuperSwikiPublishOptions.
treeExtent := Project current world height < 500 px ifTrue: [ 350 px @ 150 px ] ifFalse: [ 350 px @ 300 px ].
(treePane := aFileList morphicDirectoryTreePaneFiltered: option) extent: treeExtent; retractable: false; borderWidth: 0. window addARowCentered: { window fancyText: 'Publish This Project' translated font: Preferences standardWindowTitleFont color: textColor1 }. buttonRow := OrderedCollection new. buttons do: [:button | buttonRow add: button] separatedBy: [buttonRow add: ((Morph new extent: 30 px @ 5 px) color: Color transparent)].
" addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second. (Morph new extent: 30 px@ 5 px) color: Color transparent. buttons third };" window addARowCentered: buttonRow; addARowCentered: { (window inAColumn: {(ProjectViewMorph on: aProject) lock}) layoutInset: 4 px}; addARowCentered: { window fancyText: 'Please select a folder' translated font: Preferences standardButtonFont color: textColor1 }; addARow: { ( window inAColumn: { (pane2 := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) } ) layoutInset: 10 px }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2 fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). " buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]. " window morphicLayerNumber: window class dialogLayer. aFileList postOpen. window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window ! !
!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:52'! defaultsQuadsDefiningStackToolsFlap "Answer a structure defining the items on the default system Stack Tools flap. previously in quadsDefiningStackToolsFlap"
^ { {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}. {#StackMorph. #stackHelpWindow. 'Stack Help' translatedNoop. 'Some hints about how to use Stacks' translatedNoop}. {#TextMorph . #authoringPrototype. 'Simple Text' translatedNoop. 'Text that you can edit into anything you wish' translatedNoop}. {#TextMorph . #fancyPrototype. 'Fancy Text' translatedNoop. 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop}. {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}. {#StackMorph. #previousCardButton. 'Previous Card' translatedNoop. 'A button that takes the user to the previous card in the stack' translatedNoop}. {#StackMorph. #nextCardButton. 'Next Card' translatedNoop. 'A button that takes the user to the next card in the stack' translatedNoop} } asOrderedCollection ! !
!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:52'! defaultsQuadsDefiningSuppliesFlap "Answer a list of quads which define the objects to appear in the default Supplies flap. previously in quadsDefiningSuppliesFlap"
^ { {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}. {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}. {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}. {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}. {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}. {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}. {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}. {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}. {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}. {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}. {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}. {#TabbedPalette. #authoringPrototype. 'TabbedPalette' translatedNoop. 'A structure with tabs' translatedNoop}. {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}. {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}. {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}. {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop} } asOrderedCollection! !
!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 14:38'! defaultsQuadsDefiningToolsFlap "Answer a structure defining the default Tools flap. previously in quadsDefiningToolsFlap"
^ OrderedCollection new addAll: #( (Browser prototypicalToolWindow 'Browser' 'A Browser is a tool that allows you to view all the code of all the classes in the system') (TranscriptStream openMorphicTranscript 'Transcript' 'A Transcript is a window usable for logging and debugging; browse references to #Transcript for examples of how to write to it.') (Workspace prototypicalToolWindow 'Workspace' 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.')); add: { FileList2 . #prototypicalToolWindow. 'File List'. 'A File List is a tool for browsing folders and files on disks and FTP servers.' }; addAll: #( (DualChangeSorter prototypicalToolWindow 'Change Sorter' 'Shows two change sets side by side') (SelectorBrowser prototypicalToolWindow 'Method Finder' 'A tool for discovering methods by providing sample values for arguments and results') (MessageNames prototypicalToolWindow 'Message Names' 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.') (PreferencesBrowser prototypicalToolWindow 'Preferences' 'Allows you to control numerous options') (Utilities recentSubmissionsWindow 'Recent' 'A message browser that tracks the most recently-submitted methods') (ProcessBrowser prototypicalToolWindow 'Processes' 'A Process Browser shows you all the running processes') (PackagePaneBrowser prototypicalToolWindow 'Packages' 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"') (ChangeSorter prototypicalToolWindow 'Change Set' 'A tool that allows you to view and manipulate all the code changes in a single change set')); yourself! !
!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:53'! defaultsQuadsDefiningWidgetsFlap "Answer a structure defining the default Widgets flap. previously in quadsDefiningWidgetsFlap"
^ #( (TrashCanMorph new 'Trash' 'A tool for discarding objects') (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there') (GeeMailMorph new 'Gee-Mail' 'A place to present annotated content') (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.') (FrameRateMorph authoringPrototype 'FrameRate' 'An indicator of how fast your system is running') (MagnifierMorph newRound 'Magnifier' 'A magnifying glass') (ObjectsTool newStandAlone 'ObjectCatalog' 'A tool that lets you browse the catalog of objects') ) asOrderedCollection! !
!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:50'! initializeFlapsQuads "initialize the list of dynamic flaps quads. self initializeFlapsQuads" FlapsQuads := nil. self registeredFlapsQuads at: 'Stack Tools' put: self defaultsQuadsDefiningStackToolsFlap; at: 'Supplies' put: self defaultsQuadsDefiningSuppliesFlap; at: 'Tools' put: self defaultsQuadsDefiningToolsFlap; at: 'Widgets' put: self defaultsQuadsDefiningWidgetsFlap. ^ self registeredFlapsQuads! !
!Flaps class methodsFor: 'new flap' stamp: 'mt 8/4/2023 14:02'! addLocalFlap: anEvent titled: title onEdge: edge
| flapTab menu world | flapTab := self newFlapTitled: title onEdge: edge. (world := anEvent hand world) addMorphFront: flapTab. menu := flapTab buildHandleMenu: anEvent hand. flapTab addTitleForHaloMenu: menu. flapTab computeEdgeFraction. menu popUpEvent: anEvent in: world.! !
!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 8/10/2023 11:29'! addStandardFlaps "Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed. " SharedFlapTabs ifNil: [SharedFlapTabs := OrderedCollection new]. SharedFlapTabs add: self newSqueakFlap. SharedFlapTabs add: self newSuppliesFlap. SharedFlapTabs add: self newToolsFlap. SharedFlapTabs add: self newWidgetsFlap. SharedFlapTabs add: self newStackToolsFlap.
Preferences showProjectNavigator ifTrue:[SharedFlapTabs add: self newNavigatorFlap].
SharedFlapTabs add: self newObjectsFlap. self disableGlobalFlapWithID: 'Stack Tools' translated.
Preferences showProjectNavigator ifTrue:[self disableGlobalFlapWithID: 'Navigator' translated].
^ SharedFlapTabs! !
!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 7/31/2023 11:11'! newSqueakFlap "Answer a new default 'Squeak' flap for the left edge of the screen"
| aFlap aFlapTab aButton aClock buttonColor anOffset bb aFont | aFlap := PasteUpMorph newSticky borderWidth: 0. aFlapTab := FlapTab new referent: aFlap. aFlapTab setName: 'Squeak' translated edge: #left color: Color brown lighter lighter. aFlapTab position: (0 @ ((Display height - aFlapTab height) // 2)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
aFlap cellInset: 14@14. aFlap beFlap: true. aFlap color: (Color brown muchLighter lighter "alpha: 0.3"). aFlap extent: 150 @ self currentWorld height. aFlap layoutPolicy: TableLayout new. aFlap wrapCentering: #topLeft. aFlap layoutInset: 2. aFlap listDirection: #topToBottom. aFlap wrapDirection: #leftToRight.
"self addProjectNavigationButtonsTo: aFlap." anOffset := 16.
aClock := ClockMorph newSticky. aClock color: Color red. aClock showSeconds: false. aClock font: (TextStyle default fontAt: 3). aClock step. aClock setBalloonText: 'The time of day. If you prefer to see seconds, check out my menu.' translated. aFlap addCenteredAtBottom: aClock offset: anOffset.
buttonColor := Color cyan muchLighter. bb := SimpleButtonMorph new target: Smalltalk. bb color: buttonColor. aButton := bb copy. aButton actionSelector: #saveSession. aButton setBalloonText: 'Make a complete snapshot of the current state of the image onto disk.' translated. aButton label: 'save' translated font: (aFont := Preferences standardButtonFont). aFlap addCenteredAtBottom: aButton offset: anOffset.
aButton := bb copy target: MCMcmUpdater. aButton actionSelector: #updateFromServer. aButton label: 'load code updates' translated font: aFont. aButton color: buttonColor. aButton setBalloonText: 'Check the Squeak server for any new code updates, and load any that are found.' translated. aFlap addCenteredAtBottom: aButton offset: anOffset.
aButton := SimpleButtonMorph new target: Smalltalk; actionSelector: #aboutThisSystem; label: 'about this system' translated font: aFont. aButton color: buttonColor. aButton setBalloonText: 'click here to find out version information' translated. aFlap addCenteredAtBottom: aButton offset: anOffset.
aFlap addCenteredAtBottom: (Preferences themeChoiceButtonOfColor: buttonColor font: aFont) offset: anOffset.
aButton := TrashCanMorph newSticky. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton startStepping.
^ aFlapTab
"Flaps replaceGlobalFlapwithID: 'Squeak' translated "! !
!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 8/28/2023 14:29'! newSuppliesFlapFromQuads: quads positioning: positionSymbol "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen. Use #center as the positionSymbol to have it centered at the bottom of the screen, or #right to have it placed off near the right edge."
| aFlapTab aStrip hPosition | aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: quads. "self twiddleSuppliesButtonsIn: aStrip." aFlapTab := FlapTab new referent: aStrip beSticky. aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter. hPosition := positionSymbol == #center ifTrue: [(Display width // 2) - (aFlapTab width // 2)] ifFalse: [Display width - (aFlapTab width + 22)]. aFlapTab position: (hPosition @ (self currentWorld height - aFlapTab height)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
aStrip extent: self currentWorld width @ 136. aStrip beFlap: true. aStrip autoLineLayout: true. ^ aFlapTab
"Flaps replaceGlobalFlapwithID: 'Supplies' translated"! !
!Flaps class methodsFor: 'replacement' stamp: 'mt 8/4/2023 15:19'! replaceGlobalFlapwithID: flapID "If there is a global flap with flapID, replace it with an updated one."
| replacement tabs | (tabs := self globalFlapTabsWithID: flapID) size = 0 ifTrue: [^ self]. tabs do: [:tab | self removeFlapTab: tab keepInList: false]. flapID = 'Stack Tools' translated ifTrue: [replacement := self newStackToolsFlap]. flapID = 'Supplies' translated ifTrue: [replacement := self newSuppliesFlap]. flapID = 'Tools' translated ifTrue: [replacement := self newToolsFlap]. flapID = 'Widgets' translated ifTrue: [replacement := self newWidgetsFlap]. flapID = 'Navigator' translated ifTrue: [replacement := self newNavigatorFlap]. flapID = 'Squeak' translated ifTrue: [replacement := self newSqueakFlap]. replacement ifNil: [^ self]. self addGlobalFlap: replacement. self currentWorld ifNotNil: [self currentWorld addGlobalFlaps]
"Flaps replaceFlapwithID: 'Widgets' translated "! !
!FontSubstitutionDuringLoading methodsFor: 'accessing' stamp: 'mt 8/11/2023 13:59'! defaultAction familyName ifNil: [ familyName := 'NoName' ]. pixelSize ifNil: [ pixelSize := 12 ].
^((familyName beginsWith: 'Comic') ifTrue: [ TextStyle named: (Preferences standardDefaultTextFont familyName) ] ifFalse: [ TextStyle default ]) fontOfSize: pixelSize.! !
!Form methodsFor: 'converting' stamp: 'mt 8/16/2023 16:54'! blendColor: aTranslucentColor
| form canvas | form := self deepCopy asFormOfDepth: 32. canvas := form getCanvas. canvas stencil: form at: 0 @ 0 sourceRect: (0 @ 0 extent: form extent) color: aTranslucentColor. ^ canvas form! !
!Form methodsFor: 'scaling, rotation' stamp: 'sw 4/16/2008 00:13'! scaledToHeight: newHeight "Answer the receiver, scaled such that it has the desired height."
newHeight = self height ifTrue: [^ self]. ^self magnify: self boundingBox by: (newHeight / self height) smoothing: 2. ! !
!Form methodsFor: 'scaling, rotation' stamp: 'ct 9/17/2019 18:50'! scaledToWidth: newWidth "Answer the receiver, scaled such that it has the desired width."
newWidth = self width ifTrue: [^ self]. ^self magnify: self boundingBox by: (newWidth / self width) smoothing: 2. ! !
!Form class methodsFor: '*MorphicExtras-examples' stamp: 'mt 8/14/2023 16:21'! gridFormExample "Original was in Morph >> #setStandardTexture and #textureParameters and #makeGraphPaperGrid:... Morph new color: Form gridFormExample; extent: 500@500; openInHand "
^ self gridFormOrigin: 0@0 grid: 16 px background: Color black line: Color lightGreen lighter lighter ! !
!Form class methodsFor: '*MorphicExtras-sprites' stamp: 'mt 8/14/2023 16:20'! gridFormOrigin: origin grid: smallGrid background: backColor line: lineColor
| bigGrid gridForm gridOrigin | gridOrigin := origin \ smallGrid. bigGrid := (smallGrid asPoint x) @ (smallGrid asPoint y). gridForm := Form extent: bigGrid depth: Display depth. backColor ifNotNil: [gridForm fillWithColor: backColor]. gridOrigin x to: gridForm width by: smallGrid asPoint x do: [:x | gridForm fill: (x@0 extent: 1@gridForm height) fillColor: lineColor]. gridOrigin y to: gridForm height by: smallGrid asPoint y do: [:y | gridForm fill: (0@y extent: gridForm width@1) fillColor: lineColor]. ^ InfiniteForm with: gridForm! !
!GetTextExporter class methodsFor: 'utilities' stamp: 'mt 8/4/2023 13:49'! listAllHelp "self listAllHelp" | spec specs oCatalog flap flapSelectors allKeys oCatalogHelp flapHelp | oCatalog := Dictionary new. Morph withAllSubclasses do: [:aClass | (aClass class includesSelector: #descriptionForPartsBin) ifTrue: [spec := aClass descriptionForPartsBin. oCatalog at: spec formalName put: spec documentation]]. Morph withAllSubclasses do: [:aClass | (aClass class includesSelector: #supplementaryPartsDescriptions) ifTrue: [specs := aClass supplementaryPartsDescriptions. specs do: [:each | oCatalog at: each formalName put: each documentation]]]. flap := Dictionary new. flapSelectors := #( #defaultsQuadsDefiningStackToolsFlap #defaultsQuadsDefiningSuppliesFlap #defaultsQuadsDefiningToolsFlap #defaultsQuadsDefiningWidgetsFlap ). flapSelectors do: [:selector | specs := Flaps perform: selector. specs do: [:each | flap at: each third put: each fourth]]. allKeys := oCatalog keys intersection: flap keys. allKeys asArray sort do: [:each | oCatalogHelp := oCatalog at: each ifAbsent: ['']. flapHelp := flap at: each ifAbsent: ['']. oCatalogHelp = flapHelp ifFalse: [Transcript cr; show: 'Name: ' , each. Transcript cr; show: 'O: ' , oCatalogHelp. Transcript cr; show: 'F: ' , flapHelp. Transcript cr.
]]! !
!ImageSegment methodsFor: 'fileIn' stamp: 'mt 8/16/2023 16:51'! declareAndPossiblyRename: classThatIsARoot | existing catInstaller | "The class just arrived in this segment. How fit it into the Smalltalk dictionary? If it had an association, that was installed with associationDeclareAt:."
catInstaller := [ classThatIsARoot category: Object categoryForUniclasses. ]. classThatIsARoot superclass addSubclass: classThatIsARoot. (Smalltalk includesKey: classThatIsARoot name) ifFalse: [ "Class entry in Smalltalk not referred to in Segment, install anyway." catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. existing := Smalltalk at: classThatIsARoot name. existing xxxClass == ImageSegmentRootStub ifTrue: [ "We are that segment!! Must ask it carefully!!" catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. existing == false | (existing == nil) ifTrue: [ "association is in outPointers, just installed" catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. "Conflict with existing global or copy of the class" (existing isKindOf: Class) ifTrue: [ classThatIsARoot isSystemDefined not ifTrue: [ "UniClass. give it a new name" classThatIsARoot setName: MorphicModel chooseUniqueClassName. catInstaller value. "must be after new name" ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. "Take the incoming one" self inform: 'Using newly arrived version of ', classThatIsARoot name. classThatIsARoot superclass removeSubclass: classThatIsARoot. "just in case" (Smalltalk at: classThatIsARoot name) becomeForward: classThatIsARoot. catInstaller value. ^ classThatIsARoot superclass addSubclass: classThatIsARoot]. self error: 'Name already in use by a non-class: ', classThatIsARoot name. ! !
!ImageSegment class methodsFor: 'fileIn/Out' stamp: 'mt 8/28/2023 15:10'! copyFromRootsLocalFileFor: rootArray sizeHint: segSize
^ NativeImageSegment new copyFromRootsLocalFileFor: rootArray sizeHint: segSize! !
!Inspector methodsFor: 'menu' stamp: 'mt 8/28/2023 14:33'! inspectorKey: aChar from: view "Respond to a Command key issued while the cursor is over my field list"
^ aChar caseOf: { [$x] -> [self removeSelection]. [$i] -> [self inspectSelection]. [$I] -> [self exploreSelection]. [$b] -> [self browseClass]. [$h] -> [self browseClassHierarchy]. [$p] -> [self browseFullProtocol]. [$r] -> [self browseVariableReferences]. [$a] -> [self browseVariableAssignments]. [$N] -> [self browseClassRefs]. [$c] -> [self copyName] } otherwise: [self arrowKey: aChar from: view]! !
!Inspector methodsFor: 'menu' stamp: 'mt 3/10/2023 15:12'! mainFieldListMenu: aMenu "Arm the supplied menu with items for the field-list of the receiver" <fieldListMenu> aMenu addStayUpItemSpecial. self addObjectItemsTo: aMenu. (#(self ellipsis element nil) includes: self typeOfSelection) ifTrue: [self addCollectionItemsTo: aMenu].
self typeOfSelection = #instVar ifTrue: [self addInstVarItemsTo: aMenu].
self addFieldItemsTo: aMenu. self addClassItemsTo: aMenu.
^ aMenu! !
!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 7/31/2023 10:45'! formAtKey: aString "Answer the form saved under the given key"
^(Symbol lookup: aString) ifNotNil: [ :aKey | ScriptingIcons at: aKey ifAbsent: [ self blankIcon ] ] ifNil: [ self blankIcon ]! !
!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:08'! formPressedAtKey: aSymbol "Answer the form for pressed button. It is automatically generated if unavailable." "(ScriptingSystem formPressedAtKey: #TryIt) asMorph openInHand" | pressedName pressedImage | pressedName := (aSymbol , 'Pressed') asSymbol. ((ScriptingIcons includesKey: aSymbol) and: [(ScriptingIcons includesKey: pressedName) not]) ifTrue: [pressedImage := ((self formAtKey: aSymbol) blendColor: (Color black alpha: 0.3)) colorReduced. ScriptingIcons at: pressedName put: pressedImage]. ^ self formAtKey: pressedName! !
!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:11'! saveForm: aForm atKey: aKey ScriptingIcons at: aKey asSymbol put: aForm! !
!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:05'! scriptingIcons
^ ScriptingIcons ifNil: [ScriptingIcons := IdentityDictionary new]! !
!MessageSet methodsFor: 'filtering' stamp: 'mt 8/28/2023 15:11'! filterMessageList "Allow the user to refine the list of messages." | builder menuSpec | builder := ToolBuilder default. menuSpec := builder pluggableMenuSpec new model: self; yourself. menuSpec addList: #( ('unsent messages' filterToUnsentMessages 'filter to show only messages that have no senders') - ('messages that send...' filterToSendersOf 'filter to show only messages that send a selector I specify') ('messages that do not send...' filterToNotSendersOf 'filter to show only messages that do not send a selector I specify') - ('messages whose selector is...' filterToImplementorsOf 'filter to show only messages with a given selector I specify') ('messages whose selector is NOT...' filterToNotImplementorsOf 'filter to show only messages whose selector is NOT a seletor I specify') - ('messages in current change set' filterToCurrentChangeSet 'filter to show only messages that are in the current change set') ('messages not in current change set' filterToNotCurrentChangeSet 'filter to show only messages that are not in the current change set') - ('messages in any change set' filterToAnyChangeSet 'filter to show only messages that occur in at least one change set') ('messages not in any change set' filterToNotAnyChangeSet 'filter to show only messages that do not occur in any change set in the system') - ('messages authored by me' filterToCurrentAuthor 'filter to show only messages whose authoring stamp has my initials') ('messages not authored by me' filterToNotCurrentAuthor 'filter to show only messages whose authoring stamp does not have my initials') - ('messages logged in .changes file' filterToMessagesInChangesFile 'filter to show only messages whose latest source code is logged in the .changes file') ('messages only in .sources file' filterToMessagesInSourcesFile 'filter to show only messages whose latest source code is logged in the .sources file') - ('messages with prior versions' filterToMessagesWithPriorVersions 'filter to show only messages that have at least one prior version') ('messages without prior versions' filterToMessagesWithoutPriorVersions 'filter to show only messages that have no prior versions') - ('uncommented messages' filterToUncommentedMethods 'filter to show only messages that do not have comments at the beginning') ('commented messages' filterToCommentedMethods 'filter to show only messages that have comments at the beginning') - ('messages in hardened classes' filterToMessagesWithHardenedClasses 'filter to show only messages of established classes (as opposed to Uniclasses such as MorphicModel23)') - ('methods in classes with matching names' filterToMatchingClassesNames 'filter to show only methods of classes with names that match the given criteria (wildcards are allowed)') ('methods in package...' filterToPackage 'filter to show only methods of a given package') ('methods not in package...' filterToNotPackage 'filter to show only methods not of a given package') - ('messages that...' filterToMessagesThat 'let me type in a block taking a class and a selector, which will specify yea or nay concerning which elements should remain in the list')). builder runModal: (builder open: menuSpec).! !
!Lexicon methodsFor: 'toolbuilder' stamp: 'mt 7/31/2023 11:13'! addSpecialButtonsTo: buttonPanelSpec with: builder
| homeCatBtnSpec menuBtnSpec mostGenericBtnSpec | homeCatBtnSpec := builder pluggableButtonSpec new model: self; action: #showHomeCategory; label: MenuIcons smallHomeIcon scaleIconToDisplay; help: 'show this method''s home category'; yourself. menuBtnSpec := builder pluggableButtonSpec new model: self; action: #offerMenu; label: (MenuIcons formAtKey: #TinyMenu) asMorph; help: 'click here to get a menu with further options'; yourself. mostGenericBtnSpec :=builder pluggableButtonSpec new model: self; action: #chooseLimitClass; label: #limitClassString; help: 'Governs which classes'' methods should be shown. If this is the same as the viewed class, then only methods implemented in that class will be shown. If it is ProtoObject, then methods of all classes in the vocabulary will be shown.'. buttonPanelSpec children add: homeCatBtnSpec; addFirst: mostGenericBtnSpec; addFirst: menuBtnSpec.! !
!InstanceBrowser methodsFor: 'menu commands' stamp: 'mt 8/16/2023 16:52'! offerMenu "Offer a menu to the user, in response to the hitting of the menu button on the tool pane"
| aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu title: ('Messages of {1}' translated format: {objectViewed nameForViewer}). aMenu addStayUpItem. aMenu addTranslatedList: #( ('vocabulary...' chooseVocabulary) ('what to show...' offerWhatToShowMenu) - ('inst var refs (here)' setLocalInstVarRefs) ('inst var defs (here)' setLocalInstVarDefs) ('class var refs (here)' setLocalClassVarRefs) -
('navigate to a sender...' navigateToASender) ('recent...' navigateToRecentMethod) ('show methods in current change set' showMethodsInCurrentChangeSet) ('show methods with initials...' showMethodsWithInitials) - "('toggle search pane' toggleSearch)"
- - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' browseClassHierarchy) ('browse protocol (p)' browseFullProtocol) - ('fileOut' fileOutMessage) ('printOut' printOutMessage) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('versions (v)' browseVersions) ('inheritance (i)' methodHierarchy) - ('references... (r)' browseVariableReferences) ('assignments... (a)' browseVariableAssignments) - ('inspector on me' inspectViewee) - ('more...' shiftedYellowButtonActivity)). ^ aMenu popUpInWorld: self currentWorld! !
!MethodCall methodsFor: 'initialization' stamp: 'mt 8/28/2023 14:54'! receiver: aReceiver methodInterface: aMethodInterface "Initialize me to have the given receiver and methodInterface"
receiver := aReceiver. selector := aMethodInterface selector. methodInterface := aMethodInterface. arguments := aMethodInterface defaultArguments. lastValue := nil.! !
!MethodFinder methodsFor: 'initialize' stamp: 'mt 3/10/2023 15:58'! initialize "The methods we are allowed to use. (MethodFinder new initialize) "
Approved := Set new. AddAndRemove := Set new. Blocks := Set new. "These modify an argument and are not used by the MethodFinder: longPrintOn: printOn: storeOn: sentTo: storeOn:base: printOn:base: absPrintExactlyOn:base: absPrintOn:base: absPrintOn:base:digitCount: writeOn: writeScanOn: possibleVariablesFor:continuedFrom: printOn:format:"
"Object" #("in class, instance creation" categoryForUniclasses chooseUniqueClassName initialInstance isSystemDefined newFrom: officialClass readCarefullyFrom: "accessing" at: basicAt: basicSize bindWithTemp: in: size yourself "testing" basicType ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: isColor isFloat isFraction isInMemory isInteger isMorph isNil isNumber isPoint isText isTransparent isWebBrowser knownName notNil pointsTo: wantsSteps "comparing" = == closeTo: hash identityHash identityHashPrintString ~= ~~ "copying" copy shallowCopy "dependents access" canDiscardEdits dependents hasUnacceptedEdits "updating" changed changed: okToChange update: windowIsClosing "printing" fullPrintString isLiteral longPrintString printString storeString stringForReadout stringRepresentation "class membership" class isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass "error handling" "user interface" addModelMenuItemsTo:forMorph:hand: defaultLabelForInspector fullScreenSize initialExtent modelWakeUp mouseUpBalk: newTileMorphRepresentative windowActiveOnFirstClick windowReqNewLabel: "system primitives" asOop instVarAt: instVarNamed: "private" "associating" -> "converting" as: asOrderedCollection asString "casing" caseOf: caseOf:otherwise: "binding" bindingOf: "macpal" contentsChanged currentEvent currentHand currentWorld flash instanceVariableValues "flagging" flag: "translation support" "objects from disk" "finalization" ) do: [:sel | Approved add: sel]. #(at:add: at:modify: at:put: basicAt:put: "NOT instVar:at:" "message handling" perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: ) do: [:sel | AddAndRemove add: sel].
"Boolean, True, False, UndefinedObject" #("logical operations" & eqv: not xor: | "controlling" and: ifFalse: ifFalse:ifTrue: ifTrue: ifTrue:ifFalse: or: "copying" "testing" isEmptyOrNil) do: [:sel | Approved add: sel].
"Behavior" #("initialize-release" "accessing" compilerClass decompilerClass evaluatorClass format methodDict parserClass sourceCodeTemplate subclassDefinerClass "testing" instSize instSpec isBits isBytes isFixed isPointers isVariable isWeak isWords "copying" "printing" printHierarchy "creating class hierarchy" "creating method dictionary" "instance creation" basicNew basicNew: new new: "accessing class hierarchy" allSubclasses allSubclassesWithLevelDo:startingLevel: allSuperclasses subclasses superclass withAllSubclasses withAllSuperclasses "accessing method dictionary" allSelectors changeRecordsAt: compiledMethodAt: compiledMethodAt:ifAbsent: firstCommentAt: lookupSelector: selectors selectorsDo: selectorsWithArgs: "slow but useful ->" sourceCodeAt: sourceCodeAt:ifAbsent: sourceMethodAt: sourceMethodAt:ifAbsent: "accessing instances and variables" allClassVarNames allInstVarNames allSharedPools classVarNames instVarNames instanceCount sharedPools someInstance subclassInstVarNames "testing class hierarchy" inheritsFrom: kindOfSubclass "testing method dictionary" canUnderstand: classThatUnderstands: hasMethods includesSelector: whichClassIncludesSelector: whichSelectorsAccess: whichSelectorsReferTo: whichSelectorsReferTo:special:byte: whichMethodsStoreInto: "enumerating" "user interface") do: [:sel | Approved add: sel].
"ClassDescription" #("initialize-release" "accessing" classVersion isMeta name theNonMetaClass "copying" "printing" classVariablesString instanceVariablesString sharedPoolsString "instance variables" checkForInstVarsOK: "method dictionary" "organization" category organization whichCategoryIncludesSelector: "compiling" acceptsLoggingOfCompilation wantsChangeSetLogging "fileIn/Out" definition "private" ) do: [:sel | Approved add: sel].
"Class" #("initialize-release" "accessing" classPool "testing" "copying" "class name" "instance variables" "class variables" classVarAt: classVariableAssociationAt: "pool variables" "compiling" "subclass creation" "fileIn/Out" ) do: [:sel | Approved add: sel].
"Metaclass" #("initialize-release" "accessing" isSystemDefined soleInstance "copying" "instance creation" "instance variables" "pool variables" "class hierarchy" "compiling" "fileIn/Out" nonTrivial ) do: [:sel | Approved add: sel].
"Context, BlockContext" #(receiver client method receiver tempAt: "debugger access" pc selector sender shortStack sourceCode tempNames tempsAndValues "controlling" "printing" "system simulation" "initialize-release" "accessing" hasMethodReturn home numArgs "evaluating" value value:ifError: value:value: value:value:value: value:value:value:value: valueWithArguments: "controlling" "scheduling" "instruction decoding" "printing" "private" "system simulation" ) do: [:sel | Approved add: sel]. #(value: "<- Association has it as a store" ) do: [:sel | AddAndRemove add: sel].
"Message" #("inclass, instance creation" selector: selector:argument: selector:arguments: "accessing" argument argument: arguments sends: "printing" "sending" ) do: [:sel | Approved add: sel]. #("private" setSelector:arguments:) do: [:sel | AddAndRemove add: sel].
"Magnitude" #("comparing" < <= > >= between:and: "testing" max: min: min:max: ) do: [:sel | Approved add: sel].
"Date, Time" #("in class, instance creation" fromDays: fromSeconds: fromString: newDay:month:year: newDay:year: today "in class, general inquiries" dateAndTimeNow dayOfWeek: daysInMonth:forYear: daysInYear: firstWeekdayOfMonth:year: indexOfMonth: leapYear: nameOfDay: nameOfMonth: "accessing" day leap monthIndex monthName weekday year "arithmetic" addDays: subtractDate: subtractDays: "comparing" "inquiries" dayOfMonth daysInMonth daysInYear daysLeftInYear firstDayOfMonth previous: "converting" asSeconds "printing" mmddyyyy printFormat: "private" weekdayIndex "in class, instance creation" fromSeconds: now "in class, general inquiries" dateAndTimeFromSeconds: dateAndTimeNow millisecondClockValue millisecondsToRun: totalSeconds "accessing" hours minutes seconds "arithmetic" addTime: subtractTime: "comparing" "printing" intervalString print24 "converting") do: [:sel | Approved add: sel]. #("private" ) do: [:sel | AddAndRemove add: sel].
"Number" #("in class" readFrom:base: "arithmetic" * + - / // \ abs negated quo: reciprocal rem: "mathematical functions" arcCos arcSin arcTan arcTan: cos exp floorLog: ln log log: raisedTo: raisedToInteger: sin sqrt squared tan "truncation and round off" ceiling detentBy:atMultiplesOf:snap: floor roundTo: roundUpTo: rounded truncateTo: truncated "comparing" "testing" even isDivisibleBy: isInfinite isNaN isZero negative odd positive sign strictlyPositive "converting" @ asInteger asNumber asPoint asSmallAngleDegrees degreesToRadians radiansToDegrees "intervals" to: to:by: "printing" printStringBase: storeStringBase: ) do: [:sel | Approved add: sel].
"Integer" #("in class" primesUpTo: "testing" isPowerOfTwo "arithmetic" alignedTo: "comparing" "truncation and round off" atRandom normalize "enumerating" timesRepeat: "mathematical functions" degreeCos degreeSin factorial gcd: lcm: take: "bit manipulation" << >> allMask: anyMask: bitAnd: bitClear: bitInvert bitInvert32 bitOr: bitShift: bitXor: lowBit noMask: "converting" asCharacter asColorOfDepth: asFloat asFraction asHexDigit "printing" asStringWithCommas hex hex8 radix: "system primitives" lastDigit replaceFrom:to:with:startingAt: "private" "benchmarks" ) do: [:sel | Approved add: sel].
"SmallInteger, LargeNegativeInteger, LargePositiveInteger" #("arithmetic" "bit manipulation" highBit "testing" "comparing" "copying" "converting" "printing" "system primitives" digitAt: digitLength "private" fromString:radix: ) do: [:sel | Approved add: sel]. #(digitAt:put: ) do: [:sel | AddAndRemove add: sel].
"Float" #("arithmetic" "mathematical functions" reciprocalLogBase2 timesTwoPower: "comparing" "testing" "truncation and round off" exponent fractionPart integerPart significand significandAsInteger "converting" asApproximateFraction asIEEE32BitWord asTrueFraction "copying") do: [:sel | Approved add: sel].
"Fraction, Random" #(denominator numerator reduced next nextValue) do: [:sel | Approved add: sel]. #(setNumerator:denominator:) do: [:sel | AddAndRemove add: sel].
"Collection" #("accessing" anyOne "testing" includes: includesAllOf: includesAnyOf: includesSubstringAnywhere: isEmpty isSequenceable occurrencesOf: "enumerating" collect: collect:thenSelect: count: detect: detect:ifNone: detectMax: detectMin: detectSum: inject:into: reject: select: select:thenCollect: intersection: "converting" asBag asCharacterSet asSet asSortedArray asSortedCollection asSortedCollection: "printing" "private" maxSize "arithmetic" "math functions" average max median min range sum) do: [:sel | Approved add: sel]. #("adding" add: addAll: addIfNotPresent: "removing" remove: remove:ifAbsent: removeAll: removeAllFoundIn: removeAllSuchThat: remove:ifAbsent:) do: [:sel | AddAndRemove add: sel].
"SequenceableCollection" #("comparing" hasEqualElements: "accessing" allButFirst allButLast at:ifAbsent: atAll: atPin: atRandom: atWrap: fifth first fourth identityIndexOf: identityIndexOf:ifAbsent: indexOf: indexOf:ifAbsent: indexOf:startingAt:ifAbsent: indexOfSubCollection:startingAt: indexOfSubCollection:startingAt:ifAbsent: last second sixth third "removing" "copying" , copyAfterLast: copyAt:put: copyFrom:to: copyReplaceAll:with: copyReplaceFrom:to:with: copyUpTo: copyUpToLast: copyWith: copyWithout: copyWithoutAll: forceTo:paddingWith: shuffled sorted: "enumerating" withIndexCollect: findFirst: findLast: pairsCollect: with:collect: withIndexCollect: polynomialEval: "converting" asArray asDictionary asFloat32Array asFloat64Array asIntegerArray asStringWithCr asWordArray reversed "private" copyReplaceAll:with:asTokens: ) do: [:sel | Approved add: sel]. #( swap:with:) do: [:sel | AddAndRemove add: sel].
"ArrayedCollection, Bag" #("private" defaultElement "sorting" isSorted "accessing" cumulativeCounts sortedCounts sortedElements "testing" "adding" add:withOccurrences: "removing" "enumerating" ) do: [:sel | Approved add: sel]. #( mergeSortFrom:to:by: sort sort: add: add:withOccurrences: "private" setDictionary ) do: [:sel | AddAndRemove add: sel].
"Other messages that modify the receiver" #(atAll:put: atAll:putAll: atAllPut: atWrap:put: replaceAll:with: replaceFrom:to:with: removeFirst removeLast) do: [:sel | AddAndRemove add: sel].
self initialize2.
" MethodFinder new initialize. MethodFinder new organizationFiltered: Set "
! !
!MissingFont methodsFor: 'handling' stamp: 'mt 3/7/2023 15:07'! defaultAction familyName ifNil: [ familyName := 'NoName' ]. pixelSize ifNil: [ pixelSize := 12 ].
^((familyName beginsWith: 'Comic') ifTrue: [ TextStyle named: (Preferences standardButtonFont familyName) ] ifFalse: [ TextStyle default ]) fontOfSize: pixelSize.! !
!Morph methodsFor: 'accessing' stamp: 'mt 8/11/2023 16:29'! balloonText "Answer balloon help text or nil, if no help is available." "NB: subclasses may override such that they programatically construct the text, for economy's sake, such as model phrases in a Viewer."
| balloonSelector | extension ifNil: [^ nil]. extension balloonText ifNotNil: [:balloonText | ^ balloonText]. balloonSelector := extension balloonTextSelector ifNil: [^ nil]. balloonSelector isUnary ifTrue: [ (self respondsTo: balloonSelector) ifTrue: [^ self perform: balloonSelector]. (self model respondsTo: balloonSelector) ifTrue: [^ self model perform: balloonSelector]]. ^ nil! !
!Morph methodsFor: 'copying' stamp: 'mt 3/10/2023 14:51'! duplicate "Make and return a duplicate of the receiver"
| newMorph aName w topRend | ((topRend := self topRendererOrSelf) ~~ self) ifTrue: [^ topRend duplicate].
self okayToDuplicate ifFalse: [^ self]. aName := (w := self world) ifNotNil: [w nameForCopyIfAlreadyNamed: self]. newMorph := self veryDeepCopy. aName ifNotNil: [newMorph setNameTo: aName].
newMorph arrangeToStartStepping. newMorph privateOwner: nil. "no longer in world" newMorph isPartsDonor: false. "no longer parts donor" ^ newMorph! !
!Morph methodsFor: 'debug and other' stamp: 'mt 3/10/2023 15:09'! buildDebugMenu: aHand "Answer a debugging menu for the receiver. The hand argument is seemingly historical and plays no role presently"
| aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu addStayUpItem. (self hasProperty: #errorOnDraw) ifTrue: [aMenu add: 'start drawing again' translated action: #resumeAfterDrawError. aMenu addLine]. (self hasProperty: #errorOnStep) ifTrue: [aMenu add: 'start stepping again' translated action: #resumeAfterStepError. aMenu addLine]. (self hasProperty: #errorOnLayout) ifTrue: [aMenu add: 'start layouting again' translated action: #resumeAfterLayoutError. aMenu addLine].
aMenu add: 'inspect morph' translated action: #inspectInMorphic:. aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain. Smalltalk isMorphic ifFalse: [aMenu add: 'inspect morph (in MVC)' translated action: #inspect].
self isMorphicModel ifTrue: [aMenu add: 'inspect model' translated target: self model action: #inspect; add: 'explore model' translated target: self model action: #explore].
aMenu add: 'explore morph' translated target: self selector: #exploreInMorphic:.
aMenu addLine.
aMenu add: 'browse morph class' translated target: self selector: #browseHierarchy. (self isMorphicModel) ifTrue: [aMenu add: 'browse model class' target: self model selector: #browseHierarchy]. aMenu addLine.
self addViewingItemsTo: aMenu. aMenu add: 'make own subclass' translated action: #subclassMorph; add: 'save morph in file' translated action: #saveOnFile; addLine; add: 'call #tempCommand' translated action: #tempCommand; add: 'define #tempCommand' translated action: #defineTempCommand; addLine;
add: 'control-menu...' translated target: self selector: #invokeMetaMenu:; add: 'edit balloon help' translated action: #editBalloonHelpText.
^ aMenu! !
!Morph methodsFor: 'debug and other' stamp: 'mt 8/16/2023 17:11'! deleteAnyMouseActionIndicators
self changed. (self valueOfProperty: #mouseActionIndicatorMorphs ifAbsent: [#()]) do: [ :each | each delete "one is probably enough, but be safe" ]. self removeProperty: #mouseActionIndicatorMorphs. self hasRolloverBorder: false. self removeProperty: #rolloverWidth. self removeProperty: #rolloverColor. self layoutChanged. self changed.
! !
!Morph methodsFor: 'dropping/grabbing' stamp: 'mt 8/4/2023 14:49'! justDroppedInto: aMorph event: anEvent "This message is sent to a dropped morph after it has been dropped on -- and been accepted by -- a drop-sensitive morph"
| partsBinCase cmd | (self formerOwner notNil and: [self formerOwner ~~ aMorph]) ifTrue: [self removeHalo]. self formerOwner: nil. self formerPosition: nil. cmd := self valueOfProperty: #undoGrabCommand. cmd ifNotNil:[aMorph rememberCommand: cmd. self removeProperty: #undoGrabCommand]. (partsBinCase := aMorph isPartsBin) ifFalse: [self isPartsDonor: false]. (self isInWorld and: [partsBinCase not]) ifTrue: [self world startSteppingSubmorphsOf: self]. "Note an unhappy inefficiency here: the startStepping... call will often have already been called in the sequence leading up to entry to this method, but unfortunately the isPartsDonor: call often will not have already happened, with the result that the startStepping... call will not have resulted in the startage of the steppage."! !
!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:54'! handleMouseDown: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseDown: and #mouseDown: in your custom morphs. See #handlerForMouseDown: and #mouseDownPriority." anEvent wasHandled ifTrue:[^self]. "not interested" anEvent hand removePendingBalloonFor: self. anEvent wasHandled: true.
"Make me modal during mouse transitions" anEvent hand newMouseFocus: self event: anEvent. "this mouse down could be the start of a gesture, or the end of a gesture focus" (self isGestureStart: anEvent) ifTrue: [^ self gestureStart: anEvent].
self mouseDown: anEvent.
(self handlesMouseStillDown: anEvent) ifTrue:[ self startStepping: #handleMouseStillDown: at: Time millisecondClockValue + self mouseStillDownThreshold arguments: {anEvent copy resetHandlerFields} stepTime: self mouseStillDownStepRate ]. ! !
!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:54'! handleMouseEnter: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseOver: and #mouseEnter: in your custom morphs. Also see/use #handlesMouseOverDragging: and #mouseEnterDragging:."
(anEvent isDraggingEvent) ifTrue:[ (self handlesMouseOverDragging: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseEnterDragging: anEvent]. ^self]. self wantsBalloon ifTrue:[anEvent hand triggerBalloonFor: self after: self balloonHelpDelayTime]. (self handlesMouseOver: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseEnter: anEvent. ].! !
!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:55'! handleMouseLeave: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseOver: and #mouseLeave: in your custom morphs. Also see/use #handlesMouseOverDragging: and #mouseLeaveDragging:."
anEvent hand removePendingBalloonFor: self. anEvent isDraggingEvent ifTrue:[ (self handlesMouseOverDragging: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseLeaveDragging: anEvent]. ^self]. (self handlesMouseOver: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseLeave: anEvent. ]. ! !
!Morph methodsFor: 'halos and balloon help' stamp: 'mt 8/14/2023 15:59'! addHandlesTo: aHaloMorph box: box "Add halo handles to the halo. Apply the halo filter if appropriate." aHaloMorph haloBox: box. Preferences haloSpecifications do: [:aSpec | (self wantsHaloHandleWithSelector: aSpec addHandleSelector inHalo: aHaloMorph) ifTrue: [aHaloMorph perform: aSpec addHandleSelector with: aSpec]].
aHaloMorph innerTarget addOptionalHandlesTo: aHaloMorph box: box! !
!Morph methodsFor: 'halos and balloon help' stamp: 'mt 8/11/2023 16:50'! balloonHelpTextForHandle: aHandle "Answer a string providing balloon help for the given halo handle" | itsSelector | itsSelector := aHandle eventHandler firstMouseSelector. itsSelector == #doRecolor:with: ifTrue: [^ 'Change color']. itsSelector == #mouseDownInDimissHandle:with: ifTrue: [^ TrashCanMorph preserveTrash ifTrue: ['Move to trash'] ifFalse: ['Remove from screen']]. #(#(#addFullHandles 'More halo handles') #(#addSimpleHandles 'Fewer halo handles') #(#chooseEmphasisOrAlignment 'Emphasis & alignment') #(#chooseFont 'Change font') #(#chooseStyle 'Change style') #(#dismiss 'Remove') #(#doDebug:with: 'Debug') #(#doDirection:with: 'Choose forward direction') #(#doDup:with: 'Duplicate') #(#doMenu:with: 'Menu') #(#doGrab:with: 'Pick up') #(#editButtonsScript 'See the script for this button') #(#editDrawing 'Repaint') #(#mouseDownInCollapseHandle:with: 'Collapse') #(#mouseDownOnHelpHandle: 'Help') #(#paintBackground 'Paint background') #(#prepareToTrackCenterOfRotation:with: 'Move object or set center of rotation') #(#presentViewMenu 'Present the Viewing menu') #(#startDrag:with: 'Move') #(#startGrow:with: 'Change size (Ctrl + drag blue button)') #(#startRot:with: 'Rotate') #(#startScale:with: 'Change scale') #(#tearOffTile 'Make a tile representing this object') #(#trackCenterOfRotation:with: 'Set center of rotation') ) do: [:pair | itsSelector == pair first ifTrue: [^ pair last]]. ^ 'unknown halo handle'translated! !
!Morph methodsFor: 'menu' stamp: 'mt 8/11/2023 14:44'! addYellowButtonMenuItemsTo: aMenu event: evt "Populate aMenu with appropriate menu items for a yellow-button (context menu) click." aMenu defaultTarget: self. "" aMenu addStayUpItem. "" self addModelYellowButtonItemsTo: aMenu event: evt. "" Preferences generalizedYellowButtonMenu ifFalse: [^ self]. "" aMenu addLine. aMenu add: 'inspect' translated action: #inspect. "" aMenu addLine. self world selectedObject == self ifTrue: [aMenu add: 'deselect' translated action: #removeHalo] ifFalse: [aMenu add: 'select' translated action: #addHalo]. "" self isWorldMorph ifFalse: ["" aMenu addLine. aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: evt hand]. "" self isWorldMorph ifFalse: ["" Smalltalk at: #NCAAConnectorMorph ifPresent: [:connectorClass | aMenu addLine. aMenu add: 'connect to' translated action: #startWiring. aMenu addLine]. ""
self isFullOnScreen ifFalse: [aMenu add: 'move onscreen' translated action: #goHome]]. "" self addLayoutMenuItems: aMenu hand: evt hand. (owner notNil and: [owner isTextMorph]) ifTrue: [self addTextAnchorMenuItems: aMenu hand: evt hand]. "" self isWorldMorph ifFalse: ["" aMenu addLine. self addToggleItemsToHaloMenu: aMenu]. "" aMenu addLine. self isWorldMorph ifFalse: [aMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:]. self hasStrings ifTrue: [ aMenu add: 'copy text' translated action: #clipText]. "" self addExportMenuItems: aMenu hand: evt hand. "" self isWorldMorph not ifTrue: ["" aMenu addLine. aMenu add: 'adhere to edge...' translated action: #adhereToEdge]. "" self addCustomMenuItems: aMenu hand: evt hand! !
!Morph methodsFor: 'menu' stamp: 'mt 3/10/2023 16:07'! wantsYellowButtonMenu "Answer true if the receiver wants a yellow button menu" self valueOfProperty: #wantsYellowButtonMenu ifPresentDo: [:value | ^ value]. "" self isInSystemWindow ifTrue: [^ false]."" ^ Preferences generalizedYellowButtonMenu! !
!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:59'! absorbStateFromRenderer: aRenderer "Transfer knownName, actorState, visible over from aRenderer, which was formerly imposed above me as a transformation shell but is now going away."
| current | (current := aRenderer actorStateOrNil) ifNotNil: [self actorState: current. aRenderer actorState: nil].
(current := aRenderer knownName) ifNotNil: [self setNameTo: current. aRenderer setNameTo: nil].
self visible: aRenderer visible! !
!Morph methodsFor: 'menus' stamp: 'mt 3/10/2023 14:25'! addHaloActionsTo: aMenu "Add items to aMenu representing actions requestable via halo"
| subMenu | subMenu := MenuMorph new defaultTarget: self. subMenu addTitle: self externalName. subMenu addStayUpItemSpecial. subMenu addLine. subMenu add: 'delete' translated action: #dismissViaHalo. subMenu balloonTextForLastItem: 'Delete this object -- warning -- can be destructive!!' translated.
self maybeAddCollapseItemTo: subMenu. subMenu add: 'grab' translated action: #openInHand. subMenu balloonTextForLastItem: 'Pick this object up -- warning, since this removes it from its container, it can have adverse effects.' translated.
subMenu addLine.
subMenu add: 'resize' translated action: #resizeFromMenu. subMenu balloonTextForLastItem: 'Change the size of this object' translated.
subMenu add: 'duplicate' translated action: #maybeDuplicateMorph. subMenu balloonTextForLastItem: 'Hand me a copy of this object' translated. "Note that this allows access to the non-instancing duplicate even when this is a uniclass instance"
subMenu addLine.
subMenu add: 'set color' translated target: self renderedMorph action: #changeColor. subMenu balloonTextForLastItem: 'Change the color of this object' translated.
subMenu addLine.
subMenu add: 'inspect' translated target: self action: #inspect. subMenu balloonTextForLastItem: 'Open an Inspector on this object' translated.
aMenu add: 'halo actions...' translated subMenu: subMenu ! !
!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:47'! addMiscExtrasTo: aMenu "Add a submenu of miscellaneous extra items to the menu."
| realOwner realMorph subMenu | subMenu := MenuMorph new defaultTarget: self. self isWorldMorph ifFalse: [subMenu add: 'adhere to edge...' translated action: #adhereToEdge. subMenu addLine]. realOwner := (realMorph := self topRendererOrSelf) owner. (realOwner isKindOf: TextPlusPasteUpMorph) ifTrue: [subMenu add: 'GeeMail stuff...' translated subMenu: (realOwner textPlusMenuFor: realMorph)]. subMenu add: 'add mouse up action' translated action: #addMouseUpAction; add: 'remove mouse up action' translated action: #removeMouseUpAction; add: 'hand me tiles to fire this button' translated action: #handMeTilesToFire. subMenu addLine. subMenu add: 'arrowheads on pen trails...' translated action: #setArrowheads. subMenu addLine. subMenu defaultTarget: self topRendererOrSelf. subMenu add: 'draw new path' translated action: #definePath. subMenu add: 'follow existing path' translated action: #followPath. subMenu add: 'delete existing path' translated action: #deletePath. subMenu addLine. self addGestureMenuItems: subMenu hand: self currentHand. aMenu add: 'extras...' translated subMenu: subMenu! !
!Morph methodsFor: 'menus' stamp: 'mt 8/16/2023 15:58'! addStandardHaloMenuItemsTo: aMenu hand: aHandMorph "Add standard halo items to the menu"
| unlockables |
self isWorldMorph ifTrue: [^ self addWorldHaloMenuItemsTo: aMenu hand: aHandMorph].
aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: aHandMorph. aMenu addLine.
self addFillStyleMenuItems: aMenu hand: aHandMorph. self addBorderStyleMenuItems: aMenu hand: aHandMorph. self addDropShadowMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph. self addHaloActionsTo: aMenu. owner isTextMorph ifTrue:[self addTextAnchorMenuItems: aMenu hand: aHandMorph]. aMenu addLine. self addToggleItemsToHaloMenu: aMenu. aMenu addLine. self addCopyItemsTo: aMenu. self addExportMenuItems: aMenu hand: aHandMorph. self addMiscExtrasTo: aMenu. self addDebuggingItemsTo: aMenu hand: aHandMorph.
aMenu addLine. aMenu defaultTarget: self.
aMenu addLine.
unlockables := self submorphs select: [:m | m isLocked]. unlockables size = 1 ifTrue: [aMenu add: ('unlock "{1}"' translated format: unlockables first externalName) action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' translated action: #unlockContents].
aMenu defaultTarget: aHandMorph. ! !
!Morph methodsFor: 'menus' stamp: 'mt 3/10/2023 16:06'! addToggleItemsToHaloMenu: aMenu "Add standard true/false-checkbox items to the memu"
#( (resistsRemovalString toggleResistsRemoval 'whether I should be reistant to easy deletion via the pink X handle') (stickinessString toggleStickiness 'whether I should be resistant to a drag done by mousing down on me') (lockedString lockUnlockMorph 'when "locked", I am inert to all user interactions') (hasClipSubmorphsString changeClipSubmorphs 'whether the parts of objects within me that are outside my bounds should be masked.') (hasDirectionHandlesString changeDirectionHandles 'whether direction handles are shown with the halo') (hasDragEnabledString changeDrag 'whether I am open to having objects dragged out of me') (hasDropEnabledString changeDrop 'whether I am open to having objects dropped into me') ) do: [:each | aMenu addUpdating: each first action: each second. aMenu balloonTextForLastItem: each third translated].
self couldHaveRoundedCorners ifTrue: [aMenu addUpdating: #roundedCornersString action: #toggleCornerRounding. aMenu balloonTextForLastItem: 'whether my corners should be rounded' translated]! !
!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:59'! transferStateToRenderer: aRenderer "Transfer knownName, actorState, visible over to aRenderer, which is being imposed above me as a transformation shell"
| current | (current := self actorStateOrNil) ifNotNil: [aRenderer actorState: current. self actorState: nil].
(current := self knownName) ifNotNil: [aRenderer setNameTo: current. self setNameTo: nil].
aRenderer simplySetVisible: self visible
! !
!Morph methodsFor: 'meta-actions' stamp: 'mt 3/10/2023 16:06'! buildHandleMenu: aHand "Build the morph menu for the given morph's halo's menu handle. This menu has two sections. The first section contains commands that are interpreted by the hand; the second contains commands provided by the target morph. This method allows the morph to decide which items should be included in the hand's section of the menu."
| menu | menu := MenuMorph new defaultTarget: self. menu addStayUpItem. menu addLine. self addStandardHaloMenuItemsTo: menu hand: aHand. menu defaultTarget: aHand. self addAddHandMenuItemsForHalo: menu hand: aHand. menu defaultTarget: self. self addCustomHaloMenuItems: menu hand: aHand. menu defaultTarget: aHand. ^ menu ! !
!Morph methodsFor: 'naming' stamp: 'mt 3/8/2023 10:49'! renameTo: aName self knownName = aName ifTrue: [^ aName]. self topRendererOrSelf setNameTo: aName. ^ aName! !
!Morph methodsFor: 'stepping' stamp: 'mt 8/28/2023 15:14'! step "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message." ! !
!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:53'! stepAt: millisecondClockValue "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message. The millisecondClockValue parameter gives the value of the millisecond clock at the moment of dispatch. Default is to dispatch to the parameterless step method for the morph, but this protocol makes it possible for some morphs to do differing things depending on the clock value" self step ! !
!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:53'! stepTime "Answer the desired time between steps in milliseconds. This default implementation requests that the 'step' method be called once every second."
^ 1000! !
!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:57'! wantsSteps "Return true if the receiver overrides the default Morph step method." "Details: Find first class in superclass chain that implements #step and return true if it isn't class Morph."
| c | self isPartsDonor ifTrue: [^ false]. c := self class. [c includesSelector: #step] whileFalse: [c := c superclass]. ^ c ~= Morph! !
!Morph methodsFor: 'thumbnail' stamp: 'mt 8/14/2023 17:40'! representativeNoTallerThan: maxHeight norWiderThan: maxWidth thumbnailHeight: thumbnailHeight "Return a morph representing the receiver but which is no taller than aHeight. If the receiver is already small enough, just return it, else return a MorphThumbnail companioned to the receiver, enforcing the maxWidth. If the receiver personally *demands* thumbnailing, do it even if there is no size-related reason to do it."
self permitsThumbnailing ifFalse: [^ self]. (self fullBounds height <= maxHeight and: [self fullBounds width <= maxWidth]) ifTrue: [^ self].
^ MorphThumbnail new extent: maxWidth @ (thumbnailHeight min: self fullBounds height); morphRepresented: self! !
!Morph methodsFor: 'WiW support' stamp: 'mt 3/7/2023 15:07'! eToyRejectDropMorph: morphToDrop event: evt
| tm am |
tm := TextMorph new beAllFont: ((TextStyle named: Preferences standardButtonFont familyName) fontOfSize: 24); contents: 'GOT IT!!'. (am := AlignmentMorph new) color: Color yellow; layoutInset: 10; useRoundedCorners; vResizing: #shrinkWrap; hResizing: #shrinkWrap; addMorph: tm; fullBounds; position: (self bounds center - (am extent // 2)); openInWorld: self world. SoundService default playSoundNamed: 'yum' ifAbsentReadFrom: 'yum.aif'. morphToDrop rejectDropMorphEvent: evt. "send it back where it came from" am delete ! !
!Morph methodsFor: 'private' stamp: 'mt 3/10/2023 14:53'! privateMoveBy: delta "Private!! Use 'position:' instead." | fill | bounds := bounds translateBy: delta. fullBounds ifNotNil: [fullBounds := fullBounds translateBy: delta]. fill := self fillStyle. fill isOrientedFill ifTrue: [fill origin: fill origin + delta]! !
!Morph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/10/2023 14:50'! delete "Remove the receiver as a submorph of its owner and make its new owner be nil." | oldWorld | self removeHalo. (oldWorld := self world) ifNotNil: [ self disableSubmorphFocusForHand: self activeHand. self activeHand releaseKeyboardFocus: self; releaseMouseFocus: self]. owner ifNotNil: [ self privateDelete. "remove from world"].! !
!Morph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/10/2023 14:27'! goBehind "Move the receiver to bottom z-order."
| topRend | topRend := self topRendererOrSelf. topRend owner ifNotNil: [:own | own addMorphBack: topRend] ! !
!Morph methodsFor: 'submorphs - layers' stamp: 'dgd 8/31/2004 16:21'! wantsToBeTopmost "Answer if the receiver want to be one of the topmost objects in its owner" ^ self isFlapOrTab! !
!BorderedMorph methodsFor: 'menu' stamp: 'mt 4/11/2018 08:30'! changeBorderWidth: evt | handle origin aHand newWidth oldWidth | aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand]. origin := aHand position. oldWidth := self borderWidth. (handle := HandleMorph new) forEachPointDo: [:newPoint | handle removeAllMorphs. handle addMorph: (LineMorph from: origin to: newPoint color: Color black width: 1). newWidth := (newPoint - origin) r asInteger // 5. self borderWidth: newWidth] lastPointDo: [:newPoint | handle deleteBalloon. self halo ifNotNil: [:halo | halo addHandles]. self rememberCommand: (Command new cmdWording: 'border change' translated; undoTarget: self selector: #borderWidth: argument: oldWidth; redoTarget: self selector: #borderWidth: argument: newWidth)]. aHand attachMorph: handle. handle setProperty: #helpAtCenter toValue: true. handle showBalloon: 'Move cursor farther from this point to increase border width. Click when done.' translated hand: evt hand. handle startStepping! !
!AlignmentMorph methodsFor: 'geometry' stamp: 'mt 3/7/2023 14:37'! addTransparentSpacerOfSize: aPoint "Required for several MorphicExtras and other non-Etoys stuff."
self addMorphBack: ((Morph new extent: aPoint asPoint) color: Color transparent)! !
!BookPageSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'! addControls "Add the control bar at the top of the tool."
| bb r str aCheckbox aWrapper | r := AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0. r wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. bb := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort)). bb setBalloonText: 'Accept the changes made here as the new page-order for this book' translated. r addTransparentSpacerOfSize: 12. bb := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #delete)). bb setBalloonText: 'Forgot any changes made here, and dismiss this sorter' translated.
"eliminate the parts-bin button on the book-page sorters... r addTransparentSpacerOfSize: 24 @ 0.
aCheckbox := UpdatingThreePhaseButtonMorph checkBox. aCheckbox target: self; actionSelector: #togglePartsBinStatus; arguments: #(); getSelector: #getPartsBinStatus. str := StringMorph contents: 'Parts bin' translated font: Preferences standardButtonFont. aWrapper := AlignmentMorph newRow beTransparent. aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0. aWrapper addMorphBack: (self wrapperFor: aCheckbox); addMorphBack: (self wrapperFor: str lock). r addMorphBack: aWrapper."
self addMorphFront: r ! !
!BookPageSorterMorph methodsFor: 'initialization' stamp: 'mt 8/16/2023 13:52'! initialize "initialize the state of the receiver" super initialize. "" self extent: Display extent - 100; listDirection: #topToBottom; wrapCentering: #topLeft; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 3. pageHolder := PasteUpMorph new. pageHolder vResizeToFit: true; autoLineLayout: true. pageHolder extent: self extent - self borderWidth. pageHolder hResizing: #shrinkWrap. "pageHolder cursor: 0." "causes a walkback as of 5/25/2000" self addControls. self addMorphBack: pageHolder! !
!BooklikeMorph methodsFor: 'misc' stamp: 'mt 8/4/2023 13:41'! playPageFlipSound: soundName PageFlipSoundOn "mechanism to suppress sounds at init time" ifTrue: [self playSoundNamed: soundName]. ! !
!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:39'! addBookMenuItemsTo: aMenu hand: aHandMorph | controlsShowing subMenu | subMenu := MenuMorph new defaultTarget: self. subMenu add: 'previous page' translated action: #previousPage. subMenu add: 'next page' translated action: #nextPage. subMenu add: 'goto page' translated action: #goToPage. subMenu add: 'insert a page' translated action: #insertPage. subMenu add: 'delete this page' translated action: #deletePage.
controlsShowing := self hasSubmorphWithProperty: #pageControl. controlsShowing ifTrue: [subMenu add: 'hide page controls' translated action: #hidePageControls. subMenu add: 'fewer page controls' translated action: #fewerPageControls] ifFalse: [subMenu add: 'show page controls' translated action: #showPageControls]. self isInFullScreenMode ifTrue: [ subMenu add: 'exit full screen' translated action: #exitFullScreen. ] ifFalse: [ subMenu add: 'show full screen' translated action: #goFullScreen. ]. subMenu addLine. subMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:. subMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:. subMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:. subMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:.
subMenu addLine. subMenu add: 'sort pages' translated action: #sortPages:. subMenu add: 'uncache page sorter' translated action: #uncachePageSorter. (self hasProperty: #dontWrapAtEnd) ifTrue: [subMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true] ifFalse: [subMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false].
subMenu addLine. subMenu add: 'search for text' translated action: #textSearch. (aHandMorph pasteBuffer class isKindOf: PasteUpMorph class) ifTrue: [subMenu add: 'paste book page' translated action: #pasteBookPage].
subMenu add: 'send all pages to server' translated action: #savePagesOnURL. subMenu add: 'send this page to server' translated action: #saveOneOnURL. subMenu add: 'reload all from server' translated action: #reload. subMenu add: 'copy page url to clipboard' translated action: #copyUrl. subMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype. newPagePrototype ifNotNil: [subMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype].
aMenu add: 'book...' translated subMenu: subMenu ! !
!BookMorph methodsFor: 'menu' stamp: 'mt 8/11/2023 14:44'! invokeBookMenu "Invoke the book's control panel menu." | aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'Book' translated. aMenu addStayUpItem. aMenu add: 'find...' translated action: #textSearch. aMenu add: 'go to page...' translated action: #goToPage. aMenu addLine.
aMenu addList: { {'sort pages' translated. #sortPages}. {'uncache page sorter' translated. #uncachePageSorter}}. (self hasProperty: #dontWrapAtEnd) ifTrue: [aMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true] ifFalse: [aMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false]. aMenu addList: { {'make bookmark' translated. #bookmarkForThisPage}. {'make thumbnail' translated. #thumbnailForThisPage}}. aMenu addUpdating: #showingPageControlsString action: #toggleShowingOfPageControls. aMenu addUpdating: #showingFullScreenString action: #toggleFullScreen.
aMenu addLine. aMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:. aMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:. aMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:. aMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:.
aMenu addLine. (self primaryHand pasteBuffer class isKindOf: PasteUpMorph class) ifTrue: [aMenu add: 'paste book page' translated action: #pasteBookPage].
aMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype. newPagePrototype ifNotNil: [ aMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype].
aMenu add: (self dragNDropEnabled ifTrue: ['close dragNdrop'] ifFalse: ['open dragNdrop']) translated action: #changeDragAndDrop. aMenu add: 'make all pages this size' translated action: #makeUniformPageSize. aMenu addUpdating: #keepingUniformPageSizeString target: self action: #toggleMaintainUniformPageSize. aMenu addLine.
aMenu add: 'send all pages to server' translated action: #savePagesOnURL. aMenu add: 'send this page to server' translated action: #saveOneOnURL. aMenu add: 'reload all from server' translated action: #reload. aMenu add: 'copy page url to clipboard' translated action: #copyUrl.
aMenu addLine. aMenu add: 'load PPT images from slide #1' translated action: #loadImagesIntoBook. aMenu add: 'background color for all pages...' translated action: #setPageColor. aMenu add: 'make a thread of projects in this book' translated action: #buildThreadOfProjects.
aMenu popUpEvent: self world activeHand lastEvent in: self world ! !
!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:38'! saveAsNumberedURLs "Write out all pages in this book that are not showing, onto a server. The local disk could be the server. For any page that does not have a SqueakPage and a url already, name that page file by its page number. Any pages that are already totally out will stay that way."
| stem list firstTime | firstTime := (self valueOfProperty: #url) isNil. stem := self getStemUrl. "user must approve" stem isEmpty ifTrue: [^self]. firstTime ifTrue: [self setProperty: #futureUrl toValue: stem , '.bo']. self reserveUrlsIfNeeded. pages withIndexDo: [:aPage :ind | "does write the current page too"
aPage isInMemory ifTrue: ["not out now" aPage saveOnURL: stem , ind printString , '.sp']]. list := pages collect: [:aPage | aPage sqkPage prePurge]. "knows not to purge the current page" list := (list select: [:each | each notNil]) asArray. "do bulk become:" (list collect: [:each | each contentsMorph]) elementsExchangeIdentityWith: (list collect: [:spg | MorphObjectOut new xxxSetUrl: spg url page: spg]). self saveIndexOnURL. firstTime ifTrue: ["Put a thumbnail into the hand"
URLMorph grabForBook: self. self setProperty: #futureUrl toValue: nil "clean up"]! !
!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:39'! saveOnUrlPage: pageMorph "Write out this single page in this book onto a server. See savePagesOnURL. (Don't compute the texts, only this page's is written.)" | stem ind response rand newPlace dir | "Don't give the chance to put in a different place. Assume named by number" ((self valueOfProperty: #url) isNil and: [pages first url notNil]) ifTrue: [response := Project uiManager chooseOptionFrom: {'Old book' translated. 'New book sharing old pages' translated} title: 'Modify the old book, or make a new book sharing its pages?' translated. response = 2 ifTrue: ["Make up new url for .bo file and confirm with user." "Mark as shared" [rand := String new: 4. 1 to: rand size do: [:ii | rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)]. (newPlace := self getStemUrl) ifEmpty: [^ self]. newPlace := (newPlace copyUpToLast: $/), '/BK', rand, '.bo'. dir := ServerFile new fullPath: newPlace. (dir includesKey: dir fileName)] whileTrue. "keep doing until a new file" self setProperty: #url toValue: newPlace]. response = 0 ifTrue: [^ self]].
stem := self getStemUrl. "user must approve" stem ifEmpty: [^ self]. ind := pages identityIndexOf: pageMorph ifAbsent: [self error: 'where is the page?' translated]. pageMorph isInMemory ifTrue: "not out now" [pageMorph saveOnURL: stem,(ind printString),'.sp']. self saveIndexOfOnly: pageMorph.! !
!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:40'! savePagesOnURL "Write out all pages in this book onto a server. For any page that does not have a SqueakPage and a url already, ask the user for one. Give the option of naming all page files by page number. Any pages that are not in memory will stay that way. The local disk could be the server."
| response list firstTime newPlace rand dir bookUrl | self getAllText. "stored with index later" response := Project uiManager chooseOptionFrom: {'Use page numbers' translated. 'Type in file names' translated. 'Save in a new place (using page numbers)' translated. 'Save in a new place (typing names)' translated. 'Save new book sharing old pages' translated. } title: 'Each page will be a file on the server. Do you want to page numbers be the names of the files? or name each one yourself?' translated. response = 1 ifTrue: [self saveAsNumberedURLs. ^ self]. response = 3 ifTrue: [self forgetURLs; saveAsNumberedURLs. ^ self]. response = 4 ifTrue: [self forgetURLs]. response = 5 ifTrue: ["Make up new url for .bo file and confirm with user." "Mark as shared" [rand := String new: 4. 1 to: rand size do: [:ii | rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)]. (newPlace := self getStemUrl) isEmpty ifTrue: [^ self]. newPlace := (newPlace copyUpToLast: $/), '/BK', rand, '.bo'. dir := ServerFile new fullPath: newPlace. (dir includesKey: dir fileName)] whileTrue. "keep doing until a new file"
self setProperty: #url toValue: newPlace. self saveAsNumberedURLs. bookUrl := self valueOfProperty: #url. (SqueakPage stemUrl: bookUrl) = (SqueakPage stemUrl: currentPage url) ifTrue: [bookUrl := true]. "not a shared book" (URLMorph grabURL: currentPage url) book: bookUrl. ^ self]. response = 0 ifTrue: [^ self].
"self reserveUrlsIfNeeded. Need two passes here -- name on one, write on second" pages do: [:aPage | "does write the current page too" aPage isInMemory ifTrue: "not out now" [aPage saveOnURLbasic]]. "ask user if no url"
list := pages collect: [:aPage | aPage sqkPage prePurge]. "knows not to purge the current page" list := (list select: [:each | each notNil]) asArray. "do bulk become:" (list collect: [:each | each contentsMorph]) elementsExchangeIdentityWith: (list collect: [:spg | MorphObjectOut new xxxSetUrl: spg url page: spg]).
firstTime := (self valueOfProperty: #url) isNil. self saveIndexOnURL. firstTime ifTrue: "Put a thumbnail into the hand" [URLMorph grabForBook: self. self setProperty: #futureUrl toValue: nil]. "clean up" ! !
!BookMorph methodsFor: 'navigation' stamp: 'mt 8/4/2023 13:34'! goToPageMorph: aMorph "Set the given morph as the current page; run closing and opening scripts as appropriate"
self goToPage: (pages identityIndexOf: aMorph ifAbsent: [^ self "abort"]) transitionSpec: nil! !
!BookMorph methodsFor: 'navigation' stamp: 'mt 8/4/2023 13:30'! goToPageMorph: newPage transitionSpec: transitionSpec "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly. Apply the transitionSpec provided."
| pageIndex aWorld oldPageIndex ascending tSpec readIn | pages isEmpty ifTrue: [^self]. self setProperty: #searchContainer toValue: nil. "forget previous search" self setProperty: #searchOffset toValue: nil. self setProperty: #searchKey toValue: nil. pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"]. readIn := newPage isInMemory not. oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil]. ascending := (oldPageIndex isNil or: [newPage == currentPage]) ifTrue: [nil] ifFalse: [oldPageIndex < pageIndex]. tSpec := transitionSpec ifNil: ["If transition not specified by requestor..."
newPage valueOfProperty: #transitionSpec ifAbsent: [" ... then consult new page"
self transitionSpecFor: self " ... otherwise this is the default"]]. self flag: #arNote. "Probably unnecessary" (aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus]. currentPage ifNotNil: [currentPage updateCachedThumbnail]. self currentPage notNil ifTrue: [(((pages at: pageIndex) owner isKindOf: TransitionMorph) and: [(pages at: pageIndex) isInWorld]) ifTrue: [^self "In the process of a prior pageTurn"]. ascending ifNotNil: ["Show appropriate page transition and start new page when done"
currentPage stopStepping. (pages at: pageIndex) position: currentPage position. ^(TransitionMorph effect: tSpec second direction: tSpec third inverse: (ascending or: [transitionSpec notNil]) not) showTransitionFrom: currentPage to: (pages at: pageIndex) in: self whenStart: [self playPageFlipSound: tSpec first] whenDone: [currentPage delete; fullReleaseCachedState. self insertPageMorphInCorrectSpot: (pages at: pageIndex). self adjustCurrentPageForFullScreen. self snapToEdgeIfAppropriate. aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. aWorld := self world. readIn ifTrue: [currentPage updateThumbnailUrlInBook: self url. currentPage sqkPage computeThumbnail "just store it"]]].
"No transition, but at least decommission current page" currentPage delete; fullReleaseCachedState]. self insertPageMorphInCorrectSpot: (pages at: pageIndex). "sets currentPage" self adjustCurrentPageForFullScreen. self snapToEdgeIfAppropriate. aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. aWorld := self world. readIn ifTrue: [currentPage updateThumbnailUrl. currentPage sqkPage computeThumbnail "just store it"].! !
!DockingBarMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 16:05'! wantsYellowButtonMenu "Answer true if the receiver wants a yellow button menu" ^ true! !
!EventRecorderMorph methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:52'! makeStatusLightIn: aPoint
^statusLight := EllipseMorph new extent: aPoint; color: Color green; borderWidth: 0! !
!GraphMorph methodsFor: 'accessing'! valueAtCursor: aPointOrNumber
data isEmpty ifTrue: [^ 0]. data at: ((cursor truncated max: 1) min: data size) put: (self asNumber: aPointOrNumber). self flushCachedForm. ! !
!GraphMorph methodsFor: 'commands'! appendValue: aPointOrNumber
| newVal | (data isKindOf: OrderedCollection) ifFalse: [data := data asOrderedCollection]. newVal := self asNumber: aPointOrNumber. data addLast: newVal. newVal < minVal ifTrue: [minVal := newVal]. newVal > maxVal ifTrue: [maxVal := newVal]. self cursor: data size. self flushCachedForm. ! !
!GraphMorph methodsFor: 'private' stamp: 'mt 8/14/2023 16:25'! asNumber: aPointOrNumber
^ aPointOrNumber isPoint ifTrue: [aPointOrNumber r] ifFalse: [aPointOrNumber]! !
!GraphicalDictionaryMenu methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'! initializeFor: aTarget fromDictionary: aDictionary "Initialize me for a target and a dictionary."
| anIndex aButton | self baseDictionary: aDictionary. target := aTarget. coexistWithOriginal := true. self extent: 210 @ 210. self clipSubmorphs: true. self layoutPolicy: ProportionalLayout new. aButton := (IconicButton new) borderWidth: 0; labelGraphic: (MenuIcons formAtKey: 'TinyMenu'); color: Color transparent; actWhen: #buttonDown; actionSelector: #showMenu; target: self; setBalloonText: 'menu'. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (-50 @ 6 extent: aButton extent)). aButton := (SimpleButtonMorph new) target: self; borderColor: Color black; label: 'Prev'; actionSelector: #downArrowHit; actWhen: #whilePressed; setBalloonText: 'show previous picture'; yourself. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (-24 @ 4 extent: aButton extent)). aButton := (SimpleButtonMorph new) target: self; borderColor: Color black; label: 'Next'; actionSelector: #upArrowHit; actWhen: #whilePressed; setBalloonText: 'show next pictutre'. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (24 @ 4 extent: aButton extent)). self addMorph: ((UpdatingStringMorph new) contents: ' '; target: self; putSelector: #renameGraphicTo:; getSelector: #truncatedNameOfGraphic; useStringFormat; setBalloonText: 'The name of the current graphic'; yourself) fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ 0) offsets: (10 @ 40 corner: -10 @ 60)). self addMorph: ((Morph new) extent: 100 @ 4; color: Color black) fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ 0) offsets: (0 @ 60 corner: 0 @ 64)). formDisplayMorph := (Thumbnail new) extent: 100 @ 100; useInterpolation: true; maxWidth: 300 minHeight: 100; yourself. formDisplayMorph layoutFrame: (LayoutFrame fractions: (0 @ 0 extent: 0@0) offsets: (8 @ 72 corner: 108 @ 172)). self addMorph: formDisplayMorph. self minimumExtent: 116@180. target ifNotNil: [(anIndex := formChoices indexOf: target form ifAbsent: []) ifNotNil: [currentIndex := anIndex]]. self updateThumbnail! !
!GraphicalDictionaryMenu methodsFor: 'menu commands' stamp: 'mt 8/16/2023 13:50'! repaintEntry "Let the user enter into painting mode to repaint the item and save it back."
| aWorld bnds sketchEditor aPaintBox formToEdit | (aWorld := self world) assureNotPaintingElse: [^ self].
formToEdit := formChoices at: currentIndex. bnds := (submorphs second boundsInWorld origin extent: formToEdit extent) intersect: aWorld bounds. bnds := bnds expandBy: 60@60. sketchEditor := SketchEditorMorph new. aWorld addMorphFront: sketchEditor. sketchEditor initializeFor: ((aWorld drawingClass withForm: formToEdit) position: submorphs second positionInWorld) inBounds: bnds pasteUpMorph: aWorld paintBoxPosition: bnds topRight. sketchEditor afterNewPicDo: [:aForm :aRect | formChoices at: currentIndex put: aForm. baseDictionary at: (entryNames at: currentIndex) put: aForm. self updateThumbnail. (aPaintBox := aWorld paintBoxOrNil) ifNotNil: [aPaintBox delete]] ifNoBits: [(aPaintBox := aWorld paintBoxOrNil) ifNotNil: [aPaintBox delete]]. ! !
!HandMorph methodsFor: 'paste buffer' stamp: 'mt 3/10/2023 14:49'! pasteMorph
| aPastee | PasteBuffer ifNil: [^ self inform: 'Nothing to paste.' translated]. self attachMorph: (aPastee := self objectToPaste). aPastee align: aPastee center with: self position.! !
!HandMorphForReplay methodsFor: 'event handling' stamp: 'mt 8/28/2023 14:05'! processEvents "Play back the next event"
| evt hadMouse hadAny tracker | suspended == true ifTrue: [^ self]. hadMouse := hadAny := false. tracker := recorder objectTrackingEvents. [(evt := recorder nextEventToPlay) isNil] whileFalse: [ ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self]. tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp]. evt type == #EOF ifTrue: [recorder pauseIn: self currentWorld. ^ self]. evt type == #startSound ifTrue: [evt argument play. recorder synchronize. ^ self].
evt isMouse ifTrue: [hadMouse := true]. (evt isMouse or: [evt isKeyboard]) ifTrue: [self handleEvent: (evt setHand: self) resetHandlerFields. hadAny := true]]. (mouseClickState notNil and: [hadMouse not]) ifTrue: ["No mouse events during this cycle. Make sure click states time out accordingly"
mouseClickState handleEvent: lastMouseEvent asMouseMove from: self]. hadAny ifFalse: ["No pending events. Make sure z-order is up to date"
self mouseOverHandler processMouseOver: lastMouseEvent]! !
!ImageMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:15'! setNewImageFrom: formOrNil "Change the receiver's image to be one derived from the supplied form. If nil is supplied, clobber any existing image in the receiver, and in its place put a default graphic, either the one known to the receiver as its default value"
formOrNil ifNotNil: [^ self image: formOrNil]. self image: (Form extent: 16@16 depth: 32) ! !
!GrabPatchMorph methodsFor: 'dropping' stamp: 'mt 8/14/2023 17:31'! wantsToBeDroppedInto: aMorph "Only into PasteUps that are not part bins"
^ aMorph isWorldMorph! !
!GrabPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:11'! initialize "Initialize the receiver. Emblazon the GrabPatch icon on its face"
super initialize. self image: (MenuIcons formAtKey: 'GrabPatch'). self setProperty: #ignorePartsBinDrop toValue: true! !
!GrabPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:11'! initializeToStandAlone "Initialize the receiver. Emblazon the GrabPatch icon on its face"
super initializeToStandAlone. self image: (MenuIcons formAtKey: 'GrabPatch')! !
!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'mt 8/23/2023 13:48'! insertNewProject
[MorphicProject openViewOn: nil] on: ProjectViewOpenNotification do: [ :ex | ex resume: false].! !
!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'mt 8/11/2023 14:44'! moreCommands "Put up a menu of options"
| allThreads aMenu others target | allThreads := self class knownThreads. aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'navigation' translated.
self flag: #deferred. "Probably don't want that stay-up item, not least because the navigation-keystroke stuff is not dynamically handled" aMenu addStayUpItem. others := (allThreads keys reject: [ :each | each = threadName]) asArray sort. others do: [ :each | aMenu add: ('switch to <{1}>' translated format:{each}) selector: #switchToThread: argument: each ].
aMenu addList: { {'switch to recent projects' translated. #getRecentThread}. #-. {'create a new thread' translated. #threadOfNoProjects}. {'edit this thread' translated. #editThisThread}. {'create thread of all projects' translated. #threadOfAllProjects}. #-. {'First project in thread' translated. #firstPage}. {'Last project in thread' translated. #lastPage} }.
(target := self currentIndex + 2) > listOfPages size ifFalse: [ aMenu add: ('skip over next project ({1})' translated format:{(listOfPages at: target - 1) first}) action: #skipOverNext ].
aMenu addList: { {'jump within this thread' translated. #jumpWithinThread}. {'insert new project' translated. #insertNewProject}. #-. {'simply close this navigator' translated. #delete}. {'destroy this thread' translated. #destroyThread}. #- }.
(self currentWorld keyboardNavigationHandler == self) ifFalse:[ aMenu add: 'start keyboard navigation with this thread' translated action: #startKeyboardNavigation ] ifTrue: [ aMenu add: 'stop keyboard navigation with this thread' translated action: #stopKeyboardNavigation ].
aMenu popUpInWorld.! !
!LassoPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'! initialize "Initialize the receiver. Sets its image to the lasso picture"
super initialize. self image: (MenuIcons formAtKey: 'Lasso')! !
!LassoPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'! initializeToStandAlone "Initialize the receiver such that it can live on its own. Sets its image to the lasso picture"
super initializeToStandAlone. self image: (MenuIcons formAtKey: 'Lasso')! !
!Morph class methodsFor: 'fileIn/Out' stamp: 'mt 3/8/2023 09:07'! fromFileName: fullName "Reconstitute a Morph from the file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world"
| aFileStream morphOrList | aFileStream := (MultiByteBinaryOrTextStream with: ((FileStream readOnlyFileNamed: fullName) binary contentsOfEntireFile)) binary reset. morphOrList := aFileStream fileInObjectAndCode. Project current world addMorphsAndModel: morphOrList.! !
!Morph class methodsFor: '*MorphicExtras-parts bin' stamp: 'mt 8/4/2023 14:43'! supplementaryPartsDescriptions "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
^ {DescriptionForPartsBin formalName: 'NextPage' translatedNoop categoryList: {'Multimedia' translatedNoop} documentation: 'A button which, when clicked, takes the reader to the next page of a book' translatedNoop globalReceiverSymbol: #BookMorph nativitySelector: #nextPageButton. DescriptionForPartsBin formalName: 'PreviousPage' translatedNoop categoryList: {'Multimedia'} documentation: 'A button which, when clicked, takes the reader to the previous page of a book' translatedNoop globalReceiverSymbol: #BookMorph nativitySelector: #previousPageButton.}! !
!GraphicalDictionaryMenu class methodsFor: 'example' stamp: 'mt 7/31/2023 11:13'! example "GraphicalDictionaryMenu example" | aDict | aDict := Dictionary new. #('ColorTilesOff' 'ColorTilesOn' 'Controls') do: [:aString | aDict at: aString put: (MenuIcons formAtKey: aString)]. self openOn: aDict withLabel: 'Testing One Two Three'! !
!ImageMorph class methodsFor: 'scripting' stamp: 'mt 3/15/2023 14:10'! authoringPrototype | aMorph aForm | aMorph := super authoringPrototype. aForm := MenuIcons formAtKey: 'Image'. aForm ifNil: [aForm := aMorph image rotateBy: 90]. aMorph image: aForm. ^ aMorph! !
!GrabPatchMorph class methodsFor: 'instance creation' stamp: 'mt 7/31/2023 11:11'! authoringPrototype "Answer a prototype for use in a parts bin"
^ self new image: (MenuIcons formAtKey: 'GrabPatch'); markAsPartsDonor; setBalloonText: 'Use this to grab a rectangular patch from the screen'; yourself! !
!LassoPatchMorph class methodsFor: 'instance creation' stamp: 'mt 7/31/2023 11:13'! authoringPrototype "Answer a prototype for use in a parts bin"
^ self new image: (MenuIcons formAtKey: 'Lasso'); markAsPartsDonor; setBalloonText: 'Drop this on the desktop and you can then grab a patch from the screen with a lasso.'; yourself! !
!MorphExtension methodsFor: 'accessing - other properties' stamp: 'mt 3/10/2023 14:57'! sortedPropertyNames "answer the receiver's property names in a sorted way"
| props | props := WriteStream on: (Array new: 10). locked == true ifTrue: [props nextPut: #locked]. visible == false ifTrue: [props nextPut: #visible]. sticky == true ifTrue: [props nextPut: #sticky]. balloonText isNil ifFalse: [props nextPut: #balloonText]. balloonTextSelector isNil ifFalse: [props nextPut: #balloonTextSelector]. externalName isNil ifFalse: [props nextPut: #externalName]. isPartsDonor == true ifTrue: [props nextPut: #isPartsDonor]. actorState isNil ifFalse: [props nextPut: #actorState]. eventHandler isNil ifFalse: [props nextPut: #eventHandler]. otherProperties ifNotNil: [otherProperties associationsDo: [:a | props nextPut: a key]]. ^props contents sort: [:s1 :s2 | s1 <= s2]! !
!MorphExtension methodsFor: 'connectors-copying' stamp: 'mt 3/10/2023 16:11'! veryDeepInner: deepCopier "Copy all of my instance variables. Some otherProperties need to be not copied at all, but shared. Their names are given by copyWeakly. Some otherProperties should not be copied or shared. Their names are given by propertyNamesNotCopied. This is special code for the dictionary. See DeepCopier, and veryDeepFixupWith:."
| namesOfWeaklyCopiedProperties weaklyCopiedValues | super veryDeepInner: deepCopier. locked := locked veryDeepCopyWith: deepCopier. visible := visible veryDeepCopyWith: deepCopier. sticky := sticky veryDeepCopyWith: deepCopier. balloonText := balloonText veryDeepCopyWith: deepCopier. balloonTextSelector := balloonTextSelector veryDeepCopyWith: deepCopier. externalName := externalName veryDeepCopyWith: deepCopier. isPartsDonor := isPartsDonor veryDeepCopyWith: deepCopier. actorState := actorState veryDeepCopyWith: deepCopier. eventHandler := eventHandler veryDeepCopyWith: deepCopier. "has its own restrictions"
otherProperties ifNil: [ ^self ].
otherProperties := otherProperties copy. self propertyNamesNotCopied do: [ :propName | otherProperties removeKey: propName ifAbsent: [] ].
namesOfWeaklyCopiedProperties := self copyWeakly. weaklyCopiedValues := namesOfWeaklyCopiedProperties collect: [ :propName | otherProperties removeKey: propName ifAbsent: [] ].
"Now copy all the others." otherProperties := otherProperties veryDeepCopyWith: deepCopier.
"And replace the weak ones." namesOfWeaklyCopiedProperties with: weaklyCopiedValues do: [ :name :value | value ifNotNil: [ otherProperties at: name put: value ]]. ! !
!MorphExtension methodsFor: 'other' stamp: 'mt 3/10/2023 16:11'! isDefault "Return true if the receiver is a default and can be omitted" locked == true ifTrue: [^ false]. visible == false ifTrue: [^ false]. sticky == true ifTrue: [^ false]. balloonText isNil ifFalse: [^ false]. balloonTextSelector isNil ifFalse: [^ false]. externalName isNil ifFalse: [^ false]. isPartsDonor == true ifTrue: [^ false]. actorState isNil ifFalse: [^ false]. eventHandler isNil ifFalse: [^ false]. otherProperties ifNotNil: [otherProperties isEmpty ifFalse: [^ false]]. ^ true! !
!MorphExtension methodsFor: 'printing' stamp: 'mt 3/10/2023 16:11'! printOn: aStream "Append to the argument, aStream, a sequence of characters that identifies the receiver." super printOn: aStream. aStream nextPutAll: ' ' , self identityHashPrintString. locked == true ifTrue: [aStream nextPutAll: ' [locked] ']. visible == false ifTrue: [aStream nextPutAll: '[not visible] ']. sticky == true ifTrue: [aStream nextPutAll: ' [sticky] ']. balloonText ifNotNil: [aStream nextPutAll: ' [balloonText] ']. balloonTextSelector ifNotNil: [aStream nextPutAll: ' [balloonTextSelector: ' , balloonTextSelector printString , '] ']. externalName ifNotNil: [aStream nextPutAll: ' [externalName = ' , externalName , ' ] ']. isPartsDonor == true ifTrue: [aStream nextPutAll: ' [isPartsDonor] ']. eventHandler ifNotNil: [aStream nextPutAll: ' [eventHandler = ' , eventHandler printString , '] ']. (otherProperties isNil or: [otherProperties isEmpty ]) ifTrue: [^ self]. aStream nextPutAll: ' [other: '. self otherProperties keysDo: [:aKey | aStream nextPutAll: ' (' , aKey , ' -> ' , (self otherProperties at: aKey) printString , ')']. aStream nextPut: $]! !
!MorphHierarchy class methodsFor: 'opening' stamp: 'mt 8/4/2023 14:46'! openOrDelete | oldMorph | oldMorph := Project current world submorphs detect: [:each | each hasProperty: #morphHierarchy] ifNone: [| newMorph | newMorph := self new asMorph. newMorph bottomLeft: self currentHand position. newMorph openInWorld. ^ self]. "" oldMorph delete! !
!MorphListItemWrapper methodsFor: 'accessing' stamp: 'mt 3/10/2023 16:07'! contents "Answer the receiver's contents"
| tentative submorphs | tentative := item submorphs collect: [:each | each renderedMorph].
submorphs := tentative reject: [:each | each isKindOf: HaloMorph].
^ submorphs collect: [:each | self class with: each]! !
!MorphicModel methodsFor: 'submorphs - accessing' stamp: 'mt 3/10/2023 14:52'! allKnownNames "Return a list of all known names based on the scope of the receiver. If the receiver is a member of a uniclass, incorporate the original 1997 logic that queries the known names of the values of all the instance variables."
| superNames | superNames := super allKnownNames. "gather them from submorph tree" ^self class isUniClass ifTrue: [superNames , (self instanceVariableValues select: [:e | e notNil and: [e knownName notNil]] thenCollect: [:e | e knownName])] ifFalse: [superNames]! !
!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 3/8/2023 11:01'! copyFromRootsForExport: rootArray "When possible, use copySmartRootsExport:. This way may not copy a complete tree of objects. Add to roots: all of the methods pointed to from the outside by blocks." | newRoots segSize symbolHolder | arrayOfRoots := rootArray. "self halt." symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers, so they will be in outPointers" "Creation of the segment happens here" self copyFromRoots: arrayOfRoots sizeHint: 0. segSize := segment size. [(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize]. "with methods pointed at from outside" [(newRoots := self rootsIncludingBlocks) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize]. "with methods, blocks from outPointers" "Zap sender of a homeContext. Can't send live stacks out." "Why not? eem 7/3/2017 15:31" 1 to: outPointers size do: [:ii | | outPointer | outPointer := outPointers at: ii. (outPointer isBlock or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil]]. symbolHolder size "Keep reference to symbolHolder until the last"! !
!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/28/2023 15:10'! copyFromRootsLocalFileFor: rootArray sizeHint: segSize
arrayOfRoots := rootArray. self copyFromRoots: arrayOfRoots sizeHint: segSize.! !
!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/28/2023 15:40'! copySmartRootsExport: rootArray "Use SmartRefStream to find the object. Make them all roots. Create the segment in memory. Project should be in first five objects in rootArray." | newRoots segSize symbolHolder replacements naughtyBlocks allClasses sizeHint proj dummy world |
world := Project current world. symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers, so they will be in outPointers"
dummy := ReferenceStream on: (DummyStream on: nil). "Write to a fake Stream, not a file" "Collect all objects" dummy insideASegment: true. "So Uniclasses will be traced" dummy rootObject: rootArray. "inform him about the root" dummy nextPut: rootArray. (proj :=dummy project) ifNotNil: [self dependentsSave: dummy]. allClasses := SmartRefStream new uniClassInstVarsRefs: dummy. "catalog the extra objects in UniClass inst vars. Put into dummy" allClasses do: [:cls | dummy references at: cls class put: false. "put MorphicModel5 class in roots" dummy blockers removeKey: cls class ifAbsent: []]. "refs := dummy references." arrayOfRoots := self smartFillRoots: dummy. "guaranteed none repeat" replacements := dummy blockers. dummy project "recompute it" ifNil: [self error: 'lost the project!!']. dummy project class == DiskProxy ifTrue: [self error: 'saving the wrong project']. dummy := nil. "Allow dummy to be GC'ed below (bytesLeft)." naughtyBlocks := arrayOfRoots select: [ :each | each isContext and: [each hasInstVarRef]].
"since the caller switched ActiveWorld, put the real one back temporarily" naughtyBlocks isEmpty ifFalse: [world becomeActiveDuring: [world firstHand becomeActiveDuring: [ | goodToGo | goodToGo := (Project uiManager chooseOptionFrom: #('keep going' 'stop and take a look') title: 'Some block(s) which reference instance variables are included in this segment. These may fail when the segment is loaded if the class has been reshaped. What would you like to do?') = 1. goodToGo ifFalse: [naughtyBlocks inspect. self error: 'Here are the bad blocks']]]]. "Creation of the segment happens here"
"try using one-quarter of memory min: four megs to publish (will get bumped up later if needed)" sizeHint := (Smalltalk bytesLeft // 4 // 4) min: 1024*1024. self copyFromRoots: arrayOfRoots sizeHint: sizeHint areUnique: true. segSize := segment size. [(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true]. "with methods pointed at from outside" [(newRoots := self rootsIncludingBlocks) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true]. "with methods, blocks from outPointers" 1 to: outPointers size do: [:ii | | outPointer | outPointer := outPointers at: ii. (outPointer isBlock or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil]. "substitute new object in outPointers" (replacements includesKey: outPointer) ifTrue: [outPointers at: ii put: (replacements at: outPointer)]]. proj ifNotNil: [self dependentsCancel: proj]. symbolHolder. "hold onto symbolHolder until the last."! !
!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/16/2023 16:58'! smartFillRoots: dummy | refs known ours ww blockers | "Put all traced objects into my arrayOfRoots. Remove some that want to be in outPointers. Return blockers, an IdentityDictionary of objects to replace in outPointers."
blockers := dummy blockers. known := (refs := dummy references) size. refs keys do: [:obj | "copy keys to be OK with removing items" (obj isSymbol) ifTrue: [refs removeKey: obj. known := known-1]. (obj class == PasteUpMorph) ifTrue: [ obj isWorldMorph & (obj owner == nil) ifTrue: [ (dummy project ~~ nil and: [obj == dummy project world]) ifFalse: [ refs removeKey: obj. known := known-1. blockers at: obj put: (StringMorph contents: 'The worldMorph of a different world')]]]. "Make a ProjectViewMorph here" "obj class == Project ifTrue: [Transcript show: obj; cr]." (blockers includesKey: obj) ifTrue: [ refs removeKey: obj ifAbsent: [known := known+1]. known := known-1]. ]. ours := (dummy project ifNil: [Project current]) world. refs keysDo: [:obj | obj isMorph ifTrue: [ ww := obj world. (ww == ours) | (ww == nil) ifFalse: [ refs removeKey: obj. known := known-1. blockers at: obj put: (StringMorph contents: obj printString, ' from another world')]]]. "keep original roots on the front of the list" dummy rootObject do: [:rr | refs removeKey: rr ifAbsent: []]. ^dummy rootObject, refs keys asArray! !
!NativeImageSegment methodsFor: 'testing' stamp: 'mt 3/8/2023 11:01'! findRogueRootsImSeg: rootArray "This is a tool to track down unwanted pointers into the segment. If we don't deal with these pointers, the segment turns out much smaller than it should. These pointers keep a subtree of objects out of the segment. 1) Break all owner pointers in submorphs and all scripts. 2) Create the segment and look at outPointers. 3) Remove those we expect. 4) Remember to quit without saving -- the owner pointers are smashed."
| suspects bag1 bag2 | arrayOfRoots := rootArray. self findRogueRootsPrep. "and free that context!!" Smalltalk garbageCollect. self copyFromRoots: arrayOfRoots sizeHint: 0.
suspects := outPointers select: [:oo | oo isMorph]. suspects size > 0 ifTrue: [suspects inspect]. bag1 := Bag new. bag2 := Bag new. outPointers do: [:key | (key isKindOf: Class) ifTrue: [bag2 add: key class name] ifFalse: [(#(Symbol Point Rectangle True False String Float Color Form ColorForm StrikeFont Metaclass UndefinedObject TranslucentColor) includes: key class name) ifTrue: [bag2 add: key class name] ifFalse: [bag1 add: key class name]]]. "(bag sortedCounts) is the SortedCollection" (StringHolder new contents: bag1 sortedCounts printString, '
', bag2 sortedCounts printString) openLabel: 'Objects pointed at by the outside'. self halt: 'Examine local variables pointIn and inSeg'.
"Use this in inspectors: outPointers select: [:oo | oo class == <a Class>]. " ! !
!NativeImageSegment methodsFor: 'testing' stamp: 'mt 3/10/2023 15:12'! findRogueRootsPrep "Part of the tool to track down unwanted pointers into the segment. Break all owner pointers in submorphs, scripts, and viewers in flaps."
| wld morphs | wld := arrayOfRoots detect: [:obj | obj isMorph ifTrue: [obj isWorldMorph] ifFalse: [false]] ifNone: [nil]. wld ifNil: [wld := arrayOfRoots detect: [:obj | obj isMorph] ifNone: [^ self error: 'can''t find a root morph']]. morphs := IdentitySet new: 400. wld allMorphsDo: [:m | morphs add: m]. morphs do: [:mm | "break the back pointers" mm isInMemory ifTrue: [ (mm respondsTo: #target) ifTrue: [ mm nearestOwnerThat: [:ow | ow == mm target ifTrue: [mm target: nil. true] ifFalse: [false]]]. (mm respondsTo: #arguments) ifTrue: [ mm arguments do: [:arg | arg ifNotNil: [ mm nearestOwnerThat: [:ow | ow == arg ifTrue: [mm arguments at: (mm arguments indexOf: arg) put: nil. true] ifFalse: [false]]]]]. mm eventHandler ifNotNil: ["recipients point back up" (morphs includesAllOf: (mm eventHandler allRecipients)) ifTrue: [ mm eventHandler: nil]]. "temporary, until using Model for PartsBin" (mm isMorphicModel) ifTrue: [ (mm model isMorphicModel) ifTrue: [ mm model breakDependents]]. (mm isTextMorph) ifTrue: [mm setContainer: nil]]]. (Smalltalk includesKey: #Owners) ifTrue: [Smalltalk at: #Owners put: nil]. "in case findOwnerMap: is commented out" "self findOwnerMap: morphs." morphs do: [:mm | "break the back pointers" mm isInMemory ifTrue: [mm privateOwner: nil]]. "more in extensions?" ! !
!NebraskaCommunicatorMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/11/2023 13:59'! textEntryFieldNamed: aSymbol with: aString help: helpString
| f col | f := (StringMorph new contents: aString; font: Preferences standardDefaultTextFont; yourself) setBalloonText: helpString; on: #mouseUp send: #editEvent:for: to: self. self field: aSymbol is: f. col := (self inAColumn: {f}) color: Color white; hResizing: #shrinkWrap. ^col! !
!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:52'! acceptTo: someText forMorph: aMorph
| betterText |
betterText := self improveText: someText forMorph: aMorph. self transmitStreamedObject: (SmartRefStream streamedRepresentationOf: betterText) to: self ipAddress. aMorph setText: '' asText. self appendMessage: self startOfMessageFromMe, ' - ', betterText, String cr.
^true! !
!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:56'! appendMessage: aText
receivingPane setText: (receivingPane text append: aText).! !
!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:54'! improveText: someText forMorph: aMorph
| betterText conversions fontForAll |
fontForAll := TextStyle default. betterText := someText veryDeepCopy. conversions := OrderedCollection new. betterText runs withStartStopAndValueDo: [:start :stop :attributes | attributes do: [:att | (att isMemberOf: TextFontChange) ifTrue: [ conversions add: {att. start. stop} ] ] ]. conversions do: [ :old | | newAttr | betterText removeAttribute: old first from: old second to: old third. newAttr := TextFontReference toFont: (fontForAll fontAt: old first fontNumber). newAttr fontNumber: old first fontNumber. betterText addAttribute: newAttr from: old second to: old third. ]. ^betterText! !
!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:57'! reportError: aString
receivingPane setText: (receivingPane text append: (aString asText addAttribute: TextColor red), String cr).! !
!NebraskaFridgeMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:52'! acceptDroppingMorph: morphToDrop event: evt
| outData |
(morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt ]. self eToyRejectDropMorph: morphToDrop event: evt. "we will keep a copy" (morphToDrop isKindOf: NebraskaSenderMorph) ifTrue: [ self class addRecipient: morphToDrop. ^self rebuild ]. self stopFlashing. "7 mar 2001 - remove #veryDeepCopy" outData := SmartRefStream streamedRepresentationOf: morphToDrop. self resetIndicator: #working. self class fridgeRecipients do: [ :each | self transmitStreamedObject: outData to: each ipAddress ].
! !
!NebraskaMorphsWelcomeMorph methodsFor: 'initialization' stamp: 'mt 8/11/2023 13:59'! initialize "initialize the state of the receiver" | earMorph | super initialize. "" self layoutInset: 8 @ 8. "earMorph := (EToyListenerMorph makeListeningToggle: true) asMorph." earMorph := TextMorph new contents: 'Morphs welcome here'; fontName: Preferences standardDefaultTextFont familyName size: 18; centered; lock. self addARow: {earMorph}. self setBalloonText: 'My presence in this world means received morphs may appear automatically' translated! !
!NebraskaMultiChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:52'! acceptTo: someText forMorph: aMorph
| streamedMessage betterText |
betterText := self improveText: someText forMorph: aMorph. streamedMessage := SmartRefStream streamedRepresentationOf: {targetIPAddresses. betterText}. targetIPAddresses do: [ :each | self transmitStreamedObject: streamedMessage to: each. ]. aMorph setText: '' asText. self appendMessage: self startOfMessageFromMe, ' - ', betterText, String cr.
^true! !
!NebraskaSenderMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:53'! acceptDroppingMorph: morphToDrop event: evt
| myCopy outData |
(morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it"
"7 mar 2001 - remove #veryDeepCopy" myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position. self stopFlashing.
outData := SmartRefStream streamedRepresentationOf: myCopy. self resetIndicator: #working. self transmitStreamedObject: outData to: self ipAddress.
! !
!NebraskaSenderMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:53'! sendStatusReply
| null | null := String with: 0 asCharacter. NebraskaPeerToPeer new sendSomeData: { NebraskaIncomingMessage typeStatusReply,null. Preferences defaultAuthorName,null. (SmartRefStream streamedRepresentationOf: (NebraskaGateKeeperMorph acceptableTypesFor: self ipAddress)). } to: self ipAddress for: self. ! !
!NebraskaServerMorph methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:54'! rebuild
| myServer toggle closeBox font |
font := StrikeFont familyName: #Palatino size: 14. self removeAllMorphs. self setColorsAndBorder. self updateCurrentStatusString. toggle := SimpleHierarchicalListMorph new perform: ( fullDisplay ifTrue: [#expandedForm] ifFalse: [#notExpandedForm] ). closeBox := SimpleButtonMorph new borderWidth: 0; label: 'X' font: Preferences standardButtonFont; color: Color transparent; actionSelector: #delete; target: self; extent: 14@14; setBalloonText: 'End Nebraska session' translated.
self addARow: { self inAColumn: {closeBox}. self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentStatusString; contents: self currentStatusString; stepTime: 2000; lock. }. self inAColumn: { toggle asMorph on: #mouseUp send: #toggleFull to: self; setBalloonText: 'Show more or less of Nebraska Status' translated }. }. myServer := self server. (myServer isNil or: [fullDisplay not]) ifTrue: [ ^self world startSteppingSubmorphsOf: self ]. "--- the expanded display ---" self addARow: { self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentBacklogString; contents: self currentBacklogString; stepTime: 2000; lock. }. }.
self addARow: { self inAColumn: { (StringMorph contents: '--clients--' translated) lock; font: font. }. }.
myServer clients do: [ :each | self addARow: { UpdatingStringMorph new useStringFormat; target: each; font: font; getSelector: #currentStatusString; contents: each currentStatusString; stepTime: 2000; lock. } ]. self world startSteppingSubmorphsOf: self.! !
!NebraskaServerMorph methodsFor: 'initialization' stamp: 'mt 8/23/2023 13:26'! setColorsAndBorder
self color: (Color r: 0.9 g: 0.9 b: 0.9). self borderStyle: (BorderStyle raised width: 1). self useRoundedCorners! !
!NetworkTerminalMorph methodsFor: 'events-processing' stamp: 'mt 8/14/2023 11:29'! handleMouseDown: anEvent anEvent wasHandled ifTrue:[^self]. anEvent hand removePendingBalloonFor: self. anEvent wasHandled: true. anEvent hand newMouseFocus: self event: anEvent. anEvent hand removeHaloFromClick: anEvent on: self. self sendEventAsIs: anEvent.! !
!NetworkTerminalMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:53'! acceptDroppingMorph: morphToDrop event: evt
| myCopy outData null |
(morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it"
"7 mar 2001 - remove #veryDeepCopy" myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position.
outData := SmartRefStream streamedRepresentationOf: myCopy. null := String with: 0 asCharacter. NebraskaPeerToPeer new sendSomeData: { NebraskaIncomingMessage typeMorph,null. Preferences defaultAuthorName,null. outData } to: connection remoteSocketAddress hostNumber for: self. ! !
!NewHandleMorph methodsFor: 'initialization' stamp: 'mt 3/10/2023 16:07'! initialize "initialize the state of the receiver"
super initialize. "" waitingForClickInside := true.! !
!ObjectExplorer methodsFor: 'menus' stamp: 'mt 8/28/2023 14:40'! explorerKey: aChar from: view event: event
event anyModifierKeyPressed ifFalse: [^ false].
self object ifNotNil: [ aChar == $i ifTrue: [self inspectSelection. ^ true]. aChar == $I ifTrue: [self exploreSelection. ^ true].
aChar == $b ifTrue: [self browseFull. ^ true]. aChar == $h ifTrue: [self browseClassHierarchy. ^ true]. aChar == $c ifTrue: [self copyName. ^ true]. aChar == $p ifTrue: [self browseFullProtocol. ^ true]. aChar == $N ifTrue: [self browseClassRefs. ^ true]].
^ false! !
!ObjectlandMorph methodsFor: 'projects' stamp: 'mt 8/11/2023 15:16'! fillObjectlandProject
^ self fillObjectlandProjectWith: { self createGamesProject. self createGraphicsProject. self createToolsProject. self createSoundsProject }! !
!ObjectsTool methodsFor: 'search' stamp: 'mt 8/11/2023 13:59'! newSearchPane "Answer a type-in pane for searches"
| aTextMorph | aTextMorph := TextMorph new setProperty: #defaultContents toValue: ('' asText allBold addAttribute: (TextFontChange font3)); setTextStyle: (TextStyle fontArray: { Preferences standardDefaultTextFont }); setDefaultContentsIfNil; on: #keyStroke send: #searchPaneCharacter: to: self; setNameTo: 'SearchPane'; setBalloonText: 'Type here and all entries that match will be shown.' translated; vResizing: #shrinkWrap; hResizing: #spaceFill; margins: 4 px @ 6 px; backgroundColor: Color white. ^ aTextMorph! !
!PackageDependencyTest methodsFor: 'tests' stamp: 'mt 3/15/2023 14:59'! testMorphic self testPackage: #Morphic dependsExactlyOn: #( Balloon #'Chronology-Core' Collections Compiler Compression Files Graphics 'Installer-Core' "Because of TheWorldMainDockingBar's install feature ..." Kernel MonticelloConfigurations MorphicExtras Multilingual Network Sound System SystemReporter #'ToolBuilder-Kernel' #'ToolBuilder-Morphic' Tools TrueType ).! !
!PackageDependencyTest methodsFor: 'failures' stamp: 'mt 3/15/2023 14:58'! expectedFailures
^ #(testSystem testTools)! !
!PaintBoxMorph methodsFor: 'actions' stamp: 'mt 8/10/2023 15:31'! currentColor: aColor
currentColor := aColor.! !
!PaintBoxMorph methodsFor: 'initialization' stamp: 'mt 8/28/2023 14:39'! addLabels
self addGraphicLabels ifFalse: [self addTextualLabels].! !
!PaintBoxMorph methodsFor: 'initialization' stamp: 'mt 8/10/2023 15:30'! beSupersized "Not supported."! !
!PaintBoxMorph methodsFor: 'other' stamp: 'mt 8/28/2023 14:39'! offsetFromMaxBounds "location of normal PaintBox within maxBounds." | left | left := self left. self flag: #useBiggerPaintingBox. left := left - (( self width * 1.5)- self width). ^ left - colorMemory left @ 0! !
!PaintBoxMorph class methodsFor: 'instance creation' stamp: 'mt 8/28/2023 15:42'! new
| pb | pb := self prototype veryDeepCopy. pb stampHolder normalize. "Get the stamps to show" "Get my own copies of the brushes so I can modify them" #(brush1: brush2: brush3: brush4: brush5: brush6:) do: [:sel | | dualUse button | button := pb submorphNamed: sel. button offImage: button offImage deepCopy. dualUse := button onImage == button pressedImage. "sometimes shared" button onImage: button onImage deepCopy. dualUse ifTrue: [button pressedImage: button onImage] ifFalse: [button pressedImage: button pressedImage deepCopy]. ]. pb showColor. pb fixUpRecentColors. pb addLabels. ^ pb! !
!ParagraphEditor methodsFor: 'editing keys' stamp: 'mt 8/11/2023 14:44'! changeEmphasis: characterStream "Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change. Keeps typeahead." | keyCode attribute oldAttributes index thisSel colors extras |
"control 0..9 -> 0..9" keyCode := ('0123456789' indexOf: sensor keyboard ifAbsent: [1]) - 1.
oldAttributes := paragraph text attributesAt: self pointIndex forStyle: paragraph textStyle. thisSel := self selection.
"Decipher keyCodes for Command 0-9..." "(keyCode between: 1 and: 5) ifTrue: [ attribute := TextFontChange fontNumber: keyCode ]."
keyCode = 5 ifTrue: [ | labels lines | colors := #(#black #magenta #red #yellow #green #blue #cyan #white ). extras := #('Link to comment of class' 'Link to definition of class' 'Link to hierarchy of class' 'Link to method' ).
labels := colors , #('choose color...' 'Do it' 'Print it' ) , extras , #('be a web URL link' 'Edit hidden info' 'Copy hidden info' ). lines := Array with: colors size + 1.
"index := (PopUpMenu labelArray: labels lines: lines) startUp. " index := UIManager default chooseFrom: labels lines: lines. index = 0 ifTrue: [ ^ true]. index <= colors size ifTrue: [ attribute := TextColor color: (Color perform: (colors at: index)) ] ifFalse: [ index := index - colors size - 1. "Re-number!!!!!!"
index = 0 ifTrue: [ attribute := self chooseColor ].
index = 1 ifTrue: [ attribute := TextDoIt new. thisSel := attribute analyze: self selection asString ].
index = 2 ifTrue: [ attribute := TextPrintIt new. thisSel := attribute analyze: self selection asString ].
extras size = 0 & (index > 2) ifTrue: [ index := index + 4 "skip those" ].
index = 3 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Comment' ].
index = 4 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Definition' ].
index = 5 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Hierarchy' ].
index = 6 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString ]. index = 7 ifTrue: [ attribute := TextURL new. thisSel := attribute analyze: self selection asString ]. index = 8 ifTrue: [ "Edit hidden info" thisSel := self hiddenInfo. "includes selection" attribute := TextEmphasis normal ].
index = 9 ifTrue: [ "Copy hidden info" self copyHiddenInfo. ^ true ]. "no other action" thisSel ifNil: [ ^ true ] ] ].
(keyCode between: 6 and: 9) ifTrue: [ sensor leftShiftDown ifTrue: [ keyCode = 6 ifTrue: [ attribute := TextKern kern: -1 ]. keyCode = 7 ifTrue: [ attribute := TextKern kern: 1 ] ] ifFalse: [ "And remember this: nine is fine for underline, obliter-eight it as you see fit, seven has been bold for ever'n, which leaves six as the obivous fix to emphasize your poetics." attribute := TextEmphasis perform: (#(italic bold struckOut underlined) at: keyCode - 5). oldAttributes do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]] ] ].
keyCode = 0 ifTrue: [attribute := TextEmphasis normal].
attribute ifNil: [^ true].
beginTypeInBlock ~~ nil ifTrue: [ "only change emphasisHere while typing" self insertTypeAhead: characterStream. emphasisHere := Text addAttribute: attribute toArray: oldAttributes. ^ true ].
self replaceSelectionWith: (thisSel asText addAttribute: attribute). ^ true ! !
!ParagraphEditor class methodsFor: 'class initialization' stamp: 'mt 8/11/2023 14:47'! yellowButtonMenu
^ SelectionMenu fromArray: StringHolder yellowButtonMenuItems! !
!ParagraphEditor class methodsFor: 'keyboard shortcut tables' stamp: 'mt 8/11/2023 14:45'! initializeCmdKeyShortcuts "Initialize the (unshifted) command-key (or alt-key) shortcut table."
"NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"
"ParagraphEditor initialize"
| cmdMap |
cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash"
cmdMap at: 1 + 1 put: #cursorHome:. "home key" cmdMap at: 4 + 1 put: #cursorEnd:. "end key" cmdMap at: 8 + 1 put: #backspace:. "ctrl-H or delete key" cmdMap at: 11 + 1 put: #cursorPageUp:. "page up key" cmdMap at: 12 + 1 put: #cursorPageDown:. "page down key" cmdMap at: 13 + 1 put: #crWithIndent:. "cmd-Return" cmdMap at: 27 + 1 put: #offerMenuFromEsc:. "escape key" cmdMap at: 28 + 1 put: #cursorLeft:. "left arrow key" cmdMap at: 29 + 1 put: #cursorRight:. "right arrow key" cmdMap at: 30 + 1 put: #cursorUp:. "up arrow key" cmdMap at: 31 + 1 put: #cursorDown:. "down arrow key" cmdMap at: 32 + 1 put: #selectWord:. "space bar key" cmdMap at: 127 + 1 put: #forwardDelete:. "del key"
'0123456789' do: [:char | cmdMap at: char asciiValue + 1 put: #changeEmphasis:].
"triplet = {character. comment selector. novice appropiated}" #( ($a #selectAll: ) ($b #browseIt: ) ($c #copySelection: ) ($d #doIt: ) ($e #exchange: ) ($f #find: ) ($g #findAgain: ) ($h #setSearchString: ) ($i #inspectIt: ) ($j #doAgainOnce: ) ($k #offerFontMenu: ) ($l #cancel: ) ($m #implementorsOfIt: ) ($n #sendersOfIt: ) ($o #spawnIt: ) ($p #printIt: ) ($q #querySymbol: ) ($s #save: ) ($t #tempCommand: ) ($u #align: ) ($v #paste: ) ($w #backWord: ) ($x #cut: ) ($y #swapChars: ) ($z #undo: ) ) do:[:triplet | cmdMap at: triplet first asciiValue + 1 put: triplet second].
CmdActions := cmdMap. ! !
!ParagraphEditor class methodsFor: 'keyboard shortcut tables' stamp: 'mt 8/11/2023 14:46'! initializeShiftCmdKeyShortcuts "Initialize the shift-command-key (or control-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the capitalized versions of the letters. TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values."
| cmdMap |
"shift-command and control shortcuts" cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash"
cmdMap at: ( 1 + 1) put: #cursorHome:. "home key" cmdMap at: ( 4 + 1) put: #cursorEnd:. "end key" cmdMap at: ( 8 + 1) put: #forwardDelete:. "ctrl-H or delete key" cmdMap at: (11 + 1) put: #cursorPageUp:. "page up key" cmdMap at: (12 + 1) put: #cursorPageDown:. "page down key" cmdMap at: (13 + 1) put: #crWithIndent:. "ctrl-Return" cmdMap at: (27 + 1) put: #offerMenuFromEsc:. "escape key" cmdMap at: (28 + 1) put: #cursorLeft:. "left arrow key" cmdMap at: (29 + 1) put: #cursorRight:. "right arrow key" cmdMap at: (30 + 1) put: #cursorUp:. "up arrow key" cmdMap at: (31 + 1) put: #cursorDown:. "down arrow key" cmdMap at: (32 + 1) put: #selectWord:. "space bar key" cmdMap at: (45 + 1) put: #changeEmphasis:. "cmd-sh-minus" cmdMap at: (61 + 1) put: #changeEmphasis:. "cmd-sh-plus" cmdMap at: (127 + 1) put: #forwardDelete:. "del key"
"triplet = {character. comment selector. novice appropiated}" #( ($a argAdvance: ) ($b browseItHere: ) ($c compareToClipboard: ) ($d debugIt: ) ($e methodStringsContainingIt:) ($f displayIfFalse: ) ($g fileItIn: ) ($h cursorTopHome: ) ($i exploreIt: ) ($j doAgainMany: ) ($k changeStyle: ) ($m selectCurrentTypeIn: ) ($n referencesToIt: ) ($p makeProjectLink: ) ($s search: ) ($t displayIfTrue: ) ($u changeLfToCr: ) ($v pasteInitials: ) ($w methodNamesContainingIt:) ($x makeLowercase: ) ($y makeUppercase: ) ($z makeCapitalized: ) ) do:[:triplet | cmdMap at: (triplet first asciiValue + 1) put: triplet second. "plain keys" cmdMap at: (triplet first asciiValue - 32 + 1) put: triplet second. "shifted keys" cmdMap at: (triplet first asciiValue - 96 + 1) put: triplet second. "ctrl keys" ].
ShiftCmdActions := cmdMap! !
!PasteUpMorph methodsFor: 'accessing' stamp: 'mt 8/11/2023 16:19'! flapTab "Answer the tab affilitated with the receiver. Normally every flap tab is expected to have a PasteUpMorph which serves as its 'referent.'"
self isFlap ifFalse: [^ nil]. ^ self flapTabs detect: [:any| any referent == self] ifNone: [nil]! !
!PasteUpMorph methodsFor: 'caching' stamp: 'mt 3/10/2023 15:07'! releaseCachedState super releaseCachedState. self isWorldMorph ifTrue:[self cleanseStepList].! !
!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'mt 8/14/2023 17:42'! acceptDroppingMorph: dropped event: evt "The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied"
| aMorph | (self isWorldMorph and: [dropped isTransferMorph] and: [self hasTransferMorphConverter not]) ifTrue: [ dropped dragTransferType = #filesAndDirectories ifTrue: [^ self dropFiles: dropped passenger event: evt]. dropped dragTransferType = #sourceCode ifTrue: [^ self dropSourceCode: dropped passenger event: evt]. dropped dragTransferType = #inspectorField "See Tools-Inspector" ifTrue: [^ self dropInspectorField: dropped passenger event: evt]. dropped dragTransferType = #explorerField "See Tools-Explorer" ifTrue: [^ self dropExplorerField: dropped passenger from: dropped source model event: evt]]. aMorph := self morphToDropFrom: dropped. self isWorldMorph ifFalse: [super acceptDroppingMorph: aMorph event: evt] ifTrue: ["Add the given morph to this world and start stepping it if it wants to be." aMorph isInWorld ifFalse: [aMorph position: evt position]. self addMorphFront: aMorph. (aMorph fullBounds intersects: self viewBox) ifFalse: [Beeper beep. aMorph position: self bounds center]]. aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]]. self isPartsBin ifTrue: [aMorph isPartsDonor: true. aMorph stopSteppingSelfAndSubmorphs. aMorph suspendEventHandler] ifFalse: [self world startSteppingSubmorphsOf: aMorph]. self bringTopmostsToFront.! !
!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'mt 8/14/2023 17:41'! morphToDropFrom: aMorph "Given a morph being carried by the hand which the hand is about to drop, answer the actual morph to be deposited. Normally this would be just the morph itself, but several unusual cases arise, which this method is designed to service."
| aNail representee handy posBlock | handy := self isWorldMorph ifTrue: [self primaryHand] ifFalse: [self currentHand]. posBlock := [:z | | tempPos | tempPos := handy position - ((handy targetOffset - aMorph formerPosition) * (z extent / aMorph extent)) rounded. self pointFromWorld: tempPos]. self alwaysShowThumbnail ifTrue: [aNail := aMorph representativeNoTallerThan: self maxHeightToAvoidThumbnailing norWiderThan: self maximumThumbnailWidth thumbnailHeight: self heightForThumbnails. aNail == aMorph ifFalse: [aMorph formerPosition: aMorph position. aNail position: (posBlock value: aNail)]. ^aNail]. ((aMorph isKindOf: MorphThumbnail) and: [(representee := aMorph morphRepresented) owner isNil]) ifTrue: [representee position: (posBlock value: representee). ^representee].
^aMorph morphToDropInPasteUp: self! !
!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/15/2023 13:45'! handlesKeyboard: evt ^self isWorldMorph! !
!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/15/2023 13:45'! keyStroke: anEvent "A keystroke has been made. Service event handlers and, if it's a keystroke presented to the world, dispatch it to #unfocusedKeystroke:"
| selected | super keyStroke: anEvent. "Give event handlers a chance"
selected := self selectedObject. selected isNil ifFalse:[ selected moveOrResizeFromKeystroke: anEvent ].
self isWorldMorph ifTrue: [self keystrokeInWorld: anEvent]! !
!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 16:08'! mouseDown: evt "Handle a mouse down event." | grabbedMorph handHadHalos |
(Preferences generalizedYellowButtonMenu and: [evt yellowButtonPressed]) ifTrue: [^ self yellowButtonActivity: evt shiftPressed].
grabbedMorph := self morphToGrab: evt. grabbedMorph ifNotNil:[ grabbedMorph isSticky ifTrue:[^self]. self isPartsBin ifFalse:[^evt hand grabMorph: grabbedMorph]. grabbedMorph := grabbedMorph partRepresented duplicate. grabbedMorph restoreSuspendedEventHandler. (grabbedMorph fullBounds containsPoint: evt position) ifFalse:[grabbedMorph position: evt position]. "Note: grabbedMorph is ownerless after duplicate so use #grabMorph:from: instead" ^ evt hand grabMorph: grabbedMorph from: self].
(super handlesMouseDown: evt) ifTrue:[^super mouseDown: evt].
handHadHalos := evt hand halo notNil.
evt hand removeHalo. "shake off halos" evt hand releaseKeyboardFocus. "shake of keyboard foci"
self submorphs select:[:each | each hasProperty: #morphHierarchy] thenDo:[:each | each delete].
(evt shiftPressed not and:[ self isWorldMorph not and:[ self wantsEasySelection not ]]) ifTrue:[ "explicitly ignore the event if we're not the world and we'll not select, so that we could be picked up if need be" evt wasHandled: false. ^ self. ].
( evt shiftPressed or: [ self wantsEasySelection ] ) ifTrue:[ "We'll select on drag, let's decide what to do on click" | clickSelector |
clickSelector := nil.
evt shiftPressed ifTrue:[ clickSelector := #findWindow:. ] ifFalse:[ self isWorldMorph ifTrue:[ clickSelector := handHadHalos ifTrue: [ #delayedInvokeWorldMenu: ] ifFalse: [ #invokeWorldMenu: ] ] ].
evt hand waitForClicksOrDrag: self event: evt selectors: { clickSelector. nil. nil. #dragThroughOnDesktop: } threshold: HandMorph dragThreshold. ] ifFalse:[ "We wont select, just bring world menu if I'm the world" self isWorldMorph ifTrue:[ handHadHalos ifTrue: [ self delayedInvokeWorldMenu: evt ] ifFalse: [ self invokeWorldMenu: evt ] ] ]. ! !
!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/7/2023 18:18'! windowEvent: anEvent
self windowEventHandler ifNotNil: [^self windowEventHandler windowEvent: anEvent]. anEvent type caseOf: { [#windowClose] -> [TheWorldMenu basicNew quitSession]. [#windowDeactivated] -> [ "The host window has been deactivated. Until it regains the focus, honor the fact that we will not receive keyboard events again by changing the current keyboard focus morph. windowHostFocusMorph represents the host system which now holds the keyboard focus instead of the previousFocus." (self valueOfProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | "There is currently no exact-once guarantee for this event type from the VM. Mark any older host focus morph as inactive, it will be held as the previousFocus of the next host focus morph." hostFocus active: false]. self setProperty: #windowHostFocusMorph toValue: (WindowHostFocusMorph new in: [:hostFocus | hostFocus previousFocus: anEvent hand keyboardFocus. anEvent hand newKeyboardFocus: hostFocus.]; yourself)]. [#windowActivated] -> [ "Alright, the spook is over!! We have back control over the keyboard focus, delete the windowHostFocusMorph and restore the previous focus holder." (self removeProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | hostFocus active: false. (anEvent hand keyboardFocus == hostFocus and: [hostFocus previousFocus notNil]) ifTrue: [anEvent hand newKeyboardFocus: hostFocus previousFocus]]]. } otherwise: []! !
!PasteUpMorph methodsFor: 'events-processing' stamp: 'mt 3/10/2023 16:09'! tryInvokeHalo: aUserInputEvent
Morph haloForAll ifFalse: [ ^ self ].
(self transferHalo: aUserInputEvent) ifTrue: "The event was handled, don't let it cause any further side-effects." [ aUserInputEvent ignore ].! !
!PasteUpMorph methodsFor: 'events-processing' stamp: 'mt 3/10/2023 11:27'! tryInvokeMetaMenu: anEvent
| innerMost target | Morph metaMenuForAll ifFalse: [^ self]. innerMost := (self morphsAt: anEvent position unlocked: true) first. "Traverse the owner chain if some morph does not want to show its meta menu." target := innerMost. [target isNil or: [target wantsMetaMenu]] whileFalse: [target := target owner]. target ifNil: [^ self]. target invokeMetaMenu: anEvent. anEvent ignore.! !
!PasteUpMorph methodsFor: 'halos and balloon help' stamp: 'mt 3/7/2023 17:39'! wantsHaloFromClick (owner isSystemWindow) ifTrue: [^ false]. ^ true. ! !
!PasteUpMorph methodsFor: 'initialization' stamp: 'mt 3/10/2023 15:29'! initialize "initialize the state of the receiver" super initialize. "" padding := 3. self enableDragNDrop. self clipSubmorphs: true. self initializeKeyboardShortcuts. self initializeMouseShortcuts.! !
!PasteUpMorph methodsFor: 'menu & halo' stamp: 'mt 8/11/2023 16:18'! addCustomMenuItems: menu hand: aHandMorph "Add morph-specific menu itemns to the menu for the hand" super addCustomMenuItems: menu hand: aHandMorph.
self isWorldMorph ifTrue: [ | twm | menu addLine. menu addUpdating: #showWorldMainDockingBarString action: #toggleShowWorldMainDockingBar. menu addLine. Flaps sharedFlapsAllowed ifTrue: [ menu addUpdating: #suppressFlapsString target: Project current action: #toggleFlapsSuppressed. ].
twm := TheWorldMenu new. twm world: self project: Project current hand: aHandMorph.
menu add: 'old desktop menu... (W)' translated subMenu: twm buildWorldMenu. ]. ! !
!PasteUpMorph methodsFor: 'menu & halo' stamp: 'mt 8/16/2023 16:02'! addWorldHaloMenuItemsTo: aMenu hand: aHandMorph "Add standard halo items to the menu, given that the receiver is a World"
| unlockables | self addFillStyleMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph.
aMenu addLine. self addWorldToggleItemsToHaloMenu: aMenu. aMenu addLine. self addCopyItemsTo: aMenu. self addExportMenuItems: aMenu hand: aHandMorph. self addMiscExtrasTo: aMenu.
self addDebuggingItemsTo: aMenu hand: aHandMorph.
aMenu addLine. aMenu defaultTarget: self.
aMenu addLine.
unlockables := self submorphs select: [:m | m isLocked]. unlockables size = 1 ifTrue: [aMenu add: ('unlock "{1}"' translated format:{unlockables first externalName})action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' translated action: #unlockContents].
aMenu defaultTarget: aHandMorph. ! !
!PasteUpMorph methodsFor: 'options' stamp: 'mt 8/4/2023 14:08'! autoLineLayout: aBoolean "Make the receiver be viewed with auto-line-layout, which means that its submorphs will be laid out left-to-right and then top-to-bottom in the manner of a word processor, or (if aBoolean is false,) cease applying auto-line-layout"
aBoolean ifTrue:[ self layoutPolicy: TableLayout new. self layoutInset: 8; cellGap: 4. self listDirection: #leftToRight; wrapDirection: #topToBottom. ] ifFalse:[ self layoutPolicy: nil. self layoutInset: 0; cellGap: 0. ]. ! !
!PasteUpMorph methodsFor: 'undo' stamp: 'fbs 12/31/2013 12:08'! onceAgainDismiss: aMorph "Occasioned by a redo of a dismiss-via-halo"
aMorph dismissMorph. TrashCanMorph preserveTrash ifTrue: [TrashCanMorph slideDismissalsToTrash ifTrue:[aMorph slideToTrash: nil] ifFalse:[TrashCanMorph moveToTrash: aMorph]]! !
!PasteUpMorph methodsFor: 'undo' stamp: 'mt 8/4/2023 14:45'! reintroduceIntoWorld: aMorph "The given morph is being raised from the dead. Bring it back to life."
(aMorph valueOfProperty: #lastPosition) ifNotNil: [:pos | aMorph position: pos]. aMorph openInWorld
! !
!PasteUpMorph methodsFor: 'WiW support' stamp: 'raa 11/14/2017 07:47'! installAsActiveSubprojectIn: enclosingWorld at: newBounds titled: aString | window howToOpen tm boundsForWorld | howToOpen := self embeddedProjectDisplayMode. "#scaled may be the only one that works at the moment" submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." boundsForWorld := howToOpen == #naked ifTrue: [newBounds] ifFalse: [bounds]. worldState canvas: nil. worldState viewBox: boundsForWorld. self bounds: boundsForWorld.
"self viewBox: Display boundingBox." "worldState handsDo: [:h | h initForEvents]." self installFlaps.
"SystemWindow noteTopWindowIn: self." "self displayWorldSafely." howToOpen == #naked ifTrue: [enclosingWorld addMorphFront: self]. howToOpen == #window ifTrue: [window := (SystemWindow labelled: aString) model: self. window addMorph: self frame: (0 @ 0 extent: 1.0 @ 1.0). window openInWorld: enclosingWorld]. howToOpen == #frame ifTrue: [window := (AlignmentMorphBob1 new) minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color green; bounds: newBounds. window addMorph: self. window openInWorld: enclosingWorld]. howToOpen == #scaled ifTrue: [self position: 0 @ 0. window := (EmbeddedWorldBorderMorph new) minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color green; bounds: newBounds. tm := BOBTransformationMorph new. window addMorph: tm. tm addMorph: self. window openInWorld: enclosingWorld. tm changeWorldBoundsToShow: bounds. self arrangeToStartSteppingIn: enclosingWorld "tm scale: (tm width / self width min: tm height / self height) asFloat."]! !
!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 8/14/2023 17:32'! findWindow: evt "Present a menu names of windows and naked morphs, and activate the one that gets chosen. Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo." | menu expanded collapsed nakedMorphs | menu := MenuMorph new. expanded := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed not]. collapsed := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed]. nakedMorphs := self submorphsSatisfying: [:m | m isSystemWindow not and: [(m isFlapTab) not]]. (expanded isEmpty & (collapsed isEmpty & nakedMorphs isEmpty)) ifTrue: [^ Beeper beep]. (expanded sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: (w label contractTo: 80) target: w action: #beKeyWindow. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. (expanded isEmpty | (collapsed isEmpty & nakedMorphs isEmpty)) ifFalse: [menu addLine]. (collapsed sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: (w label contractTo: 80) target: w action: #collapseOrExpand. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. nakedMorphs isEmpty ifFalse: [menu addLine]. (nakedMorphs sort: [:w1 :w2 | w1 nameForFindWindowFeature caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) do: [:w | menu add: (w nameForFindWindowFeature contractTo: 80) target: w action: #comeToFrontAndAddHalo]. menu addTitle: 'find window' translated. menu popUpEvent: evt in: self.! !
!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 11:27'! invokeWorldMenu: evt "Put up the world menu, triggered by the passed-in event."
self putUpWorldMenu: evt.! !
!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 11:27'! keystrokeInWorld: evt "A keystroke was hit when no keyboard focus was set, so it is sent here to the world instead."
| aChar isCmd ascii | aChar := evt keyCharacter. (ascii := aChar asciiValue) = Character escape asciiValue ifTrue: [evt commandKeyPressed ifFalse: [^ self putUpWorldMenuFromEscapeKey]]. (evt controlKeyPressed not and: [(#(1 4 8 28 29 30 31 32) includes: ascii) "home, end, backspace, arrow keys, space" and: [self keyboardNavigationHandler notNil]]) ifTrue: [self keyboardNavigationHandler navigateFromKeystroke: aChar].
isCmd := evt commandKeyPressed and: [Preferences cmdKeysInText]. (isCmd and: [Preferences honorDesktopCmdKeys]) ifTrue: [^ self dispatchCommandKeyInWorld: aChar event: evt].
"It was unhandled. Remember the keystroke." self lastKeystroke: evt keyString. self triggerEvent: #keyStroke! !
!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/8/2023 10:36'! putUpNewMorphMenu "Put up the New Morph menu in the world"
TheWorldMenu new world: self project: Project current hand: self currentHand; newMorph! !
!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 16:08'! putUpWorldMenuFromEscapeKey self putUpWorldMenu: self currentEvent.! !
!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/10/2023 13:57'! allNonWindows "Answer all non-window submorphs"
^submorphs select: [:m | (m isSystemWindow) not and: [m wantsToBeTopmost not]]! !
!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/10/2023 15:29'! beWorldForProject: aProject
self privateOwner: nil. worldState := WorldState new. self addHand: HandMorph new. self setProperty: #optimumExtentFromAuthor toValue: Display extent. self startSteppingSubmorphsOf: self! !
!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/15/2023 13:18'! initForProject: aWorldState
worldState := aWorldState. self viewBox: Display boundingBox. self color: Preferences defaultWorldColor. self addHand: HandMorph new. self setProperty: #optimumExtentFromAuthor toValue: Display extent. self borderWidth: 0. model := nil. ! !
!PasteUpMorph methodsFor: 'world state' stamp: 'mt 8/11/2023 16:20'! install
owner := nil. "since we may have been inside another world previously" submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." self viewBox: Display boundingBox. EventSensor default flushEvents. worldState handsDo: [:h | h initForEvents]. self installFlaps. self borderWidth: 0. "default" (Preferences showSecurityStatus and: [SecurityManager default isInRestrictedMode]) ifTrue: [self borderWidth: 2; borderColor: Color red]. SystemWindow noteTopWindowIn: self.! !
!PasteUpMorph methodsFor: 'world state' stamp: 'mt 8/10/2023 15:27'! paintBox "Return the painting controls widget (PaintBoxMorph) to be used for painting in this world. If there is not already a PaintBox morph, or if it has been deleted from this world, create a new one."
| newPaintBox refPoint | self allMorphsDo: [:m | (m isKindOf: PaintBoxMorph) ifTrue: [^ m]]. refPoint := self topRight. newPaintBox := PaintBoxMorph new. newPaintBox position: (refPoint - (newPaintBox width @ 0)). self addMorph: newPaintBox. ^ newPaintBox ! !
!PasteUpMorph methodsFor: 'world state' stamp: 'sw 9/2/1999 12:01'! paintBoxOrNil "Return the painting controls widget (PaintBoxMorph) to be used for painting in this world. If there is not already a PaintBox morph return nil"
self allMorphsDo: [:m | (m isKindOf: PaintBoxMorph) ifTrue: [^ m]]. ^ nil ! !
!PasteUpMorph methodsFor: '*Tools' stamp: 'mt 3/10/2023 16:08'! defaultDesktopCommandKeyTriplets "Answer a list of triplets of the form <key> <receiver> <selector> [+ optional fourth element, a <description> for use in desktop-command-key-help] that will provide the default desktop command key handlers. If the selector takes an argument, that argument will be the command-key event" "World initializeDesktopCommandKeySelectors"
| noviceKeys expertKeys |
noviceKeys := { {$r. self. #restoreMorphicDisplay. 'Redraw the screen' translated}. {$M. self. #toggleShowWorldMainDockingBar. 'Show/Hide the Main Docking Bar' translated}. {$]. Smalltalk. #saveSession. 'Save the image.' translated}. }. expertKeys := { {$b. SystemBrowser. #defaultOpenBrowser. 'Open a new System Browser' translated}. {$k. Workspace. #open. 'Open a new Workspace' translated}. {$m. self. #putUpNewMorphMenu. 'Put up the "New Morph" menu' translated}. {$O. self. #findAMonticelloBrowser. 'Bring a Monticello window into focus.' translated}. {$t. self. #findATranscript:. 'Make a System Transcript visible' translated}. {$w. SystemWindow. #closeTopWindow. 'Close the topmost window' translated}. {Character escape. SystemWindow. #closeTopWindow. 'Close the topmost window' translated}. {$C. self. #findAChangeSorter:. 'Make a Change Sorter visible' translated}. {$L. self. #findAFileList:. 'Make a File List visible' translated}. {$P. self. #findAPreferencesPanel:. 'Activate the Preferences tool' translated}. {$R. Utilities. #browseRecentSubmissions. 'Make a Recent Submissions browser visible' translated}. {$W. self. #findAMessageNamesWindow:. 'Make a MessageNames tool visible' translated}. {$Z. ChangeList. #browseRecentLog. 'Browse recently-logged changes' translated}. {$. SystemWindow. #sendTopWindowToBack. 'Send the top window to the back' translated}. {$_. Smalltalk. #quitPrimitive. 'Quit the image immediately.' translated}. {$-. Preferences. #decreaseFontSize. 'Decrease all font sizes' translated}. {$+. Preferences. #increaseFontSize. 'Increase all font sizes' translated}. }. ^ noviceKeys, expertKeys! !
!PasteUpMorph methodsFor: 'flaps' stamp: 'mt 8/4/2023 14:02'! addGlobalFlaps "Must make global flaps adapt to world. Do this even if not shown, so the old world will not be pointed at by the flaps."
| use thisWorld | use := Flaps sharedFlapsAllowed. Project current flapsSuppressed ifTrue: [use := false]. "Smalltalk isMorphic ifFalse: [use := false]." thisWorld := use ifTrue: [self] ifFalse: [PasteUpMorph new initForProject: "fake to be flap owner" WorldState new; bounds: (0@0 extent: 4000@4000); viewBox: (0@0 extent: 4000@4000)]. Flaps globalFlapTabsIfAny do: [:aFlapTab | (Project current isFlapEnabled: aFlapTab) ifTrue: [(aFlapTab world == thisWorld) ifFalse: [thisWorld addMorphFront: aFlapTab]. "always do" use ifTrue: [aFlapTab spanWorld. aFlapTab adjustPositionAfterHidingFlap. aFlapTab flapShowing ifTrue: [aFlapTab showFlap]]]]! !
!PasteUpMorph methodsFor: 'flaps' stamp: 'nice 12/27/2009 20:14'! localFlapTabs "Answer a list of local flap tabs in the current project"
| globalList aList | globalList := Flaps globalFlapTabsIfAny. aList := OrderedCollection new. submorphs do: [:m | | aFlapTab | ((m isFlapTab) and: [(globalList includes: m) not]) ifTrue: [aList add: m] ifFalse: [((m isFlap) and: [(aFlapTab := m submorphs detect: [:n | n isFlapTab] ifNone: [nil]) notNil]) ifTrue: [aList add: aFlapTab]]]. ^ aList! !
!PasteUpMorph methodsFor: '*services-base' stamp: 'mt 8/4/2023 14:03'! openWorldMenu | menu | menu := (TheWorldMenu new world: self project: nil hand: self primaryHand) buildWorldMenu. menu addTitle: Preferences desktopMenuTitle translated. menu openInHand! !
!PasteUpMorph methodsFor: '*services-base' stamp: 'mt 8/28/2023 14:42'! worldMenu ^ TheWorldMenu new world: self project: nil hand: self primaryHand! !
!PasteUpMorph class methodsFor: 'scripting' stamp: 'mt 3/15/2023 13:30'! authoringPrototype "Answer an instance of the receiver suitable for placing in a parts bin for authors" | proto | proto := self new markAsPartsDonor. proto color: Color green muchLighter; extent: 100 @ 80; borderColor: (Color r: 0.645 g: 0.935 b: 0.161). proto extent: 300 @ 240. proto beSticky. ^ proto! !
!PasteUpMorph class methodsFor: '*MorphicExtras-class initialization' stamp: 'mt 7/31/2023 11:14'! initialize "Initialize the class"
self registerInFlapsRegistry.! !
!PolygonMorph methodsFor: 'stepping' stamp: 'mt 3/10/2023 15:01'! stepTime "Answer the desired time between steps in milliseconds."
^ 100! !
!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:59'! printStandardSystemFonts "self printStandardSystemFonts"
| string | string := String streamContents: [ :s |
#(standardDefaultTextFont standardListFont standardFlapFont standardMenuFont windowTitleFont standardBalloonHelpFont standardCodeFont standardButtonFont) do: [:selector | | font | font := Preferences perform: selector. s nextPutAll: selector; space; nextPutAll: font familyName; space; nextPutAll: (AbstractFont emphasisStringFor: font emphasis); nextPutAll: ' points: '; print: font pointSize; nextPutAll: ' height: '; print: font height; cr ]].
(StringHolder new) contents: string; openLabel: 'Current system font settings' translated. ! !
!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:58'! refreshFontSettings "Try to update all the current font settings to make things consistent."
UserInterfaceTheme current applyAfter: [ self setFlapsFontTo: (self standardFlapFont); setWindowTitleFontTo: (self windowTitleFont); setListFontTo: (self standardListFont); setMenuFontTo: (self standardMenuFont); setSystemFontTo: (TextStyle defaultFont); setCodeFontTo: (self standardCodeFont); setBalloonHelpFontTo: (BalloonMorph balloonFont)].
SystemWindow allSubInstancesDo: [ :s | | rawLabel | rawLabel := s getRawLabel. rawLabel owner vResizing: #spaceFill. rawLabel font: rawLabel font. s setLabel: s label. s replaceBoxes ].! !
!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:59'! restoreFontsAfter: aBlock
"Restore the currently chosen set of standard fonts after evaluating aBlock. Used for tests that modify the default fonts."
| standardDefaultTextFont standardListFont standardMenuFont windowTitleFont standardBalloonHelpFont standardCodeFont standardButtonFont |
standardDefaultTextFont := Preferences standardDefaultTextFont. standardListFont := Preferences standardListFont. standardMenuFont := Preferences standardMenuFont. windowTitleFont := Preferences windowTitleFont. standardBalloonHelpFont := Preferences standardBalloonHelpFont. standardCodeFont := Preferences standardCodeFont. standardButtonFont := Preferences standardButtonFont. ^ UserInterfaceTheme current applyAfter: [ aBlock ensure: [ Preferences setSystemFontTo: standardDefaultTextFont. Preferences setListFontTo: standardListFont. Preferences setMenuFontTo: standardMenuFont. Preferences setWindowTitleFontTo: windowTitleFont. Preferences setBalloonHelpFontTo: standardBalloonHelpFont. Preferences setCodeFontTo: standardCodeFont. Preferences setButtonFontTo: standardButtonFont]]. ! !
!Preferences class methodsFor: 'support - misc' stamp: 'mt 3/7/2023 15:42'! personalizeUserMenu: aMenu "The user has clicked on the morphic desktop with the yellow mouse button (option+click on the Mac); a menu is being constructed to present to the user in response; its default target is the current world. In this method, you are invited to add items to the menu as per personal preferences. The default implementation, for illustrative purposes, sets the menu title to 'personal', and adds items for go-to-previous-project, show/hide flaps, and load code updates" aMenu addTitle: 'personal' translated. "Remove or modify this as per personal choice"
aMenu addStayUpItem. aMenu add: 'previous project' translated action: #goBack. aMenu add: 'load latest code updates' translated target: MCMcmUpdater action: #updateFromServer. aMenu add: 'about this system...' translated target: Smalltalk action: #aboutThisSystem.! !
!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'! classicHaloSpecs "Non-iconic halos with traditional placements"
"Preferences installClassicHaloSpecs" "Preferences resetHaloSpecifications" " <- will result in the standard default halos being reinstalled" "NB: listed below in clockwise order"
^ #( " selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addMenuHandle: left top (red) none) (addDismissHandle: leftCenter top (red muchLighter) 'Halo-Dismiss') (addGrabHandle: center top (black) none) (addDragHandle: rightCenter top (brown) none) (addDupHandle: right top (green) none) (addDebugHandle: right topCenter (blue veryMuchLighter) none) (addGrowHandle: right bottom (yellow) none) (addScaleHandle: right bottom (lightOrange) none) (addFontEmphHandle: rightCenter bottom (lightBrown darker) none) (addFontStyleHandle: center bottom (lightRed) none) (addFontSizeHandle: leftCenter bottom (lightGreen) none)
(addRecolorHandle: right bottomCenter (magenta darker) none)
(addRotateHandle: left bottom (blue) none))
! !
!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/8/2023 11:41'! customHaloSpecs "Intended for you to modify to suit your personal preference. What is implemented in the default here is just a skeleton; in comment at the bottom of this method are some useful lines you may wish to paste in to the main body here, possibly modifying positions, colors, etc.. Note that in this example, we include: Dismiss handle, at top-left Menu handle, at top-right Resize handle, at bottom-right Rotate handle, at bottom-left Drag handle, at top-center Recolor handle, at left-center. (this one is NOT part of the standard formulary -- it is included here to illustrate how to add non-standard halos) Note that the optional handles for specialized morphs, such as Sketch, Text, PasteUp, are also included"
^ #( (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addMenuHandle: right top (red) 'Halo-Menu') (addDragHandle: center top (brown) 'Halo-Drag') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale')
(addRecolorHandle: left center (green muchLighter lighter) 'Halo-Recolor')
(addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRotateHandle: left bottom (blue) 'Halo-Rot')
(addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug')
)
" Other useful handles...
selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------
(addTileHandle: left bottomCenter (lightBrown) 'Halo-Tile') (addViewHandle: left center (cyan) 'Halo-View') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addFewerHandlesHandle: left topCenter (paleBuff) 'Halo-FewerHandles') (addPaintBgdHandle: right center (lightGray) 'Halo-Paint') (addRepaintHandle: right center (lightGray) 'Halo-Paint') " ! !
!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/8/2023 11:30'! haloSpecificationsForWorld | desired | "Answer a list of HaloSpecs that describe which halos are to be used on a world halo, what they should look like, and where they should be situated" "Preferences resetHaloSpecifications"
desired := #(addDebugHandle: addMenuHandle: addHelpHandle: addRecolorHandle:). ^ self haloSpecifications select: [:spec | desired includes: spec addHandleSelector]! !
!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'! iconicHaloSpecifications "Answer an array that characterizes the locations, colors, icons, and selectors of the halo handles that may be used in the iconic halo scheme"
"Preferences resetHaloSpecifications"
^ #( " selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addCollapseHandle: left topCenter (tan) 'Halo-Collapse') (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addMenuHandle: leftCenter top (red) 'Halo-Menu') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor') ) ! !
!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'! simpleFullHaloSpecifications "This method gives the specs for the 'full' handles variant when simple halos are in effect"
"Preferences resetHaloSpecifications"
^ #( " selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addMenuHandle: leftCenter top (red) 'Halo-Menu') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale') (addFewerHandlesHandle: left topCenter (paleBuff) 'Halo-FewerHandles') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor')
) ! !
!Preferences class methodsFor: 'defaults' stamp: 'mt 8/29/2023 15:25'! defaultValueTableForCurrentRelease "Answer a table defining default values for all the preferences in the release. Returns a list of (pref-symbol, boolean-symbol) pairs"
^ #( (alternativeBrowseIt false) (annotationPanes false) (areaFillsAreTolerant false) (areaFillsAreVeryTolerant false) (automaticKeyGeneration false) (balloonHelpEnabled true) (balloonHelpInMessageLists false) (caseSensitiveFinds false) (changeSetVersionNumbers true) (checkForSlips true) (checkForUnsavedProjects true) (cmdDotEnabled true) (collapseWindowsInPlace false) (confirmFirstUseOfStyle true) (conversionMethodsAtFileOut false) (debugHaloHandle true) (debugPrintSpaceLog false) (debugShowDamage false) (decorateBrowserButtons true) (diffsInChangeList true) (diffsWithPrettyPrint false) (dismissAllOnOptionClose false) (fastDragWindowForMorphic true) (fullScreenLeavesDeskMargins true) (higherPerformance false) (honorDesktopCmdKeys true) (logDebuggerStackToFile true) (menuKeyboardControl false) (modalColorPickers true) (mouseOverForKeyboardFocus false) (navigatorOnLeftEdge true) (optionalButtons true) (passwordsOnPublish false) (personalizedWorldMenu true) (postscriptStoredAsEPS false) (projectViewsInWindows true) (projectZoom true) (projectsSentToDisk false) (readDocumentAtStartup true) (restartAlsoProceeds false) (reverseWindowStagger true) (roundedMenuCorners true) (scrollBarsNarrow false) (scrollBarsOnRight true) (securityChecksEnabled false) (showBoundsInHalo false) (showDirectionForSketches false) (showDirectionHandles false) (showProjectNavigator false) (showSecurityStatus true) (signProjectFiles true) (smartUpdating true) (startInUntrustedDirectory false) (systemWindowEmbedOK false) (timeStampsInMenuTitles true) (turnOffPowerManager false) (twentyFourHourFileStamps true) (uniqueNamesInHalos false) (useButtonPropertiesToFire false) (warnAboutInsecureContent true) (warnIfNoChangesFile true) (warnIfNoSourcesFile true))
" Preferences defaultValueTableForCurrentRelease do: [:pair | (Preferences preferenceAt: pair first ifAbsent: [nil]) ifNotNilDo: [:pref | pref defaultValue: (pair last == true)]]. Preferences chooseInitialSettings. "! !
!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/10/2023 16:09'! disableProgrammerFacilities "Warning: do not call this lightly!! It disables all access to menus, debuggers, halos. There is no guaranteed return from this, which is to say, you cannot necessarily reenable these things once they are disabled -- you can only use whatever the UI of the current project affords, and you cannot even snapshot -- you can only quit.
You can completely reverse the work of this method by calling the dual Preferences method enableProgrammerFacilities, provided you have left yourself leeway to bring about a call to that method.
To set up a system that will come up in such a state, you have to request the snapshot in the same breath as you disable the programmer facilities. To do this, put the following line into the 'do' menu and then evaluate it from that 'do' menu:
Preferences disableProgrammerFacilities.
You will be prompted for a new image name under which to save the resulting image."
Beeper beep. (self confirm: 'CAUTION!!!! This is a drastic step!! Do you really want to do this?') ifFalse: [Beeper beep. ^self inform: 'whew!!']. self disable: #cmdDotEnabled. "No user-interrupt-into-debugger" self compileAccessorForPreferenceNamed: #cmdGesturesEnabled value: false. "No halos, etc." self compileAccessorForPreferenceNamed: #cmdKeysInText value: false. "No user commands invokable via cmd-key combos in text editor" self disable: #warnIfNoSourcesFile. self disable: #warnIfNoChangesFile. Smalltalk saveAs! !
!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/10/2023 16:09'! enableProgrammerFacilities "Meant as a one-touch recovery from a #disableProgrammerFacilities call." "Preferences enableProgrammerFacilities"
self enable: #cmdDotEnabled. self compileAccessorForPreferenceNamed: #cmdGesturesEnabled value: true. self compileAccessorForPreferenceNamed: #cmdKeysInText value: true. self enable: #warnIfNoSourcesFile. self enable: #warnIfNoChangesFile.! !
!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/15/2023 13:50'! setNotificationParametersForStandardPreferences "Set up the notification parameters for the standard preferences that require need them. When adding new Preferences that require use of the notification mechanism, users declare the notifcation info as part of the call that adds the preference, or afterwards -- the two relevant methods for doing that are: Preferences.addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: and Preference changeInformee:changeSelector:"
"Preferences setNotificationParametersForStandardPreferences"
#( (annotationPanes annotationPanesChanged) (optionalButtons optionalButtonsChanged) (smartUpdating smartUpdatingChanged) ) do:
[:pair | | aPreference | aPreference := self preferenceAt: pair first. aPreference changeInformee: self changeSelector: pair second]! !
!Preferences class methodsFor: 'initialization - save/load' stamp: 'mt 3/7/2023 13:27'! loadPreferencesFrom: aFile
| stream params dict desktopColor patternsToIgnore | patternsToIgnore := #('*updateMapName' '*defaultUpdateURL'). stream := ReferenceStream fileNamed: aFile. params := stream next. self assert: (params isKindOf: IdentityDictionary). params removeKey: #PersonalDictionaryOfPreferences. dict := stream next. self assert: (dict isKindOf: IdentityDictionary). desktopColor := stream next. stream close. dict rehash. "See http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217817.html" dict keys reject: [:key | patternsToIgnore anySatisfy: [:pattern | pattern match: key]] thenDo: [:key | | value | value := dict at: key. (self preferenceAt: key ifAbsent: [nil]) ifNotNil: [:pref | [pref preferenceValue: value preferenceValue] on: Deprecation do: [ : err | "Ignore preferences which may not be supported anymore."]]]. params keysAndValuesDo: [ :key :value | self setParameter: key to: value ]. Project current world fillStyle: desktopColor.! !
!ProgressMorph methodsFor: 'private' stamp: 'mt 8/11/2023 14:00'! fontOfPointSize: size ^ (TextConstants at: Preferences standardDefaultTextFont familyName ifAbsent: [TextStyle default]) fontOfPointSize: size! !
!Project methodsFor: 'displaying' stamp: 'mt 8/28/2023 14:08'! displayZoom: entering "Show the project transition when entering a new project" | newDisplay vanishingPoint | "Show animated zoom to new display" newDisplay := self imageForm. entering ifTrue: [vanishingPoint := Sensor cursorPoint] ifFalse: [vanishingPoint := self viewLocFor: CurrentProject]. Display zoomIn: entering orOutTo: newDisplay at: 0@0 vanishingPoint: vanishingPoint.! !
!Project methodsFor: 'file in/out' stamp: 'mt 8/16/2023 15:46'! exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: noInteraction
| exportChangeSet |
"An experimental version to fileout a changeSet first so that a project can contain its own classes"
"Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target image. Name it <project name>.extSeg. Player classes are included automatically." exportChangeSet := nil. (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [ (noInteraction or: [self confirm: 'Would you like to include all the changes in the change set as part of this publishing operation?' translated]) ifTrue: [ exportChangeSet := changeSet ]. ].
^ self exportSegmentWithChangeSet: exportChangeSet fileName: aFileName directory: aDirectory withoutInteraction: noInteraction! !
!Project methodsFor: 'menu messages' stamp: 'mt 8/23/2023 13:50'! validateProjectNameIfOK: aBlock
| details |
details := world valueOfProperty: #ProjectDetails. details ifNotNil: ["ensure project info matches real project name" details at: 'projectname' put: self name. ]. self doWeWantToRename ifTrue: [self notify: 'Please choose another name!!'] ifFalse: [aBlock value: details]! !
!MorphicProject methodsFor: 'initialize' stamp: 'mt 3/8/2023 09:42'! initialize "Initialize a new Morphic Project"
super initialize. world := PasteUpMorph newWorldForProject: self. self setWorldBackground: true. Locale switchToID: CurrentProject localeID. Project current isMorphic ifTrue: [ "Only trigger tool builders etc. if we are already in the same kind of project because there is global state that cannot yet be configured in a dynamic scope such as 'ToolBuilder default'." self assureMainDockingBarPresenceMatchesPreference].! !
!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/16/2023 17:02'! exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory withoutInteraction: noInteraction "Store my project out on the disk as an *exported* ImageSegment. All outPointers will be in a form that can be resolved in the target image. Name it <project name>.extSeg. Whatdo we do about subProjects, especially if they are out as local image segments? Force them to come in? Player classes are included automatically."
| is str ans revertSeg roots holder collector fd mgr stacks |
"Files out a changeSet first, so that a project can contain its own classes" world ifNil: [^ false].
ScrapBook default emptyScrapBook. world currentHand pasteBuffer: nil. "don't write the paste buffer." world currentHand mouseOverHandler initialize. "forget about any references here" "Display checkCurrentHandForObjectToPaste." Command initialize. world clearCommandHistory. world fullReleaseCachedState. world cleanseStepList. world localFlapTabs size = world flapTabs size ifFalse: [noInteraction ifTrue: [^ false]. self error: 'Still holding onto Global flaps']. world releaseSqueakPages. holder := Project allProjects. "force them in to outPointers, where DiskProxys are made"
"Just export me, not my previous version" revertSeg := self parameterAt: #revertToMe. self removeParameter: #revertToMe.
roots := OrderedCollection new. roots add: self; add: world; add: transcript; add: aChangeSetOrNil; add: thumbnail; add: world activeHand.
roots := roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail"
fd := aDirectory directoryNamed: self resourceDirectoryName. fd assureExistence. "Clean up resource references before writing out" mgr := self resourceManager. self resourceManager: nil. ResourceCollector current: ResourceCollector new. ResourceCollector current localDirectory: fd. ResourceCollector current baseUrl: self resourceUrl. ResourceCollector current initializeFrom: mgr. ProgressNotification signal: '2:findingResources' extra: '(collecting resources...)' translated. "Must activate old world because this is run at #armsLength. Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent will not be captured correctly if referenced from blocks or user code." world becomeActiveDuring: [is := ImageSegment copySmartRootsExport: roots asArray. "old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)"]. self resourceManager: mgr. collector := ResourceCollector current. ResourceCollector current: nil. ProgressNotification signal: '2:foundResources' extra: ''. is state = #tooBig ifTrue: [collector replaceAll. ^ false].
str := ''. "considered legal to save a project that has never been entered" (is outPointers includes: world) ifTrue: [str := str, '\Project''s own world is not in the segment.' translated withCRs]. str isEmpty ifFalse: [ans := Project uiManager chooseOptionFrom: {'Do not write file' translated. 'Write file anyway' translated. 'Debug' translated} title: str. ans = 1 ifTrue: [revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. ^ false]. ans = 3 ifTrue: [collector replaceAll. self halt: 'Segment not written' translated]]. stacks := is findStacks.
is writeForExportWithSources: aFileName inDirectory: fd changeSet: aChangeSetOrNil. SecurityManager default signFile: aFileName directory: fd. "Compress all files and update check sums" collector forgetObsolete. self storeResourceList: collector in: fd. self storeHtmlPageIn: fd. self storeManifestFileIn: fd. self writeStackText: stacks in: fd registerIn: collector. "local proj.005.myStack.t" self compressFilesIn: fd to: aFileName in: aDirectory resources: collector. "also deletes the resource directory" "Now update everything that we know about" mgr updateResourcesFrom: collector.
revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. world flapTabs do: [:ft | (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. ^ true ! !
!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/11/2023 16:06'! storeSegment "Store my project out on the disk as an ImageSegment. Keep the outPointers in memory. Name it <project name>.seg. *** Caller must be holding (Project alInstances) to keep subprojects from going out. ***"
| currentWorld is sizeHint | currentWorld := Project current world. (currentWorld == world) ifTrue: [^ false]. "self inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ false]. "already done" world ifNil: [^ false].
ScrapBook default emptyScrapBook. currentWorld checkCurrentHandForObjectToPaste. world releaseSqueakPages. sizeHint := self projectParameters at: #segmentSize ifAbsent: [0].
is := ImageSegment copyFromRootsLocalFileFor: {world} sizeHint: sizeHint.
is state = #tooBig ifTrue: [^ false]. is segment size < 2000 ifTrue: ["debugging" Transcript show: self name, ' only ', is segment size printString, 'bytes in Segment.'; cr]. self projectParameters at: #segmentSize put: is segment size. is extract; writeToFile: self name. ^ true! !
!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/11/2023 16:08'! storeSegmentNoFile "For testing. Make an ImageSegment. Keep the outPointers in memory. Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)"
| is currentWorld | currentWorld := Project current world. (currentWorld == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ self]. "already done" world ifNil: [^ self].
"Do this on project enter" ScrapBook default emptyScrapBook. currentWorld checkCurrentHandForObjectToPaste2.
is := ImageSegment copyFromRootsLocalFileFor: {world} sizeHint: 0.
is segment size < 800 ifTrue: ["debugging" Transcript show: self name, ' did not get enough objects'; cr. ^ Beeper beep].
is extract. "is instVarAt: 2 put: is segment clone." "different memory"! !
!MorphicProject methodsFor: 'enter' stamp: 'mt 3/10/2023 15:01'! enterAsActiveSubprojectWithin: enclosingWorld
"Install my ChangeSet, Transcript, and scheduled views as current globals.
If returningFlag is true, we will return to the project from whence the current project was entered; don't change its previousProject link in this case. If saveForRevert is true, save the ImageSegment of the project being left. If revertFlag is true, make stubs for the world of the project being left. If revertWithoutAsking is true in the project being left, then always revert."
"Experimental mods for initial multi-project work: 1. assume in morphic (this eliminated need for <showZoom>) 2. assume <saveForRevert> is false (usual case) - removed <old> 3. assume <revertFlag> is false 4. assume <revertWithoutAsking> is false - <forceRevert> now auto false <seg> n.u. 5. no zooming 6. assume <projectsSentToDisk> false - could be dangerous here 7. assume no isolation problems (isolationHead ==) 8. no closing scripts "
self isCurrentProject ifTrue: [^ self].
"guards ifNotNil: [ guards := guards reject: [:obj | obj isNil]. guards do: [:obj | obj okayToEnterProject ifFalse: [^ self]] ]."
"CurrentProject makeThumbnail." "--> Display bestGuessOfCurrentWorld triggerClosingScripts." CurrentProject displayDepth: Display depth.
displayDepth == nil ifTrue: [displayDepth := Display depth]. "Display newDepthNoRestore: displayDepth."
"(world hasProperty: #letTheMusicPlay) ifTrue: [world removeProperty: #letTheMusicPlay] ifFalse: [Smalltalk at: #ScorePlayer ifPresent: [:playerClass | playerClass allSubInstancesDo: [:player | player pause]]]."
"returningFlag ifTrue: [nextProject := CurrentProject] ifFalse: [previousProject := CurrentProject]."
"CurrentProject saveState." "CurrentProject := self." "Smalltalk newChanges: changeSet." "TranscriptStream newTranscript: transcript." "Sensor flushKeyboard." "recorderOrNil := Display pauseMorphicEventRecorder."
"Display changeMorphicWorldTo: world." "Signifies Morphic" world installAsActiveSubprojectIn: enclosingWorld titled: self name.
"recorderOrNil ifNotNil: [recorderOrNil resumeIn: world]." self removeParameter: #exportState. "self spawnNewProcessAndTerminateOld: true"! !
!MorphicProject methodsFor: 'enter' stamp: 'mt 8/28/2023 14:28'! finalEnterActions: leavingProject "Perform the final actions necessary as the receiver project is entered"
| navigator armsLengthCmd navType thingsToUnhibernate | "If this image has a global World variable, update it now" Smalltalk globals at: #World ifPresent: [ :w | Smalltalk globals at: #World put: world ]. world install. world transferRemoteServerFrom: leavingProject world. "(revertFlag | saveForRevert | forceRevert) ifFalse: [ (Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [ self storeSomeSegment]]." "Transfer event recorder to me." leavingProject isMorphic ifTrue: [ leavingProject world pauseEventRecorder ifNotNil: [:rec | rec resumeIn: world]].
self initializeMenus. self projectParameters at: #projectsToBeDeleted ifPresent: [ :projectsToBeDeleted | self removeParameter: #projectsToBeDeleted. projectsToBeDeleted do: [:each | each delete]].
Locale switchToID: self localeID.
thingsToUnhibernate := world valueOfProperty: #thingsToUnhibernate ifAbsent: [#()]. thingsToUnhibernate do: [:each | each unhibernate]. world removeProperty: #thingsToUnhibernate.
navType := ProjectNavigationMorph preferredNavigator. armsLengthCmd := self parameterAt: #armsLengthCmd ifAbsent: [nil]. navigator := world findA: navType. (Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator and: [navigator isNil]]) ifTrue: [(navigator := navType new) bottomLeft: world bottomLeft; openInWorld: world]. navigator notNil & armsLengthCmd notNil ifTrue: [navigator color: Color lightBlue]. armsLengthCmd notNil ifTrue: [self flapsSuppressed: true. navigator ifNotNil: [navigator visible: false]. armsLengthCmd openInWorld: world]. world reformulateUpdatingMenus. self assureMainDockingBarPresenceMatchesPreference.
world repairEmbeddedWorlds.! !
!MorphicProject methodsFor: 'enter' stamp: 'mt 8/11/2023 16:05'! finalExitActions: enteringProject
"Pause sound players, subject to preference settings" (world hasProperty: #letTheMusicPlay) ifTrue: [world removeProperty: #letTheMusicPlay] ifFalse: [SoundService stop].
world sleep. (world findA: ProjectNavigationMorph) ifNotNil: [:navigator | navigator retractIfAppropriate].
self clearGlobalState. EventSensor default flushEvents. self world submorphsDo: [:ea | ea removeProperty: #dropShadow].! !
!MorphicProject methodsFor: 'release' stamp: 'mt 3/10/2023 15:10'! prepareForDelete "The window in which the project is housed is about to deleted. Perform any necessary actions to prepare for deletion."
Smalltalk at: #WonderlandCameraMorph ifPresent:[:aClass | world submorphs do: "special release for wonderlands" [:m | (m isKindOf: aClass) and: [m getWonderland release]]]. ! !
!MorphicProject methodsFor: 'language' stamp: 'mt 3/10/2023 16:07'! chooseNaturalLanguage "Put up a menu allowing the user to choose the natural language for the project"
| aMenu availableLanguages | aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'choose language' translated. aMenu lastItem setBalloonText: 'This controls the human language in which tiles should be viewed. It is potentially extensible to be a true localization mechanism, but initially it only works in the classic tile scripting system. Each project has its own private language choice' translated. aMenu addStayUpItem.
availableLanguages := NaturalLanguageTranslator availableLanguageLocaleIDs sorted:[:x :y | x displayName < y displayName].
availableLanguages do: [:localeID | aMenu addUpdating: #stringForLanguageNameIs: target: Locale selector: #switchToID: argumentList: {localeID}]. aMenu popUpInWorld
"Project current chooseNaturalLanguage"! !
!MorphicProject methodsFor: 'language' stamp: 'mt 8/4/2023 15:20'! updateLocaleDependents "Set the project's natural language as indicated"
Flaps disableGlobalFlaps: false. Flaps enableGlobalFlaps.
(self isFlapIDEnabled: 'Navigator' translated) ifFalse: [Flaps enableDisableGlobalFlapWithID: 'Navigator' translated]. ScrapBook default emptyScrapBook. MenuIcons initializeTranslations. super updateLocaleDependents. "self setFlaps. self setPaletteFor: aLanguageSymbol."! !
!MorphicProject methodsFor: 'scheduling & debugging' stamp: 'mt 3/10/2023 11:26'! interruptCleanUpFor: interruptedProcess "Clean up things in case of a process interrupt."
super interruptCleanUpFor: interruptedProcess.
self uiProcess == interruptedProcess ifTrue: [ self currentHand ifNotNil: [:hand | hand interrupted]. world removeProperty: #shouldDisplayWorld].! !
!Project class methodsFor: 'utilities' stamp: 'mt 3/15/2023 14:01'! removeAll: projects "Project removeAll: (Project allSubInstances copyWithout: Project current)"
AllProjects := nil. Smalltalk garbageCollect.
ProjectHistory currentHistory initialize. projects do: [:project | Project deletingProject: project].
Smalltalk garbageCollect. Smalltalk garbageCollect. ! !
!ProjectLauncher methodsFor: 'initialization' stamp: 'mt 8/4/2023 13:21'! setupFlaps "Only called when the image has been launched in a browser. If I am requested to show all flaps, then if flaps already exist, use them as is, else set up to show the default set of standard flaps."
whichFlaps = 'all' ifTrue: [Flaps sharedFlapsAllowed ifFalse: [Flaps enableGlobalFlaps]]! !
!ProjectLauncher methodsFor: 'running' stamp: 'mt 8/4/2023 13:23'! startUp | scriptName loader isUrl | self setupFlaps. Smalltalk firstArgMightBeDocument ifTrue: [scriptName := Smalltalk documentPath. scriptName := scriptName convertFromSystemString. scriptName isEmpty ifFalse: ["figure out if script name is a URL by itself" isUrl := (scriptName asLowercase beginsWith: 'http://') or: [(scriptName asLowercase beginsWith: 'file://') or: [scriptName asLowercase beginsWith: 'ftp://']]. isUrl ifFalse: [| encodedPath pathTokens | "Allow for ../dir/scriptName arguments" pathTokens := scriptName splitBy: FileDirectory slash. pathTokens := pathTokens collect: [:s | s encodeForHTTP]. encodedPath := pathTokens reduce: [:acc :each | acc , FileDirectory slash , each]. scriptName := (FileDirectory default uri resolveRelativeURI: encodedPath) asString]]] ifFalse: [scriptName := '']. scriptName isEmptyOrNil ifTrue: [^ self]. loader := CodeLoader new. loader loadSourceFiles: (Array with: scriptName). (scriptName asLowercase endsWith: '.pr') ifTrue: [self installProjectFrom: loader] ifFalse: [loader installSourceFiles]! !
!ProjectLoading class methodsFor: 'accessing' stamp: 'mt 8/28/2023 13:46'! projectStreamFromArchive: archive | ext prFiles entry unzipped | ext := FileDirectory dot, Project projectExtension. prFiles := archive members select:[:any| any fileName endsWith: ext]. prFiles isEmpty ifTrue: ['']. entry := prFiles first. unzipped := MultiByteBinaryOrTextStream on: (ByteArray new: entry uncompressedSize). entry extractTo: unzipped. ^unzipped reset! !
!ProjectLoading class methodsFor: 'loading' stamp: 'mt 8/28/2023 13:51'! openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView clearOriginFlag: clearOriginFlag "Reconstitute a Morph from the selected file, presumed to represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world."
| morphOrList archive mgr substituteFont numberOfFontSubstitutes resultArray anObject project manifests dict | ProgressNotification signal: '0.2'. archive := preStream isZipArchive ifTrue:[ZipArchive new readFrom: preStream] ifFalse:[nil]. archive ifNotNil:[ manifests := (archive membersMatching: '*manifest'). (manifests size = 1 and: [((dict := self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression']) ifTrue: [^ self notify: 'S-Expression format projects not supported. Use Squeak 6.0 or older.']].
morphOrList := self morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive. morphOrList ifNil: [^ self]. ProgressNotification signal: '0.4'. resultArray := self fileInName: aFileName archive: archive morphOrList: morphOrList. anObject := resultArray first. numberOfFontSubstitutes := resultArray second. substituteFont := resultArray third. mgr := resultArray fourth. preStream close. ProgressNotification signal: '0.7'. "the hard part is over" (anObject isKindOf: ImageSegment) ifTrue: [ project := self loadImageSegment: anObject fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr. project noteManifestDetailsIn: dict. clearOriginFlag ifTrue: [project forgetExistingURL]. ProgressNotification signal: '0.8'. ^ project ifNil: [self inform: 'No project found in this file' translated] ifNotNil: [ProjectEntryNotification signal: project]]. Project current openViewAndEnter: anObject! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'tak 9/3/2006 11:00'! checkSecurity: aFileName preStream: preStream projStream: projStream "Answer true if passed" | trusted enterRestricted | trusted := SecurityManager default positionToSecureContentsOf: projStream. trusted ifFalse: [enterRestricted := (preStream isTypeHTTP or: [aFileName isNil]) ifTrue: [Preferences securityChecksEnabled] ifFalse: [Preferences standaloneSecurityChecksEnabled]. enterRestricted ifTrue: [SecurityManager default enterRestrictedMode ifFalse: [preStream close. ^ false]]]. ^ true ! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'mt 8/28/2023 13:49'! fileInName: aFileName archive: archive morphOrList: morphOrList | baseChangeSet substituteFont numberOfFontSubstitutes exceptions anObject mgr | ResourceCollector current: ResourceCollector new. baseChangeSet := ChangeSet current. self useTempChangeSet. "named zzTemp" "The actual reading happens here" substituteFont := Preferences standardDefaultTextFont copy. numberOfFontSubstitutes := 0. exceptions := Set new. [[anObject := morphOrList fileInObjectAndCodeForProject] on: MissingFont do: [ :ex | exceptions add: ex. numberOfFontSubstitutes := numberOfFontSubstitutes + 1. ex resume: substituteFont ]] ensure: [ ChangeSet newChanges: baseChangeSet]. mgr := ResourceManager new initializeFrom: ResourceCollector current. mgr fixJISX0208Resource. mgr registerUnloadedResources. archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName]. ResourceCollector current: nil. ^ {anObject. numberOfFontSubstitutes. substituteFont. mgr}! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'mt 8/28/2023 14:00'! loadImageSegment: morphOrList fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr
| proj projectsToBeDeleted f | (f := (Flaps globalFlapTabWithID: 'Navigator' translated)) ifNotNil: [f hideFlap]. proj := morphOrList arrayOfRoots detect: [:mm | mm isKindOf: Project] ifNone: [^ nil]. proj projectParameterAt: #substitutedFont put: substituteFont. proj projectParameters at: #MultiSymbolInWrongPlace put: false. "Yoshiki did not put MultiSymbols into outPointers in older images!!" morphOrList arrayOfRoots do: [:obj | obj fixUponLoad: proj seg: morphOrList "imageSegment"]. (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [ morphOrList arrayOfRoots do: [:obj | (obj isKindOf: HashedCollection ) ifTrue: [obj rehash]]].
proj resourceManager: mgr. "proj versionFrom: preStream." proj lastDirectory: aDirectoryOrNil. proj setParent: Project current. projectsToBeDeleted := OrderedCollection new. existingView == #none ifFalse: [ self makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted]. ChangeSet allChangeSets add: proj changeSet. Project current projectParameters at: #deleteWhenEnteringNewProject ifPresent: [ :ignored | projectsToBeDeleted add: Project current. Project current removeParameter: #deleteWhenEnteringNewProject. ]. projectsToBeDeleted isEmpty ifFalse: [ proj projectParameters at: #projectsToBeDeleted put: projectsToBeDeleted. ]. ^ proj! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'pre 8/22/2019 15:03'! makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted existingView ifNil: [ Smalltalk isMorphic ifTrue: [ proj createViewIfAppropriate. ] ifFalse: [ ChangeSet allChangeSets add: proj changeSet. Project current openProject: proj. "Note: in MVC we get no further than the above" ]. ] ifNotNil: [ (existingView project isKindOf: DiskProxy) ifFalse: [ existingView project changeSet name: ChangeSet defaultName. projectsToBeDeleted add: existingView project. ]. (existingView owner isSystemWindow) ifTrue: [ existingView owner model: proj ]. existingView project: proj. ]. ! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'cmm 10/23/2013 16:24'! morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive "Answer morphOrList or nil if problem happened" | projStream localDir morphOrList | projStream := archive ifNil: [preStream] ifNotNil: [self projectStreamFromArchive: archive]. (self checkSecurity: aFileName preStream: preStream projStream: projStream) ifFalse: [^nil]. localDir := Project squeakletDirectory. aFileName ifNotNil: [ (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName ~= localDir pathName]) ifTrue: [ localDir deleteFileNamed: aFileName. (localDir fileNamed: aFileName) binary nextPutAll: preStream remainingContents; close. ]. ]. morphOrList := projStream asUnZippedStream. preStream sleep. "if ftp, let the connection close" ^ morphOrList ! !
!ProjectLoading class methodsFor: 'loading - support' stamp: 'yo 2/5/2008 17:15'! parseManifest: aString
| dict line index key value aStream | aStream := aString readStream. dict := Dictionary new. [(line := aStream nextLine) notNil] whileTrue: [ index := line indexOf: $:. index > 0 ifTrue: [ key := line copyFrom: 1 to: index - 1. value := (line copyFrom: index + 1 to: line size) withBlanksTrimmed. dict at: key put: value. ]. ]. ^ dict.! !
!ProjectNavigationMorph methodsFor: 'buttons' stamp: 'mt 8/10/2023 11:32'! makeTheAdvancedButtons
^{ self buttonNewProject. self buttonShare. self buttonPrev. self buttonNext. self buttonPublish. self buttonNewer. self buttonTell. self buttonFind. self buttonFullScreen. "self buttonFlaps." }, ( Preferences includeSoundControlInNavigator ifTrue: [{self buttonSound}] ifFalse: [#()] ), { self buttonLanguage. self buttonUndo. self buttonQuit. } ! !
!ProjectNavigationMorph methodsFor: 'buttons' stamp: 'mt 8/28/2023 14:27'! makeTheButtons ^ self makeTheAdvancedButtons! !
!ProjectNavigationMorph methodsFor: 'the actions' stamp: 'mt 8/23/2023 13:51'! doPublishButtonMenuEvent: evt
| selection | selection := UIManager default chooseFrom: { 'Publish' translated. 'Publish As...' translated. 'Publish to Different Server' translated. } values: { [self publishProject]. [self publishProjectAs]. [self publishDifferent]. } title: 'Publish options' translated. selection ifNil: [^self]. selection value.
! !
!ProjectSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'! addControls "Add the control bar at the top of the tool."
| b r partsBinButton newButton aWrapper | newButton := ImageMorph new image: (Project current makeThumbnail scaledToSize: 48@36). newButton on: #mouseDown send: #insertNewProject: to: self. newButton setBalloonText: 'Make a new Project' translated. (partsBinButton := UpdatingThreePhaseButtonMorph checkBox) target: self; actionSelector: #togglePartsBinStatus; arguments: #(); getSelector: #getPartsBinStatus. (r := AlignmentMorph newRow) color: Color transparent; borderWidth: 0; layoutInset: 0; cellInset: 10@0; wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. b := SimpleButtonMorph new target: self; color: self defaultColor darker; borderColor: Color black. r addMorphBack: (self wrapperFor: (b label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort)). b := SimpleButtonMorph new target: self; color: self defaultColor darker; borderColor: Color black. r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #delete)); addTransparentSpacerOfSize: 8 @ 0; addMorphBack: (self wrapperFor: (newButton)); addTransparentSpacerOfSize: 8 @ 0.
aWrapper := AlignmentMorph newRow beTransparent. aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0. aWrapper addMorphBack: (self wrapperFor: partsBinButton); addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated font: Preferences standardButtonFont) lock). r addMorphBack: aWrapper.
self addMorphFront: r. ! !
!ProjectSorterMorph methodsFor: 'initialization' stamp: 'mt 8/14/2023 16:22'! initialize "initialize the state of the receiver"
super initialize. self useRoundedCorners. pageHolder useRoundedCorners; borderWidth: 0; color: (Form gridFormOrigin: 0 @ 0 grid: 32 @ 32 background: Color white line: Color blue muchLighter)! !
!ProjectSorterMorph methodsFor: 'controls' stamp: 'mt 8/23/2023 13:50'! insertNewProject: evt
[MorphicProject openViewOn: nil] on: ProjectViewOpenNotification do: [ :ex | ex resume: false].! !
!RecordingControlsMorph methodsFor: 'button commands' stamp: 'mt 8/22/2023 15:53'! makeTile "Make a tile representing my sound. Get a sound-name from the user by which the sound is to be known."
| tile | recorder verifyExistenceOfRecordedSound ifFalse: [^ self]. recorder pause. tile := InterimSoundMorph new sound: (SampledSound samples: recorder condensedSamples samplingRate: recorder samplingRate). tile bounds: tile fullBounds. tile openInHand! !
!ReferenceMorph methodsFor: 'menu' stamp: 'mt 8/14/2023 17:24'! changeTabGraphic | aGraphicalMenu | aGraphicalMenu := GraphicalMenu new initializeFor: submorphs first withForms: submorphs first reasonableForms coexist: true. self primaryHand attachMorph: aGraphicalMenu.! !
!ReferenceMorph methodsFor: 'menu' stamp: 'mt 7/31/2023 11:15'! graphicalMorphForTab | formToUse | formToUse := self valueOfProperty: #priorGraphic ifAbsent: [MenuIcons formAtKey: 'squeakyMouse']. ^ SketchMorph withForm: formToUse! !
!FlapTab methodsFor: 'show & hide' stamp: 'mt 8/4/2023 14:02'! showFlap "Open the flap up"
| thicknessToUse flapOwner |
"19 sept 2000 - going for all paste ups <- raa note" flapOwner := self pasteUpMorph. self referentThickness <= 0 ifTrue: [thicknessToUse := lastReferentThickness ifNil: [100]. self orientation == #horizontal ifTrue: [referent height: thicknessToUse] ifFalse: [referent width: thicknessToUse]]. inboard ifTrue: [self stickOntoReferent]. "makes referent my owner, and positions me accordingly" referent pasteUpMorph == flapOwner ifFalse: [flapOwner accommodateFlap: self. "Make room if needed" flapOwner addMorphFront: referent. flapOwner startSteppingSubmorphsOf: referent. self positionReferent]. inboard ifFalse: [self adjustPositionVisAVisFlap]. flapShowing := true. self pasteUpMorph hideFlapsOtherThan: self ifClingingTo: edgeToAdhereTo.
flapOwner bringTopmostsToFront! !
!ReferenceStream class methodsFor: 'accessing' stamp: 'mt 8/28/2023 15:43'! versionCode "Answer a number representing the 'version' of the ReferenceStream facility; this is stashed at the beginning of ReferenceStreams, as a secondary versioning mechanism (the primary one is the fileTypeCode). At present, it serves for information only, and is not checked for compatibility at reload time, but could in future be used to branch to variant code. "
" 1 = original version 1992" " 2 = HyperSqueak. PathFromHome used for Objs outside the tree. SqueakSupport SysLibrary for shared globals like Display and StrikeFonts. File has version number, class structure, then an IncomingObjects manager. 8/16/96 tk. Extended to SmartRefStream. class structure also keeps superclasse chain. Does analysis on structure to see when translation methods are needed. Embedable in file-ins. (factored out HyperSqueak support) Feb-May 97 tk" " 3 = Reference objects are byte offsets relative to the start of the object portion of the file. Rectangles with values -2048 to 2047 are encoded compactly." " 4 = If UniClasses have class instance variables, append their values in the form (#Class43 (val1 val2 vla3)). An array of those. Can still read version 3." ^ 4! !
!ReleaseBuilder class methodsFor: 'scripts' stamp: 'mt 8/16/2023 15:43'! configureTools "Initialize well-known tools and other resources."
FileList initialize. FileServices initialize. "register file reader services" RealEstateAgent standardSize: 650@425. SMLoaderPlus setDefaultFilters: #(filterSafelyAvailable).
"Default applications and tools." SystemBrowser default: TreeBrowser. MailSender default: nil. SoundService default: BaseSoundSystem. ToolSet default: StandardToolSet. WebBrowser default: nil. ! !
!ReleaseBuilder class methodsFor: 'scripts - support' stamp: 'mt 3/7/2023 14:05'! discardUserObjects
"Remove the classes." MorphicModel removeUninstantiatedSubclassesSilently.
"Clean-up environment hick-ups." Environment default allClassesDo: [:cls | (cls isUniClass and: [cls environment ~~ Environment default]) ifTrue: [Environment default forgetClass: cls logged: false]]. Environment default declarations select: [:binding | (binding value isBehavior and: [binding value isUniClass]) and: [binding value isObsolete]] thenDo: [:binding | SystemOrganization removeElement: binding key. Environment default removeKey: binding key].
"Remove auto-generated accessors. See Preferences." (MCPackage named: 'Autogenerated') unload.
"Remove empty categories for user objects. See Object class >> #categoryForUniclasses." SystemOrganizer cleanUp: true.! !
!RemoteHandMorph methodsFor: 'event handling' stamp: 'mt 8/28/2023 14:35'! transmitEvent: aMorphicEvent "Transmit the given event to all remote connections." | firstEvt | self readyToTransmit ifFalse: [^ self]. self lastEventTransmitted = aMorphicEvent ifTrue: [^ self]. sendBuffer ifNil: [sendBuffer := WriteStream on: (String new: 10000)]. sendBuffer nextPutAll: aMorphicEvent storeString; cr. self lastEventTransmitted: aMorphicEvent.
sendSocket isConnected ifTrue:[ sendState = #opening ifTrue: [ "connection established; disable TCP delays on sends" sendSocket setOption: 'TCP_NODELAY' value: true. "send worldExtent as first event" firstEvt := MorphicUnknownEvent new setType: #worldBounds argument: self worldBounds extent. sendSocket sendData: firstEvt storeString, (String with: Character cr). Transcript show: 'Connection established with remote WorldMorph at '; show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. sendState := #connected]. sendSocket sendData: sendBuffer contents. ] ifFalse: [ owner primaryHand removeEventListener: self. sendState = #connected ifTrue: [ "other end has closed; close our end" Transcript show: 'Closing connection with remote WorldMorph at '; show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. sendSocket close. sendState := #closing]].
sendBuffer reset. ! !
!ResourceCollector methodsFor: 'initialize' stamp: 'mt 3/15/2023 14:07'! initialize originalMap := IdentityDictionary new. stubMap := IdentityDictionary new. locatorMap := IdentityDictionary new. internalStubs := IdentityDictionary new.! !
!ScreenController methodsFor: 'nested menus' stamp: 'mt 7/31/2023 11:19'! helpMenu "Answer the help menu to be put up as a screen submenu"
^ SelectionMenu labelList: #( 'about this system...' 'update code from server' 'preferences...'
'command-key help' 'font size summary' 'useful expressions' 'view graphical imports' 'standard graphics library'),
(Array with: (SoundService soundEnablingString)) ,
#( 'set author initials...' 'vm statistics' 'space left') lines: #(1 4 6 11) selections: #( aboutThisSystem absorbUpdatesFromServer editPreferences openCommandKeyHelp fontSizeSummary openStandardWorkspace viewImageImports soundOnOrOff setAuthorInitials vmStatistics garbageCollect) " ScreenController new helpMenu startUp "! !
!ScrollableField methodsFor: 'menu' stamp: 'mt 8/11/2023 14:47'! getMenu: shiftKeyState ^ shiftKeyState not ifTrue: [TextEditor yellowButtonMenu] ifFalse: [TextEditor shiftedYellowButtonMenu]! !
!SelectionMorph methodsFor: 'halo commands' stamp: 'mt 3/10/2023 15:26'! duplicate "Make a duplicate of the receiver and havbe the hand grab it"
selectedItems := self duplicateMorphCollection: selectedItems. selectedItems reverseDo: [:m | (owner ifNil: [self currentWorld]) addMorph: m]. dupLoc := self position. self currentHand grabMorph: self.! !
!ServerDirectory class methodsFor: 'school support' stamp: 'mt 3/10/2023 11:45'! projectDefaultDirectory ^ FileDirectory default! !
!ServerDirectory class methodsFor: 'server prefs' stamp: 'mt 8/16/2023 15:50'! parseServerEntryFrom: stream | server type directory entries serverName |
entries := ExternalSettings parseServerEntryArgsFrom: stream.
serverName := entries at: 'name' ifAbsent: [^nil]. directory := entries at: 'directory' ifAbsent: [^nil]. type := entries at: 'type' ifAbsent: [^nil]. type = 'file' ifTrue: [ server := self determineLocalServerDirectory: directory. entries at: 'userListUrl' ifPresent:[:value | "Ignore" ]. entries at: 'baseFolderSpec' ifPresent:[:value | "Ignore" ]. ^self addLocalProjectDirectory: server]. type = 'bss' ifTrue: [server := SuperSwikiServer new type: #http]. type = 'http' ifTrue: [server := HTTPServerDirectory new type: #ftp]. type = 'ftp' ifTrue: [server := ServerDirectory new type: #ftp].
server directory: directory. entries at: 'server' ifPresent: [:value | server server: value]. entries at: 'user' ifPresent: [:value | server user: value]. entries at: 'group' ifPresent: [:value | server groupName: value]. entries at: 'passwdseq' ifPresent: [:value | server passwordSequence: value asNumber]. entries at: 'url' ifPresent: [:value | server altUrl: value]. entries at: 'loaderUrl' ifPresent: [:value | server loaderUrl: value]. entries at: 'acceptsUploads' ifPresent: [:value | server acceptsUploads: value asLowercase = 'true']. entries at: 'userListUrl' ifPresent:[:value | "Ignore" ]. entries at: 'encodingName' ifPresent:[:value | server encodingName: value]. ServerDirectory addServer: server named: serverName. ! !
!IconicButton methodsFor: 'initialization' stamp: 'mt 3/7/2023 15:06'! initializeWithThumbnail: aThumbnail withLabel: aLabel andColor: aColor andSend: aSelector to: aReceiver "Initialize the receiver to show aThumbnail on its face, giving it the label supplied and arranging for it, when the button goes down on it, to obtain a new morph by sending the supplied selector to the supplied receiver"
| labeledItem nonTranslucent | nonTranslucent := aColor asNontranslucentColor. labeledItem := AlignmentMorph newColumn. labeledItem color: nonTranslucent. labeledItem borderWidth: 0. labeledItem layoutInset: 4@0; cellPositioning: #center. labeledItem addMorph: aThumbnail. labeledItem addMorphBack: (Morph new extent: (4@4)) beTransparent. labeledItem addMorphBack: (TextMorph new backgroundColor: nonTranslucent; contentsAsIs: aLabel; beAllFont: Preferences standardButtonFont; centered).
self beTransparent; labelGraphic: ((labeledItem imageForm: 32 backgroundColor: nonTranslucent forRectangle: labeledItem fullBounds) replaceColor: nonTranslucent withColor: Color transparent); borderWidth: 0; target: aReceiver; actionSelector: #launchPartVia:label:; arguments: {aSelector. aLabel}; actWhen: #buttonDown.
self stationarySetup.! !
!IconicButton methodsFor: 'initialization' stamp: 'mt 3/15/2023 14:10'! setDefaultLabel self labelGraphic: (MenuIcons formAtKey: 'squeakyMouse')! !
!HaloMorph methodsFor: 'handles' stamp: 'mt 3/15/2023 13:34'! addDismissHandle: handleSpec "Add the dismiss handle according to the spec, unless my target resists dismissal"
| dismissHandle | target okayToAddDismissHandle ifTrue: [dismissHandle := self addHandle: handleSpec on: #mouseDown send: #mouseDownInDimissHandle:with: to: self. dismissHandle on: #mouseUp send: #maybeDismiss:with: to: self. dismissHandle on: #mouseDown send: #setDismissColor:with: to: self. dismissHandle on: #mouseMove send: #setDismissColor:with: to: self] ! !
!HaloMorph methodsFor: 'handles' stamp: 'mt 8/11/2023 14:24'! addDupHandle: haloSpec "Add the halo that offers duplication"
self addHandle: haloSpec on: #mouseDown send: #doDup:with: to: self
! !
!HaloMorph methodsFor: 'handles' stamp: 'sw 1/26/2000 16:16'! addHelpHandle: haloSpec target balloonText ifNotNil: [(self addHandle: haloSpec on: #mouseDown send: #mouseDownOnHelpHandle: to: innerTarget) on: #mouseUp send: #deleteBalloon to: innerTarget] ! !
!HaloMorph methodsFor: 'handles' stamp: 'RAA 3/15/2001 11:24'! addRecolorHandle: haloSpec "Add a recolor handle to the receiver, if appropriate"
| recolorHandle |
"since this halo now opens a more general properties panel, allow it in all cases" "innerTarget canSetColor ifTrue:"
recolorHandle := self addHandle: haloSpec on: #mouseUp send: #doRecolor:with: to: self. recolorHandle on: #mouseUp send: #doRecolor:with: to: self
! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/15/2023 14:10'! addGraphicalHandleFrom: formKey at: aPoint "Add the supplied form as a graphical handle centered at the given point. Return the handle." | handle aForm | aForm := (MenuIcons formAtKey: formKey) ifNil: [MenuIcons formAtKey: #SolidMenu]. handle := ImageMorph new image: aForm; bounds: (Rectangle center: aPoint extent: aForm extent). handle borderColor: Color black; borderWidth: 2. handle wantsYellowButtonMenu: false. self addMorph: handle. handle on: #mouseUp send: #endInteraction: to: self. ^ handle ! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/15/2023 14:10'! createHandleAt: aPoint color: aColor iconName: iconName | bou handle | bou := Rectangle center: aPoint extent: self handleSize asPoint. Preferences alternateHandlesLook ifTrue: [handle := RectangleMorph newBounds: bou color: aColor. handle useRoundedCorners. self setColor: aColor toHandle: handle] ifFalse: [handle := EllipseMorph newBounds: bou color: aColor]. handle borderWidth: 0; wantsYellowButtonMenu: false. "" iconName isNil ifFalse: [| form | form := MenuIcons formAtKey: iconName. form isNil ifFalse: [| image | image := ImageMorph new. image image: form scaleIconToDisplay. image color: aColor makeForegroundColor. image lock. handle addMorphCentered: image]]. "" ^ handle! !
!HaloMorph methodsFor: 'private' stamp: 'mt 2/19/2021 14:52'! doGrow: evt with: growHandle "Called while the mouse is down in the grow handle"
| newExtent extentToUse scale | evt hand obtainHalo: self. newExtent := (target pointFromWorld: evt cursorPoint - positionOffset) - target topLeft. evt shiftPressed ifTrue: [ scale := (newExtent x / (originalExtent x max: 1)) min: (newExtent y / (originalExtent y max: 1)). newExtent := (originalExtent x * scale) asInteger @ (originalExtent y * scale) asInteger ]. (newExtent x < 1 or: [newExtent y < 1 ]) ifTrue: [^ self]. target renderedMorph setExtentFromHalo: (extentToUse := newExtent). growHandle position: evt cursorPoint - (growHandle extent // 2). self layoutChanged. (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | "Update the final extent" cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: extentToUse] ! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/8/2023 11:29'! doRecolor: evt with: aHandle "The mouse went down in the 'recolor' halo handle. Allow the user to change the color of the innerTarget"
evt hand obtainHalo: self. (aHandle containsPoint: evt cursorPoint) ifFalse: "only do it if mouse still in handle on mouse up" [self delete. target addHalo: evt] ifTrue: [innerTarget changeColor. self showingDirectionHandles ifTrue: [self addHandles]]! !
!HaloMorph methodsFor: 'private' stamp: 'ul 12/12/2009 14:11'! doRot: evt with: rotHandle "Update the rotation of my target if it is rotatable. Keep the relevant command object up to date."
| degrees | evt hand obtainHalo: self. degrees := (evt cursorPoint - (target pointInWorld: target referencePosition)) degrees. degrees := degrees - angleOffset degrees. degrees := degrees detentBy: 10.0 atMultiplesOf: 90.0 snap: false. degrees = 0.0 ifTrue: [self setColor: Color lightBlue toHandle: rotHandle] ifFalse: [self setColor: Color blue toHandle: rotHandle]. rotHandle submorphsDo: [:m | m color: rotHandle color makeForegroundColor]. self removeAllHandlesBut: rotHandle. self showingDirectionHandles ifFalse: [self showDirectionHandles: true addHandles: false]. self addDirectionHandles.
target rotationDegrees: degrees.
rotHandle position: evt cursorPoint - (rotHandle extent // 2). (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | "Update the final rotation" cmd redoTarget: target renderedMorph selector: #heading: argument: degrees]. self layoutChanged! !
!HaloMorph methodsFor: 'private' stamp: 'ul 12/12/2009 14:11'! doScale: evt with: scaleHandle "Update the scale of my target if it is scalable." | newHandlePos colorToUse | evt hand obtainHalo: self. newHandlePos := evt cursorPoint - (scaleHandle extent // 2). target scaleToMatch: newHandlePos. colorToUse := target scale = 1.0 ifTrue: [Color yellow] ifFalse: [Color orange]. self setColor: colorToUse toHandle: scaleHandle. scaleHandle submorphsDo: [:m | m color: colorToUse makeForegroundColor]. scaleHandle position: newHandlePos. self layoutChanged.
(self valueOfProperty: #commandInProgress) ifNotNil:[:cmd | "Update the final extent" cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent ]. ! !
!HaloMorph methodsFor: 'private' stamp: 'mt 8/11/2023 17:00'! endInteraction: event "Clean up after a user interaction with the a halo control"
| m | (target isInWorld not or: [owner isNil]) ifTrue: [^self]. [target isFlexMorph and: [target hasNoScaleOrRotation]] whileTrue: [m := target firstSubmorph. target removeFlexShell. target := m]. self restoreTargetDropShadows. target changedViaHalo: self. self isInWorld ifTrue: ["make sure handles show in front, even if flex shell added" self flag: #tofix. "mt: Try to avoid deleting and re-creating an event handler (here: the handle) while handling the event." self comeToFront. self addHandles. event hand newMouseFocus: self]. (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | self rememberCommand: cmd. self removeProperty: #commandInProgress].! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/10/2023 15:08'! maybeDismiss: evt with: dismissHandle "Ask hand to dismiss my target if mouse comes up in it."
evt hand obtainHalo: self. (dismissHandle containsPoint: evt cursorPoint) ifFalse: [self delete. target addHalo: evt] ifTrue: [target resistsRemoval ifTrue: [(Project uiManager chooseOptionFrom: {'Yes' translated. 'Um, no, let me reconsider' translated.} title: 'Really throw this away?' translated) = 1 ifFalse: [^ self]]. evt hand removeHalo. self delete. target dismissViaHalo].! !
!HaloMorph methodsFor: 'private' stamp: 'HenrikSperreJohansen 1/21/2011 18:34'! mouseDownInDimissHandle: evt with: dismissHandle evt hand obtainHalo: self. SoundService soundEnabled ifTrue: [TrashCanMorph playMouseEnterSound]. self removeAllHandlesBut: dismissHandle. self setColor: Color darkGray toHandle: dismissHandle. ! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/10/2023 13:51'! startDrag: evt with: dragHandle "Drag my target without removing it from its owner."
self obtainHaloForEvent: evt andRemoveAllHandlesBut: dragHandle. target aboutToBeDraggedViaHalo. positionOffset := dragHandle center - (target point: target position in: owner).! !
!HaloMorph methodsFor: 'private' stamp: 'ct 2/28/2022 16:24'! startGrow: evt with: growHandle "Initialize resizing of my target. Launch a command representing it, to support Undo"
| botRt | self obtainHaloForEvent: evt andRemoveAllHandlesBut: growHandle. self backupAndHideTargetDropShadows. target aboutToBeGrownViaHalo. botRt := target point: target bottomRight in: owner. positionOffset := (self world viewBox containsPoint: botRt) ifTrue: [evt cursorPoint - botRt] ifFalse: [0@0].
self setProperty: #commandInProgress toValue: (Command new cmdWording: ('resize ' translated, target nameForUndoWording); undoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent).
originalExtent := target extent! !
!HaloMorph methodsFor: 'private' stamp: 'mt 8/11/2023 16:59'! startRot: evt with: rotHandle "Initialize rotation of my target if it is rotatable. Launch a command object to represent the action"
self obtainHaloForEvent: evt andRemoveAllHandlesBut: rotHandle. self backupAndHideTargetDropShadows. target aboutToBeRotatedViaHalo. target isFlexMorph ifFalse: [target addFlexShellIfNecessary]. growingOrRotating := true.
self removeAllHandlesBut: rotHandle. "remove all other handles" angleOffset := evt cursorPoint - (target pointInWorld: target referencePosition). angleOffset := Point r: angleOffset r degrees: angleOffset degrees - target rotationDegrees. self setProperty: #commandInProgress toValue: (Command new cmdWording: ('rotate ' translated, target nameForUndoWording); undoTarget: target renderedMorph selector: #heading: argument: target rotationDegrees)
! !
!HaloMorph methodsFor: 'private' stamp: 'mt 3/7/2023 16:46'! startScale: evt with: scaleHandle "Initialize scaling of my target."
self obtainHaloForEvent: evt andRemoveAllHandlesBut: scaleHandle. self backupAndHideTargetDropShadows. target aboutToBeScaledViaHalo. target isFlexMorph ifFalse: [target addFlexShellIfNecessary]. growingOrRotating := true. positionOffset := 0@0. originalExtent := target extent ! !
!HaloMorph methodsFor: 'pop up' stamp: 'mt 3/15/2023 13:40'! popUpFor: morph at: position hand: hand
super popUpFor: morph at: position hand: hand. self startStepping.! !
!HaloMorph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/15/2023 13:40'! delete "Delete the halo. Tell the target that it no longer has the halo; accept any pending edits to the name; and then actually delete myself"
self acceptNameEdit. super delete.! !
!SketchEditorMorph methodsFor: 'initialization' stamp: 'mt 8/10/2023 15:28'! initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph."
| paintBoxBounds worldBounds | self setProperty: #recipientPasteUp toValue: aPasteUpMorph.
paintBoxBounds := self world paintBox bounds. worldBounds := self world bounds.
self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: ((boundsToUse topRight extent: paintBoxBounds extent) translatedToBeWithin: worldBounds) topLeft. ! !
!SketchEditorMorph methodsFor: 'start & finish' stamp: 'mt 8/10/2023 15:34'! cancelOutOfPainting "The user requested to back out of a painting session without saving"
self deleteSelfAndSubordinates. emptyPicBlock ifNotNil: [emptyPicBlock value]. "note no args to block!!" hostView ifNotNil: [hostView changed]. ^ nil! !
!SketchEditorMorph methodsFor: 'start & finish' stamp: 'mt 8/10/2023 15:34'! deliverPainting: result evt: evt "Done painting. May come from resume, or from original call. Execute user's post painting instructions in the block. Always use this standard one. 4/21/97 tk"
| newBox newForm ans | palette ifNotNil: "nil happens" [palette setAction: #paint: evt: evt]. "Get out of odd modes" "rot := palette getRotations." "rotate with heading, or turn to and fro" "palette setRotation: #normal." result == #cancel ifTrue: [ ans := Project uiManager chooseOptionFrom: { 'throw it away' translated. 'keep painting it' translated} title: 'Do you really want to throw away what you just painted?' translated. ^ ans = 1 ifTrue: [self cancelOutOfPainting] ifFalse: [nil]]. "cancelled out of cancelling."
"hostView rotationStyle: rot." "rotate with heading, or turn to and fro" newBox := paintingForm rectangleEnclosingPixelsNotOfColor: Color transparent. registrationPoint ifNotNil: [registrationPoint := registrationPoint - newBox origin]. "relative to newForm origin" newForm := Form extent: newBox extent depth: paintingForm depth. newForm copyBits: newBox from: paintingForm at: 0@0 clippingBox: newForm boundingBox rule: Form over fillColor: nil. newForm isAllWhite ifTrue: [(self valueOfProperty: #background) == true ifFalse: [^ self cancelOutOfPainting]].
newForm fixAlpha. "so alpha channel stays intact for 32bpp"
self delete. "so won't find me again" dimForm ifNotNil: [dimForm delete]. newPicBlock value: newForm value: (newBox copy translateBy: bounds origin).! !
!SketchMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:15'! setNewFormFrom: formOrNil "Set the receiver's form as indicated. If nil is provided, then a default form will be used"
formOrNil ifNotNil: [^ self form: formOrNil]. self form: (Form extent: 16@16 depth: 32) ! !
!SketchMorph methodsFor: 'initialization' stamp: 'mt 3/15/2023 14:10'! initialize "initialize the state of the receiver" ^ self initializeWith: (MenuIcons formAtKey: 'Painting') deepCopy! !
!SketchMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 14:30'! addPaintingItemsTo: aMenu hand: aHandMorph | subMenu movies | subMenu := MenuMorph new defaultTarget: self. subMenu add: 'repaint' translated action: #editDrawing; add: 'set rotation center' translated action: #setRotationCenter; add: 'reset forward-direction' translated action: #resetForwardDirection; add: 'set rotation style' translated action: #setRotationStyle; add: 'erase pixels of color' translated action: #erasePixelsUsing:; add: 'recolor pixels of color' translated action: #recolorPixelsUsing:; add: 'reduce color palette' translated action: #reduceColorPalette:; add: 'detect edges' translated action: #edgeDetect; add: 'sharpen' translated action: #sharpen; add: 'blur' translated action: #blur; add: 'emboss' translated action: #emboss; add: 'add a border around this shape...' translated action: #addBorderToShape:. movies := (self world rootMorphsAt: aHandMorph targetPoint) select: [:m | (m isKindOf: MovieMorph) or: [m isSketchMorph]]. movies size > 1 ifTrue: [subMenu add: 'insert into movie' translated action: #insertIntoMovie:]. aMenu add: 'painting...' translated subMenu: subMenu! !
!SketchMorph methodsFor: 'menu' stamp: 'mt 8/10/2023 15:33'! editDrawingIn: aPasteUpMorph forBackground: forBackground "Edit an existing sketch."
| w bnds sketchEditor rotCenter aWorld aPaintBox | self world assureNotPaintingElse: [^self]. w := aPasteUpMorph world.
w displayWorld. self visible: false. bnds := forBackground ifTrue: [aPasteUpMorph boundsInWorld] ifFalse: [self boundsInWorld expandBy: 60 @ 60]. sketchEditor := SketchEditorMorph new. forBackground ifTrue: [sketchEditor setProperty: #background toValue: true]. w addMorphFront: sketchEditor. sketchEditor initializeFor: self inBounds: bnds pasteUpMorph: aPasteUpMorph. rotCenter := self rotationCenter.
sketchEditor afterNewPicDo: [:aForm :aRect | | tfx | self visible: true. self form: aForm. tfx := aPasteUpMorph transformFrom: aPasteUpMorph world. self topRendererOrSelf position: (tfx globalPointToLocal: aRect origin). self rotationStyle: sketchEditor rotationStyle. self forwardDirection: sketchEditor forwardDirection. (rotCenter notNil and: [(rotCenter = (0.5 @ 0.5)) not]) ifTrue: [self rotationCenter: rotCenter]. aWorld := self world. (aPaintBox := aWorld paintBox) ifNotNil: [aPaintBox delete].
forBackground ifTrue: [self goBehind "shouldn't be necessary"]] ifNoBits: []! !
!SketchMorph methodsFor: 'menus' stamp: 'mt 3/10/2023 16:09'! addToggleItemsToHaloMenu: aCustomMenu "Add toggle-items to the halo menu" super addToggleItemsToHaloMenu: aCustomMenu. aCustomMenu addUpdating: #useInterpolationString target: self action: #toggleInterpolation.! !
!SketchMorph methodsFor: 'menus' stamp: 'mt 8/11/2023 13:42'! chooseNewGraphic "Allow the user to choose a different form for her form-based morph"
| aGraphicalMenu | aGraphicalMenu := GraphicalMenu new initializeFor: self withForms: self reasonableForms coexist: true. self primaryHand attachMorph: aGraphicalMenu.! !
!SketchMorph methodsFor: 'parts bin' stamp: 'mt 3/15/2023 14:10'! initializeToStandAlone super initializeToStandAlone. self initializeWith: (MenuIcons formAtKey: 'Painting') deepCopy
! !
!ColorPickerMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 14:01'! mouseUp: evt
self stopStepping. sourceHand := nil. deleteOnMouseUp ifTrue: [self delete]. self updateTargetColor. ! !
!ColorPickerMorph methodsFor: 'menu' stamp: 'mt 3/15/2023 14:09'! pickUpColorFor: aMorph "Show the eyedropper cursor, and modally track the mouse through a mouse-down and mouse-up cycle"
| aHand localPt | aHand := aMorph ifNil: [self activeHand] ifNotNil: [aMorph activeHand]. aHand ifNil: [aHand := self currentHand]. self addToWorld: aHand world near: (aMorph ifNil: [aHand world]) fullBounds. self owner ifNil: [^ self].
aHand showTemporaryCursor: (MenuIcons formAtKey: #Eyedropper) hotSpotOffset: 2@14. "<<<< the form was changed a bit??"
self updateContinuously: false. [Sensor anyButtonPressed] whileFalse: [self trackColorUnderMouse]. self deleteAllBalloons.
localPt := Sensor cursorPoint - self topLeft. self inhibitDragging ifFalse: [ (DragBox containsPoint: localPt) ifTrue: ["Click or drag the drag-dot means to anchor as a modeless picker" ^ self anchorAndRunModeless: aHand]. ]. (clickedTranslucency := TransparentBox containsPoint: localPt) ifTrue: [selectedColor := originalColor].
self updateContinuously: true. [Sensor anyButtonPressed] whileTrue: [self updateTargetColorWith: self indicateColorUnderMouse]. aHand newMouseFocus: nil; showTemporaryCursor: nil; flushEvents. self delete. ! !
!ColorPickerMorph methodsFor: 'private' stamp: 'mt 3/10/2023 14:01'! pickColorAt: aGlobalPoint
| alpha selfRelativePoint pickedColor | clickedTranslucency ifNil: [clickedTranslucency := false]. selfRelativePoint := (self globalPointToLocal: aGlobalPoint) - self topLeft. (FeedbackBox containsPoint: selfRelativePoint) ifTrue: [^ self]. (RevertBox containsPoint: selfRelativePoint) ifTrue: [^ self updateColor: originalColor feedbackColor: originalColor].
"check for transparent color and update using appropriate feedback color " (TransparentBox containsPoint: selfRelativePoint) ifTrue: [clickedTranslucency ifFalse: [^ self]. "Can't wander into translucency control" alpha := (selfRelativePoint x - TransparentBox left - 10) asFloat / (TransparentBox width - 20) min: 1.0 max: 0.0. "(alpha roundTo: 0.01) printString , ' ' displayAt: 0@0." " -- debug" self updateColor: (selectedColor alpha: alpha) feedbackColor: (selectedColor alpha: alpha). ^ self].
"pick up color, either inside or outside this world" clickedTranslucency ifTrue: [^ self]. "Can't wander out of translucency control" self locationIndicator visible: false. self refreshWorld. pickedColor := Display colorAt: aGlobalPoint. self locationIndicator visible: true. self refreshWorld. self updateColor: ( (selectedColor isColor and: [selectedColor isTranslucentColor]) ifTrue: [pickedColor alpha: selectedColor alpha] ifFalse: [pickedColor] ) feedbackColor: pickedColor! !
!SmartRefStream methodsFor: 'read write' stamp: 'mt 3/10/2023 15:43'! initKnownRenames renamed at: #FlasherMorph put: #Flasher; at: #AlansTextPlusMorph put: #TextPlusMorph; at: #Project put: #MorphicProject; at: #InputSensor put: #EventSensor; yourself! !
!SmartRefStream methodsFor: 'read write' stamp: 'mt 3/10/2023 15:43'! restoreClassInstVars "Install the values of the class instance variables of UniClasses."
self flag: #todo. "mt: See EToys in Squeak 6.0 and before."! !
!SqueakToolsDebuggerHelp class methodsFor: 'pages' stamp: 'mt 3/15/2023 14:10'! showForm: aSymbol | form contents | form := MenuIcons formAtKey: aSymbol. contents := (String with: Character cr) asText, (Text string: ' ' attribute: (TextFontReference toFont: (FormSetFont new fromFormArray: (Array with: form) asciiStart: Character space asInteger ascent: form height))), (String with: Character cr) asText. ^contents! !
!SystemWindow methodsFor: 'initialization' stamp: 'mt 3/10/2023 16:09'! initializeLabelArea "Initialize the label area (titlebar) for the window." labelString ifNil: [labelString := 'Untitled Window']. label := StringMorph new contents: labelString; font: (self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont]); yourself. "Add collapse box so #labelHeight will work" collapseBox := self createCollapseBox. stripes := Array with: (RectangleMorph newBounds: bounds) with: (RectangleMorph newBounds: bounds). "see extent:" self addLabelArea. self setLabelWidgetAllowance. self addCloseBox. self class moveMenuButtonRight ifTrue: [self addLabel. self addMenuControl] ifFalse: [self addMenuControl. self addLabel]. self addExpandBox. labelArea addMorphBack: collapseBox. self setFramesForLabelArea. ! !
!SystemWindow methodsFor: 'menu' stamp: 'dao 10/1/2004 12:57'! fullScreenMaximumExtent "Zoom Window to Full World size with possible DeskMargins obey the maximum extent rules" | left right possibleBounds | left := right := 0. self paneMorphs do: [:pane | ((pane isKindOf: ScrollPane) and: [pane retractableScrollBar]) ifTrue: [pane scrollBarOnLeft ifTrue: [left := left max: pane scrollBarThickness] ifFalse: [right := right max: pane scrollBarThickness]]]. possibleBounds := self worldBounds insetBy: (left @ 0 corner: right @ 0).
self maximumExtent ifNotNil: [possibleBounds := possibleBounds origin extent: ( self maximumExtent min: ( possibleBounds extent ))]. ((Flaps sharedFlapsAllowed and: [Project current flapsSuppressed not]) or: [Preferences fullScreenLeavesDeskMargins]) ifTrue: [possibleBounds := possibleBounds insetBy: 22]. self bounds: possibleBounds! !
!SystemWindow methodsFor: 'menu' stamp: 'mt 3/10/2023 14:27'! sendToBack | aWorld nextWindow | aWorld := self world. nextWindow := aWorld submorphs detect: [:m | (m isSystemWindow) and: [m ~~ self]] ifNone: [^self]. nextWindow beKeyWindow. aWorld addMorphBack: self! !
!SystemWindow methodsFor: 'open/close' stamp: 'mt 3/7/2023 17:40'! delete | thisWorld | self mustNotClose ifTrue: [^self]. model okToClose ifFalse: [^self]. thisWorld := self world. self activeHand removeKeyboardListener: self. self isFlexed ifTrue: [owner delete] ifFalse: [super delete]. model windowIsClosing; release. model := nil. SystemWindow noteTopWindowIn: thisWorld! !
!SystemWindow methodsFor: 'stepping' stamp: 'mt 8/28/2023 15:51'! stepAt: millisecondClockValue "If the receiver is not collapsed, step it, after first stepping the model."
(isCollapsed not or: [self wantsStepsWhenCollapsed]) ifTrue: [model ifNotNil: [model stepAt: millisecondClockValue in: self]. super stepAt: millisecondClockValue]
"Since this method ends up calling step, the model-stepping logic should not be duplicated there."! !
!SystemWindow methodsFor: 'stepping' stamp: 'mt 3/10/2023 15:01'! wantsSteps "Return true if the model wants its view to be stepped. For an open system window, we give the model to offer an opinion"
self isPartsDonor ifTrue: [^ false]. ^ isCollapsed not and: [model wantsStepsIn: self]! !
!SystemWindow methodsFor: 'top window' stamp: 'mt 3/7/2023 17:40'! comeToFront
"Modal windows: Walk along the modal owner chain, the bring all to top." self modalOwner ifNotNil: [:mo | mo isSystemWindow ifTrue: [ ^ mo modalOwner ifNil: [mo comeToFrontModally] ifNotNil: [:omo | omo comeToFront]]]. self modalChild ifNotNil: [^ self comeToFrontModally]. "Now show me." super comeToFront. "Label should be visible to interact with." self assureLabelAreaVisible.! !
!TabMorph methodsFor: 'tabs' stamp: 'mt 8/4/2023 13:36'! tabSelected "Called when the receiver is hit. First, bulletproof against someone having taken the structure apart. My own action basically requires that my grand-owner be a TabbedPalette" (owner isKindOf: IndexTabs) ifFalse: [^ Beeper beep]. (owner owner isKindOf: TabbedPalette) ifFalse: [^ Beeper beep]. owner owner selectTab: self! !
!TabSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'! addControls "Add the control bar at the top of the tool."
| b r | b := SimpleButtonMorph new target: self; borderColor: Color black. r := AlignmentMorph newRow. r color: b color; borderWidth: 0; layoutInset: 0. r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. r wrapCentering: #topLeft. r addMorphBack: (b label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort). b := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (b label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #cancelSort). self addMorphFront: r. ! !
!TabSorterMorph methodsFor: 'initialization' stamp: 'mt 8/16/2023 13:52'! initialize "Initialize the receiver."
super initialize. self removeAllMorphs.
self extent: 300@100. pageHolder := PasteUpMorph new. pageHolder vResizeToFit: true; autoLineLayout: true. pageHolder extent: self extent - self borderWidth. pageHolder padding: 8. pageHolder cursor: 0. self addControls. self addMorphBack: pageHolder! !
!TabbedPalette methodsFor: 'palette menu' stamp: 'mt 8/4/2023 13:42'! addBookMenuItemsTo: aCustomMenu hand: aHandMorph aCustomMenu add: 'add palette menu' translated action: #addMenuTab.! !
!TabbedPalette methodsFor: 'palette menu' stamp: 'mt 7/31/2023 11:20'! addMenuTab "Add the menu tab. This is ancient code, not much in the spirit of anything current"
| aMenu aTab aGraphic sk | aMenu := MenuMorph new defaultTarget: self. aMenu stayUp: true. "aMenu add: 'clear' translated action: #showNoPalette." aMenu add: 'sort tabs' translated action: #sortTabs:. aMenu add: 'choose new colors for tabs' translated action: #recolorTabs. aMenu setProperty: #paletteMenu toValue: true. "aMenu add: 'make me the Standard palette' translated action: #becomeStandardPalette." aTab := self addTabForBook: aMenu withBalloonText: 'a menu of palette-related controls' translated. aTab highlightColor: tabsMorph highlightColor; regularColor: tabsMorph regularColor. tabsMorph laySubpartsOutInOneRow; layoutChanged.
aGraphic := MenuIcons formAtKey: 'TinyMenu'. aGraphic ifNotNil: [aTab removeAllMorphs. aTab addMorph: (sk := Project current world drawingClass withForm: aGraphic). sk position: aTab position. sk lock. aTab fitContents]. self layoutChanged! !
!TabbedPalette methodsFor: 'user-interface' stamp: 'mt 8/4/2023 13:36'! selectTab: aTab | currentPalette morphToInstall oldTab aSketchEditor | oldTab := tabsMorph highlightedTab. (oldTab notNil and: [(morphToInstall := oldTab morphToInstall) isKindOf: PaintBoxMorph]) ifTrue: [(aSketchEditor := self world submorphOfClass: SketchEditorMorph) ifNotNil: [aSketchEditor cancelOutOfPainting]. morphToInstall delete].
tabsMorph selectTab: aTab. morphToInstall := aTab morphToInstall.
(morphToInstall isKindOf: PaintBoxMorph) "special case, maybe generalize this need?" ifFalse: [self goToPageMorph: morphToInstall] ifTrue: [self showNoPaletteAndHighlightTab: aTab. self world addMorphFront: morphToInstall. morphToInstall position: ((self left max: 90) "room for the pop-out-to-left panel" @ (tabsMorph bottom))]. (currentPalette := self currentPalette) ifNotNil: [currentPalette layoutChanged]. self snapToEdgeIfAppropriate! !
!TabbedPalette class methodsFor: 'scripting' stamp: 'mt 7/31/2023 11:20'! authoringPrototype | aTabbedPalette aBook aTab | aTabbedPalette := self new markAsPartsDonor. aTabbedPalette pageSize: 200 @ 300. aTabbedPalette tabsMorph highlightColor: Color red regularColor: Color blue. aTabbedPalette addMenuTab.
aBook := BookMorph new setNameTo: 'one'; pageSize: aTabbedPalette pageSize. aBook color: Color blue muchLighter. aBook removeEverything; insertPage; showPageControls. aBook currentPage addMorphBack: (Project current world drawingClass withForm: (MenuIcons formAtKey: 'squeakyMouse')). aTab := aTabbedPalette addTabForBook: aBook.
aBook := BookMorph new setNameTo: 'two'; pageSize: aTabbedPalette pageSize. aBook color: Color red muchLighter. aBook removeEverything; insertPage; showPageControls. aBook currentPage addMorphBack: CurveMorph authoringPrototype. aTabbedPalette addTabForBook: aBook.
aTabbedPalette selectTab: aTab.
aTabbedPalette beSticky. aTabbedPalette tabsMorph hResizing: #spaceFill. ^ aTabbedPalette! !
!TextMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 16:10'! getMenu: shiftKeyState ^ shiftKeyState not ifTrue: [TextEditor yellowButtonMenu] ifFalse: [TextEditor shiftedYellowButtonMenu]! !
!TextMorph methodsFor: 'events-processing' stamp: 'mt 3/15/2023 13:46'! handleKeystroke: anEvent "Overwritten to support tab-among-fields preference."
anEvent wasHandled ifTrue:[^self]. (self handlesKeyboard: anEvent) ifFalse: [^ self]. (anEvent hand keyboardFocus ~~ self and: [self handlesKeyboardOnlyOnFocus]) ifTrue: [^ self]. ^ super handleKeystroke: anEvent! !
!TextMorph methodsFor: 'menu' stamp: 'mt 8/16/2023 13:54'! addCustomMenuItems: aCustomMenu hand: aHandMorph | outer | super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu add: 'text properties...' translated action: #changeTextColor. aCustomMenu addUpdating: #autoFitString target: self action: #autoFitOnOff. aCustomMenu addUpdating: #wrapString target: self action: #wrapOnOff. aCustomMenu add: 'text margins...' translated action: #changeMargins:. aCustomMenu add: 'add predecessor' translated action: #addPredecessor:. aCustomMenu add: 'add successor' translated action: #addSuccessor:. outer := self owner. outer ifNotNil: [ outer isLineMorph ifTrue: [container isNil ifTrue: [Smalltalk at: #TextOnCurveContainer ifPresent: [:ignored | aCustomMenu add: 'follow owner''s curve' translated action: #followCurve]] ifFalse: [aCustomMenu add: 'reverse direction' translated action: #reverseCurveDirection. aCustomMenu add: 'set baseline' translated action: #setCurveBaseline:]] ifFalse: [self fillsOwner ifFalse: [aCustomMenu add: 'fill owner''s shape' translated action: #fillingOnOff] ifTrue: [aCustomMenu add: 'rectangular bounds' translated action: #fillingOnOff]. self avoidsOcclusions ifFalse: [aCustomMenu add: 'avoid occlusions' translated action: #occlusionsOnOff] ifTrue: [aCustomMenu add: 'ignore occlusions' translated action: #occlusionsOnOff]]]. ! !
!TextMorph class methodsFor: 'parts bin' stamp: 'mt 3/7/2023 15:07'! fancyPrototype
| t | t := self authoringPrototype. t autoFit: false; extent: 150@75. t borderWidth: 2; margins: 4@0; useRoundedCorners. "Why not rounded?" "fancy font, shadow, rounded" t fontName: Preferences standardButtonFont familyName size: 18; textColor: Color blue; fillStyle: Color lightBrown. t addDropShadow.
"Strangeness here in order to avoid two offset copies of the default contents when operating in an mvc project before cursor enters the morphic window" t paragraph. ^ t! !
!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 8/11/2023 15:18'! extrasMenuOn: aDockingBar
aDockingBar addItem: [ :it| it contents: 'Extras' translated; addSubMenu: [:menu| menu addItem:[:item| item contents: 'Recover Changes' translated; help: 'Recover changes after a crash' translated; icon: MenuIcons smallDocumentClockIcon; target: ChangeList; selector: #browseRecentLog]. menu addItem:[:item| item contents: 'Recover Method Versions' translated; help: 'Recover versions of deleted methods' translated; target: ChangeList; selector: #browseMethodVersions]. menu addLine. menu addItem:[:item| item contents: 'Themes & Colors' translated; subMenuUpdater: self selector: #themesAndWindowColorsOn: ]. menu addItem:[:item| item contents: 'Scale Factor' translated; subMenuUpdater: self selector: #scaleFactorsOn:]. menu addItem:[:item| item contents: 'Language' translated; subMenuUpdater: self selector: #languageTranslatorsOn: ]. menu addItem:[:item| item contents: 'Set Author Initials' translated; help: 'Sets the author initials' translated; icon: MenuIcons smallUserQuestionIcon; target: Utilities; selector: #setAuthorInitials]. menu addItem:[:item| item contents: 'Restore Display (r)' translated; help: 'Redraws the entire display' translated; target: Project current; selector: #restoreDisplay]. menu addItem:[:item| item contents: 'Rebuild Menus' translated; help: 'Rebuilds the menu bar' translated; target: TheWorldMainDockingBar; selector: #updateInstances]. menu addLine. menu addItem:[:item| item contents: 'Start Profiler' translated; help: 'Starts the profiler' translated; icon: MenuIcons smallTimerIcon; target: self; selector: #startMessageTally]. menu addItem:[:item| item contents: 'Collect Garbage' translated; help: 'Run the garbage collector and report space usage' translated; target: Utilities; selector: #garbageCollectAndReport]. menu addItem:[:item| item contents: 'Purge Undo Records' translated; help: 'Save space by removing all the undo information remembered in all projects' translated; target: CommandHistory; selector: #resetAllHistory]. menu addItem:[:item| item contents: 'VM statistics' translated; help: 'Virtual Machine information' translated; target: self; selector: #vmStatistics]. menu addLine. menu addItem:[:item| item contents: 'Graphical Imports' translated; help: 'View the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList' translated; target: (Imports default); selector: #viewImages]. menu addItem:[:item| item contents: 'Browse My Changes' translated; help: 'Browse all of my changes since the last time #condenseSources was run.' translated; target: SystemNavigation new; selector: #browseMyChanges]. ] ]! !
!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 3/7/2023 13:59'! themesAndWindowColorsOn: menu | themes | menu addItem:[:item| item contents: 'Fonts' translated; subMenuUpdater: Preferences selector: #fontConfigurationMenu:; icon: MenuIcons smallFontsIcon]. menu addLine. menu addItem:[:item| item contents: (Model useColorfulWindows ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Colorful Windows' translated; target: self; selector: #toggleColorfulWindows]. menu addItem:[:item| item contents: (SystemWindow gradientWindow not ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Flat Widget Look' translated; target: self; selector: #toggleGradients]. menu addLine. menu addItem:[:item | item contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Soft Shadows' translated; target: self; selector: #toggleSoftShadows]. menu addItem:[:item | item contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow not]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Hard Shadows' translated; target: self; selector: #toggleHardShadows]. menu addLine. menu addItem:[:item | item contents: (SystemWindow roundedWindowCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Window/Dialog Look' translated; target: self; selector: #toggleRoundedWindowLook]. menu addItem:[:item | item contents: (PluggableButtonMorph roundedButtonCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Button/Scrollbar/Menu Look' translated; target: self; selector: #toggleRoundedButtonLook]. menu addLine. themes := UserInterfaceTheme allThemes asArray sort: #name ascending. themes := themes select: [ :each | each isGenuine]. themes ifEmpty: [ menu addItem: [ :item | item contents: '(No UI themes found.)' translated; isEnabled: false ] ]. themes do: [ :each | menu addItem: [ :item | item contents: (UserInterfaceTheme current name = each name ifTrue: ['<yes>'] ifFalse: ['<no>']), each name; target: each; selector: #applyScaled ] ]. menu addLine; add: 'Restore UI theme background' translated target: self selector: #restoreThemeBackground; add: 'Reset all UI themes' translated target: self selector: #resetAllThemes; add: 'Edit current UI theme...' translated target: self selector: #editCurrentTheme.! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/4/2023 13:59'! addObjectsAndTools: menu self fillIn: menu from: { nil. { 'objects (o)'. { #myWorld. #activateObjectsTool }. 'A tool for finding and obtaining many kinds of objects' }. { 'new morph...'. { self. #newMorph }. 'Offers a variety of ways to create new objects' }. nil. { 'flaps...'. { self. #flapsDo }. 'A menu relating to use of flaps. For best results, use "keep this menu up"' }. { 'projects...'. { self. #projectDo }. 'A menu of commands relating to use of projects' }. { 'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}. nil }! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:54'! addPrintAndDebug: menu self fillIn: menu from: { { 'make screenshot'. {self. #saveScreenshot}. 'makes a screenshot and saves it to disk'}. "{ 'print PS to file...'. { self. #printWorldOnFile }. 'write the world into a postscript file' }." { 'debug...'. { self. #debugDo }. 'a menu of debugging items' } }! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:58'! addUtilities: menu self fillIn: menu from: { { 'open...'. { self. #openWindow } }. { 'windows...'. { self. #windowsDo } }. { 'changes...'. { self. #changesDo } } }. self fillIn: menu from: { { 'help...'. { self. #helpDo }. 'puts up a menu of useful items for updating the system, determining what version you are running, and much else' }. { 'appearance...'. { self. #appearanceDo }. 'put up a menu offering many controls over appearance.' } }. self fillIn: menu from: { { 'do...'. { Utilities. #offerCommonRequests }. 'put up an editible list of convenient expressions, and evaluate the one selected.' } }! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:57'! appearanceMenu "Build the appearance menu for the world."
^self fillIn: (self menu: 'appearance...') from: {
{'preferences...' . { self . #openPreferencesBrowser} . 'Opens a "Preferences Browser" which allows you to alter many settings' } . {'preferences wizard...' . { self . #openPreferencesWizard} . 'Opens a "Preferences Wizard" which allows you to alter many settings in a guided fashion' } . {'choose set of preferences...' . { Preferences . #offerThemesMenu} . 'Presents you with a menu of sets or preferences; each item''s balloon-help will tell you about the particular set. If you choose one, many different preferences that come along are set at the same time; you can subsequently change any settings by using a Preferences Panel'} . nil . {'system fonts...' . { self . #standardFontDo} . 'Choose the standard fonts to use for code, lists, menus, window titles, etc.'}. nil. {'full screen on' . { DisplayScreen . #fullScreenOn} . 'puts you in full-screen mode, if not already there.'}. {'full screen off' . { DisplayScreen . #fullScreenOff} . 'if in full-screen mode, takes you out of it.'}. nil. {'set display depth...' . {self. #setDisplayDepth} . 'choose how many bits per pixel.'}. {'set desktop color...' . {self. #changeBackgroundColor} . 'choose a uniform color to use as desktop background.'}. {'set gradient color...' . {self. #setGradientColor} . 'choose second color to use as gradient for desktop background.'}.
}! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 7/31/2023 11:19'! helpMenu "Build the help menu for the world." | menu |
menu := self menu: 'help...'.
self fillIn: menu from: { {'about this system...'. {Smalltalk. #aboutThisSystem}. 'current version information.'}. {'update code from server'. {MCMcmUpdater. #updateFromServer}. 'load latest code updates via the internet'}. {'preferences...'. {self. #openPreferencesBrowser}. 'view and change various options.'}. {'set language...' . {Project. #chooseNaturalLanguage}. 'choose the language in which tiles should be displayed.'} . nil. {'command-key help'. { TheWorldMainDockingBar instance . #commandKeyHelp}. 'summary of keyboard shortcuts.'} }.
self addGestureHelpItemsTo: menu.
self fillIn: menu from: { {'world menu help'. { self . #worldMenuHelp}. 'helps find menu items buried in submenus.'}. "{'info about flaps' . { Utilities . #explainFlaps}. 'describes how to enable and use flaps.'}." {'font size summary' . { TextStyle . #fontSizeSummary}. 'summary of names and sizes of available fonts.'}. {'useful expressions' . { Utilities . #openStandardWorkspace}. 'a window full of useful expressions.'}. {'annotation setup...' . { Preferences . #editAnnotations}. 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools'}. nil. {'graphical imports' . { Imports default . #viewImages}. 'view the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList'}. nil. {'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}. {#soundEnablingString . { SoundService . #toggleSoundEnabled}. 'turning sound off will completely disable Squeak''s use of sound.'}. nil.
{'set author initials...' . { Utilities . #setAuthorInitials }. 'supply initials to be used to identify the author of code and other content.'}. {'vm statistics' . { self . #vmStatistics}. 'obtain some intriguing data about the vm.'}. nil. {'purge undo records' . { CommandHistory . #resetAllHistory }. 'save space by removing all the undo information remembered in all projects.'}. {'space left' . { self . #garbageCollect}. 'perform a full garbage-collection and report how many bytes of space remain in the image.'}. }.
^menu
! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/16/2023 11:24'! newMorph "The user requested 'new morph' from the world menu. Put up a menu that allows many ways of obtaining new morphs."
| menu |
menu := self menu: 'Add a new morph'. menu add: 'from paste buffer' translated target: myHand action: #pasteMorph; add: 'from alphabetical list' translated subMenu: self alphabeticalMorphMenu; add: 'from a file...' translated target: self action: #readMorphFromAFile. menu addLine. menu add: 'grab rectangle from screen' translated target: myWorld action: #grabDrawingFromScreen:; add: 'grab with lasso from screen' translated target: myWorld action: #grabLassoFromScreen:; add: 'grab rubber band from screen' translated target: myWorld action: #grabRubberBandFromScreen:; add: 'grab flood area from screen' translated target: myWorld action: #grabFloodFromScreen:. menu addLine. menu add: 'make link to project...' translated target: self action: #projectThumbnail.
self doPopUp: menu. ! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/11/2023 16:37'! openMenu "Build the open window menu for the world."
| menu | menu := self menu: 'open...'. menu defaultTarget: ToolSet default. menu addList: ToolSet menuItems. menu defaultTarget: self. self fillIn: menu from: { nil. {'file...' . { self . #openFileDirectly} . 'Lets you open a window on a single file'}. {'transcript (t)' . {self . #openTranscript}. 'A window used to report messages sent to Transcript' }. "{'inner world' . { WorldWindow . #test1} }." nil. }. self fillIn: menu from: self class registeredOpenCommands. menu addLine.
self fillIn: menu from: { {'morphic project' . {self. #openMorphicProject} . 'Creates a new morphic project'}. {'mvc project' . {self. #openMVCProject} . 'Creates a new project of the classic "mvc" style'} }.
^menu ! !
!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/11/2023 16:37'! projectMenu "Build the project menu for the world." | menu |
self flag: #bob0302.
menu := self menu: 'projects...'. self fillIn: menu from: { { 'save on server (also makes a local copy)' . { #myProject . #storeOnServer } }. { 'save to a different server' . { #myProject . #saveAs } }. { 'save project on local file only' . { #myWorld . #saveOnFile } }. { 'see if server version is more recent...' . { #myProject . #loadFromServer } }. { 'load project from file...' . { self . #loadProject } }. nil. }.
self fillIn: menu from: { { 'create new morphic project' . { self . #openMorphicProject } }. { 'create new mvc project'. { self . #openMVCProject } }. }.
self fillIn: menu from: { nil. { 'go to previous project' . { Project . #returnToPreviousProject } }. { 'go to next project' . { Project . #advanceToNextProject } }. { 'jump to project...' . { #myWorld . #jumpToProject } }. }. self fillIn: menu from: { nil. { 'save for future revert' . { #myProject . #saveForRevert } }. { 'revert to saved copy' . { #myProject . #revert } }. }.
^ menu! !
!TheWorldMenu methodsFor: '*MorphicExtras-windows & flaps menu' stamp: 'mt 8/4/2023 15:18'! formulateFlapsMenu: aMenu "Fill aMenu with appropriate content"
aMenu addTitle: 'flaps' translated. aMenu addStayUpItem. Preferences classicNavigatorEnabled ifTrue: [aMenu addUpdating: #navigatorShowingString enablementSelector: #enableProjectNavigator target: Preferences selector: #toggle: argumentList: #(showProjectNavigator). aMenu balloonTextForLastItem: (Preferences preferenceAt: #showProjectNavigator) helpString translated].
Flaps sharedFlapsAllowed ifTrue: [self fillIn: aMenu from: {{#suppressFlapsString. {Project current. #toggleFlapsSuppressed}. 'Whether prevailing flaps should be shown in the project right now or not.'}}.
aMenu addUpdating: #automaticFlapLayoutString target: Preferences selector: #toggle: argumentList: #(automaticFlapLayout). aMenu balloonTextForLastItem: (Preferences preferenceAt: #automaticFlapLayout) helpString translated.
aMenu addLine. Flaps addIndividualGlobalFlapItemsTo: aMenu].
self fillIn: aMenu from: { nil.
{'make a new flap'. {Flaps. #addLocalFlap}. 'Create a new flap. You can later make it into a shared flap is you wish.'}.
nil.}. Flaps sharedFlapsAllowed ifTrue: [aMenu addWithLabel: 'put shared flaps on bottom' translated enablementSelector: #showSharedFlaps target: Flaps selector: #sharedFlapsAlongBottom argumentList: #(). aMenu balloonTextForLastItem: 'Group all the standard shared flaps along the bottom edge of the screen' translated.
self fillIn: aMenu from: { {'destroy all shared flaps'. {Flaps. #disableGlobalFlaps}. 'Destroy all the shared flaps and disable their use in all projects.'}}] ifFalse: [aMenu add: 'install default shared flaps' translated target: Flaps action: #enableGlobalFlaps. aMenu balloonTextForLastItem: 'Create the default set of shared flaps' translated. aMenu addLine].
self fillIn: aMenu from: { nil. {'about flaps...'. {Flaps . #explainFlaps}. 'Gives a window full of details about how to use flaps.'}}! !
!ThreePhaseButtonMorph class methodsFor: 'class initialization' stamp: 'mt 3/15/2023 14:11'! initialize "ThreePhaseButtonMorph initialize" | extent inset | extent := 12@12. inset := 3.
#('CheckBoxOff' 'CheckBoxOn' 'CheckBoxPressed') do: [:button | | f r | f := ColorForm extent: extent depth: 1. f colors: {Color transparent. Color black}. f borderWidth: 1. r := f boundingBox insetBy: inset. button = 'CheckBoxPressed' ifTrue: [f border: r width: 1]. button = 'CheckBoxOn' ifTrue: [f fillBlack: r]. MenuIcons saveForm: f atKey: button].
#('RadioButtonOff' 'RadioButtonOn' 'RadioButtonPressed') do: [:button | | f r c | f := ColorForm extent: extent depth: 1. f colors: {Color transparent. Color black}. r := f boundingBox. c := f getCanvas. c frameOval: r color: Color black. r := r insetBy: inset. button = 'RadioButtonPressed' ifTrue: [c frameOval: r color: Color black]. button = 'RadioButtonOn' ifTrue: [c fillOval: r color: Color black]. MenuIcons saveForm: f atKey: button]! !
!ThreePhaseButtonMorph class methodsFor: 'instance creation' stamp: 'mt 3/15/2023 14:09'! labelSymbol: aSymbol "(self labelSymbol: #TryIt) openInHand" | aButton form | aButton := ThreePhaseButtonMorph new. form := MenuIcons formAtKey: aSymbol. aButton offImage: form. aButton image: form. aButton pressedImage: (MenuIcons formPressedAtKey: aSymbol). ^ aButton! !
!ThumbnailMorph methodsFor: 'stepping' stamp: 'mt 8/28/2023 14:37'! stepTime "Adjust my step time to the time it takes drawing my referent" drawTime ifNil:[^ 250]. ^(20 * drawTime) max: 250.! !
!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'! actualViewee "Return the actual morph to be viewed, or nil if there isn't an appropriate morph to view."
| aMorph actualViewee | aMorph := self morphToView ifNil: [^ nil]. aMorph isInWorld ifFalse: [^ nil]. actualViewee := viewSelector ifNil: [aMorph] ifNotNil: [objectToView perform: viewSelector]. actualViewee == 0 ifTrue: [^ nil]. "valueAtCursor result for an empty HolderMorph" actualViewee ifNil: [actualViewee := objectToView]. (actualViewee isMorph and: [actualViewee isFlexMorph and: [actualViewee submorphs size = 1]]) ifTrue: [actualViewee := actualViewee firstSubmorph]. ^ actualViewee! !
!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'! formOrMorphToView "Answer the form to be viewed, or the morph to be viewed, or nil"
| actualViewee | (objectToView isForm) ifTrue: [^objectToView]. actualViewee := viewSelector ifNil: [objectToView] ifNotNil: [objectToView perform: viewSelector]. ^actualViewee == 0 ifTrue: [nil "valueAtCursor result for an empty HolderMorph"] ifFalse: [actualViewee]! !
!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'! morphToView "If the receiver is viewing some object, answer a morph can be thought of as being viewed; A gesture is made toward generalizing this beyond the morph/player regime, in that a plain blue rectangle is returned rather than simply failing if the referent is not itself displayable."
objectToView ifNil: [^ nil]. ^ objectToView isMorph ifTrue: [objectToView] ifFalse: [RectangleMorph new color: Color blue]! !
!TransformationMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 15:02'! removeFlexShell "Remove the shell used to make a morph rotatable and scalable."
| oldHalo unflexed myWorld refPos aPosition | self isInWorld ifFalse: [^self]. refPos := self referencePosition. myWorld := self world. oldHalo := self halo. submorphs isEmpty ifTrue: [^ self delete]. aPosition := (owner submorphIndexOf: self) ifNil: [1]. unflexed := self firstSubmorph. self submorphs do: [:m | m position: self center - (m extent // 2). owner addMorph: m asElementNumber: aPosition]. unflexed absorbStateFromRenderer: self. oldHalo ifNotNil: [oldHalo setTarget: unflexed]. myWorld ifNotNil: [myWorld startSteppingSubmorphsOf: unflexed]. self delete. unflexed referencePosition: refPos. ^ unflexed! !
!TransformationMorph methodsFor: 'private' stamp: 'mt 3/10/2023 11:18'! adjustAfter: changeBlock "Cause this morph to remain centered where it was before, and choose appropriate smoothing, after a change of scale or rotation." | oldRefPos | oldRefPos := self referencePosition. changeBlock value. self chooseSmoothing. self layoutChanged. owner ifNotNil: [owner invalidRect: bounds] ! !
!TranslucentProgessMorph methodsFor: 'drawing' stamp: 'mt 3/7/2023 15:07'! drawOn: aCanvas
| revealPercentage revealingStyle revealingColor revealingBounds revealToggle x baseColor revealTimes secondsRemaining stringToDraw where fontToUse innerBounds | innerBounds := bounds. opaqueBackgroundColor ifNotNil: [ aCanvas frameAndFillRectangle: bounds fillColor: opaqueBackgroundColor borderWidth: 8 borderColor: Color blue. innerBounds := innerBounds insetBy: 8. ]. revealTimes := (self valueOfProperty: #revealTimes) ifNil: [^self]. revealPercentage := (revealTimes first / revealTimes second) asFloat. revealingStyle := self revealingStyle. x := self valueOfProperty: #progressStageNumber ifAbsent: [1]. baseColor := Color perform: (#(red blue green magenta cyan yellow) atPin: x). revealingColor := baseColor alpha: 0.2. revealingStyle = 3 ifTrue: [ "wrap and change color" revealPercentage > 1.0 ifTrue: [ revealingColor := baseColor alpha: (0.2 + (revealingStyle / 10) min: 0.5). ]. revealPercentage := revealPercentage fractionPart. ]. revealingStyle = 2 ifTrue: [ "peg at 75 and blink" revealPercentage > 0.75 ifTrue: [ revealToggle := self valueOfProperty: #revealToggle ifAbsent: [true]. self setProperty: #revealToggle toValue: revealToggle not. revealToggle ifTrue: [revealingColor := baseColor alpha: 0.8.]. ]. revealPercentage := revealPercentage min: 0.75. ]. revealingBounds := innerBounds withLeft: innerBounds left + (innerBounds width * revealPercentage) truncated. aCanvas fillRectangle: revealingBounds color: revealingColor. secondsRemaining := (revealTimes second - revealTimes first / 1000) rounded. secondsRemaining > 0 ifTrue: [ fontToUse := StrikeFont familyName: Preferences standardButtonFont familyName size: 24. stringToDraw := secondsRemaining printString. where := innerBounds corner - ((fontToUse widthOfString: stringToDraw) @ fontToUse height). aCanvas drawString: stringToDraw in: (where corner: innerBounds corner) font: fontToUse color: Color black. aCanvas drawString: stringToDraw in: (where - (1@1) corner: innerBounds corner) font: fontToUse color: Color white. ].
! !
!TrashCanMorph methodsFor: 'event handling' stamp: 'mt 8/11/2023 13:45'! doubleClick: evt evt hand world addMorphCentered: ScrapBook default scrapBook! !
!UpdatingRectangleMorph methodsFor: 'setting' stamp: 'mt 3/10/2023 15:02'! valueProvider "Answer the object to which my get/set messages should be sent. This is inefficient and contorted in order to support grandfathered content for an earlier design"
^ target! !
!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:28'! decimalPlaces: aNumber "Set the receiver's number of decimal places to be shown."
| constrained | self setProperty: #decimalPlaces toValue: (constrained := aNumber min: 11). self pvtFloatPrecision: (Utilities floatPrecisionForDecimalPlaces: constrained).! !
!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 15:45'! target: anObject
target := anObject. floatPrecision := 1. ! !
!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:02'! valueFromContents "Return a new value from the current contents string."
format = #symbol ifTrue: [^ lastValue]. format = #string ifTrue: [^ contents]. ^ Compiler evaluate: contents ! !
!UpdatingStringMorph methodsFor: 'target access' stamp: 'mt 3/10/2023 14:13'! readFromTarget "Update my readout from my target"
| v ret | (target isNil or: [getSelector isNil]) ifTrue: [^contents]. ret := self checkTarget. ret ifFalse: [^ '0']. v := target perform: getSelector. "scriptPerformer" (v isKindOf: Text) ifTrue: [v := v asString]. ^self acceptValueFromTarget: v! !
!UserInterfaceTheme methodsFor: 'private - fonts' stamp: 'mt 7/31/2023 11:21'! installSystemFont: aFont "Establish the default text font and style. Update the #defaultFontIndex in all known text styles to reflect the system's new default point size."
| aStyle | self flag: #todo. "mt: Support derivatives such as bold and italic." aStyle := aFont textStyleOrNil. "mt: Must be installed and thus never be nil!!" aStyle defaultFontIndex: (aStyle fontIndexOfPointSize: aFont pointSize "drop emphasis").
TextStyle setDefault: aStyle. TextStyle actualTextStyles "no defaults" do: [:ea | ea isTTCStyle ifTrue: [ea defaultFont asPointSize: aFont pointSize "May generate new pointSize"]. ea defaultFontIndex: (ea fontIndexOfPointSize: aFont pointSize)]. RealEstateAgent resetScaleFactor. Flaps replaceToolsFlap.! !
!CommunityTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addDarkWindowColors: aUserInterfaceTheme "self createDark apply." aUserInterfaceTheme set: #uniformWindowColor for: #Model to: Color darkGray; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color darker] ]; set: #unfocusedLabelColor for: #SystemWindow to: Color veryLightGray; set: #focusedLabelColor for: #SystemWindow to: Color white;
set: #customWindowColor for: #Browser to: self dbBlue; set: #customWindowColor for: #ChangeList to: self dbBlue; set: #customWindowColor for: #ChangeSorter to: self dbBlue; set: #customWindowColor for: #ChatNotes to: self dbPurple twiceDarker; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self dbPurple twiceDarker; set: #customWindowColor for: #Debugger to: self dbRed; set: #customWindowColor for: #DualChangeSorter to: self dbOrange twiceDarker; set: #customWindowColor for: #FileContentsBrowser to: self dbGray; set: #customWindowColor for: #FileList to: self dbGray; set: #customWindowColor for: #Inspector to: self dbYellow duller; set: #customWindowColor for: #InstanceBrowser to: self dbYellow duller; set: #customWindowColor for: #Lexicon to: self dbGreen; set: #customWindowColor for: #MCTool to: self dbOrange twiceDarker; set: #customWindowColor for: #MessageNames to: self dbGreen; set: #customWindowColor for: #MessageSet to: self dbGreen; set: #customWindowColor for: #ObjectExplorer to: self dbYellow duller; set: #customWindowColor for: #PackagePaneBrowser to: self dbBlue; set: #customWindowColor for: #PluggableFileList to: self dbGray; set: #customWindowColor for: #PreferenceBrowser to: self dbBlue; set: #customWindowColor for: #ProcesBrowser to: self dbAqua; set: #customWindowColor for: #SMLoader to: self dbOrange twiceDarker; set: #customWindowColor for: #SMLoaderPlus to: self dbOrange twiceDarker; set: #customWindowColor for: #SMReleaseBrowser to: self dbOrange twiceDarker; set: #customWindowColor for: #SelectorBrowser to: self dbBlue; set: #customWindowColor for: #StringHolder to: self dbGray; set: #customWindowColor for: #TestRunner to: self dbPink darker; set: #customWindowColor for: #TranscriptStream to: self dbGray; set: #customWindowColor for: #VersionsBrowser to: self dbPurple twiceDarker; set: #customWindowColor for: #Workspace to: self dbPink darker.! !
!MonokaiTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addDarkWindowColors: theme "self createDark apply." theme set: #uniformWindowColor for: #Model to:( self invisibleColor adjustBrightness: 0.16) "lighter twice"; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: -0.16 "darker twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: [ Model useColorfulWindows ifTrue: [(Color r: 0.285 g: 0.282 b: 0.242) "invisible color"] ifFalse: [(Color r: 0.972 g: 0.972 b: 0.948) "foreground color"] ]; set: #focusedLabelColor for: #SystemWindow to: [ Model useColorfulWindows ifTrue: [(Color r: 0.152 g: 0.156 b: 0.133) "background color"] ifFalse: [(Color r: 0.901 g: 0.858 b: 0.455) "yellow"] ];
set: #customWindowColor for: #Browser to: self green duller; set: #customWindowColor for: #ChangeList to: self blue duller; set: #customWindowColor for: #ChangeSorter to: self blue duller; set: #customWindowColor for: #ChatNotes to: self magenta duller; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet duller; set: #customWindowColor for: #Debugger to: self red duller; set: #customWindowColor for: #DualChangeSorter to: self blue duller; set: #customWindowColor for: #FileContentsBrowser to: self yellow duller; set: #customWindowColor for: #FileList to: self yellow duller; set: #customWindowColor for: #InstanceBrowser to: self cyan duller; set: #customWindowColor for: #Lexicon to: self cyan duller; set: #customWindowColor for: #MCTool to: self violet duller; set: #customWindowColor for: #MessageNames to: self green duller; set: #customWindowColor for: #MessageSet to: self cyan duller; set: #customWindowColor for: #PackagePaneBrowser to: self green duller; set: #customWindowColor for: #PluggableFileList to: self yellow duller; set: #customWindowColor for: #PreferenceBrowser to: self cyan duller; set: #customWindowColor for: #SMLoader to: self orange duller; set: #customWindowColor for: #SMLoaderPlus to: self orange duller; set: #customWindowColor for: #SMReleaseBrowser to: self orange duller; set: #customWindowColor for: #SelectorBrowser to: self cyan duller; set: #customWindowColor for: #StringHolder to: self yellow duller; set: #customWindowColor for: #TestRunner to: self orange duller; set: #customWindowColor for: #TranscriptStream to: self orange duller; set: #customWindowColor for: #VersionsBrowser to: self violet duller.! !
!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addDarkWindowColors: theme "doIt: [self createDark apply.]"
theme set: #uniformWindowColor for: #Model to: (self darkBackgroundHighlights adjustBrightness: 0.16 "lighter twice");
set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: -0.16 "darker twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: self darkContentEmphasized; set: #focusedLabelColor for: #SystemWindow to: self darkContentEmphasizedMore;
set: #customWindowColor for: #Browser to: self green; set: #customWindowColor for: #ChangeList to: self blue; set: #customWindowColor for: #ChangeSorter to: self blue; set: #customWindowColor for: #ChatNotes to: self magenta; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet; set: #customWindowColor for: #Debugger to: self red; set: #customWindowColor for: #DualChangeSorter to: self blue; set: #customWindowColor for: #FileContentsBrowser to: self yellow; set: #customWindowColor for: #FileList to: self yellow; set: #customWindowColor for: #InstanceBrowser to: self cyan; set: #customWindowColor for: #Lexicon to: self cyan; set: #customWindowColor for: #MCTool to: self violet; set: #customWindowColor for: #MessageNames to: self green; set: #customWindowColor for: #MessageSet to: self cyan; set: #customWindowColor for: #PackagePaneBrowser to: self green; set: #customWindowColor for: #PluggableFileList to: self yellow; set: #customWindowColor for: #PreferenceBrowser to: self cyan; set: #customWindowColor for: #SMLoader to: self orange; set: #customWindowColor for: #SMLoaderPlus to: self orange; set: #customWindowColor for: #SMReleaseBrowser to: self orange; set: #customWindowColor for: #SelectorBrowser to: self cyan; set: #customWindowColor for: #StringHolder to: self yellow; set: #customWindowColor for: #TestRunner to: self orange; set: #customWindowColor for: #TranscriptStream to: self orange; set: #customWindowColor for: #VersionsBrowser to: self violet.! !
!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addLightWindowColors: theme "You have to create dark first. doIt: [self createDark. self createLight apply.]"
theme set: #uniformWindowColor for: #Model to: (self lightBackgroundHighlights adjustBrightness: -0.16 "darker twice");
set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: 0.16 "lighter twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: self lightContentEmphasized; set: #focusedLabelColor for: #SystemWindow to: self lightContentEmphasizedMore;
set: #customWindowColor for: #Browser to: self green; set: #customWindowColor for: #ChangeList to: self blue; set: #customWindowColor for: #ChangeSorter to: self blue; set: #customWindowColor for: #ChatNotes to: self magenta; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet; set: #customWindowColor for: #Debugger to: (self red adjustSaturation: -0.27 brightness: 0.27); set: #customWindowColor for: #DualChangeSorter to: self blue; set: #customWindowColor for: #FileContentsBrowser to: self yellow; set: #customWindowColor for: #FileList to: self yellow; set: #customWindowColor for: #InstanceBrowser to: self cyan; set: #customWindowColor for: #Lexicon to: self cyan; set: #customWindowColor for: #MCTool to: self violet; set: #customWindowColor for: #MessageNames to: self green; set: #customWindowColor for: #MessageSet to: self cyan; set: #customWindowColor for: #PackagePaneBrowser to: self green; set: #customWindowColor for: #PluggableFileList to: self yellow; set: #customWindowColor for: #PreferenceBrowser to: self cyan; set: #customWindowColor for: #SMLoader to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SMLoaderPlus to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SMReleaseBrowser to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SelectorBrowser to: self cyan; set: #customWindowColor for: #StringHolder to: self yellow; set: #customWindowColor for: #TestRunner to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #TranscriptStream to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #VersionsBrowser to: self violet.! !
!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addDullerWindowColors: theme
theme set: #uniformWindowColor for: #Model to: Color veryVeryLightGray duller; set: #customWindowColor for: #Browser to: (Color r: 0.764 g: 0.9 b: 0.63) duller; set: #customWindowColor for: #ChangeList to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #ChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #ChatNotes to: (Color r: 1.0 g: 0.7 b: 0.8) duller; set: #customWindowColor for: #ClassCommentVersionsBrowser to: (Color r: 0.753 g: 0.677 b: 0.9) duller; set: #customWindowColor for: #Debugger to: (Color r: 0.9 g: 0.719 b: 0.719) duller; set: #customWindowColor for: #DualChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #FileContentsBrowser to: (Color r: 0.7 g: 0.7 b: 0.508) duller; set: #customWindowColor for: #FileList to: (Color r: 0.65 g: 0.65 b: 0.65) duller; set: #customWindowColor for: #InstanceBrowser to: (Color r: 0.726 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #Lexicon to: (Color r: 0.79 g: 0.9 b: 0.79) duller; set: #customWindowColor for: #MCTool to: (Color r: 0.65 g: 0.691 b: 0.876) duller; set: #customWindowColor for: #MessageNames to: (Color r: 0.639 g: 0.9 b: 0.497) duller; set: #customWindowColor for: #MessageSet to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #PackagePaneBrowser to: (Color r: 0.9 g: 0.9 b: 0.63) duller; set: #customWindowColor for: #PluggableFileList to: Color lightYellow duller; set: #customWindowColor for: #PreferenceBrowser to: (Color r: 0.671 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #SMLoader to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SMLoaderPlus to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SMReleaseBrowser to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SelectorBrowser to: (Color r: 0.45 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #StringHolder to: (Color r: 0.9 g: 0.9 b: 0.719) duller; set: #customWindowColor for: #TestRunner to: (Color r: 0.9 g: 0.576 b: 0.09) duller; set: #customWindowColor for: #TranscriptStream to: (Color r: 0.9 g: 0.75 b: 0.45) duller; set: #customWindowColor for: #VersionsBrowser to: (Color r: 0.782 g: 0.677 b: 0.9) duller.! !
!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addWindowColors: theme
theme set: #titleFont for: #SystemWindow to: [Preferences windowTitleFont]; set: #borderColorModifier for: #SystemWindow to: [ [:c | c adjustBrightness: -0.3] ]; set: #borderColorModifier for: #ScrollPane to: [ [:c | c adjustBrightness: -0.3] ]; set: #borderWidth for: #SystemWindow to: 1; derive: #resizerColorModifier for: #AbstractResizerMorph from: #SystemWindow at: #borderColorModifier; set: #uniformWindowColor for: #Model to: Color veryVeryLightGray; derive: #uniformWindowColor for: #TranscriptStream from: #Model; derive: #color for: #SystemWindow from: #Model at: #uniformWindowColor; "Fall back for windows without models." set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color darker] ]; set: #unfocusedLabelColor for: #SystemWindow to: Color darkGray; set: #focusedLabelColor for: #SystemWindow to: Color black;
set: #customWindowColor for: #Browser to: (Color r: 0.764 g: 0.9 b: 0.63); set: #customWindowColor for: #ChangeList to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #ChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #ChatNotes to: (Color r: 1.0 g: 0.7 b: 0.8); set: #customWindowColor for: #ClassCommentVersionsBrowser to: (Color r: 0.753 g: 0.677 b: 0.9); set: #customWindowColor for: #Debugger to: (Color r: 0.9 g: 0.719 b: 0.719); set: #customWindowColor for: #DualChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #FileContentsBrowser to: (Color r: 0.7 g: 0.7 b: 0.508); set: #customWindowColor for: #FileList to: (Color r: 0.65 g: 0.65 b: 0.65); set: #customWindowColor for: #InstanceBrowser to: (Color r: 0.726 g: 0.9 b: 0.9); set: #customWindowColor for: #Lexicon to: (Color r: 0.79 g: 0.9 b: 0.79); set: #customWindowColor for: #MCTool to: (Color r: 0.65 g: 0.691 b: 0.876); set: #customWindowColor for: #MessageNames to: (Color r: 0.639 g: 0.9 b: 0.497); set: #customWindowColor for: #MessageSet to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #PackagePaneBrowser to: (Color r: 0.9 g: 0.9 b: 0.63); set: #customWindowColor for: #PluggableFileList to: Color lightYellow; set: #customWindowColor for: #PreferenceBrowser to: (Color r: 0.671 g: 0.9 b: 0.9); set: #customWindowColor for: #SMLoader to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SMLoaderPlus to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SMReleaseBrowser to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SelectorBrowser to: (Color r: 0.45 g: 0.9 b: 0.9); set: #customWindowColor for: #StringHolder to: (Color r: 0.9 g: 0.9 b: 0.719); set: #customWindowColor for: #TestRunner to: (Color r: 0.9 g: 0.576 b: 0.09); set: #customWindowColor for: #TranscriptStream to: (Color r: 0.9 g: 0.75 b: 0.45); set: #customWindowColor for: #VersionsBrowser to: (Color r: 0.782 g: 0.677 b: 0.9).! !
!TrimTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'! addWindowColors: theme | windowColorBrightnessAdjustment | windowColorBrightnessAdjustment := -0.35. theme set: #titleFont for: #SystemWindow to: [Preferences windowTitleFont]; set: #borderColorModifier for: #SystemWindow to: [ [:c | c adjustBrightness: -0.1] ]; set: #borderColorModifier for: #ScrollPane to: [ [:c | c adjustBrightness: 0.1] ]; set: #borderWidth for: #SystemWindow to: 1; set: #uniformWindowColor for: #Model to: self gray76; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color alphaMixed: 0.5 with: self gray40] ]; set: #unfocusedLabelColor for: #SystemWindow to: self gray168; set: #focusedLabelColor for: #SystemWindow to: Color white;
set: #customWindowColor for: #Browser to: ((Color r: 0.764 g: 0.9 b: 0.63) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChangeList to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChangeSorter to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChatNotes to: ((Color r: 1.0 g: 0.7 b: 0.8) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ClassCommentVersionsBrowser to: ((Color r: 0.753 g: 0.677 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #Debugger to: ((Color r: 0.9 g: 0.719 b: 0.719) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #DualChangeSorter to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #FileContentsBrowser to: ((Color r: 0.7 g: 0.7 b: 0.508) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #FileList to: ((Color r: 0.65 g: 0.65 b: 0.65) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #InstanceBrowser to: ((Color r: 0.726 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #Lexicon to: ((Color r: 0.79 g: 0.9 b: 0.79) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MCTool to: ((Color r: 0.65 g: 0.691 b: 0.876) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MessageNames to: ((Color r: 0.639 g: 0.9 b: 0.497) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MessageSet to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PackagePaneBrowser to: ((Color r: 0.9 g: 0.9 b: 0.63) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PluggableFileList to: (Color lightYellow adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PreferenceBrowser to: ((Color r: 0.671 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMLoader to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMLoaderPlus to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMReleaseBrowser to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SelectorBrowser to: ((Color r: 0.45 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #StringHolder to: ((Color r: 0.9 g: 0.9 b: 0.719) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #TestRunner to: ((Color r: 0.9 g: 0.576 b: 0.09) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #TranscriptStream to: ((Color r: 0.9 g: 0.75 b: 0.45) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #VersionsBrowser to: ((Color r: 0.782 g: 0.677 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment).! !
!Utilities class methodsFor: 'common requests' stamp: 'mt 8/11/2023 15:01'! initializeCommonRequestStrings "Initialize the common request strings, a directly-editable list of expressions that can be evaluated from the 'do...' menu."
CommonRequestStrings := StringHolder new contents: 'Utilities emergencyCollapse. Utilities closeAllDebuggers. RecentMessages default revertMostRecent. - MCFileBasedRepository flushAllCaches - Sensor keyboard. ParagraphEditor abandonChangeText. Cursor normal show. - CommandHistory resetAllHistory. Project allInstancesDo: [:p | p displayDepth: 16]. ScriptingSystem inspectFormDictionary. Form fromUser bitEdit. Display border: (0@0 extent: 640@480) width: 2. - Undeclared inspect. Undeclared removeUnreferencedKeys; inspect. Transcript clear. GIFReadWriter grabScreenAndSaveOnDisk. FrameRateMorph new openInHand. - Utilities reconstructTextWindowsFromFileNamed: ''TW''. Utilities storeTextWindowContentsToFileNamed: ''TW''. ChangeSet removeEmptyUnnamedChangeSets. ChangesOrganizer reorderChangeSets.'
"Utilities initializeCommonRequestStrings"! !
!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:55'! addControls | slider aWrapper m aButton | aWrapper := AlignmentMorph newRow. aWrapper color: Color transparent; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 @ 5. aWrapper wrapCentering: #topLeft. aButton := self buttonName: 'X' action: #delete. aButton setBalloonText: 'Close WaveEditor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Menu' translated action: #invokeMenu. aButton setBalloonText: 'Open a menu' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play' translated action: #play. aButton setBalloonText: 'Play sound' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play Before' translated action: #playBeforeCursor. aButton setBalloonText: 'Play before cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play After' translated action: #playAfterCursor. aButton setBalloonText: 'Play after cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play Loop' translated action: #playLoop. aButton setBalloonText: 'Play the loop' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Test' translated action: #playTestNote. aButton setBalloonText: 'Test the note' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Save' translated action: #saveInstrument. aButton setBalloonText: 'Save the sound' translated. aWrapper addMorphBack: aButton.
aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set Loop End' translated action: #setLoopEnd. aButton setBalloonText: 'Set loop end at cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set One Cycle' translated action: #setOneCycle. aButton setBalloonText: 'Set one cycle' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set Loop Start' translated action: #setLoopStart. aButton setBalloonText: 'Set the loop start at cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. self addMorphBack: aWrapper. aWrapper := AlignmentMorph newRow. aWrapper color: self color; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5 @ 20; wrapCentering: #center; cellPositioning: #leftCenter. m := StringMorph new contents: 'Index: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #cursor; putSelector: #cursor:; font: Preferences standardButtonFont; growable: false; width: 71; step. aWrapper addMorphBack: m. m := StringMorph new contents: 'Value: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #valueAtCursor; putSelector: #valueAtCursor:; font: Preferences standardButtonFont; growable: false; width: 50; step. aWrapper addMorphBack: m. slider := SimpleSliderMorph new color: color; extent: 200 @ 10; target: self; actionSelector: #scrollTime:. aWrapper addMorphBack: slider. m := Morph new color: aWrapper color; extent: 10 @ 5. "spacer" aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #startIndex; putSelector: #startIndex:; font: Preferences standardButtonFont; width: 40; step. aWrapper addMorphBack: m. self addMorphBack: aWrapper! !
!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:56'! addLoopPointControls
| m aWrapper | aWrapper := AlignmentMorph newRow. aWrapper color: self color; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
m := StringMorph new contents: 'Loop end: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopEnd; putSelector: #loopEnd:; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Loop length: ' translated ; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopLength; putSelector: #loopLength:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Loop cycles: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopCycles; putSelector: #loopCycles:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Frequency: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #perceivedFrequency; putSelector: #perceivedFrequency:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m.
self addMorphBack: aWrapper ! !
!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:53'! buttonName: aString action: aSymbol "Create a button with the given label and action selector, and answer it."
^ SimpleButtonMorph new target: self; label: aString font: Preferences standardButtonFont; actionSelector: aSymbol! !
WebCamMorph class removeSelector: #additionsToViewerCategories! SymbolListType removeSelector: #initialValueForASlotFor:! StringType removeSelector: #initialValueForASlotFor:! SoundType removeSelector: #initialValueForASlotFor:! PointType removeSelector: #initialValueForASlotFor:! NumberType removeSelector: #initialValueForASlotFor:! GraphicType removeSelector: #initialValueForASlotFor:!
!GraphicType reorganize! ('initial value') ('initialization' initialize) !
ColorType removeSelector: #initialValueForASlotFor:! BooleanType removeSelector: #initialValueForASlotFor:! DataType removeSelector: #initialValueForASlotFor:! Vocabulary removeSelector: #isEToyVocabulary! UpdatingStringMorph removeSelector: #isEtoyReadout!
!UpdatingStringMorph reorganize! ('accessing' autoAcceptOnFocusLoss autoAcceptOnFocusLoss: decimalPlaces decimalPlaces: floatPrecision format getSelector getSelector: growable growable: maximumWidth maximumWidth: minWidth minWidth: putSelector putSelector: pvtFloatPrecision: target target: valueFromContents) ('copying' veryDeepFixupWith: veryDeepInner:) ('editing' acceptContents acceptValue: addCustomMenuItems:hand: doneWithEdits lostFocusWithoutAccepting setDecimalPlaces: setFontSize setFontStyle setPrecision setToAllowTextEdit toggleGrowability userEditsAllowed) ('event handling' handlesMouseDown: mouseDown: wouldAcceptKeyboardFocus) ('events-processing' handlerForMouseDown:) ('formats' useDefaultFormat useStringFormat useSymbolFormat) ('initialization' defaultMaximumWidth defaultMinimumWidth initialize) ('stepping' step stepTime stepTime: updateContentsFrom:) ('target access' acceptValueFromTarget: checkTarget informTarget readFromTarget setDecimalPlacesFromTypeIn: stringForNumericValue:) ('layout' fitContents) ('*MorphicExtras-accessing' floatPrecision:) !
UpdatingRectangleMorph removeSelector: #isEtoyReadout!
!UpdatingRectangleMorph reorganize! ('accessing' contents contents: getSelector getSelector: putSelector putSelector: target target: userEditsAllowed) ('copying' veryDeepFixupWith: veryDeepInner:) ('event handling' handlesMouseDown: mouseUp:) ('initialization' defaultBorderColor) ('setting' setTargetColor: valueProvider) ('stepping' step stepTime) ('target access' readFromTarget) !
UpdatingMenuItemMorph removeSelector: #adaptToWorld:! ThumbnailMorph removeSelector: #isEtoyReadout!
!ThumbnailMorph reorganize! ('accessing' getSelector getSelector: putSelector target) ('caching' releaseCachedState) ('copying' veryDeepFixupWith: veryDeepInner:) ('display' drawForForm:on: drawMeOn: scaleFor:in:) ('drawing' drawOn:) ('initialization' defaultBorderWidth defaultColor initialize objectToView: objectToView:viewSelector:) ('stepping' step stepTime) ('texture support' installAsWonderlandTextureOn:) ('what to view' actualViewee formOrMorphToView morphToView) !
ThreePhaseButtonMorph initialize!
!ThreePhaseButtonMorph class reorganize! ('class initialization' initialize) ('instance creation' checkBox labelSymbol: radioButton) ('preferences' themeProperties) !
ThreePhaseButtonMorph removeSelector: #adaptToWorld:! TheWorldMenu removeSelector: #adaptToWorld:! TheWorldMenu removeSelector: #menuColorString! TheWorldMenu removeSelector: #mvcProjectsAllowed! TheWorldMenu removeSelector: #roundedCornersString! TheWorldMenu removeSelector: #toggleMenuColorPolicy!
!TheWorldMenu reorganize! ('action' commandKeyTypedIntoMenu: doMenuItem:with: projectThumbnail saveScreenshot setGradientColor soundEnablingString staggerPolicyString toggleRoundedCorners toggleWindowPolicy) ('commands' changeBackgroundColor cleanUpWorld garbageCollect loadProject lookForSlips newMorphOfClass:event: openBrowser openFileDirectly openFileList openMorphicProject openMVCProject openPreferencesBrowser openPreferencesWizard openTranscript openWorkspace projectForMyWorld quitSession readMorphFromAFile saveAndQuit saveWorldInFile setDisplayDepth splitNewMorphList:depth: startMessageTally vmStatistics worldMenuHelp) ('construction' addObjectsAndTools: addPrintAndDebug: addProjectEntries: addRestoreDisplay: addSaveAndQuit: addUtilities: alphabeticalMorphMenu appearanceMenu buildWorldMenu changesMenu colorForDebugging: debugMenu fillIn:from: helpMenu makeConvenient: newMorph openMenu projectMenu remoteMenu) ('mechanics' menu: world:project:hand:) ('menu' addGestureHelpItemsTo:) ('popups' appearanceDo changesDo debugDo doPopUp: helpDo openWindow projectDo remoteDo standardFontDo) ('windows & flaps menu' suppressFlapsString windowsDo windowsMenu) ('*MorphicExtras-action' createStandardPartsBin launchCustomPartsBin toggleFlapSuppressionInProject) ('*MorphicExtras-construction' myMenuColor) ('*MorphicExtras-mechanics') ('*MorphicExtras-windows & flaps menu' flapsDo flapsMenu formulateFlapsMenu: globalFlapsEnabled newGlobalFlapString) ('*Tools' browseRecentLog openChangeSorter1 openChangeSorter2 openMessageNames openProcessBrowser openSelectorBrowser startThenBrowseMessageTally) ('*MorphicExtras-Postscript Canvases' printWorldOnFile) !
TextMorphForEditView removeSelector: #wouldAcceptKeyboardFocusUponTab!
!TextMorph class reorganize! ('class initialization' cleanUp defaultEditorClass defaultEditorClass: initialize registerInFlapsRegistry unload) ('connectorstext-parts bin' boldAuthoringPrototype) ('new-morph participation' includeInNewMorphMenu) ('parts bin' borderedPrototype exampleBackgroundLabel fancyPrototype) ('scripting' authoringPrototype defaultNameStemForInstances) ('instance creation' string:fontName: string:fontName:size: string:fontName:size:wrap: string:size:) ('*MorphicExtras-parts bin' supplementaryPartsDescriptions) !
TextMorph removeSelector: #cursor! TextMorph removeSelector: #cursorWrapped:! TextMorph removeSelector: #getAllButFirstCharacter! TextMorph removeSelector: #holderForCharacters! TextMorph removeSelector: #insertCharacters:! TextMorph removeSelector: #insertContentsOf:! TextMorph removeSelector: #setAllButFirstCharacter:! TextMorph removeSelector: #wouldAcceptKeyboardFocusUponTab!
!TextMorph reorganize! ('accessing' autoFit: backgroundColor backgroundColor: borderWidth: caretColor caretColor: contents contentsAsIs: contentsWrapped: contents: contents:wrappedTo: crAction crAction: editor elementCount font: getFirstCharacter getLastCharacter hasTranslucentColor isAutoFit isWrapped margins margins: newContents: plainTextOnly plainTextOnly: readOnly readOnly: selectAll selectFrom:to: selectInterval: selection selectionColor selectionColor: selectionInterval selectionInterval: setCharacters: setFirstCharacter: setLastCharacter: text textAlignment textAlignmentSymbol textColor textColor: textStyle textStyle: unfocusedSelectionColor unfocusedSelectionColor: userString wrapFlag:) ('alignment' centered justified leftFlush rightFlush) ('anchors' adjustTextAnchor: anchorMorph:at:type:) ('caching' loadCachedState releaseCachedState) ('change reporting' ownerChanged) ('classification' isTextMorph) ('containment' avoidsOcclusions fillingOnOff fillsOwner fillsOwner: occlusionsOnOff recognizerArena setContainer:) ('copying' copy veryDeepFixupWith: veryDeepInner:) ('drawing' areasRemainingToFill: debugDrawLineRectsOn: drawNullTextOn: drawOn:) ('editing' acceptContents acceptOnCR cancelEdits cancelEditsSafely chooseAlignment chooseEmphasis chooseEmphasisOrAlignment chooseFont chooseStyle handleEdit: handleInteraction:fromEvent: hasUnacceptedEdits: passKeyboardFocusTo: setCompositionWindow xeqLinkText:withParameter:) ('event handling' click: getMenu: handlesKeyboard: handlesMouseDown: handlesMouseMove: handlesMouseOver: handlesMouseStillDown: hasFocus keyboardFocusChange: keyStroke: mouseDown: mouseEnter: mouseLeave: mouseMove: mouseUp: startDrag: wantsKeyboardFocus yellowButtonActivity:) ('events-processing' handleKeystroke:) ('geometry' bounds container defaultLineHeight extent: maximumContainerExtent privateMoveBy: textBounds) ('geometry testing' containsPoint:) ('initialization' beAllFont: defaultBorderWidth defaultColor fontName:pointSize: fontName:size: initialize setTextStyle: string:fontName:size: string:fontName:size:wrap:) ('layout' acceptDroppingMorph:event: averageLineLength averageLineLength: doLayoutIn: layoutChanged minCompositionHeight minCompositionWidth minHeight minWidth) ('linked frames' addPredecessor: addSuccessor: firstCharacterIndex firstInChain isLinkedTo: lastCharacterIndex predecessor recomposeChain startingIndex successor withSuccessorsDo:) ('menu' addCustomMenuItems:hand: autoFitOnOff autoFitString changeMargins: changeTextColor followCurve reverseCurveDirection setCurveBaseline: wrapOnOff wrapString) ('multi level undo' editHistory) ('objects from disk' convertToCurrentVersion:refStream: fixUponLoad:seg:) ('visual properties' fillStyle fillStyle:) ('*MorphicExtras-accessing' getCharacters) ('*MorphicExtras-copying' updateReferencesUsing:) ('private' adjustLineIndicesBy: clippingRectangle composeToBounds compositionRectangle createParagraph editorClass fit installEditorToReplace: paragraph paragraphClass predecessorChanged predecessor:successor: privateOwner: releaseEditor releaseParagraph releaseParagraphReally removedMorph: selectionChanged selectionChanged: setDefaultContentsIfNil setPredecessor: setSuccessor: text:textStyle: text:textStyle:wrap:color:predecessor:successor: updateFromParagraph) ('blinking' blinkStart blinkStart: onBlinkCursor resetBlinkCursor startBlinking stopBlinking) ('layout-properties' hResizing hResizing: vResizing vResizing: wrapDirection) ('printing' fullPrintOn:) ('Multilingual-ImmPlugin' preferredKeyboardPosition) ('submorphs - add/remove' addMorphFront:fromWorldPosition: delete goBehind) ('converting' asText withNoLineLongerThan:) !
TabbedPalette removeSelector: #becomeStandardPalette!
!TabbedPalette reorganize! ('dropping/grabbing' wantsDroppedMorph:event:) ('halos and balloon help' defersHaloOnClickTo:) ('initialization' addTabFor:font: addTabForBook: addTabForBook:withBalloonText: defaultColor defaultPageSize initialize newTabs: setInitialState) ('misc menu items' recolorTabs showNoPalette showNoPaletteAndHighlightTab: sortTabs:) ('miscellaneous' currentPalette tabsMorph) ('navigation' transitionSpecFor:) ('other' setExtentFromHalo:) ('palette menu' addBookMenuItemsTo:hand: addMenuTab) ('scraps tab' hasScrapsTab scrapsBook showScrapsTab) ('user-interface' selectTab: selectTabNamed: selectTabOfBook: tabMorphs tabNamed:) ('submorphs - add/remove' replaceSubmorph:by:) !
SystemWindow removeSelector: #extantSketchEditor! SystemWindow removeSelector: #wantsExpandBox! SystemWindow removeSelector: #wantsHalo!
!SystemWindow reorganize! ('drawing' areasRemainingToFill: colorForInsets makeMeVisible wantsRoundedCorners) ('events' doFastFrameDrag: filterEvent:for: handleListenEvent: handleMouseDown: handleMouseUp: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: paneTransition: secondaryPaneTransition:divider: startDragFromLabel: wantsToBeDroppedInto:) ('geometry' extent: justDroppedInto:event: labelRect paneMorphs panelRect position: removeMenuBox setPaneRectsFromBounds) ('initialization' addCloseBox addExpandBox addGrips addKeyboardShortcuts addLabelArea addMenuControl applyModelExtent boxExtent createBox: createCloseBox createCollapseBox createExpandBox createMenuBox defaultBounds defaultColor initialize initializeKeyboardShortcuts initializeLabelArea initializeWithLabel: maximumExtent maximumExtent: model: removeKeyboardShortcuts replaceBoxes setDefaultParameters setFramesForLabelArea) ('label' addLabel getRawLabel knownName label labelArea labelHeight labelWidgetAllowance relabel relabelEvent: setLabel: setLabelWidgetAllowance tryToRenameTo: update: widthOfFullLabelText) ('layout' assureLabelAreaVisible changeCellGapOfLayoutFrames: convertAlignment displayScaleChangedBy: layoutBounds putLabelItemsInLabelArea) ('menu' addCustomMenuItems:hand: buildWindowMenu changeColor deleteCloseBox fullScreen fullScreenMaximumExtent makeClosable makeSecondTopmost makeUnclosable offerWindowMenu sendToBack setWindowColor takeOutOfWindow wantsYellowButtonMenu) ('object fileIn' convertToCurrentVersion:refStream:) ('open/close' anyOpenWindowLikeMeIn: closeBoxHit delete initialExtent mustNotClose openAsIs openAsIsIn: openInWorld: openInWorld:extent: openInWorldExtent: postAcceptBrowseFor:) ('panes' addMorph:frame: addMorph:fullFrame: holdsTranscript paneMorphSatisfying: replacePane:with: setUpdatablePanesFrom: titleAndPaneText updatablePanes updateBox:color: updateBoxesColor:) ('resize/collapse' allowReframeHandles allowReframeHandles: collapse collapseOrExpand collapsedFrame contractToOriginalSize dragToEdgeDistance dragToEdgesSelectorFor:in: expand expandBoxHit expandToFullScreen fastFramingOn fullFrame getBoundsWithFlex getCollapsedFrame isCollapsed isPoint:nearBottomLeftOf: isPoint:nearBottomOf: isPoint:nearBottomRightOf: isPoint:nearLeftOf: isPoint:nearRightOf: isPoint:nearTopLeftOf: isPoint:nearTopOf: isPoint:nearTopRightOf: mouseLeaveEvent:fromPane: paneWithLongestSide:near: reframePanesAdjoining:along:to: setBoundsWithFlex: unexpandedFrame unexpandedFrame:) ('stepping' amendSteppingStatus stepAt: stepTime wantsSteps wantsStepsWhenCollapsed) ('testing' isSystemWindow isWindowForModel: shouldDropOnMouseUp wantsToBeCachedByHand) ('top window' beKeyWindow beKeyWindowIfNeeded: comeToFront comeToFrontModally dimWindowButtons isKeyWindow undimWindowButtons updatePanesFromSubmorphs) ('thumbnail' icon) ('polymorph' modalChild modalLockTo: modalOwner modalUnlockFrom: rememberedKeyboardFocus) ('focus' activate defaultFocusMorph defaultFocusMorph: isActive isActive: isLookingFocused isLookingFocused: lockWindowDecorations lockWindowTitle lookFocused lookUnfocused passivate passivateIfNeeded unlockWindowDecorations unlockWindowTitle updateFocusLookAtHand updateFocusLookForKeyboardFocus windowDecorations) ('colors' existingPaneColor gradientWithColor: paneColor paneColor: paneColorToUse paneColorToUseWhenNotActive raisedColor refreshWindowColor restoreDefaultPaneColor setStripeColorsFrom: setWindowColor: updatePaneColors) ('user interface' applyUserInterfaceTheme) ('*ToolBuilder-Morphic-opening' openAsTool) ('*services-base' requestor topWindow) ('*60Deprecated-open/close' anyOpenWindowLikeMe) !
SuperSwikiServer removeSelector: #matchingEntries:! StringButtonMorph removeSelector: #adaptToWorld:!
!StringButtonMorph reorganize! ('accessing' actionSelector actionSelector: arguments arguments: target target:) ('button' doButtonAction) ('copying' updateReferencesUsing: veryDeepFixupWith: veryDeepInner:) ('event handling' handlesMouseDown: handlesMouseStillDown: mouseDown: mouseMove: mouseStillDown: mouseUp:) ('initialization' initialize) ('menu' addCustomMenuItems:hand: addTargetingMenuItems:hand: clearTarget setActWhen setActionSelector setArguments setLabel setTarget:) ('submorphs - add/remove' actWhen:) ('classification' isButton) !
SqueakFurtherCorePackagesHelp class removeSelector: #etoys!
!SmartRefStream reorganize! ('accessing' structures: superclasses:) ('class changed shape' catalogValues:size: conversionMethodsFor: storeInstVarsIn:from: writeClassRename:was: writeClassRenameMethod:was:fromInstVars: writeConversionMethod:class:was:fromInstVars:to: writeConversionMethodIn:fromInstVars:to:renamedFrom:) ('conversion' inputSensorx0 worldMorphbosfcebbfgccpmcpbttloiairfidcuwhavcdsll0) ('import image segment' applyConversionMethodsTo:className:varMap: checkFatalReshape: convert1:to:allVarMaps: convert2:allVarMaps: mapClass:origName: reshapedClassesIn:) ('read write' appendClassDefns checkCrLf initKnownRenames initShapeDicts instVarInfo: mapClass: moreObjects next nextAndClose nextPut: nextPutObjOnly: noHeader readInstance readInstanceSize:clsname:refPosn: readShortInst readWordLike recordImageSegment: renamed renamedConv restoreClassInstVars saveClassInstVars scanFrom: scanFrom:environment: setStream: setStream:reading: structures superclasses uniClasesDo: uniClassInstVarsRefs: verifyStructure versionSymbol:) ('*Morphic-conversion' bookPageMorphbosfcepcbbfgcc0 clippingMorphbosfcep0 clippingMorphbosfcepc0 dropShadowMorphbosfces0 layoutMorphbosfcepbbochvimol0 layoutMorphbosfcepcbbochvimol0 morphicEventtcbks0 morphicSoundEventtcbkss0 multiNewParagraphttfclpomsswfpp0 myMorphbosfce0 newMorphicEventts0) ('*ST80-conversion' scrollControllermvslrrsmsms0) ('*Graphics-conversion' transparentColorrcc0) ('strings-conversion' abstractStringx0 multiStringx0 multiSymbolx0) !
ColorPickerMorph removeSelector: #delete! ColorPickerMorph removeSelector: #getColorFromKedamaWorldIfPossible:!
!ColorPickerMorph reorganize! ('accessing' argument argument: deleteOnMouseUp deleteOnMouseUp: locationIndicator originalColor: selectedColor selector selector: sourceHand sourceHand: target target: updateContinuously updateContinuously:) ('drawing' drawOn:) ('event handling' handlesMouseDown: inhibitDragging mouseDown: mouseUp:) ('geometry testing' containsPoint:) ('halos and balloon help' isLikelyRecipientForMouseOverHalos) ('initialization' buildChartForm choseModalityFromPreference initialize initializeForPropertiesPanel initializeModal: updateSelectorDisplay) ('menu' addCustomMenuItems:hand: pickUpColorFor: toggleDeleteOnMouseUp toggleUpdateContinuously) ('other' addToWorld:near: bestPositionNear:inWorld: indicateColorUnderMouse putUpFor:near: trackColorUnderMouse) ('stepping' step stepTime) ('private' anchorAndRunModeless: argumentsWith: deleteAllBalloons modalBalloonHelpAtPoint: pickColorAt: positionOfColor: trackColorAt: updateAlpha: updateColor:feedbackColor: updateTargetColor updateTargetColorWith:) ('submorphs - add/remove' delete) !
SketchMorph removeSelector: #firstIntersectionWithLineFrom:to:!
!SketchMorph reorganize! ('accessing' form form: framesToDwell framesToDwell: keepAspectRatio keepAspectRatio: nominalForm: originalForm: rotatedForm scaleFactor scalePoint scalePoint: setNewFormFrom: useInterpolation useInterpolation: wantsSimpleSketchMorphHandles) ('caching' releaseCachedState) ('drawing' canBeEnlargedWithB3D drawHighResolutionOn:in: drawInterpolatedImage:on: drawOn: generateInterpolatedForm generateRotatedForm) ('support' baseGraphic baseGraphic: flipHorizontal flipVertical rotationStyle rotationStyle: wantsRecolorHandle) ('geometry' extent:) ('geometry testing' containsPoint:) ('halos and balloon help' isLikelyRecipientForMouseOverHalos wantsDirectionHandles wantsDirectionHandles:) ('initialization' initialize initializeWith:) ('layout' layoutChanged) ('menu' addBorderToShape: addCustomMenuItems:hand: addPaintingItemsTo:hand: blur callThisBaseGraphic edgeDetect editDrawing editDrawingIn:forBackground: emboss erasePixelsOfColor: erasePixelsUsing: insertIntoMovie: recolorPixelsOfColor:with: recolorPixelsUsing: reduceColorPalette: restoreBaseGraphic restoreBaseGraphicFromMenu setRotationStyle sharpen toggleInterpolation useInterpolationString) ('menus' addFillStyleMenuItems:hand: addToggleItemsToHaloMenu: changePixelsOfColor:toColor: chooseNewGraphic collapse) ('objects from disk' convertToCurrentVersion:refStream:) ('other' newForm: replaceSelfWithMovie) ('parts bin' initializeToStandAlone) ('pen support' clearExtent:fillColor: penOnMyForm revealPenStrokes) ('rotate scale and flex' forwardDirection: heading:) ('*MorphicExtras-testing' canDrawAtHigherResolution) !
SketchEditorMorph removeSelector: #wantsHaloFromClick! SimpleSliderMorph removeSelector: #isLikelyRecipientForMouseOverHalos!
!SimpleSliderMorph reorganize! ('accessing' actionSelector actionSelector: arguments arguments: maxVal maxVal: minVal minVal: target target:) ('copying' updateReferencesUsing: veryDeepFixupWith: veryDeepInner:) ('initialization' initialize) ('menu' addCustomMenuItems:hand: addSliderMenuItems:hand: addTargetingMenuItems:hand: clearTarget descendingString setActionSelector setArguments setLabel setMaxVal setMinVal setMinVal: setTarget: toggleDescending toggleTruncate truncateString) ('model access' setValue:) ('parts bin' initializeToStandAlone) ('private' adjustToValue: getScaledValue setMaxVal: setScaledValue: truncate truncate:) !
SimpleHierarchicalListMorph class removeSelector: #submorphsExample!
!SimpleHierarchicalListMorph class reorganize! ('instance creation' expandedForm notExpandedForm on:list:selected:changeSelected: on:list:selected:changeSelected:menu: on:list:selected:changeSelected:menu:keystroke:) ('preferences' applyUserInterfaceTheme expandAllLimit expandAllLimit: themeProperties wrappedNavigation wrappedNavigation:) !
HaloMorph removeSelector: #addChooseGraphicHandle:! HaloMorph removeSelector: #addMakeSiblingHandle:! HaloMorph removeSelector: #addPaintBgdHandle:! HaloMorph removeSelector: #addPoohHandle:! HaloMorph removeSelector: #addRepaintHandle:! HaloMorph removeSelector: #addScriptHandle:! HaloMorph removeSelector: #addTileHandle:! HaloMorph removeSelector: #addViewHandle:! HaloMorph removeSelector: #addViewingHandle:! HaloMorph removeSelector: #doDupOrMakeSibling:with:! HaloMorph removeSelector: #doMakeSibling:with:! HaloMorph removeSelector: #doMakeSiblingOrDup:with:! HaloMorph removeSelector: #fadeIn! HaloMorph removeSelector: #fadeInInitially! HaloMorph removeSelector: #fadeOut! HaloMorph removeSelector: #fadeOutFinally! HaloMorph removeSelector: #handleEntered! HaloMorph removeSelector: #handleLeft! HaloMorph removeSelector: #isMagicHalo! HaloMorph removeSelector: #isMagicHalo:! HaloMorph removeSelector: #mouseDown:! HaloMorph removeSelector: #openViewerForTarget:with:! HaloMorph removeSelector: #popUpMagicallyFor:hand:! HaloMorph removeSelector: #tearOffTileForTarget:with:! SimpleHaloMorph removeSelector: #isMagicHalo! SimpleHaloMorph removeSelector: #popUpMagicallyFor:hand:!
!IconicButton reorganize! ('events' mouseEnter: mouseLeave:) ('initialization' borderNormal borderThick buttonSetup defaultBorderWidth initialize initializeWithThumbnail:withLabel:andColor:andSend:to: initializeWithThumbnail:withLabel:andSend:to: setDefaultLabel stationarySetup) ('menu' addLabelItemsTo:hand:) ('button' doButtonAction) ('compatibility' dim undim) ('ui' darken darkenedForm restoreImage shedSelvedge) ('label' labelFromString: labelGraphic: labelMorph) ('*MorphicExtras-initialization' initializeToShow:withLabel:andSend:to:) !
SimpleButtonMorph removeSelector: #adaptToWorld:!
!ServerDirectory class reorganize! ('available servers' addLocalProjectDirectory: addServer:named: localProjectDirectories nameForServer: projectServers removeServerNamed: removeServerNamed:ifAbsent: resetLocalProjectDirectories resetServers serverForURL: serverNamed: serverNamed:ifAbsent: serverNames servers) ('class initialization' cleanUp: initialize) ('misc' defaultStemUrl newFrom: on: parseFTPEntry: secondsForDay:month:yearOrTime:thisMonth:thisYear:) ('school support' projectDefaultDirectory) ('server prefs' determineLocalServerDirectory: fetchExternalSettingsIn: parseServerEntryFrom: releaseExternalSettings serverConfDirectoryName storeCurrentServersIn: transferServerDefinitionsToExternal) ('*UpdateStream-server groups' convertGroupNames groupNames serverInGroupNamed: serversInGroupNamed:) !
Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl keepAlive encodingName' classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers' poolDictionaries: '' category: 'Network-RemoteDirectory'! SelectionMorph removeSelector: #couldMakeSibling! SelectionMorph removeSelector: #preferredDuplicationHandleSelector! ScrollableField removeSelector: #cursorWrapped:! ScrollableField removeSelector: #getAllButFirstCharacter! ScrollableField removeSelector: #getNumericValue! ScrollableField removeSelector: #insertCharacters:! ScrollableField removeSelector: #insertContentsOf:! ScrollableField removeSelector: #setNumericValue:!
!ScreeningMorph reorganize! ('accessing' passElseBlock: passingColor:) ('drawing' fullDrawOn:) ('halos and balloon help' wantsRecolorHandle) ('geometry testing' containsPoint:) ('initialization' initialize) ('layout' layoutChanged) ('menu' addCustomMenuItems:hand: chooseBlockingColor choosePassingColor exchange showScreenOnly showScreenOverSource showScreened showSourceOnly) ('private' removedMorph: screenForm screenMorph sourceMorph) ('submorphs - add/remove' addMorph:) !
ScreenController removeSelector: #standardGraphicsLibrary! ReleaseBuilder class removeSelector: #beautifyEtoys! FlapTab removeSelector: #makeNewDrawing:! FlapTab removeSelector: #startOrFinishDrawing:! FlapTab removeSelector: #thicknessString! Quadrangle class removeSelector: #exampleInViewer!
!ProjectSorterMorph reorganize! ('initialization' addControls defaultBorderWidth defaultColor initialize navigator:listOfPages:) ('event handling' clickFromSorterEvent:morph:) ('controls' insertNewProject:) ('private' morphsForMyContentsFrom:sizedTo: sorterMorphForProjectNamed:) !
ProjectNavigationMorph removeSelector: #buttonPaint! ProjectNavigationMorph removeSelector: #doNewPainting! ProjectNavigationMorph removeSelector: #editProjectInfo! ProjectNavigationMorph removeSelector: #makeTheSimpleButtons!
!ProjectLoading class reorganize! ('accessing' projectStreamFromArchive: thumbnailFromUrl:) ('loading' installRemoteNamed:from:named:in: openFromDirectory:andFileName: openFromFile:fromDirectory:withProjectView: openName:stream:fromDirectory:withProjectView: openName:stream:fromDirectory:withProjectView:clearOriginFlag: openOn:) ('utilities' bestAccessToFileName:andDirectory: useTempChangeSet) ('loading - support' checkSecurity:preStream:projStream: fileInName:archive:morphOrList: loadImageSegment:fromDirectory:withProjectView:numberOfFontSubstitutes:substituteFont:mgr: makeExistingView:project:projectsToBeDeleted: morphOrList:stream:fromDirectory:archive: parseManifest:) !
ProjectLauncher removeSelector: #cancelLogin! ProjectLauncher removeSelector: #doEtoyLogin! ProjectLauncher removeSelector: #loginAs:! ProjectLauncher removeSelector: #prepareForLogin! ProjectLauncher removeSelector: #proceedWithLogin! ProjectLauncher removeSelector: #startUpAfterLogin! AbstractLauncher subclass: #ProjectLauncher instanceVariableNames: 'showSplash splashURL whichFlaps' classVariableNames: 'SplashMorph' poolDictionaries: '' category: 'System-Download'!
!ProjectLauncher reorganize! ('initialization' initialize setupFlaps setupFromParameters) ('running' hideSplashMorph installProjectFrom: showSplashMorph startUp) ('private' showSplash) !
Project class removeSelector: #publishInSexp!
!Project class reorganize! ('class initialization' cleanUp: cleanUpProjectPreferences initialize localeChanged rebuildAllProjects) ('constants' current uiManager uiProcess) ('squeaklet on server' enterIfThereOrFind: fromUrl: isBadNameForStoring: loaderUrl mostRecent:onServer: namedUrl: parseProjectFileName: projectExtension serverDirectoryFromURL: serverFileFromURL: squeakletDirectory sweep:) ('utilities' addingProject: advanceToNextProject allNames allNamesAndProjects allProjects allProjectsOrdered canWeLoadAProjectNow chooseNaturalLanguage deletingProject: enter: flattenProjectHierarchy forget: hierarchyOfNamesAndProjects jumpToProject jumpToSelection: maybeForkInterrupt named: named:in: namedWithDepth: ofWorld: projectHierarchy releaseProjectReferences: removeAll: removeAllButCurrent returnToParentProject returnToPreviousProject storeAllInSegments topProject versionForFileName:) ('*Morphic-Support' allMorphicProjects) ('error recovery' tryEmergencyEvaluatorForRecovery: tryOtherProjectForRecovery:) ('shrinking' removeProjectsFromSystem) ('snapshots' shutDown: startUp:) ('*ST80-Support' allMVCProjects) ('preferences') ('*60Deprecated-error recovery' handlePrimitiveError:) ('*61Deprecated-utilities' resumeProcess:) !
MorphicProject removeSelector: #exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction:! MorphicProject removeSelector: #initMorphic! MorphicProject removeSelector: #myPlayerClasses! MorphicProject removeSelector: #setFlaps!
!MorphicProject reorganize! ('display' displayScaleChangedFrom:to: invalidate noDisplayDuring: previewImageForm restore viewLocFor:) ('initialize' initialize installPasteUpAsWorld: openProject: setWorldBackground:) ('testing' isMorphic) ('menu messages' assureNavigatorPresenceMatchesPreference makeThumbnail) ('utilities' addItem:toMenu:selection:color:thumbnail: composeDisplayTextIntoForm: createViewIfAppropriate do:withProgressInfoOn:label: findAFolderForProject:label: findProjectView: jumpToProject launchSystemFiles:event: offerMenu:from:shifted: pointerMoved setAsBackground: showImage:named: textWindows) ('docking bars support' assureMainDockingBarPresenceMatchesPreference createOrUpdateMainDockingBar dockingBar dockingBar: removeMainDockingBar showWorldMainDockingBar showWorldMainDockingBar: showWorldMainDockingBarString toggleShowWorldMainDockingBar) ('file in/out' acceptProjectDetails: armsLengthCommand:withDescription: compressFilesIn:to:in: compressFilesIn:to:in:resources: exportSegmentWithChangeSet:fileName:directory: exportSegmentWithChangeSet:fileName:directory:withoutInteraction: loadFromServer: noteManifestDetailsIn: storeSegment storeSegmentNoFile) ('enter' clearGlobalState enterAsActiveSubprojectWithin: finalEnterActions: finalExitActions: initializeMenus isIncompletelyLoaded resumeEventRecorder: scheduleProcessForEnter startUpActions suspendProcessForDebug terminateProcessForLeave wakeUpTopWindow) ('squeaklet on server' enterIfThereOrFind: openBlankProjectNamed:) ('release' deletingProject: prepareForDelete) ('language' chooseNaturalLanguage updateLocaleDependents) ('editors' bitEdit: bitEdit:at:scale: editCharacter:ofFont: formEdit: formViewClass openImage:name:saveResource:) ('futures' future:do:at:args: future:send:at:args:) ('active process' spawnNewProcess spawnNewProcessAndTerminateOld: spawnNewProcessIfThisIsUI: uiProcess uiProcess:) ('transcripter' displayTranscripter: initializeParagraphForTranscripter:) ('subprojects' addProject: subProjects) ('accessing' color topMorphicProject) ('updating' applyUserInterfaceTheme canApplyUserInterfaceTheme) ('scheduling & debugging' addDeferredUIMessage: fatalDrawingError: interruptCleanUpFor: lastDeferredUIMessage openDebuggerWindow: recursiveError: restoreDisplay resumeProcessSafely: suspendProcessSafely:) ('flaps support' assureFlapIntegrity cleanseDisabledGlobalFlapIDsList enableDisableGlobalFlap: flapsSuppressed: globalFlapEnabledString: globalFlapWithIDEnabledString: isFlapEnabled: isFlapIDEnabled: suppressFlapsString toggleFlapsSuppressed) ('protocols' currentVocabulary) !
Project removeSelector: #restoreReferences!
!Project reorganize! ('accessing' changeSet color displayDepth displayDepth: explicitName explicitName: findProjectView: forgetExistingURL labelString lastDirectory: lastSavedAtSeconds name nameAdjustedForDepth nextProject nilParentError previousProject projectChangeSet renameTo: storeNewPrimaryURL: thumbnail thumbnail: topProject transcript uiManager urlList viewSize viewSize: world) ('active process' depth spawnNewProcessIfThisIsUI: uiProcess) ('displaying' displayDepthChanged displayScaleChangedFrom:to: displaySizeChanged displayZoom: imageForm imageFormOfSize:depth: invalidate noDisplayDuring: previewImageForm restore restoreDisplay showZoom shrinkDisplay viewLocFor:) ('file in/out' armsLengthCommand:withDescription: assureIntegerVersion bumpVersion: couldBeSwappedOut currentVersionNumber decideAboutCreatingBlank: doArmsLengthCommand: downloadUrl ensureChangeSetNameUnique exportSegmentFileName:directory: exportSegmentFileName:directory:withoutInteraction: exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction: exportSegmentWithCatagories:classes:fileName:directory: exportSegmentWithChangeSet:fileName:directory: findAFolderToLoadProjectFrom findAFolderToStoreProjectIn fromMyServerLoad: hasBadNameForStoring htmlPagePrototype loadFromServer loadFromServer: objectForDataStream: primaryServer primaryServerIfNil: projectExtension revert saveAs saveForRevert serverList squeakletDirectory storeAttributeKey:value:on: storeAttributesOn: storeDataOn: storeHtmlPageIn: storeManifestFileIn: storeOnServer storeOnServerAssumingNameValid storeOnServerInnards storeOnServerShowProgressOn:forgetURL: storeOnServerWithProgressInfo storeOnServerWithProgressInfoOn: storeSegment storeSegmentNoFile storeSomeSegment storeToMakeRoom tryToFindAServerWithMe url urlForLoading versionForFileName versionFrom: versionedFileName writeFileNamed:fromDirectory:toServer: writeStackText:in:registerIn:) ('flaps support' flapsSuppressed flapsSuppressed: showSharedFlaps) ('initialization' initialExtent initialProject initialize installNewDisplay:depth: openProject: resetTranscript setChangeSet: setServer windowActiveOnFirstClick windowReqNewLabel:) ('language' chooseNaturalLanguage localeChanged localeID naturalLanguage updateLocaleDependents) ('menu messages' assureNavigatorPresenceMatchesPreference doWeWantToRename exit fileOut installProjectPreferences makeThumbnail saveProjectPreferences validateProjectNameIfOK:) ('printing' addSubProjectNamesTo:indentation: printOn:) ('project parameters' initializeProjectParameters initializeProjectPreferences noteThatParameter:justChangedTo: parameterAt: parameterAt:ifAbsent: projectParameterAt: projectParameterAt:ifAbsent: projectParameterAt:ifAbsentPut: projectParameterAt:put: projectParameters projectPreferenceAt: projectPreferenceAt:ifAbsent: projectPreferenceFlagDictionary rawParameters removeParameter:) ('release' addDependent: canDiscardEdits close delete deletingProject: forget okToChange prepareForDelete release removeChangeSetIfPossible windowIsClosing) ('resources' abortResourceLoading resourceDirectoryName resourceManager resourceManager: resourceUrl startResourceLoading storeResourceList:in:) ('SuperSwiki' tellAFriend tellAFriend:) ('*sound' beep) ('enter' enter enter: enter:revert:saveForRevert: finalEnterActions: finalExitActions: loadState saveState scheduleProcessForEnter shutDownActions startUpActions terminateProcessForLeave wakeUpTopWindow) ('utilities' addItem:toMenu:selection:color:thumbnail: buildJumpToMenu: composeDisplayTextIntoForm: do:withProgressInfoOn:label: findAFolderForProject:label: jumpToProject jumpToSelection: offerMenu:from:shifted: pointerMoved setAsBackground: showImage:named: textWindows) ('squeaklet on server' enterIfThereOrFind: openBlankProjectNamed:) ('futures' future:do:at:args: future:send:at:args:) ('editors' bitEdit: bitEdit:at:scale: editCharacter:ofFont: formEdit: formViewClass openImage:name:saveResource:) ('transcripter' displayTranscripter: initializeParagraphForTranscripter:) ('sub-projects & hierarchy' addProject: beTopProject children isTopProject liftSubProjects parent setParent: subProjects withChildrenDo:) ('enter - recovery' enterForEmergencyRecovery suspendProcessForDebug) ('testing' isCurrentProject isIncompletelyLoaded isMorphic) ('shrinking' removeAllOtherProjects) ('*ST80-Testing' isMVC) ('*60Deprecated-accessing' setThumbnail: setViewSize:) ('scheduling & debugging' addDeferredUIMessage: debugProcess:inDialog: debugProcess:inWindow: guardRecursiveError:during: interruptCleanUpFor: interruptName: interruptName:message: interruptName:message:preemptedProcess: interruptName:preemptedProcess: lastDeferredUIMessage openDebuggerWindow: prepareProcessForDebugger: primitiveError: recursiveError: resumeProcessSafely: suspendProcessSafely:) ('*MorphicExtras-accessing' useOwnChangeSetWithCurrentName useParentChangeSetButSetProjectName:) ('protocols' currentVocabulary) !
Preferences class removeSelector: #annotationEditingWindow! Preferences class removeSelector: #automaticViewerPlacement! Preferences class removeSelector: #batchPenTrails! Preferences class removeSelector: #capitalizedReferences! Preferences class removeSelector: #cautionBeforeClosing! Preferences class removeSelector: #chooseEToysFont! Preferences class removeSelector: #chooseEToysTitleFont! Preferences class removeSelector: #classicTilesSettingToggled! Preferences class removeSelector: #compactViewerFlaps! Preferences class removeSelector: #debugMenuItemsInvokableFromScripts! Preferences class removeSelector: #defaultPaintingExtent! Preferences class removeSelector: #dropProducesWatcher! Preferences class removeSelector: #eToyFriendly! Preferences class removeSelector: #eToyFriendlyChanged! Preferences class removeSelector: #eToyLoginEnabled! Preferences class removeSelector: #editAnnotations! Preferences class removeSelector: #enableLocalSave! Preferences class removeSelector: #expandedPublishing! Preferences class removeSelector: #fenceEnabled! Preferences class removeSelector: #fenceSoundEnabled! Preferences class removeSelector: #fenceSoundEnabled:! Preferences class removeSelector: #haloTransitions! Preferences class removeSelector: #includeSoundControlInNavigator! Preferences class removeSelector: #keepTickingWhilePainting! Preferences class removeSelector: #largeTilesSettingToggled! Preferences class removeSelector: #magicHalos! Preferences class removeSelector: #menuColorFromWorld! Preferences class removeSelector: #menuColorString! Preferences class removeSelector: #messengersInViewers! Preferences class removeSelector: #mouseOverHalos! Preferences class removeSelector: #mouseOverHalosChanged! Preferences class removeSelector: #mvcProjectsAllowed! Preferences class removeSelector: #navigatorOnLeftEdge! Preferences class removeSelector: #noviceMode! Preferences class removeSelector: #noviceModeSettingChanged! Preferences class removeSelector: #okToReinitializeFlaps! Preferences class removeSelector: #oliveHandleForScriptedObjects! Preferences class removeSelector: #propertySheetFromHalo! Preferences class removeSelector: #selectiveHalos! Preferences class removeSelector: #setEToysFontTo:! Preferences class removeSelector: #setEToysTitleFontTo:! Preferences class removeSelector: #showAdvancedNavigatorButtons! Preferences class removeSelector: #showFlapsWhenPublishing! Preferences class removeSelector: #simpleMenus! Preferences class removeSelector: #standardEToysFont! Preferences class removeSelector: #standardEToysTitleFont! Preferences class removeSelector: #tabAmongFields! Preferences class removeSelector: #tileTranslucentDrag! Preferences class removeSelector: #typeCheckingInTileScripting! Preferences class removeSelector: #uniTilesClassic! Preferences class removeSelector: #universalTiles! Preferences class removeSelector: #universalTilesSettingToggled! Preferences class removeSelector: #unlimitedPaintArea! Preferences class removeSelector: #useCategoryListsInViewers! Preferences class removeSelector: #useVectorVocabulary! Preferences class removeSelector: #vectorVocabularySettingChanged! Preferences class removeSelector: #viewersInFlaps!
!Preferences class reorganize! ('accessing' allPreferences atomicUpdatePreferences: dictionaryOfPreferences pragmaIdFor:getter: pragmaPreferenceFor:getter: preferenceAt: preferenceAt:ifAbsent:) ('class initialization' initialize unload) ('get/set' doesNotUnderstand: setPreference:toValue: setPreference:toValue:during: valueOfPreference: valueOfPreference:ifAbsent:) ('initialization' chooseInitialSettings cleanUp: cleanUpPragmaPreferences initializeDictionaryOfPreferences registerForEvents removeObsolete resetDefaultValues setPreferencesFrom:) ('parameters' expungeParameter: initializeParameters inspectParameters parameterAt: parameterAt:ifAbsentPut: parameterAt:ifAbsent: parameters setParameter:to:) ('reacting to change' isChangeSelector:) ('standard queries' alphabeticalProjectMenu alternateHandlesLook alternativeBrowseIt alternativeWindowBoxesLook alwaysHideHScrollbar alwaysShowHScrollbar alwaysShowVScrollbar annotationPanes areaFillsAreTolerant areaFillsAreVeryTolerant autoIndent automaticFlapLayout automaticKeyGeneration balloonHelpEnabled balloonHelpInMessageLists biggerHandles caseSensitiveFinds changeSetVersionNumbers checkForSlips checkForUnsavedProjects classicNavigatorEnabled cmdDotEnabled cmdGesturesEnabled collapseWindowsInPlace confirmFirstUseOfStyle conversionMethodsAtFileOut debugHaloHandle debugLogTimestamp debugPrintSpaceLog debugShowDamage decorateBrowserButtons diffsInChangeList diffsWithPrettyPrint dismissAllOnOptionClose easySelection extraDebuggerButtons fastDragWindowForMorphic fullScreenLeavesDeskMargins generalizedYellowButtonMenu haloEnclosesFullBounds higherPerformance honorDesktopCmdKeys infiniteUndo logDebuggerStackToFile maintainHalos menuAppearance3d menuKeyboardControl menuWithIcons modalColorPickers mouseOverForKeyboardFocus optionalButtons passwordsOnPublish personalizedWorldMenu postscriptStoredAsEPS projectsSentToDisk projectViewsInWindows projectZoom purgeUndoOnQuit readDocumentAtStartup readDocumentAtStartup: restartAlsoProceeds reverseWindowStagger scrollBarsNarrow scrollBarsOnRight securityChecksEnabled serverMode showBoundsInHalo showDirectionForSketches showDirectionHandles showProjectNavigator showSecurityStatus showSharedFlaps showSplitterHandles signProjectFiles smartUpdating standaloneSecurityChecksEnabled startInUntrustedDirectory swapMouseButtons systemWindowEmbedOK timeStampsInMenuTitles tinyDisplay traceMessages turnOffPowerManager twentyFourHourFileStamps uniqueNamesInHalos useButtonPropertiesToFire useUndo visualExplorer warnAboutInsecureContent warnIfNoChangesFile warnIfNoSourcesFile wordStyleCursorMovement) ('themes' outOfTheBox personal) ('*PreferenceBrowser' addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:viewRegistry:) ('private' compileAccessorForPreference: compileAccessorForPreferenceNamed:value: preference:category:description:type: preference:categoryList:description:type:) ('prefs - fonts' aaFontsColormapDepth chooseBalloonHelpFont chooseCodeFont chooseFixedFont chooseFlapsFont chooseFontWithPrompt:andSendTo:withSelector:highlightSelector: chooseHaloLabelFont chooseListFont chooseMenuFont chooseStandardButtonFont chooseSystemFont chooseWindowTitleFont decreaseFontSize fontConfigurationMenu fontConfigurationMenu: increaseFontSize printStandardSystemFonts refreshFontSettings restoreDefaultFonts restoreDefaultFontsForJapanese restoreFontsAfter: setBalloonHelpFontTo: setButtonFontTo: setCodeFontTo: setDemoFonts setFixedFontTo: setFlapFontTo: setFlapsFontTo: setHaloLabelFontTo: setListFontTo: setMenuFontTo: setPaintBoxButtonFontTo: setSystemFontTo: setWindowTitleFontTo: standardBalloonHelpFont standardButtonFont standardCodeFont standardDefaultTextFont standardFixedFont standardFlapFont standardHaloLabelFont standardListFont standardMenuFont standardPaintBoxButtonFont standardSystemFont standardWindowTitleFont subPixelRenderColorFonts subPixelRenderFonts windowTitleFont windowTitleStyle) ('support - misc' acceptAnnotationsFrom: addModelItemsToWindowMenu: automaticFlapLayoutString initialExtent inspectPreferences letUserPersonalizeMenu navigatorShowingString personalizeUserMenu: setArrowheads staggerPolicyString wantsChangeSetLogging) ('add/remove - specific' addBooleanPreference:categories:default:balloonHelp: addBooleanPreference:category:default:balloonHelp: addColorPreference:categories:default:balloonHelp: addColorPreference:category:default:balloonHelp: addFontPreference:categories:default:balloonHelp: addFontPreference:category:default:balloonHelp: addNumericPreference:categories:default:balloonHelp: addNumericPreference:category:default:balloonHelp: addTextPreference:categories:default:balloonHelp: addTextPreference:category:default:balloonHelp:) ('add/remove' addPragmaPreference: addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:type: removeAllPreferencesSuchThat: removePreference:) ('add/remove - convenience' addPreference:categories:default:balloonHelp: addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: addPreference:category:default: addPreference:category:default:balloonHelp: addPreference:default:) ('prefs - annotations' annotationInfo defaultAnnotationInfo defaultAnnotationRequests defaultAnnotationRequests:) ('updating - system' annotationPanesChanged displaySizeChanged infiniteUndoChanged optionalButtonsChanged roundedWindowCornersChanged sharedFlapsSettingChanged showProjectNavigatorChanged smartUpdatingChanged) ('prefs - misc' balloonHelpDelayTime borderColorWhenRunning cmdKeysInText defaultAuthorName defaultWorldColor desktopColor desktopColor: desktopMenuTitle enableProjectNavigator maxBalloonHelpLineLength maxBalloonHelpLineLength: metaMenuDisabled preserveCommandExcursions scrollBarColor scrollBarWidth suppressWindowTitlesInInstanceBrowsers useFormsInPaintBox:) ('themes - tools' browseThemes installTheme: offerThemesMenu themeChoiceButtonOfColor:font:) ('support' categoryList categoryListOfPreference: giveHelpWithPreferences okayToChangeProjectLocalnessOf: preferencesInCategory: typeForValue:) ('prefs - halos' classicHaloSpecs classicHalosInForce customHaloSpecs customHalosInForce editCustomHalos haloSpecifications haloSpecificationsForWorld haloTheme iconicHaloSpecifications iconicHalosInForce installClassicHaloSpecs installCustomHaloSpecs installHaloSpecsFromArray: installHaloTheme: installIconicHaloSpecs installSimpleHaloSpecs resetHaloSpecifications showChooseGraphicHaloHandle simpleFullHaloSpecifications simpleHalosInForce) ('defaults' defaultValueTableForCurrentRelease unclassifiedCategory) ('get/set - flags' disable: enable: setFlag:toValue: setFlag:toValue:during: toggle: valueOfFlag: valueOfFlag:ifAbsent:) ('initialization - misc' disableProgrammerFacilities enableProgrammerFacilities setDefaultAnnotationInfo setNotificationParametersForStandardPreferences) ('support - file list services' fileReaderServicesForFile:suffix: serviceLoadPreferencesFromDisk services) ('initialization - save/load' loadPreferencesFrom: restorePersonalPreferences restorePreferencesFromDisk restorePreferencesFromDisk: savePersonalPreferences storePreferencesIn: storePreferencesToDisk) ('updating' localeChanged prefEvent:) ('*60Deprecated-menu colors' menuBorderColor menuBorderWidth menuColor menuLineColor menuSelectionColor menuTitleBorderColor menuTitleBorderWidth menuTitleColor) ('*morphicextras' rotationAndScaleHandlesInPaintBox) ('*60Deprecated-prefs-text' chooseInsertionPointColor chooseKeyboardFocusColor chooseTextHighlightColor initializeTextHighlightingParameters insertionPointColor insertionPointColor: keyboardFocusColor keyboardFocusColor: textHighlightColor textHighlightColor:) ('*60Deprecated-Etoys-Squeakland-window colors' windowColorHelp windowSpecificationPanel) ('*60Deprecated-parameters' parameterAt:default:) !
!PolygonMorph reorganize! ('access' isClosed isCurve isOpen makeOpenOrClosed midVertices openOrClosePhrase smoothOrSegmentedPhrase vertices) ('accessing' borderColor: borderDashSpec borderStyle: borderWidth: couldHaveRoundedCorners) ('caching' loadCachedState releaseCachedState) ('dashes' borderDashOffset dashedBorder dashedBorder: removeVertex: vertexAt:) ('debug and other' installModelIn: rotateTestFlip:) ('drawing' areasRemainingToFill: drawArrowOn:at:from: drawArrowsOn: drawBorderOn: drawBorderOn:usingEnds: drawClippedBorderOn:usingEnds: drawDashedBorderOn: drawDashedBorderOn:usingEnds: drawOnFormCanvas: drawOn:) ('editing' addHandles clickVertex:event:fromHandle: deleteVertexAt: dragVertex:event:fromHandle: dragVertex:fromHandle:vertIndex: dropVertex:event:fromHandle: dropVertex:fromHandle:vertIndex: handleColorAt: insertVertexAt:put: newVertex:event:fromHandle: newVertex:fromHandle:afterVert: updateHandles verticesAt:put:) ('event handling' handlesMouseDown: mouseDown:) ('geometry' arrowsContainPoint: bounds: closestPointTo: closestSegmentTo: extent: flipHAroundX: flipVAroundY: intersectionsWith: intersectionWithLineSegmentFromCenterTo: intersects: isBordered lineBorderColor lineBorderColor: lineBorderWidth lineBorderWidth: lineColor lineColor: lineWidth lineWidth: mergeDropThird:in:from: merge: nextDuplicateVertexIndex reduceVertices straighten transformedBy:) ('geometry testing' containsPoint:) ('initialization' beSmoothCurve beStraightSegments defaultBorderColor defaultColor initialize vertices:color:borderWidth:borderColor:) ('menu' addCustomMenuItems:hand: addPolyArrowMenuItems:hand: addPolyLIneCurveMenuItems:hand: addPolyShapingMenuItems:hand: arrowLength: arrowSpec: arrows customizeArrows: handlesShowingPhrase makeBackArrow makeBothArrows makeClosed makeForwardArrow makeNoArrows makeOpen quickFill: removeHandles setRotationCenterFrom: showingHandles showOrHideHandles specifyDashedLine standardArrows toggleHandles toggleSmoothing unrotatedLength unrotatedLength: unrotatedWidth unrotatedWidth:) ('objects from disk' convertToCurrentVersion:refStream:) ('rotate scale and flex' addFlexShellIfNecessary heading heading: referencePosition rotationCenter rotationCenter: rotationDegrees rotationDegrees:) ('smoothing' coefficients computeNextToEndPoints derivs:first:second:third: lineSegmentsDo: nextToFirstPoint nextToLastPoint slopes: straightLineSegmentsDo:) ('stepping' step stepTime wantsSteps) ('testing' hasArrows isCurvier isCurvy isLineMorph) ('visual properties' canHaveFillStyles fillStyle fillStyle:) ('*MorphicExtras-geometry eToy' scale:) ('private' arrowBoundsAt:from: arrowForms borderForm computeArrowFormAt:from: computeBounds curveBounds filledForm getVertices includesHandle: lineSegments privateMoveBy: setVertices: transformVerticesFrom:to:) ('shaping' diamondOval rectOval) ('attachments' defaultAttachmentPointSpecs endShapeColor: endShapeWidth: firstVertex lastVertex midpoint nudgeForLabel: totalLength) ('rounding' cornerStyle:) ('*MorphicExtras-Postscript Canvases' drawPostscriptOn:) !
PluggableTextMorph removeSelector: #tileForIt! PasteUpMorphTest removeSelector: #testCursorWrapped! PasteUpMorphTest removeSelector: #testCursorWrappedWithFraction! PasteUpMorphTest removeSelector: #testGridToGradient! PasteUpMorph initialize! PasteUpMorph class removeSelector: #supplementaryPartsDescriptions!
!PasteUpMorph class reorganize! ('printing' defaultNameStemForInstances) ('project' newWorldForProject:) ('scripting' authoringPrototype) ('preferences' globalCommandKeysEnabled globalCommandKeysEnabled:) ('recompilation' postRecompileAction) ('*MorphicExtras-class initialization' initialize registerInFlapsRegistry unload) ('*MorphicExtras-project' newWorldTesting) ('*MorphicExtras-parts bin') ('parts bin' descriptionForPartsBin) !
PartsBin removeSelector: #morphToDropFrom:! PasteUpMorph removeSelector: #abandonCostumeHistory! PasteUpMorph removeSelector: #abandonVocabularyPreference! PasteUpMorph removeSelector: #adaptedToWorld:! PasteUpMorph removeSelector: #addPenMenuItems:hand:! PasteUpMorph removeSelector: #addPenTrailsMenuItemsTo:! PasteUpMorph removeSelector: #addPlayfieldMenuItems:hand:! PasteUpMorph removeSelector: #addStackMenuItems:hand:! PasteUpMorph removeSelector: #allScriptEditors! PasteUpMorph removeSelector: #allScriptors! PasteUpMorph removeSelector: #allTileScriptingElements! PasteUpMorph removeSelector: #assureNotPaintingEvent:! PasteUpMorph removeSelector: #automaticPhraseExpansion! PasteUpMorph removeSelector: #automaticViewing! PasteUpMorph removeSelector: #behaveLikeHolder! PasteUpMorph removeSelector: #behaveLikeHolder:! PasteUpMorph removeSelector: #behavingLikeAHolder! PasteUpMorph removeSelector: #browseAllScriptsTextually! PasteUpMorph removeSelector: #buildDebugMenu:! PasteUpMorph removeSelector: #closedViewerFlapTabs! PasteUpMorph removeSelector: #couldMakeSibling! PasteUpMorph removeSelector: #cursor! PasteUpMorph removeSelector: #cursor:! PasteUpMorph removeSelector: #cursorWrapped:! PasteUpMorph removeSelector: #detachableScriptingSpace! PasteUpMorph removeSelector: #drawOn:! PasteUpMorph removeSelector: #dumpPresenter! PasteUpMorph removeSelector: #hideViewerFlaps! PasteUpMorph removeSelector: #hideViewerFlapsOtherThanFor:! PasteUpMorph removeSelector: #indicateCursor! PasteUpMorph removeSelector: #indicateCursor:! PasteUpMorph removeSelector: #indicateCursorString! PasteUpMorph removeSelector: #installVectorVocabulary! PasteUpMorph removeSelector: #isPlayfieldLike! PasteUpMorph removeSelector: #makeNewDrawing:! PasteUpMorph removeSelector: #makeNewDrawing:at:! PasteUpMorph removeSelector: #makeNewDrawingWithin! PasteUpMorph removeSelector: #makeVectorUseConformToPreference! PasteUpMorph removeSelector: #mouseOverHalosString! PasteUpMorph removeSelector: #newDrawingFromMenu:! PasteUpMorph removeSelector: #numberAtCursor! PasteUpMorph removeSelector: #openScrapsBook:! PasteUpMorph removeSelector: #paintArea! PasteUpMorph removeSelector: #paintAreaFor:! PasteUpMorph removeSelector: #paintingBoundsAround:! PasteUpMorph removeSelector: #paintingFlapTab! PasteUpMorph removeSelector: #prepareToBeSaved! PasteUpMorph removeSelector: #prepareToPaint! PasteUpMorph removeSelector: #prepareToPaint:! PasteUpMorph removeSelector: #presentCardAndStackMenu! PasteUpMorph removeSelector: #presentPlayfieldMenu! PasteUpMorph removeSelector: #presenter! PasteUpMorph removeSelector: #printScriptSummary! PasteUpMorph removeSelector: #putUpPenTrailsSubmenu! PasteUpMorph removeSelector: #reasonablePaintingExtent! PasteUpMorph removeSelector: #rectifyCursor! PasteUpMorph removeSelector: #referencePlayfield! PasteUpMorph removeSelector: #referencePool! PasteUpMorph removeSelector: #releaseViewers! PasteUpMorph removeSelector: #removeAllViewers! PasteUpMorph removeSelector: #restoreBoundsOfSubmorphs! PasteUpMorph removeSelector: #resumeScriptsPausedByPainting! PasteUpMorph removeSelector: #roundUpStrays! PasteUpMorph removeSelector: #saveBoundsOfSubmorphs! PasteUpMorph removeSelector: #selectedRect! PasteUpMorph removeSelector: #sendTextContentsBackToDonor! PasteUpMorph removeSelector: #showStatusOfAllScripts! PasteUpMorph removeSelector: #showingListView! PasteUpMorph removeSelector: #sortSubmorphsBy:! PasteUpMorph removeSelector: #standardPlayerHit! PasteUpMorph removeSelector: #startRunningAll! PasteUpMorph removeSelector: #stepAll! PasteUpMorph removeSelector: #stopRunningAll! PasteUpMorph removeSelector: #toggleAutoLineLayout! PasteUpMorph removeSelector: #toggleClassicNavigatorIfAppropriate! PasteUpMorph removeSelector: #toggleMouseOverHalos! PasteUpMorph removeSelector: #triggerClosingScripts! PasteUpMorph removeSelector: #triggerOpeningScripts! PasteUpMorph removeSelector: #updateStatusForAllScriptEditors! PasteUpMorph removeSelector: #valueAtCursor! PasteUpMorph removeSelector: #valueAtCursor:! PasteUpMorph removeSelector: #viewingNormally! PasteUpMorph removeSelector: #wantsHaloFor:! PasteUpMorph removeSelector: #wantsMouseOverHalos! PasteUpMorph removeSelector: #wantsMouseOverHalos:! BorderedMorph subclass: #PasteUpMorph instanceVariableNames: 'model padding isPartsBin worldState' classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler' poolDictionaries: '' category: 'Morphic-Worlds'!
!PasteUpMorph reorganize! ('accessing' assureFlapWidth: flapTab lastKeystroke lastKeystroke: modelOrNil useRoundedCorners) ('alarms-scheduler' addAlarm:withArguments:for:at: removeAlarm:for:) ('caching' releaseCachedState) ('change reporting' invalidRect:from:) ('classification' isWorldMorph) ('copying' veryDeepCopyWith:) ('display' gradientFillColor: setGradientColor:) ('dropping/grabbing' acceptDroppingMorph:event: dropEnabled hasTransferMorphConverter justDroppedInto:event: morphToDropForTransferMorph: morphToDropFrom: originAtCenter positionNear:forExtent:adjustmentSuggestion: repelsMorph:event: resetTransferMorphConverter transferMorphConverter transferMorphConverter: wantsDroppedMorph:event: wantsDroppedTransferMorph:) ('event handling' dropExplorerField:from:event: dropFiles:event: dropInspectorField:event: dropSourceCode:event: handleDroppedItem:event: handlesKeyboard: handlesMouseDown: keyStroke: morphToGrab: mouseDown: mouseUp: wantsEasySelection wantsKeyboardFocusFor: wantsWindowEvent: windowEvent: windowEventHandler windowEventHandler:) ('events-processing' filterEvent:for: processEvent:using: tryInvokeHalo: tryInvokeKeyboardShortcut: tryInvokeMetaMenu:) ('geometry' bringTopmostsToFront extent: position:) ('geometry testing' fullContainsPoint:) ('halos and balloon help' defersHaloOnClickTo: wantsDirectionHandles wantsHaloFromClick) ('initialization' addKeyboardShortcuts addMouseShortcuts becomeActiveDuring: defaultBorderColor defaultBorderWidth defaultColor initialize initializeKeyboardShortcuts initializeMouseShortcuts newResourceLoaded removeKeyboardShortcuts) ('interaction loop' doOneCycleNow) ('layout' addCenteredAtBottom:offset: convertAlignment laySubpartsOutInOneRow layoutChanged) ('menu & halo' addCustomMenuItems:hand: addScalingMenuItems:hand: addWorldHaloMenuItemsTo:hand: addWorldToggleItemsToHaloMenu: autoLineLayoutString currentlyUsingVectorVocabulary defineApplicationView defineFactoryView deleteBalloonTarget: isPartsBinString originAtCenterString reformulateUpdatingMenus showApplicationView showExpandedView showFactoryView showFullView showReducedView showThumbnailString showWorldMainDockingBarString toggleShowWorldMainDockingBar transformToShow:) ('misc' alwaysShowThumbnail cachedOrNewThumbnailFrom: cartesianOrigin heightForThumbnails hideFlapsOtherThan:ifClingingTo: innocuousName maxHeightToAvoidThumbnailing maximumThumbnailWidth mouseX mouseY nameForCopyIfAlreadyNamed: padding: smallThumbnailForPageSorter thumbnailForPageSorter unhideHiddenObjects) ('model' createCustomModel model setModel:) ('name' unusedMorphNameLike:) ('objects from disk' convertToCurrentVersion:refStream: fixUponLoad:seg: saveOnFile) ('options' autoLineLayout autoLineLayout: isPartsBin: replaceTallSubmorphsByThumbnails resizeToFit resizeToFitString setPartsBinStatusTo: toggleIsPartsBin toggleResizeToFit) ('parts bin' initializeToStandAlone isPartsBin residesInPartsBin) ('printing' printOn:) ('project' project releaseSqueakPages storeProjectsAsSegments) ('project state' canvas canvas: firstHand hands handsDo: handsReverseDo: isStepping: isStepping:selector: listOfSteppingMorphs stepListSize stepListSummary steppingMorphsNotInWorld viewBox viewBox:) ('stepping' cleanseStepList runLocalStepMethods runStepMethods startStepping: startStepping:at:selector:arguments:stepTime: step stepTime stopStepping: stopStepping:selector:) ('structure' primaryHand world) ('testing' isEasySelecting) ('undo' clearCommandHistory commandHistory onceAgainDismiss: reintroduceIntoWorld:) ('update cycle' startBackgroundProcess) ('user interface' modelWakeUp) ('naming' defaultNameStemForInstances) ('visual properties' canHaveFillStyles fillStyle: setAsBackground:) ('WiW support' addMorphInLayer: installAsActiveSubprojectIn:at:titled: installAsActiveSubprojectIn:titled: restartWorldCycleWithEvent: shouldGetStepsFrom: validateMouseEvent:) ('world menu' activateObjectsTool addUndoItemsTo: bringWindowsFullOnscreen buildWorldMenu: closeUnchangedWindows collapseAll collapseNonWindows commandKeySelectors connectRemoteUser connectRemoteUserWithName:picture:andIPAddress: delayedInvokeWorldMenu: deleteNonWindows disconnectAllRemoteUsers disconnectRemoteUser dispatchCommandKeyInWorld:event: drawingClass expandAll extractScreenRegion:andPutSketchInHand: findAChangeSorter: findAFileList: findAMessageNamesWindow: findAPreferencesPanel: findATranscript: findAWindowSatisfying:orMakeOneUsing: findDirtyBrowsers: findDirtyWindows: findWindow: getWorldMenu: grabDrawingFromScreen: grabFloodFromScreen: grabLassoFromScreen: grabRubberBandFromScreen: initializeDesktopCommandKeySelectors invokeWorldMenu: keyboardNavigationHandler keyboardNavigationHandler: keystrokeInWorld: putUpNewMorphMenu putUpWorldMenu: putUpWorldMenuFromEscapeKey reportLocalAddress respondToCommand:bySending:to: undoOrRedoCommand yellowButtonClickOnDesktopWithEvent:) ('world state' abandonAllHalos addHand: addMorph:centeredNear: addMorphsAndModel: allNonFlapRelatedSubmorphs allNonWindows assureNotPaintingElse: assuredCanvas beWorldForProject: checkCurrentHandForObjectToPaste checkCurrentHandForObjectToPaste2 chooseClickTarget colorAt:belowMorph: deEmphasizeViewMVC: deleteAllHalos displayWorld displayWorldAsTwoTone displayWorldNonIncrementally displayWorldSafely doOneCycle doOneCycleInBackground doOneSubCycle dragThroughOnDesktop: embeddedProjectDisplayMode endDrawing: exit flashRects:color: fullRepaintNeeded goBack haloMorphs initForProject: install installFlaps jumpToProject nextPage noDisplayDuring: optimumExtentFromAuthor paintBox paintBoxOrNil patchAt:without:andNothingAbove: pauseEventRecorder previousPage privateOuterDisplayWorld removeHand: repairEmbeddedWorlds repositionFlapsAfterScreenSizeChange restoreFlapsDisplay restoreMainDockingBarDisplay restoreMorphicDisplay saveAsWorld sketchEditorOrNil sleep someHalo specialNameInModelFor: startSteppingSubmorphsOf:) ('*Tools' defaultDesktopCommandKeyTriplets findAMonticelloBrowser) ('private' privateFullMoveBy: privateMoveBy:) ('thumbnail' icon) ('polymorph' modalLockTo: modalUnlockFrom:) ('recompilation' updateStatePostRecompile) ('submorphs - add/remove' addAllMorphs: addMorphFront:) ('submorphs - accessing' allMorphsDo: morphsInFrontOf:overlapping:do:) ('flaps' accommodateFlap: addGlobalFlaps assureFlapTabsFitOnScreen correspondingFlapTab deleteGlobalFlapArtifacts enableGlobalFlaps flapTabs localFlapTabs offsetForAccommodating:onEdge: removeAccommodationForFlap:) ('Nebraska' addRemoteClient: convertRemoteClientToBuffered: hasRemoteServer releaseRemoteServer remoteServer remoteServer: removeRemoteClient: transferRemoteServerFrom:) ('*60Deprecated-menu & halo' isOpenForDragNDropString) ('*services-base' focusedRequestor openWorldMenu requestor worldMenu) ('*60Deprecated-accessing' modalWindow: removeModalWindow) ('*MorphicExtras-flaps' deleteAllFlapArtifacts) ('*ST80-Support' standardSystemController) ('*Protocols' currentVocabulary) !
ParagraphEditor class removeSelector: #yellowButtonExpertMenu! ParagraphEditor class removeSelector: #yellowButtonNoviceMenu! PackageDependencyTest removeSelector: #testEtoys! ObjectlandMorph removeSelector: #createEtoysProject! ObjectExplorer removeSelector: #viewerForValue! NativeImageSegment removeSelector: #findRogueRootsAllMorphs:! NativeImageSegment removeSelector: #rootsIncludingPlayers! NativeImageSegment removeSelector: #savePlayerReferences:! MorphicModel removeSelector: #addModelYellowButtonMenuItemsTo:forMorph:hand:!
!MorphicModel reorganize! ('accessing' model modelOrNil slotName wantsSlot) ('caching' releaseCachedState) ('classification' isMorphicModel) ('compilation' addPartNameLike:withValue: compileAccessForSlot: compilePropagationMethods nameFor: propagate:as: removeAll slotSelectorFor: use:orMakeModelSelectorFor:in:) ('debug and other' installModelIn:) ('drag and drop' allowSubmorphExtraction isOpen) ('geometry' charactersOccluded newBounds: recomputeBounds) ('initialization' defaultBorderColor defaultBounds defaultColor duplicate:from: initialize model: model:slotName:) ('menu' addCustomMenuItems:hand: closeToEdits openToEdits) ('naming' choosePartName) ('printing' initString) ('submorphs - accessing' allKnownNames) ('submorphs - add/remove' delete) ('*MorphicExtras-compilation' compileInitMethods) !
MorphExtension removeSelector: #player! MorphExtension removeSelector: #player:! Object subclass: #MorphExtension instanceVariableNames: 'locked visible sticky balloonText balloonTextSelector externalName isPartsDonor actorState eventHandler otherProperties' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Kernel'!
!MorphExtension reorganize! ('accessing' actorState actorState: balloonText balloonTextSelector balloonTextSelector: balloonText: eventHandler eventHandler: externalName: locked locked: sticky sticky: visible visible:) ('accessing - layout properties' layoutFrame layoutFrame: layoutPolicy layoutPolicy: layoutProperties layoutProperties:) ('accessing - other properties' assureOtherProperties hasOtherProperties hasProperty: initializeOtherProperties otherProperties privateOtherProperties: removeOtherProperties removeProperty: setProperty:toValue: sortedPropertyNames valueOfProperty: valueOfProperty:ifAbsentPut: valueOfProperty:ifAbsent:) ('connectors-copying' copyWeakly propertyNamesNotCopied veryDeepFixupWith: veryDeepInner:) ('initialization' initialize) ('objects from disk' comeFullyUpOnReload:) ('other' isDefault) ('printing' printOn:) ('viewer' externalName) ('*MorphicExtras-copying' updateReferencesUsing:) ('*MorphicExtras-Undo' removeUndoCommands) ('parts bin' isPartsDonor isPartsDonor:) ('*60Deprecated-other' inspectElement) !
ImageMorph class removeSelector: #descriptionForPartsBin!
!ImageMorph class reorganize! ('accessing' defaultForm) ('class initialization' initialize registerInFlapsRegistry unload) ('instance creation' fromString: fromString:font:) ('scripting' authoringPrototype) !
Morph class removeSelector: #selectionBackground!
!Morph class reorganize! ('class initialization' initialize) ('fileIn/Out' fileReaderServicesForFile:suffix: fromFileName: serviceLoadMorphFromFile services) ('initialize-release' unload) ('instance creation' initializedInstance newBounds: newBounds:color: newSticky) ('misc' morphsUnknownToTheirOwners) ('new-morph participation' includeInNewMorphMenu newStandAlone partName:categories:documentation: partName:categories:documentation:sampleImageForm:) ('scripting' authoringPrototype) ('testing' allSketchMorphClasses allSketchMorphForms isSketchMorphClass) ('preferences' haloForAll haloForAll: indicateKeyboardFocus indicateKeyboardFocus: metaMenuForAll metaMenuForAll: preferredCornerRadius preferredCornerRadius: themeProperties useSoftDropShadow useSoftDropShadow:) ('*Tools-icons' toolIcon) ('defaults') ('layer names' backmostLayer balloonLayer defaultLayer dialogLayer frontmostLayer haloLayer menuLayer navigatorLayer progressLayer windowLayer) ('*MorphicExtras-arrow head size' defaultArrowheadSize obtainArrowheadFor:defaultValue:) ('*MorphicExtras-parts bin' supplementaryPartsDescriptions) ('*MorphicExtras-new-morph participation' addPartsDescriptorQuadsTo:if:) !
MenuMorph removeSelector: #allWordings! MenuMorph removeSelector: #allWordingsNotInSubMenus:! MenuMorph removeSelector: #undoGrabCommand!
!MenuMorph reorganize! ('accessing' addBlankIconsIfNecessary: commandKeyHandler commandKeyHandler: defaultTarget hasItems hasSubMenu: itemWithWording: items lastItem lastSelection matchString matchString: popUpOwner popUpOwner: rootMenu stayUp stayUp:) ('construction' add:action: add:help:action: add:icon:help:subMenu: add:icon:subMenu: add:selector:argument: add:subMenu: add:subMenu:target:selector:argumentList: add:target:action: add:target:selector: add:target:selector:argument: add:target:selector:argumentList: addAllFrom: addItem: addLine addList: addMenuItem: addService:for: addServices2:for:extraLines: addServices:for:extraLines: addStayUpIcons addStayUpItem addStayUpItemSpecial addTitle: addTitle:icon: addTitle:icon:updatingSelector:updateTarget: addTitle:updatingSelector:updateTarget: addTranslatedList: addUpdating:action: addUpdating:enablement:action: addUpdating:enablementSelector:target:selector:argumentList: addUpdating:target:action: addUpdating:target:selector:argumentList: addUpdatingItem: addWithLabel:enablement:action: addWithLabel:enablementSelector:target:selector:argumentList: balloonTextForLastItem: defaultTarget: labels:lines:selections: title:) ('control' activeSubmenu: deleteIfPopUp deleteIfPopUp: popUpAdjacentTo:forHand:from: popUpAt:forHand:in: popUpAt:forHand:in:allowKeyboard: popUpEvent:in: popUpForHand:in: popUpInWorld popUpInWorld: popUpNoKeyboard selectItem:event: updateColor wantsToBeDroppedInto:) ('copying' veryDeepFixupWith: veryDeepInner:) ('dropping/grabbing' justDroppedInto:event:) ('events' activate: deactivate: handlesMouseDown: handlesMouseOver: mouseDown: mouseLeave: mouseMove: mouseUp: processFocusEvent:using: wantsEveryMouseMove) ('initialization' delete initialize setDefaultParameters setTitleParameters setTitleParametersFor:) ('keyboard control' displayFiltered: handlesKeyboard: keyStroke: matchString:event: moveSelectionDown:event: removeMatchString removeMatchString: selectCurrentItem: selectMoreItem:) ('menu' addCustomMenuItems:hand: addItem addTitle detachSubMenu: doButtonAction removeStayUpBox removeStayUpItems setInvokingView: setTarget: target: toggleStayUp: toggleStayUpIgnore:evt: updateItemsWithTarget:orWithHand:) ('modal control' informUserAt:during: invokeAt:in:allowKeyboard: invokeModal invokeModal: invokeModalAt:in: invokeModalAt:in:allowKeyboard: isModalInvokationDone isModalInvokationDone: modalSelection modalSelection:) ('private' invokeMetaMenu: positionAt:relativeTo:inWorld: selectedItem) ('update' applyUserInterfaceTheme updateMenu) ('keystroke helpers' handleCRStroke: handleCommandKeyPress: handleDelStroke: handleDownStroke: handleEscStroke: handleFiltering: handleLeftStroke: handlePageDownStroke: handlePageUpStroke: handleRightStroke: handleUpStroke: hideKeyboardHelp keyStrokeHandlers noteRootMenuHasUsedKeyboard showKeyboardHelp stepIntoSubmenu:) ('rounding' wantsRoundedCorners) ('testing' indicateKeyboardFocus) ('*ToolBuilder-Morphic-opening' openAsTool) ('*MorphicExtras-accessing') ('*60Deprecated-keyboard control' filterListWith: unfilterOrEscape:) !
MenuItemMorph removeSelector: #adaptToWorld:! MenuItemMorph removeSelector: #allWordingsNotInSubMenus:!
!MenuItemMorph reorganize! ('accessing' action: addSubMenu: addUpdatingSubMenu: arguments arguments: colorToUse contentString contentString: contents: contents:withMarkers: contents:withMarkers:inverse: hasIcon hasIconOrMarker hasMarker hasSubMenu hasSubMenu: help: icon icon: isEnabled isEnabled: isStayUpItem itemWithWording: selector selector: subMenu subMenu: subMenuUpdater:selector: subMenuUpdater:selector:arguments: target target:) ('copying' veryDeepFixupWith: veryDeepInner:) ('drawing' drawBackgroundOn: drawIconOn: drawLabelOn: drawOn: drawSubMenuMarkerOn:) ('events' activateOwnerMenu: activateSubmenu: doButtonAction handleMouseUp: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: invokeWithEvent: mouseDown: mouseEnter: mouseEnterDragging: mouseUp:) ('grabbing' aboutToBeGrabbedBy: duplicateMorph:) ('initialization' defaultBounds deleteIfPopUp: initialize) ('layout' doLayoutIn: minHeight minWidth stringMargin) ('selecting' adjacentTo deselect: isSelected isSelected: select:) ('private' bottomArrow createSubmenu createUpdatingSubmenu deselectItem iconForm leftArrow offImage onImage rightArrow selectionFillStyle subMenuMarker upArrow updateLayoutInDockingBar) ('browse' browseImplementationOfActionSelector buildDebugMenu: debugAction effectiveActionSelector effectiveActionTarget) ('testing' isMenuItemMorph) ('updating' applyUserInterfaceTheme) !
!LassoPatchMorph reorganize! ('dropping' justDroppedInto:event: wantsToBeDroppedInto:) ('initialization' initialize initializeToStandAlone) !
!GrabPatchMorph reorganize! ('dropping' justDroppedInto:event: wantsToBeDroppedInto:) ('initialization' initialize initializeToStandAlone) !
!ImageMorph reorganize! ('accessing' borderStyle: borderWidth: color: form image image: isOpaque isOpaque: preferredExtent setNewImageFrom: wantsRecolorHandle withSnapshotBorder) ('caching' releaseCachedState) ('drawing' drawOn:) ('geometry' extent:) ('initialization' initialize) ('menu' changeOpacity opacityString) ('menu commands' grabFromScreen readFromFile) ('menus' addCustomMenuItems:hand:) ('other' newForm:) ('parts bin' initializeToStandAlone) ('testing' isImageMorph) ('*MorphicExtras-Postscript Canvases' drawPostscriptOn:) !
HandMorph removeSelector: #removePendingHaloFor:! HandMorph removeSelector: #spawnMagicHaloFor:! HandMorph removeSelector: #triggerHaloFor:after:!
!HandMorph reorganize! ('accessing' anyButtonPressed colorForInsets lastEvent mouseOverHandler noButtonPressed targetOffset targetPoint userInitials userPicture userPicture:) ('balloon help' addBalloonHelp: balloonHelpList deleteBalloonTarget: removePendingBalloonFor: resetBalloonHelp: spawnBalloonFor: triggerBalloonFor:after:) ('caching' releaseCachedState) ('change reporting' invalidRect:from:) ('classification' isHandMorph) ('copying' veryDeepCopyWith:) ('cursor' cursorBounds showTemporaryCursor: showTemporaryCursor:hotSpotOffset: temporaryCursor) ('double click support' resetClickState waitForClicksOrDrag:event: waitForClicksOrDrag:event:selectors:threshold:) ('drawing' drawOn: fullDrawOn: hasChanged hasUserInformation needsToBeDrawn nonCachingFullDrawOn: restoreSavedPatchOn: savePatchFrom: shadowForm showHardwareCursor: updateCacheCanvas: visible:) ('drop shadows' shadowOffset) ('event handling' cursorPoint flushEvents noticeMouseOver:event: processEvents) ('events-processing' handleEvent: isCapturingGesturePoints sendFilterEventCaptureAgain:for:) ('focus handling' keyboardFocus keyboardFocus: mouseFocus mouseFocus: newKeyboardFocus: newMouseFocus: newMouseFocus:event: releaseAllFoci releaseKeyboardFocus releaseKeyboardFocus: releaseMouseFocus releaseMouseFocus:) ('genie-stubs' autoFocusRectangleBoundsFor: disableGenieFocus enableGenie focusStartEvent genieGestureProcessor isGenieAvailable isGenieEnabled isGenieFocused) ('geometry' position position: userInitials:andPicture:) ('grabbing/dropping' attachMorph: dropMorphs dropMorphs: dropMorph:event: grabMorph:from: targetOffset:) ('halo handling' halo: obtainHalo: releaseHalo: removeHalo removeHaloFromClick:on:) ('halos and balloon help' halo) ('initialization' becomeActiveDuring: initForEvents initialize interrupted resourceJustLoaded) ('layout' fullBounds) ('meta-actions' copyToPasteBuffer: grabMorph:) ('multilingual' clearKeyboardInterpreter keyboardInterpreter) ('objects from disk' objectForDataStream:) ('paste buffer' objectToPaste pasteBuffer pasteBuffer: pasteMorph) ('updating' applyUserInterfaceTheme changed) ('private events' generateDropFilesEvent: generateKeyboardEvent: generateMouseEvent: generateMouseWheelEvent: generateMouseWheelEvent:direction: generateWindowEvent: mouseDragTrailFrom: mouseTrailFrom: moveToEvent: sendEvent:focus: sendEvent:focus:clear: sendFocusEvent:to:clear: sendKeyboardEvent: sendListenEvent:to: sendListenEvents: sendMouseEvent:) ('selected object' selectedObject) ('*MorphicExtras-event handling' pauseEventRecorderIn:) ('gridded cursor' gridPointRaw gridTo:origin: griddedPoint: griddingOn turnOffGridding turnOnGridding) ('events-listening' addEventListener: addKeyboardListener: addListener:to: addMouseListener: eventListeners eventListeners: keyboardListeners keyboardListeners: mouseListeners mouseListeners: removeEventListener: removeKeyboardListener: removeListener:from: removeMouseListener:) ('events-filtering-bubbling' eventBubbleFilters keyboardBubbleFilters mouseBubbleFilters) ('events-filtering-capturing' eventCaptureFilters eventCaptureFilters: keyboardCaptureFilters keyboardCaptureFilters: mouseCaptureFilters mouseCaptureFilters:) ('events-debugging' logEvent: showEvent:) ('events-filtering' filterEvent:for: ignoreEvent:) ('Multilingual-ImmPlugin' compositionWindowManager) ('initialize-release' cleanUp:) !
!GraphMorph reorganize! ('accessing' color: cursor cursor: cursorAtEnd cursorColor cursorColor: cursorColorAtZeroCrossing cursorColorAtZeroCrossings: cursorWrapped: data data: dataColor dataColor: interpolatedValueAtCursor lastValue lastValue: startIndex startIndex: valueAtCursor valueAtCursor:) ('commands' appendValue: centerCursor clear loadSineWave loadSound: loadSoundData: playOnce reverse) ('drawing' drawOn:) ('event handling' handlesMouseDown: mouseMove:) ('initialization' defaultColor initialize) ('layout' layoutChanged) ('objects from disk' convertToCurrentVersion:refStream:) ('stepping' step) ('private' asNumber: drawCursorOn: drawDataOn: flushCachedForm keepIndexInView:) ('sound' addCustomMenuItems:hand: openWaveEditor readDataFromFile) !
DockingBarMorph removeSelector: #isSticky! DockingBarMorph removeSelector: #resistsRemoval! BookMorph removeSelector: #goToPage:transitionSpec:runTransitionScripts:! BookMorph removeSelector: #goToPageMorph:runTransitionScripts:! BookMorph removeSelector: #goToPageMorph:transitionSpec:runTransitionScripts:! BookMorph removeSelector: #goto:! BookMorph removeSelector: #keepTogether! BooklikeMorph removeSelector: #currentPlayerDo:!
!BooklikeMorph reorganize! ('menu commands' clearNewPagePrototype firstPage insertPage sortPages) ('menus' addCustomMenuItems:hand:) ('misc' addBookMenuItemsTo:hand: move pageSize pageSize: playPageFlipSound: showingFullScreenString showingPageControlsString) ('page controls' addPageControlMorph: fewerPageControls fullControlSpecs hidePageControls indexForPageControls makeDescriptionViewer makePageControlsFrom: makePageNumberItem setEventHandlerForPageControls: shortControlSpecs showPageControls showPageControls:) !
!BookPageSorterMorph reorganize! ('copying' veryDeepFixupWith: veryDeepInner:) ('dropping/grabbing' wantsToBeDroppedInto:) ('initialization' addControls book:morphsToSort: defaultBorderWidth defaultColor initialize) ('buttons' acceptSort getPartsBinStatus togglePartsBinStatus) ('private' changeExtent: closeButtonOnly columnWith: rowWith: wrapperFor:) ('accessing' pageHolder) !
!AlignmentMorph reorganize! ('classification' isAlignmentMorph) ('event handling' wantsKeyboardFocusFor:) ('geometry' addTransparentSpacerOfSize:) ('initialization' defaultBorderWidth defaultColor initialize openInWindowLabeled:inWorld:) ('object fileIn' convertOldAlignmentsNov2000:using:) ('objects from disk' convertToCurrentVersion:refStream:) ('visual properties' canHaveFillStyles) ('*MorphicExtras-initialization' basicInitialize) !
!BorderedMorph reorganize! ('accessing' borderColor: borderStyle: borderWidth: hasTranslucentColor useRoundedCorners useSquareCorners) ('drawing' areasRemainingToFill:) ('geometry' acquireBorderWidth: closestPointTo: intersectionWithLineSegmentFromCenterTo:) ('initialization' borderInitialize borderInset borderRaised borderSimple defaultBorderColor defaultBorderStyle defaultBorderWidth initialize) ('menu' addBorderStyleMenuItems:hand: changeBorderColor: changeBorderWidth:) ('resize handling' addCellGapToLayoutFrames addCornerGrips addEdgeGrips addGrips addMorph:fullFrame: addPaneHSplitterAtBottomOfRow: addPaneHSplitters addPaneSplitters addPaneVSplitterAtRightOfColumn: addPaneVSplitters changeCellGapOfLayoutFrames: cornerGrips doFastWindowReframe: edgeGrips fastFramingOn grips linkSubmorphsToSplitters paneMorphs removeCellGapFromLayoutFrames removeCornerGrips removeEdgeGrips removeGrips removePaneSplitters splitters wantsGrips wantsGrips: wantsPaneSplitters wantsPaneSplitters:) ('printing' fullPrintOn:) ('layout properties' cellGap:) ('display scale' displayScaleChangedBy: handlesDisplayScaleChangedBy:) ('*MorphicExtras-initialization' basicInitialize) ('*60Deprecated-private' setBorderWidth:borderColor: setColor:borderWidth:borderColor:) ('*60Deprecated-accessing' doesBevels) !
Morph removeSelector: #adaptToWorld:! Morph removeSelector: #addMagicHaloFor:! Morph removeSelector: #addMorphNearBack:! Morph removeSelector: #addPaintingItemsTo:hand:! Morph removeSelector: #allMenuWordings! Morph removeSelector: #allMorphsAndBookPagesInto:! Morph removeSelector: #allMorphsWithPlayersDo:! Morph removeSelector: #applyStatusToAllSiblings:! Morph removeSelector: #asNumber:! Morph removeSelector: #automaticViewing! Morph removeSelector: #bringAllSiblingsToMe:! Morph removeSelector: #chooseNewGraphic! Morph removeSelector: #chooseNewGraphicCoexisting:! Morph removeSelector: #chooseNewGraphicFromHalo! Morph removeSelector: #couldMakeSibling! Morph removeSelector: #currentPlayerDo:! Morph removeSelector: #cursor! Morph removeSelector: #cursor:! Morph removeSelector: #decimalPlacesForGetter:! Morph removeSelector: #defaultValueOrNil! Morph removeSelector: #demandsBoolean! Morph removeSelector: #demandsThumbnailing! Morph removeSelector: #doMenuItem:! Morph removeSelector: #embedInWindow! Morph removeSelector: #embeddedInMorphicWindowLabeled:! Morph removeSelector: #getNumericValue! Morph removeSelector: #gridFormOrigin:grid:background:line:! Morph removeSelector: #handUserASibling! Morph removeSelector: #indicateAllSiblings! Morph removeSelector: #inspectArgumentsPlayerInMorphic:! Morph removeSelector: #isAViewer! Morph removeSelector: #isCompoundTileMorph! Morph removeSelector: #isKedamaMorph! Morph removeSelector: #isLikelyRecipientForMouseOverHalos! Morph removeSelector: #isModalShell! Morph removeSelector: #isNumericReadoutTile! Morph removeSelector: #isPhraseTileMorph! Morph removeSelector: #isPlayfieldLike! Morph removeSelector: #isSoundTile! Morph removeSelector: #isStandardViewer! Morph removeSelector: #isStickySketchMorph! Morph removeSelector: #isSyntaxMorph! Morph removeSelector: #isTileEditor! Morph removeSelector: #isTileMorph! Morph removeSelector: #isTilePadMorph! Morph removeSelector: #isViewer! Morph removeSelector: #makeGraphPaper! Morph removeSelector: #makeGraphPaperGrid:background:line:! Morph removeSelector: #makeMultipleSiblings:! Morph removeSelector: #makeNascentScript! Morph removeSelector: #makeNewPlayerInstance:! Morph removeSelector: #makeSiblings:! Morph removeSelector: #makeSiblingsLookLikeMe:! Morph removeSelector: #menuItemAfter:! Morph removeSelector: #menuItemBefore:! Morph removeSelector: #methodCommentAsBalloonHelp! Morph removeSelector: #mustBeBackmost! Morph removeSelector: #noteDecimalPlaces:forGetter:! Morph removeSelector: #objectViewed! Morph removeSelector: #offerCostumeViewerMenu:! Morph removeSelector: #openAPropertySheet! Morph removeSelector: #openViewerForArgument! Morph removeSelector: #overlapsShadowForm:bounds:! Morph removeSelector: #pasteUpMorphHandlingTabAmongFields! Morph removeSelector: #player! Morph removeSelector: #player:! Morph removeSelector: #playerRepresented! Morph removeSelector: #preferredDuplicationHandleSelector! Morph removeSelector: #presenter! Morph removeSelector: #readoutForField:! Morph removeSelector: #referencePlayfield! Morph removeSelector: #renameInternal:! Morph removeSelector: #rotationStyle! Morph removeSelector: #rotationStyle:! Morph removeSelector: #roundUpStrays! Morph removeSelector: #saveDocPane! Morph removeSelector: #screenLocation! Morph removeSelector: #screenRectangle! Morph removeSelector: #setAsActionInButtonProperties:! Morph removeSelector: #setNumericValue:! Morph removeSelector: #setStandardTexture! Morph removeSelector: #shouldRememberCostumes! Morph removeSelector: #shuffleSubmorphs! Morph removeSelector: #standardPalette! Morph removeSelector: #tabAmongFields! Morph removeSelector: #textureParameters! Morph removeSelector: #unlockOneSubpart! Morph removeSelector: #updateAllScriptingElements! Morph removeSelector: #usableSiblingInstance! Morph removeSelector: #viewMorphDirectly! Morph removeSelector: #wantsHalo! Morph removeSelector: #wantsHaloFor:! Morph removeSelector: #wantsScriptorHaloHandle! Morph removeSelector: #wouldAcceptKeyboardFocusUponTab! Morph removeSelector: #wrappedInWindow:! Morph removeSelector: #wrappedInWindowWithTitle:!
!Morph reorganize! ('accessing' actorState: actorStateOrNil adoptPaneColor: balloonText balloonText: balloonTextSelector balloonTextSelector: beFlap: beSticky beTransparent beUnsticky borderColor borderColor: borderStyle borderStyle: borderStyleForSymbol: borderWidth borderWidth: borderWidthForRounding clearArea color color: colorForInsets couldHaveRoundedCorners defaultNameStemForInstances eventHandler eventHandler: hasTranslucentColor highlight highlightColor highlightColor: insetColor isFlap isLocked isShared isSticky lock lock: modelOrNil raisedColor regularColor regularColor: rememberedColor rememberedColor: resistsRemoval resistsRemoval: scaleFactor setBorderStyle: sqkPage sticky: toggleLocked toggleResistsRemoval toggleStickiness unHighlight unlock unlockContents url userString viewBox visibleClearArea wantsToBeCachedByHand) ('accessing - extension' assureExtension extension hasExtension initializeExtension privateExtension: resetExtension) ('accessing - properties' hasProperty: otherProperties removeProperty: setProperties: setProperty:toValue: valueOfProperty: valueOfProperty:ifAbsent: valueOfProperty:ifAbsentPut: valueOfProperty:ifPresentDo:) ('caching' fullLoadCachedState fullReleaseCachedState loadCachedState releaseCachedState) ('change reporting' addedMorph: colorChangedForSubmorph: invalidRect: invalidRect:from: privateInvalidateMorph: userSelectedColor:) ('classification' isAlignmentMorph isBalloonHelp isButton isFlapOrTab isFlapTab isFlexMorph isHandMorph isRenderer isTextMorph isWorldMorph isWorldOrHandMorph) ('connectors-scripting' wantsConnectorVocabulary) ('converting' asSnapshotThumbnail) ('copying' copy deepCopy duplicate duplicateMorphCollection: okayToDuplicate updateReferencesUsing: veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:) ('creation' asMorph) ('debug and other' addDebuggingItemsTo:hand: addMouseActionIndicatorsWidth:color: addMouseUpAction addMouseUpActionWith: addViewingItemsTo: allStringsAfter: allStringsAfter:do: altSpecialCursor0 altSpecialCursor1 altSpecialCursor2 altSpecialCursor3 altSpecialCursor3: buildDebugMenu: defineTempCommand deleteAnyMouseActionIndicators hasStrings inspectOwnerChain installModelIn: mouseUpCodeOrNil ownerChain programmedMouseDown:for: programmedMouseEnter:for: programmedMouseLeave:for: programmedMouseUp:for: removeMouseUpAction resumeAfterDrawError resumeAfterLayoutError resumeAfterStepError tempCommand) ('dispatching' disableSubmorphFocusForHand:) ('drawing' areasRemainingToFill: boundingBoxOfSubmorphs boundsWithinCorners changeClipSubmorphs clipLayoutCells clipLayoutCells: clipSubmorphs clipSubmorphs: clippingBounds doesOwnRotation drawDropHighlightOn: drawDropShadowOn: drawErrorOn: drawKeyboardFocusIndicationOn: drawMouseDownHighlightOn: drawOn: drawOverlayOn: drawRolloverBorderOn: drawSubmorphsOn: expandFullBoundsForDropShadow: expandFullBoundsForRolloverBorder: flashBounds fullDrawOn: hasClipSubmorphsString hide highlightedForMouseDown highlightedForMouseDown: imageForm imageForm:backgroundColor:forRectangle: imageForm:forRectangle: imageFormDepth: imageFormForRectangle: imageFormWithout:andStopThere: keyboardFocusColor keyboardFocusWidth refreshWorld shadowForm show updateDropShadowCache visible visible:) ('drop shadows' addDropShadow addDropShadowMenuItems:hand: changeShadowColor hasDropShadow hasDropShadow: hasDropShadowString hasRolloverBorder hasRolloverBorder: removeDropShadow setShadowOffset: shadowColor shadowColor: shadowOffset shadowOffset: shadowPoint: toggleDropShadow useSoftDropShadow useSoftDropShadow:) ('dropping/grabbing' aboutToBeGrabbedBy: acceptDroppingMorph:event: disableDragNDrop dragEnabled dragEnabled: dragNDropEnabled dragSelectionColor dropEnabled dropEnabled: dropHighlightColor dropSuccessColor enableDrag: enableDragNDrop enableDragNDrop: enableDrop: formerOwner formerOwner: formerPosition formerPosition: grabTransform handledOwnDraggingBy:on: highlightForDrop highlightForDrop: highlightedForDrop justDroppedInto:event: justGrabbedFrom: morphToDropInPasteUp: nameForUndoWording rejectDropMorphEvent: repelsMorph:event: resetHighlightForDrop separateDragAndDrop slideBackToFormerSituation: slideToTrash: startDrag:with: transportedMorph undoGrabCommand vanishAfterSlidingTo:event: wantsDroppedMorph:event: wantsToBeDroppedInto: wantsToBeOpenedInWorld willingToBeDiscarded) ('event handling' click click: cursorPoint doubleClick: doubleClickTimeout: firstClickTimedOut: handlerForMouseDown: handlerForYellowButtonDown: handlesKeyboard: handlesKeyboardOnlyOnFocus handlesKeyboardOnlyOnFocus: handlesMouseDown: handlesMouseMove: handlesMouseOver: handlesMouseOverDragging: handlesMouseStillDown: handlesMouseWheel: hasFocus hasKeyboardFocus hasKeyboardFocus: hasMouseFocus hasMouseFocus: keyDown: keyStroke: keyUp: keyboardFocusChange: keyboardFocusDelegate mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: mouseMove: mouseStillDown: mouseStillDownThreshold mouseUp: mouseWheel: moveOrResizeFromKeystroke: on:send:to: on:send:to:withValue: removeLink: restoreSuspendedEventHandler startDrag: suspendEventHandler transformFrom: transformFromOutermostWorld transformFromWorld wantsEveryMouseMove wantsKeyboardFocus wantsKeyboardFocusFor: wantsWindowEvents: windowEvent: wouldAcceptKeyboardFocus yellowButtonActivity:) ('events-accessing' actionMap updateableActionMap) ('events-alarms' addAlarm:after: addAlarm:at: addAlarm:with:after: addAlarm:with:at: addAlarm:with:with:after: addAlarm:with:with:at: addAlarm:withArguments:after: addAlarm:withArguments:at: alarmScheduler removeAlarm: removeAlarm:at:) ('events-processing' containsPoint:event: defaultEventDispatcher handleDropMorph: handleEvent: handleFocusEvent: handleKeyDown: handleKeyUp: handleKeystroke: handleListenEvent: handleMouseDown: handleMouseEnter: handleMouseLeave: handleMouseMove: handleMouseOver: handleMouseStillDown: handleMouseUp: handleMouseWheel: handleUnknownEvent: handleWindowEvent: mouseDownPriority mouseDownPriority: processEvent: processEvent:using: processFocusEvent: processFocusEvent:using: rejectDropEvent: rejectsEvent: sendFilterEvent:for:to: sendFilterEventBubble:for: sendFilterEventBubbleAgain:for: sendFilterEventCapture:for: sendFilterEventCaptureAgain:for: transformedFrom:) ('events-removing' releaseActionMap) ('fileIn/out' attachToResource prepareToBeSaved reserveUrl: saveAsResource saveOnFile saveOnURL saveOnURL: saveOnURLbasic updateAllFromResources updateFromResource) ('filter streaming' drawOnCanvas:) ('geometry' bottom bottom: bottomCenter bottomLeft bottomLeft: bottomRight bottomRight: bounds bounds: center center: extent extent: height height: left left: leftCenter pointAtFraction: position position: right right: rightCenter top top: topCenter topLeft topLeft: topRight topRight: width width:) ('geometry testing' containsPoint: fullContainsPoint: obtrudesBeyondContainer) ('halos and balloon help' addHalo addHalo: addHandlesTo:box: addOptionalHandlesTo:box: addSimpleHandlesTo:box: addWorldHandlesTo:box: balloonColor balloonColor: balloonFont balloonFont: balloonHelpAligner balloonHelpDelayTime balloonHelpTextForHandle: balloonMorphClass boundsForBalloon comeToFrontAndAddHalo createHalo defaultBalloonColor defaultBalloonFont defaultHaloDispatcher defersHaloOnClickTo: deleteBalloon editBalloonHelpContent: editBalloonHelpText halo haloClass haloDelayTime hasHalo hasHalo: mouseDownOnHelpHandle: noHelpString okayToAddDismissHandle okayToAddGrabHandle okayToBrownDragEasily okayToExtractEasily okayToResizeEasily okayToRotateEasily removeHalo setBalloonText: setBalloonText:maxLineLength: setCenteredBalloonText: showBalloon showBalloon: showBalloon:at: showBalloon:hand: transferHalo: transferHalo:using: wantsBalloon wantsDirectionHandles wantsDirectionHandles: wantsHaloFromClick wantsHaloFromClick: wantsHaloHandleWithSelector:inHalo: wantsRecolorHandle wantsSimpleSketchMorphHandles) ('initialization' basicInitialize defaultBounds defaultColor inAScrollPane initialize openCenteredInWorld openInHand openInWindow openInWindowLabeled: openInWindowLabeled:inWorld: openInWorld openInWorld: openNear: openNear:in: openNearMorph: resourceJustLoaded) ('layout' adjustLayoutBounds checkCellSpacingProperty: checkListSpacingProperty: checkResizingProperty: doLayout doLayoutIn: doLayoutSafely fullBounds layoutChanged layoutComputed layoutInBounds: layoutInBounds:positioning: layoutProportionallyIn: layoutProportionallyInBounds:positioning: minExtent minExtent: minHeight minHeight: minWidth minWidth: ownerChanged ownerChangedHandler ownerChangedHandler: privateFullBounds privateFullBoundsForRedraw setExtentFromLayout: setLayoutBoundsFromLayout: setPositionFromLayout: submorphBounds submorphBoundsForShrinkWrap) ('layout-menu' addCellLayoutMenuItems:hand: addLayoutMenuItems:hand: addTableLayoutMenuItems:hand: cellPositioningString: cellSpacingString: changeCellGap: changeCellInset: changeClipLayoutCells changeDisableTableLayout changeHeightForWidth changeLayoutInset: changeListDirection: changeMaxCellSize: changeMinCellSize: changeNoLayout changeProportionalLayout changeReverseCells changeRubberBandCells changeTableLayout changeWidthForHeight changesHeightForWidth changesWidthForHeight hResizingString: hasClipLayoutCellsString hasDisableTableLayoutString hasNoLayoutString hasProportionalLayoutString hasReverseCellsString hasRubberBandCellsString hasTableLayoutString layoutMenuPropertyString:from: listCenteringString: listDirectionString: listSpacingString: vResizingString: wrapCenteringString: wrapDirectionString:) ('macpal' flash) ('menu' addBorderStyleMenuItems:hand: addGestureMenuItems:hand: addGraphModelYellowButtonItemsTo:event: addModelYellowButtonItemsTo:event: addMyYellowButtonMenuItemsToSubmorphMenus addNestedYellowButtonItemsTo:event: addTitleForHaloMenu: addYellowButtonMenuItemsTo:event: buildYellowButtonMenu: hasYellowButtonMenu outermostOwnerWithYellowButtonMenu startWiring wantsMetaMenu wantsMetaMenu: wantsYellowButtonMenu wantsYellowButtonMenu:) ('menus' absorbStateFromRenderer: addAddHandMenuItemsForHalo:hand: addCopyItemsTo: addCustomHaloMenuItems:hand: addCustomMenuItems:hand: addExportMenuItems:hand: addFillStyleMenuItems:hand: addHaloActionsTo: addMiscExtrasTo: addStandardHaloMenuItemsTo:hand: addToggleItemsToHaloMenu: addWorldTargetSightingItems:hand: adhereToEdge adhereToEdge: adjustedCenter adjustedCenter: changeColor changeDirectionHandles changeDrag changeDragAndDrop changeDrop collapse defaultArrowheadSize exploreInMorphic exploreInMorphic: exportAsBMP exportAsBMPNamed: exportAsGIF exportAsGIFNamed: exportAsJPEG exportAsJPEGNamed: exportAsPNG exportAsPNGNamed: hasDirectionHandlesString hasDragAndDropEnabledString hasDragEnabledString hasDropEnabledString helpButton inspectInMorphic inspectInMorphic: lockUnlockMorph lockedString maybeAddCollapseItemTo: model presentHelp reasonableBitmapFillForms reasonableForms resetForwardDirection resistsRemovalString setArrowheads setRotationCenter setRotationCenterFrom: setToAdhereToEdge: snapToEdgeIfAppropriate stickinessString transferStateToRenderer: uncollapseSketch) ('meta-actions' addEmbeddingMenuItemsTo:hand: beThisWorldsModel buildHandleMenu: buildMetaMenu: changeColorTarget:selector:originalColor:hand: copyToPasteBuffer: dismissMorph dismissMorph: duplicateMorph: duplicateMorphImage: embedInto: grabMorph: inspectAt:event: invokeMetaMenu: invokeMetaMenuAt:event: maybeDuplicateMorph maybeDuplicateMorph: openATextPropertySheet potentialEmbeddingTargets potentialTargets potentialTargetsAt: resizeFromMenu resizeMorph: saveAsPrototype showActions showHiders sightTargets: sightWorldTargets: subclassMorph targetFromMenu: targetWith:) ('miscellaneous' setExtentFromHalo: setFlexExtentFromHalo:) ('naming' assureExternalName downshiftedNameOfObjectRepresented externalName innocuousName knownName name: nameForFindWindowFeature nameInModel nameOfObjectRepresented renameTo: setNamePropertyTo: setNameTo: specialNameInModel tryToRenameTo:) ('objects from disk' objectForDataStream: storeDataOn:) ('other events' menuButtonMouseEnter: menuButtonMouseLeave:) ('parts bin' inPartsBin initializeToStandAlone isPartsBin isPartsDonor isPartsDonor: markAsPartsDonor partRepresented residesInPartsBin) ('printing' clipText colorString: constructorString fullPrintOn: initString morphReport morphReportFor: morphReportFor:on:indent: pagesHandledAutomatically printConstructorOn:indent: printConstructorOn:indent:nodeDict: printOn: printSpecs printSpecs: printStructureOn:indent: reportableSize structureString textToPaste) ('rotate scale and flex' addFlexShell addFlexShellIfNecessary assureFlexShell forwardDirection forwardDirection: heading heading: keepsTransform newTransformationMorph referencePosition referencePosition: referencePositionInWorld referencePositionInWorld: removeFlexShell rotationCenter rotationCenter: rotationDegrees rotationDegrees: setDirectionFrom:) ('rounding' cornerRadius cornerRadius: cornerStyle cornerStyle: roundedCorners roundedCornersString toggleCornerRounding wantsRoundedCorners) ('stepping' arrangeToStartStepping arrangeToStartSteppingIn: isStepping isSteppingSelector: start startStepping startStepping:at:arguments:stepTime: startSteppingIn: startSteppingSelector: step stepAt: stepTime stop stopStepping stopSteppingSelector: stopSteppingSelfAndSubmorphs wantsSteps) ('structure' activeHand allOwners allOwnersDo: containingWindow firstOwnerSuchThat: hasOwner: isInDockingBar isInSystemWindow isInWorld morphPreceding: nearestOwnerThat: orOwnerSuchThat: outermostMorphThat: outermostWorldMorph owner ownerThatIsA: ownerThatIsA:orA: pasteUpMorph primaryHand renderedMorph root rootAt: topPasteUp topRendererOrSelf withAllOwners withAllOwnersDo: world) ('testing' canDrawAtHigherResolution canDrawBorder: completeModificationHash indicateKeyboardFocus isDockingBar isFlexed isFullOnScreen isImageMorph isLineMorph isMenuItemMorph isMorph isSafeToServe isSelectionMorph isSketchMorph isTransferMorph modificationHash shouldDropOnMouseUp) ('text-anchor' addTextAnchorMenuItems:hand: asTextAnchor textAnchorProperties) ('thumbnail' icon iconOrThumbnail iconOrThumbnailOfSize: morphRepresented permitsThumbnailing representativeNoTallerThan:norWiderThan:thumbnailHeight: thumbnail updateThumbnailUrl updateThumbnailUrlInBook:) ('undo' commandHistory undoMove:redo:owner:bounds:predecessor:) ('updating' applyUserInterfaceTheme changed) ('user interface' defaultLabelForInspector doCancel initialExtent playSoundNamed:) ('visual properties' canApplyUserInterfaceTheme canHaveFillStyles defaultBitmapFillForm fillStyle fillStyle: fillWithRamp:oriented: useBitmapFill useDefaultFill useGradientFill useSolidFill) ('WiW support' eToyRejectDropMorph:event: randomBoundsFor: shouldGetStepsFrom:) ('private' canBeEncroached privateAddAllMorphs:atIndex: privateAddMorph:atIndex: privateBounds: privateColor: privateDeleteWithAbsolutelyNoSideEffects privateFullBounds: privateFullMoveBy: privateMoveBy: privateOwner: privateRemove: privateRemoveMorphWithAbsolutelyNoSideEffects: privateSubmorphs privateSubmorphs:) ('accessing-backstop' target:) ('geniestubs' allowsGestureStart: isGestureStart: mouseStillDownStepRate redButtonGestureDictionaryOrName: yellowButtonGestureDictionaryOrName:) ('*morphic-Postscript Canvases' asPostscript clipPostscript drawPostscriptOn: fullDrawPostscriptOn: printPSToFile) ('button' doButtonAction) ('model access' models) ('other' removeAllButFirstSubmorph) ('selected object' selectedObject) ('polymorph' modalLockTo: modalUnlockFrom: openModal:) ('*Morphic-Sound-piano rolls' addMorphsTo:pianoRoll:eventTime:betweenTime:and: encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: justDroppedIntoPianoRoll:event: pauseFrom: resetFrom: resumeFrom: triggerActionFromPianoRoll) ('events-filtering-bubbling' addEventBubbleFilter: addKeyboardBubbleFilter: addMouseBubbleFilter: eventBubbleFilters eventBubbleFilters: keyboardBubbleFilters keyboardBubbleFilters: mouseBubbleFilters mouseBubbleFilters: removeEventBubbleFilter: removeKeyboardBubbleFilter: removeMouseBubbleFilter:) ('events-filtering-capturing' addEventCaptureFilter: addKeyboardCaptureFilter: addMouseCaptureFilter: eventCaptureFilters eventCaptureFilters: keyboardCaptureFilters keyboardCaptureFilters: mouseCaptureFilters mouseCaptureFilters: removeEventCaptureFilter: removeKeyboardCaptureFilter: removeMouseCaptureFilter:) ('events-filtering' addFilter:to: eventFilterDocumentation removeFilter:from:) ('*ToolBuilder-Morphic-opening' buildWith: openAsTool) ('geometry - misc' align:with: positionSubmorphs setConstrainedPosition:hangOut: shiftSubmorphsOtherThan:by: transformedBy: worldBounds worldBoundsForHalo) ('geometry - local/global' bounds:from: bounds:in: boundsIn: boundsInWorld fullBoundsInWorld globalPointToLocal: intersects: localPointToGlobal: point:from: point:in: pointFromWorld: pointInWorld: positionInWorld) ('geometry - layout' innerBounds innerBounds: innerExtent innerExtent: innerPosition innerPosition: layoutBounds layoutBounds: layoutExtent layoutExtent: layoutPosition layoutPosition: minimumExtent minimumExtent: minimumHeight minimumHeight: minimumWidth minimumWidth: outerBounds outerBounds: outerExtent outerExtent: outerPosition outerPosition:) ('Multilingual-ImmPlugin' preferredKeyboardBounds preferredKeyboardPosition) ('*ToolBuilder-Morphic' inspectorClass) ('submorphs - add/remove' abandon addAllMorphs: addAllMorphs:after: addAllMorphs:behind: addAllMorphs:inFrontOf: addAllMorphsBack: addAllMorphsFront: addMorph: addMorph:after: addMorph:asElementNumber: addMorph:atIndex: addMorph:behind: addMorph:inFrontOf: addMorphBack: addMorphFront: comeToFront delete goBehind privateDelete removeAllMorphs removeAllMorphsIn: removeMorph:) ('submorphs - misc' actWhen actWhen: addMorph:fullFrame: addMorphCentered: addMorphFront:fromWorldPosition: addMorphFrontFromWorldPosition: allNonSubmorphMorphs copyWithoutSubmorph: deleteDockingBars deleteSubmorphsWithProperty: deleteUnlessHasFocus dismissViaHalo dockingBars findA: findDeepSubmorphThat:ifAbsent: findDeeplyA: findSubmorphBinary: hasSubmorphWithProperty: indexOfMorphAbove: mainDockingBars morphsAt:behind:unlocked: morphsInFrontOf:overlapping:do: morphsInFrontOverlapping: morphsInFrontOverlapping:do: replaceSubmorph:by: rootMorphsAt: rootMorphsAtGlobal: submorphAfter submorphBefore submorphOfClass: submorphWithProperty:) ('submorphs - layers' addAllMorphsBackInLayers: addAllMorphsFrontInLayers: addAllMorphsInLayers: addMorphBackInLayer: addMorphFrontInLayer: addMorphInLayer: morphicLayerNumber morphicLayerNumber: reorderSubmorphsInLayers wantsToBeTopmost) ('submorphs - accessing' allKnownNames allMorphs firstSubmorph lastSubmorph morphsAt: morphsAt:unlocked: morphsAt:unlocked:useFullBounds: submorphCount submorphIndexOf: submorphNamed: submorphNamed:ifNone: submorphThat:ifNone: submorphs submorphsSatisfying:) ('submorphs - enumerating' allMorphsBreadthFirstDo: allMorphsBreadthFirstDo:sorted: allMorphsDepthFirstDo: allMorphsDo: allSubmorphNamesDo: morphsAt:unlocked:do: morphsAt:unlocked:useFullBounds:do: submorphsBehind:do: submorphsDo: submorphsInFrontOf:do: submorphsReverseDo:) ('layout properties' assureGridLayoutProperties assureLayoutProperties assureTableLayoutProperties copyLayoutProperties disableLayout disableLayout: disableTableLayout disableTableLayout: hResizing hResizing: layoutInset layoutInset: layoutPolicy layoutPolicy: layoutProperties layoutProperties: vResizeToFit: vResizing vResizing:) ('layout properties - table' cellGap cellGap: cellInset cellInset: cellPositioning cellPositioning: cellSpacing cellSpacing: listCentering listCentering: listDirection listDirection: listSpacing listSpacing: maxCellSize maxCellSize: minCellSize minCellSize: reverseTableCells reverseTableCells: rubberBandCells rubberBandCells: spaceFillWeight spaceFillWeight: wrapCentering wrapCentering: wrapDirection wrapDirection:) ('layout properties - grid' gridModulus gridModulus: gridOrigin gridOrigin:) ('submorphs - testing' hasSubmorphs) ('submorphs - callbacks' intoWorld: noteNewOwner: outOfWorld: removedMorph:) ('layout properties - proportional' layoutFrame layoutFrame:) ('halo notification' aboutToBeDraggedViaHalo aboutToBeGrownViaHalo aboutToBeRotatedViaHalo aboutToBeScaledViaHalo changedViaHalo:) ('display scale' displayScaleChangedBy: handlesDisplayScaleChangedBy:) ('*60Deprecated-events-processing' handleDropFiles:) ('*MorphicExtras-menus' dismissButton printPSToFileNamed:) ('*60Deprecated-rotate scale and flex' degreesOfFlex) ('*60Deprecated-text-anchor' changeDocumentAnchor changeInlineAnchor changeParagraphAnchor hasDocumentAnchorString hasInlineAnchorString hasParagraphAnchorString relativeTextAnchorPosition relativeTextAnchorPosition: textAnchorType textAnchorType:) ('*MorphicExtras' nextOwnerPage previousOwnerPage) ('*60Deprecated-event handling' dropFiles: wantsDropFiles:) ('*60Deprecated-geometry' gridPoint: griddedPoint:) ('*services-base' requestor) ('*60Deprecated-accessing' doesBevels) ('*60Deprecated-meta-actions' blueButtonDown: blueButtonUp: handlerForBlueButtonDown: handlerForMetaMenu:) ('*60Deprecated-user-interface' becomeModal) ('*MorphicExtras-books' updateCachedThumbnail) ('*60Deprecated-initialization' inATwoWayScrollPane) ('*MorphicExtras-geometry' shiftSubmorphsBy:) ('*60Deprecated-dropping/grabbing' toggleDragNDrop) ('*60Deprecated-copying' fullCopy) ('*MorphicExtras-postscript' asEPS asPostscriptPrintJob exportAsEPS exportAsEPSNamed:) ('*60Deprecated-WiW support' addMorphInFrontOfLayer: morphicLayerNumberWithin:) ('*60Deprecated-MorphicExtras-accessing' highlightOnlySubmorph:) ('*61Deprecated-drawing' highlightForMouseDown highlightForMouseDown:) !
InstanceBrowser removeSelector: #viewViewee!
!Lexicon reorganize! ('basic operation' annotation displaySelector: messageListIndex:) ('category list' categoriesPane categoryDefiningSelector: categoryList categoryListIndex categoryListIndex: categoryListKey:from: categoryListMenu:shifted: categoryListMenuTitle categoryWithNameSpecifiedBy: chooseCategory: mainCategoryListMenu: newCategoryPane reformulateCategoryList selectCategoryAll selectWithinCurrentCategoryIfPossible: selectedCategoryName selectorsReferringToClassVar showCategoriesPane) ('contents' contents) ('control buttons' customButtonSpecs) ('history' navigateToNextMethod navigateToPreviousMethod navigateToRecentMethod removeFromSelectorsVisited removeFromSelectorsVisited: selectorsVisited updateSelectorsVisitedfrom:to:) ('initialization' customButtonsFrame: initListFrom:highlighting: listFrame:fromLeft:width:) ('limit class' chooseLimitClass initialLimitClass limitClass limitClass: limitClassString setLimitClass:) ('menu commands' offerMenu removeMessage showCategory showHomeCategory showMainCategory) ('message category functions' canShowMultipleMessageCategories) ('message list menu' messageListKey:from:) ('model glue' doItReceiver okayToAccept targetObject) ('new-window queries' browseVariableAssignments browseVariableReferences) ('search' hasSearchPane lastSearchString lastSearchString: lastSendersSearchSelector methodListFromSearchString: obtainNewSearchString selectorsMatching setMethodListFromSearchString showSearchPane toggleSearch) ('selection' categoryOfSelector: selectImplementedMessageAndEvaluate: selectSelectorItsNaturalCategory: selectWithinCurrentCategory: selectedClassOrMetaClass selectedMessage setToShowSelector:selectCategory:) ('senders' navigateToASender selectorsSendingSelectedSelector setSendersSearch) ('transition' maybeReselectClass:selector: noteAcceptanceOfCodeFor: preserveSelectorIfPossibleSurrounding: reformulateList reformulateListNoting: retainMethodSelectionWhileSwitchingToCategory:) ('vocabulary' chooseVocabulary switchToVocabulary: useVocabulary:) ('window title' addModelItemsToWindowMenu: adjustWindowTitle startingWindowTitle) ('within-tool queries' currentQueryParameter methodsWithInitials methodsWithInitials: queryCharacterization seeAlso seeAlso: selectorsChanged selectorsDefiningInstVar selectorsReferringToInstVar selectorsRetrieved setLocalClassVarRefs setLocalInstVarDefs setLocalInstVarRefs showMethodsInCurrentChangeSet showMethodsWithInitials showMethodsWithInitials: showQueryResultsCategory) ('toolbuilder' addSpecialButtonsTo:with: buildCategoryListWith: buildCustomButtonsWith: buildWith: openOnClass:inWorld:showingSelector: openOnClass:showingSelector: wantsAnnotationPane) ('morphic' representsSameBrowseeAs: targetClass) ('message list' formattedLabel:forSelector:inClass: messageHelpAt: messageIconAt:) ('user interface' defaultWindowColor) ('private' contents:notifying: contents:oldSelector:in:classified:notifying: targetForContents:) !
Object subclass: #MenuIcons instanceVariableNames: '' classVariableNames: 'Icons ScriptingIcons TranslatedIcons TranslationLocale' poolDictionaries: '' category: 'Morphic-Menus'! Inspector removeSelector: #addEtoysItemsTo:!
!Inspector reorganize! ('accessing' context context: customFields doItContext doItReceiver fields object object: selectionIndex selectionIndex:) ('private' allInstVarsTranslated) ('toolbuilder' buildCodePaneWith: buildExploreButtonWith: buildFieldListWith: buildValuePaneWith: buildWith: replaceInspectorWithExplorer) ('*Protocols-Tools' browseFullProtocol spawnFullProtocol spawnProtocol) ('*60Deprecated-selecting' selectedSlotName) ('user interface - styling' aboutToStyle:requestor: fieldListStyler typeValue: updateStyler: updateStyler:requestor:) ('menu - construction' addClassItemsTo: addCollectionItemsTo: addFieldItemsTo: addInstVarItemsTo: addObjectItemsTo:) ('fields - custom' addCustomField addCustomField: hasCustomFields newCustomField removeCustomField: requestCustomFieldOrCancel:) ('user interface' applyUserInterfaceTheme defaultIntegerBase fieldList getContents representsSameBrowseeAs: textColorForError valuePane) ('menu - commands' browseClass browseClassHierarchy browseVariableAssignments browseVariableReferences chaseSelectionPointers copyExpression copyName exploreSelection exploreSelectionPointers inspectOne inspectOneOf: inspectOneOfFrom:to: inspectSelection inspectSelectionBasic objectReferencesToSelection removeSelection) ('selection - convenience' classOfSelection selectedClass selectedInstVarName selectionIsReadOnly selectionOrObject typeOfSelection) ('accessing - contents' contents:notifying: contentsTyped contentsTyped: expression expression:) ('fields - error handling' contentsForErrorDoing: emphasizeError: streamError:on: streamErrorDoing:on:) ('fields - truncation' contentsForTruncationOf: streamOn:truncate:collectFields: streamOn:truncate:collectFields:ellipsisFrom: truncationLimit truncationTail) ('fields - drag and drop' dragFromFieldList: dragTypeInFieldListAt: dropOnFieldList:at:shouldCopy:) ('selection' ensureSelectedField hasSelection noteSelectionIndex:for: replaceSelectionValue: selectField: selectFieldNamed: selectFieldSuchThat: selectedField selectedFieldName selection) ('fields' expressionForField: fieldAllInstVars fieldSelf newFieldForType: newFieldForType:key:) ('initialization' fieldClass initialExtent initialize inspect: resetContents resetFields setContents: setContentsTyped: setExpression:) ('menu' fieldListMenu: fieldListMenu:shifted: inspectorKey:from: mainFieldListMenu: metaFieldListMenu:) ('user interface - window' labelString objectOkToClose okToClose okToDiscardCustomFields) ('updating - steps' modelWakeUpIn: stepAt:in: stepTimeIn: updateListsAndCodeIn: wantsStepsIn:) ('fields - streaming' streamBaseFieldsOn: streamCustomFieldsOn: streamFieldsOn: streamIndexedVariablesOn: streamInstanceVariablesOn: streamVariableFieldsOn:) ('updating' update update: update:with: updateContentsSafely updateFieldList updateFields) ('*60Deprecated-menu' classHierarchy) ('*60Deprecated-toolbuilder' exploreObject) ('copying' veryDeepInner:) ('private - collections' elementAt: elementGetterAt:) ('user edits' okToRevertChanges:) !
!ImageSegment reorganize! ('access' allObjectsDo: arrayOfRoots arrayOfRoots:) ('read/write segment' install loadSegmentFrom:outPointers: localName readFromFile) ('error checking' checkAndReportLoadError) ('fileIn' comeFullyUpOnReload: declare: declareAndPossiblyRename: dependentsCancel: dependentsRestore: fixCapitalizationOfSymbols processRoots rehashDictionaries: reshapeClasses:refStream: restoreEndianness:) ('fileIn/Out' acceptSingleMethodSource: endianness restoreEndianness scanFrom: scanFrom:environment:) ('testing' errorWrongState forFile:outPointers:) ('private' forgetDoItsInClass: segmentFormatFrom:) !
Form removeSelector: #graphicForViewerTab!
!Form reorganize! ('accessing' bits bitsSize bits: defaultCanvasClass depth depth: extent form getCanvas hasBeenModified hasBeenModified: nativeDepth offset offset: size) ('analyzing' cgForPixelValue:orNot: colorsUsed dominantColor innerPixelRectFor:orNot: pixelCompare:with:at: primCountBits rectangleEnclosingPixelsNotOfColor: tallyPixelValues tallyPixelValuesInRect:into: xTallyPixelValue:orNot: yTallyPixelValue:orNot:) ('bordering' borderFormOfWidth:sharpCorners: borderWidth: borderWidth:color: borderWidth:fillColor: border:width:rule:fillColor: shapeBorder:width: shapeBorder:width:interiorPoint:sharpCorners:internal:) ('color mapping' balancedPatternFor: bitPatternFor: colormapFromARGB colormapIfNeededForDepth: colormapIfNeededFor: colormapToARGB makeBWForm: mapColors:to: mapColor:to: maskingMap newColorMap pixelValueFor: pixelWordFor: reducedPaletteOfSize: rgbaBitMasks) ('converting' adjustBrightness: adjustSaturation: as8BitColorForm asCursorForm asFormOfDepth: asGrayScale asSourceForm asTextAnchor blendColor: collectColors: collectPixels: colorReduced copyWithColorsReducedTo: darker dimmed dyed: flipVertically lighter orderedDither32To16) ('copying' blankCopyOf:scaledBy: contentsOfArea: contentsOfArea:into: copyBits:at:translucent: copyBits:from:at:clippingBox:rule:fillColor: copyBits:from:at:clippingBox:rule:fillColor:map: copyBits:from:at:colorMap: copy: copy:from:in:rule: copy:from:to:rule: deepCopy postCopy veryDeepCopyWith:) ('display box access' boundingBox center computeBoundingBox height width) ('displaying' displayInterpolatedIn:on: displayInterpolatedOn: displayOnPort:at: displayOn:at:clippingBox:rule:fillColor: displayOn:transformation:clippingBox:align:with:rule:fillColor: displayResourceFormOn: displayScaledOn: drawLine:from:to:clippingBox:rule:fillColor: paintBits:at:translucent:) ('editing' bitEdit bitEditAt:scale: edit) ('fileIn/Out' comeFullyUpOnReload: hibernate objectForDataStream: printOn: readAttributesFrom: readBitsFrom: readFromOldFormat: readFrom: replaceByResource: storeBitsOn:base: storeOn: storeOn:base: unhibernate writeAttributesOn: writeBitsOn: writeBMPfileNamed: writeJPEGfileNamed: writeJPEGfileNamed:progressive: writeOnMovie: writeOn: writePNGfileNamed: writeUncompressedOn:) ('filling' anyShapeFill bitPatternForDepth: convexShapeFill: eraseShape: fillFromXColorBlock: fillFromXYColorBlock: fillFromYColorBlock: fill:rule:fillColor: findShapeAroundSeedBlock: floodFill2:at: floodFillMapFrom:to:mappingColorsWithin:to: floodFill:at: floodFill:at:tolerance: shapeFill:interiorPoint: shapeFill:seedBlock:) ('image manipulation' replaceColor:withColor: smear:distance: trimBordersOfColor:) ('initialize-release' allocateForm: finish flush fromDisplay: shutDown swapEndianness) ('other' fillAlpha: fixAlpha formForColorCount: preMultiplyAlpha primPrintHScale:vScale:landscape: relativeTextAnchorPosition setAsBackground) ('pixel access' colorAt: colorAt:put: isTransparentAt: pixelValueAt: pixelValueAt:put: primPixelValueAtX:y: primPixelValueAtX:y:put:) ('postscript generation' bitsPerComponent bytesPerRow decodeArray numComponents paddedWidth printPostscript:operator: rowPadding setColorspaceOn: store15To24HexBitsOn: store32To24HexBitsOn: storeBits:to:on: storeHexBitsOn: storePostscriptHexOn:) ('resources' readNativeResourceFrom: readResourceFrom: resourceTag storeResourceOn:) ('scaling, rotation' clippedToSize: flipBy:centerAt: magnifyBy: magnify:by: magnify:by:smoothing: rotateBy: rotateBy:centerAt: rotateBy:magnify:smoothing: rotateBy:smoothing: scaledToHeight: scaledToSize: scaledToSize:smoothing: scaledToWidth: shrink:by:) ('testing' hasNonStandardPalette isAllWhite isBigEndian isDisplayScreen isForm isGrayScale isLittleEndian isStatic isTranslucent isVirtualScreen shouldPreserveContents) ('transitions' fadeImageCoarse:at: fadeImageFine:at: fadeImageHorFine:at: fadeImageHor:at: fadeImageSquares:at: fadeImageVert:at: fadeImage:at:indexAndMaskDo: pageImage:at:corner: pageWarp:at:forward: slideImage:at:delta: wipeImage:at:clippingBox:rectForIndex: wipeImage:at:delta: wipeImage:at:delta:clippingBox: zoomInTo:at: zoomIn:orOutTo:at:vanishingPoint: zoomOutTo:at:) ('*MorphicExtras-postscript generation' encodePostscriptOn:) ('*nebraska-encoding' addDeltasFrom: deltaFrom: deltaFrom:at: encodeForRemoteCanvas) ('private' hackBits: initFromArray: privateFloodFillValue: setExtent:depth: setExtent:depth:bits: setResourceBits:) ('*Morphic' asMorph blankCopyOf: iconOrThumbnailOfSize: scaledIntoFormOfSize: scaledIntoFormOfSize:smoothing:) ('*Morphic-Support-image manipulation' stencil) ('processing' approxGaussianBlur at:bias: dither: edgeDetect emboss processUsingKernel: processUsingKernel:factor:bias: sharpen) ('*System-icon scaling' scaleIconToDisplay) ('*Morphic-Text Support' textAnchorProperties) ('*Tools-Inspector' inspectorClass) ('*TrueType-displaying' advanceWidth) !
Flaps class removeSelector: #addAndEnableEToyFlaps! Flaps class removeSelector: #defaultsQuadsDefiningPlugInSuppliesFlap! Flaps class removeSelector: #defaultsQuadsDefiningScriptingFlap! Flaps class removeSelector: #enableEToyFlaps! Flaps class removeSelector: #newLoneSuppliesFlap! Flaps class removeSelector: #newPaintingFlap! Flaps class removeSelector: #paintFlapButton! Flaps class removeSelector: #possiblyReplaceEToyFlaps! Flaps class removeSelector: #setUpSuppliesFlapOnly!
!Flaps class reorganize! ('class initialization' initialize) ('construction support' addMorph:asElementNumber:inGlobalFlapSatisfying: addMorph:asElementNumber:inGlobalFlapWithID: addToSuppliesFlap:asElementNumber: deleteMorphsSatisfying:fromGlobalFlapSatisfying:) ('flap mechanics' clobberFlapTabList freshFlapsStart reinstateDefaultFlaps removeFlapTab:keepInList:) ('flaps registry' defaultsQuadsDefiningStackToolsFlap defaultsQuadsDefiningSuppliesFlap defaultsQuadsDefiningToolsFlap defaultsQuadsDefiningWidgetsFlap initializeFlapsQuads registeredFlapsQuads registeredFlapsQuadsAt: registerQuad:forFlapNamed: unregisterQuadsWithReceiver: unregisterQuadsWithReceiver:fromFlapNamed: unregisterQuad:forFlapNamed:) ('menu commands' disableGlobalFlaps disableGlobalFlaps: disableGlobalFlapWithID: enableDisableGlobalFlapWithID: enableGlobalFlapWithID: explainFlaps explainFlapsText) ('menu support' addIndividualGlobalFlapItemsTo: enableGlobalFlaps globalFlapWithIDEnabledString: showSharedFlaps suppressFlapsString) ('miscellaneous' automaticFlapLayoutChanged doAutomaticLayoutOfFlapsIfAppropriate enableClassicNavigatorChanged fileOutChanges makeNavigatorFlapResembleGoldenBar orientationForEdge: removeFromGlobalFlapTabList:) ('new flap' addLocalFlap addLocalFlap: addLocalFlap:titled:onEdge: askForEdgeOfNewFlap defaultColorForFlapBackgrounds newFlapTitled:onEdge: newFlapTitled:onEdge:inPasteUp:) ('predefined flaps' addNewDefaultSharedFlaps addStandardFlaps initializeStandardFlaps newNavigatorFlap newObjectsFlap newSqueakFlap newStackToolsFlap newSuppliesFlap newSuppliesFlapFromQuads:positioning: newToolsFlap newWidgetsFlap quadsDefiningPlugInSuppliesFlap quadsDefiningStackToolsFlap quadsDefiningSuppliesFlap quadsDefiningToolsFlap quadsDefiningWidgetsFlap quadsDeiningScriptingFlap twiddleSuppliesButtonsIn:) ('replacement' replaceGlobalFlapwithID: replacePartSatisfying:inGlobalFlapSatisfying:with: replacePartSatisfying:inGlobalFlapWithID:with: replaceToolsFlap) ('shared flaps' addGlobalFlap: enableOnlyGlobalFlapsWithIDs: globalFlapTabOrDummy: globalFlapTabs globalFlapTabsIfAny globalFlapTabsWithID: globalFlapTabWithID: globalFlapTab: positionNavigatorAndOtherFlapsAccordingToPreference positionVisibleFlapsRightToLeftOnEdge:butPlaceAtLeftFlapsWithIDs: removeDuplicateFlapTabs sharedFlapsAllowed sharedFlapsAlongBottom) ('testing' anyFlapsVisibleIn:) !
EventHandler removeSelector: #adaptToWorld:! DeepCopier removeSelector: #mapUniClasses! DeepCopier removeSelector: #newUniClasses! DeepCopier removeSelector: #newUniClasses:! DeepCopier removeSelector: #uniClasses! Object subclass: #DeepCopier instanceVariableNames: 'references' classVariableNames: '' poolDictionaries: '' category: 'System-Object Storage'!
!DeepCopier reorganize! ('like fullCopy' checkBasicClasses checkClass: checkDeep checkVariables fixDependents initialize initialize: objInMemory: references warnIverNotCopiedIn:sel:) !
ChangeList removeSelector: #buildMorphicCodePaneWith:! CodeHolder removeSelector: #installTextualCodingPane! CodeHolder removeSelector: #restoreTextualCodingPane!
!CodeHolder reorganize! ('annotation' addPriorVersionsCountForSelector:ofClass:to: annotation annotation: annotationForClassCommentFor: annotationForClassDefinitionFor: annotationForHierarchyFor: annotationForSelector:ofClass: annotationPaneMenu:shifted: annotationRequests annotationSeparator) ('categories' categoryFromUserWithPrompt:for: categoryOfCurrentMethod changeCategory letUserReclassify:in: methodCategoryChanged selectedMessageCategoryName selectedSystemCategoryName) ('categories & search pane' listPaneWithSelector: newSearchPane searchTextMorph) ('commands' adoptMessageInCurrentChangeset browseImplementors browseSenders copyUpOrCopyDown offerMenu offerShiftedClassListMenu offerUnshiftedClassListMenu shiftedYellowButtonActivity spawn: spawnToClass: spawnToCollidingClass: unshiftedYellowButtonActivity) ('construction' buildClassBrowserEditString: buildMessageBrowserEditString: buildMessageCategoryBrowserForCategory:class:selector:editString: buildMorphicCodePaneWith:) ('contents' commentContents contents contentsChanged contentsSymbol contentsSymbol: editContents editContentsWithDefault: isModeStyleable) ('controls' codePaneProvenanceString contentsSymbolQuints decorateButtons optionalButtonPairs sourceAndDiffsQuintsOnly) ('diffs' defaultDiffsSymbol diffFromPriorSourceFor: showDiffs showDiffs: showPrettyDiffs: showRegularDiffs: showingAnyKindOfDiffs showingPrettyDiffs showingPrettyDiffsString showingRegularDiffs showingRegularDiffsString toggleDiffing togglePlainSource togglePrettyDiffing togglePrettyPrint toggleRegularDiffing wantsDiffFeedback) ('message category functions' canShowMultipleMessageCategories removeMessageCategory) ('message list' decompiledSourceIntoContents decompiledSourceIntoContentsWithTempNames: formattedLabel: formattedLabel:forSelector:inClass: messageHelpForMethod: messageHelpTruncated: selectedBytecodes selectedMessage sourceStringPrettifiedAndDiffed validateMessageSource:forSelector:inClass:) ('message list menu' messageListKey:from: messageListMenuMore: shiftedMessageListMore:) ('misc' addModelItemsToWindowMenu: getSelectorAndSendQuery:to: getSelectorAndSendQuery:to:with: informPossiblyCorruptSource isThereAnOverride isThisAnOverride modelWakeUpIn: okayToAccept priorSourceOrNil refreshAnnotation refusesToAcceptCode releaseCachedState sampleInstanceOfSelectedClass sendQuery:to: sendQuery:to:with: setClassAndSelectorIn: suggestCategoryToSpawnedBrowser: useSelector:orGetSelectorAndSendQuery:to:) ('self-updating' didCodeChangeElsewhere stepIn: updateCodePaneIfNeeded updateListsAndCodeIn: wantsStepsIn:) ('toolbuilder' annotationFrame annotationPaneHeight browseButtonEnabled buildAnnotationPaneWith: buildCodePaneWith: buildCodeProvenanceButtonWith: buildOptionalButtonsWith: buttonHeight hierarchyButtonEnabled inheritanceButtonColor inheritanceButtonEnabled optionalButtonsFrame receiverClass textFrame variablesButtonEnabled versionsButtonEnabled) ('traits' makeSampleInstance showUnreferencedClassVars showUnreferencedInstVars spawnHierarchy) ('what to show' offerWhatToShowMenu prettyPrintString setContentsToForceRefetch showByteCodes: showDecompile: showDocumentation: showingByteCodes showingByteCodesString showingDecompile showingDecompileString showingDocumentation showingDocumentationString showingEditContentsOption showingPlainSource showingPlainSourceString showingPrettyPrint showingSource toggleDecompile toggleShowDocumentation toggleShowingByteCodes wantsCodeProvenanceButton) ('*services-base' messageListMenuServices: requestor) ('*Protocols-Tools' spawnFullProtocol spawnProtocol) ('multi-window support' multiWindowState multiWindowState:) ('message functions' exploreMethod inspectMethod removeMessage) ('*SUnitTools-running' testAskToCreateNewTest: testBinarySelectorNames testBrowseClassNamed:possibleMessageNamed: testFindTest testFindTested testRunSuite: testSelectorFrom:) ('*SUnitTools-message list functions' testDebugTest testRunTest) ('*SUnitTools-menus' testsMessageListMenu: testsTestFindingMenu:) ('breakpoints' isBreakOnEntry toggleBreakOnEntry) ('code pane' aboutToStyle: compileMessage:notifying:) ('accessing' contents:notifying: doItReceiver metaClassIndicated selectedClass selectedClassOrMetaClass selectedMessageName systemOrganizer) ('initialize-release' defaultBrowserTitle labelString setClass:selector:) ('*monticello-revisions' classListMenuMonticello: messageListMenuMonticello:) ('class functions' removeClass) ('system category functions' removeSystemCategory) ('*60Deprecated-annotation' defaultAnnotationPaneHeight defaultButtonPaneHeight) ('*60Deprecated-categories & search pane' searchPane) !
Object removeSelector: #adaptedToWorld:! Object removeSelector: #beViewed! Object removeSelector: #belongsToUniClass! Object removeSelector: #costumes! Object removeSelector: #defaultFloatPrecisionFor:! Object removeSelector: #evaluateUnloggedForSelf:! Object removeSelector: #isPlayer! Object removeSelector: #isPrimitiveCostume! Object removeSelector: #isScriptEditorMorph! Object removeSelector: #isUniversalTiles! Object removeSelector: #methodInterfacesForCategory:inVocabulary:limitClass:! Object removeSelector: #methodInterfacesForInstanceVariablesCategoryIn:! Object removeSelector: #methodInterfacesForScriptsCategoryIn:! Object removeSelector: #presenter! Object removeSelector: #renameInternal:! Object removeSelector: #scriptPerformer! Object removeSelector: #selfWrittenAsIll! Object removeSelector: #selfWrittenAsIm! Object removeSelector: #selfWrittenAsMe! Object removeSelector: #selfWrittenAsMy! Object removeSelector: #selfWrittenAsThis! Object removeSelector: #slotInfo! Object removeSelector: #veryDeepCopySibling!
!Object reorganize! ('accessing' at: at:modify: at:put: basicAt: basicAt:put: basicSize bindWithTemp: enclosedSetElement in: readFromString: size yourself) ('associating' ->) ('binding' bindingOf:) ('casing' caseOf: caseOf:otherwise:) ('class membership' class inheritsFromAnyIn: isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass) ('comparing' = closeTo: hash identityHashPrintString literalEqual: ~=) ('converting' adaptToFloat:andCompare: adaptToFloat:andSend: adaptToFraction:andCompare: adaptToFraction:andSend: adaptToInteger:andCompare: adaptToInteger:andSend: adaptToScaledDecimal:andCompare: adaptToScaledDecimal:andSend: as: asOrderedCollection asSetElement asString asStringOrText changeClassTo: complexContents mustBeBoolean mustBeBooleanIn: printDirectlyToDisplay withoutListWrapper) ('copying' copy copyAddedStateFrom: copyFrom: copySameFrom: copyTwoLevel deepCopy initialDeepCopierSize postCopy shallowCopy veryDeepCopy veryDeepCopyUsing: veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:) ('debugging' evaluate:wheneverChangeIn: haltIf: haltOnceIf: meetsHaltCondition: needsWork) ('debugging-haltOnce' checkHaltCountExpired clearHaltOnce decrementAndCheckHaltCount decrementHaltCount doExpiredHaltCount doExpiredHaltCount: doExpiredInspectCount halt:onCount: haltIfNil haltOnCount: haltOnce haltOnce: haltOnceEnabled hasHaltCount inspectOnCount: inspectOnce inspectUntilCount: removeHaltCount setHaltCountTo: setHaltOnce toggleHaltOnce) ('dependents access' addDependent: breakDependents canDiscardEdits dependents hasUnacceptedEdits myDependents myDependents: release removeDependent:) ('drag and drop' acceptDroppingMorph:event:inMorph: dragPassengerFor:inMorph: dragStartedFor:transferMorph: dragTransferTypeForMorph: wantsDroppedMorph:event:inMorph:) ('error handling' assert: assert:description: assert:descriptionBlock: backwardCompatibilityOnly: caseError deprecated deprecated: deprecated:block: doesNotUnderstand: dpsTrace: dpsTrace:levels: dpsTrace:levels:withContext: error error: halt halt: handles: notify: notify:at: primitiveFailed primitiveFailed: shouldBeImplemented shouldNotImplement subclassResponsibility traitConflict) ('evaluating' value valueWithArguments:) ('filter streaming' byteEncode: drawOnCanvas: elementSeparator encodePostscriptOn: flattenOnStream: fullDrawPostscriptOn: putOn: writeOnFilterStream:) ('flagging' isThisEverCalled isThisEverCalled: logEntry logExecution logExit) ('graph model' addModelYellowButtonMenuItemsTo:forMorph:hand: hasModelYellowButtonMenuItems) ('macpal' codeStrippedOut: contentsChanged flash instanceVariableValues objectRepresented refusesToAcceptCode) ('message handling' executeMethod: perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:with:with:with:with: perform:with:with:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: perform:withEnoughArguments: with:executeMethod: with:with:executeMethod: with:with:with:executeMethod: with:with:with:with:executeMethod: withArgs:executeMethod:) ('objects from disk' comeFullyUpOnReload: convertToCurrentVersion:refStream: fixUponLoad:seg: objectForDataStream: readDataFrom:size: saveOnFile saveOnFileNamed: storeDataOn:) ('printing' fullPrintString isLiteral longPrintOn: longPrintOn:limitedTo:indent: longPrintString longPrintStringLimitedTo: nominallyUnsent: printOn: printString printStringLimitedTo: printWithClosureAnalysisOn: reportableSize storeOn: storeString stringForReadout stringRepresentation) ('system primitives' asOop become: becomeForward: becomeForward:copyHash: className creationStamp instVarAt: instVarAt:put: instVarNamed: instVarNamed:put: oopString primitiveChangeClassTo: rootStubInImageSegment: someObject) ('testing' isArray isBehavior isBlock isBoolean isCharacter isClassReference isClosure isCodeReference isCollection isColor isColorForm isCompiledCode isCompiledCodeClass isCompiledMethod isComplex isContext isDictionary isFloat isForm isFraction isHeap isInteger isInterval isMessageSend isMethodContext isMethodProperties isMethodReference isMorph isMorphicEvent isMorphicModel isNumber isPoint isPromise isRectangle isScaledDecimal isSketchMorph isStream isString isSymbol isSystemWindow isText isTextView isTrait isTransparent isVariableBinding isWebBrowser isWindowForModel: knownName name nameForViewer renameTo: shouldBePrintedAsLiteral shouldBePrintedAsLiteralVisiting: showDiffs stepAt:in: stepIn: stepTime stepTimeIn: vocabularyDemanded wantsDiffFeedback wantsSteps wantsStepsIn:) ('updating' changed changed: changed:with: handledListVerification noteSelectionIndex:for: okToChange okToClose update: update:with: updateListsAndCodeIn: windowIsClosing) ('user interface' addModelItemsToWindowMenu: addModelMenuItemsTo:forMorph:hand: asExplorerString defaultLabelForInspector launchPartVia: launchPartVia:label: launchTileToRefer modelSleep modelWakeUp modelWakeUpIn: mouseUpBalk: notYetImplemented windowActiveOnFirstClick windowReqNewLabel:) ('*monticello' isConflict) ('*system-support' isPrimitiveError systemNavigation) ('*Tools-Explorer' explore exploreWithLabel:) ('*tools-browser' browseHierarchy) ('private' errorImproperStore errorNonIntegerIndex errorNotIndexable errorSubscriptBounds: setPinned: species storeAt:inTempFrame:) ('thumbnail' iconOrThumbnailOfSize:) ('*Morphic-Explorer' explorerContents hasContentsInExplorer) ('futures' future future: futureDo:at:args: futureSend:at:args:) ('*Tools-MessageSets' browseAllCallsOn: browseAllCallsOn:requestor: browseAllImplementorsOf: browseAllImplementorsOf:requestor:) ('*Tools-multi-window support' canHaveUnacceptedEdits) ('*morphic' asMorph asStringMorph asTextMorph isPluggableListMorph openAsMorph) ('tracing' inboundPointers inboundPointersExcluding: outboundPointers outboundPointersDo:) ('*Tools-Debugger' canonicalArgumentName chasePointers explorePointers shouldFollowOutboundPointers) ('*System-Object Events-accessing' actionForEvent: actionForEvent:ifAbsent: actionMap actionSequenceForEvent: actionsDo: createActionMap hasActionForEvent: setActionSequence:forEvent: updateableActionMap) ('*System-Change Notification-events' actionsWithReceiver:forEvent: renameActionsWithReceiver:forEvent:toEvent:) ('*System-Change Notification-converting' asActionSequence asActionSequenceTrappingErrors) ('*System-Tools-breakpoint' break) ('*ToolBuilder-Kernel-error handling' confirm: confirm:orCancel:) ('*ToolBuilder-Kernel-user interface' inform:) ('*System-Support-user interface' initialExtent) ('*System-Localization-locales' localeChanged localeChangedGently translatedNoop) ('*System-Object Events-accessing-removing' releaseActionMap removeAction:forEvent: removeActionsForEvent: removeActionsSatisfying: removeActionsSatisfying:forEvent: removeActionsWithReceiver: removeActionsWithReceiver:forEvent:) ('*System-Object Events-accessing-triggering' triggerEvent: triggerEvent:ifNotHandled: triggerEvent:with: triggerEvent:with:ifNotHandled: triggerEvent:withArguments: triggerEvent:withArguments:ifNotHandled:) ('*System-Object Events-accessing-registering' when:evaluate: when:send:to: when:send:to:with: when:send:to:withArguments:) ('*Traits' explicitRequirement requirement) ('*Graphics-KernelExtensions' fullScreenSize) ('*System-Finalization' actAsExecutor executor finalizationRegistry finalize hasMultipleExecutors retryWithGC:until: toFinalizeSend:to:with:) ('*collections' asLink compareSafely:) ('*Tools-Browsing' browse) ('*System-Recovery-error handling' primitiveError:) ('*SUnit-testing' isTestClass) ('*Morphic-Events-Filtering' filterEvent:for:) ('*System-Preferences' applyUserInterfaceTheme canApplyUserInterfaceTheme userInterfaceTheme) ('*Tools' environment) ('pinning' isPinned pin unpin) ('literals' allLiteralsDo: hasLiteral: hasLiteralSuchThat:) ('write barrier' attemptToAssign:withIndex: beReadOnlyObject beWritableObject isReadOnlyObject setIsReadOnlyObject:) ('*Tools-Inspector' basicInspect inspect inspectWithLabel: inspectorClass) ('*Morphic-Kernel-accessing' currentEvent currentHand currentWorld) ('*Monticello-Patching-testing' isMCPatchOperation) ('*JSON' asJsonString) ('*60Deprecated-accessing' ifNil:ifNotNilDo: ifNotNilDo: ifNotNilDo:ifNil:) ('*MorphicExtras-Undo' capturedState commandHistory purgeAllCommands redoFromCapturedState: refineRedoTarget:selector:arguments:in: refineUndoTarget:selector:arguments:in: rememberCommand: rememberUndoableAction:named: undoFromCapturedState:) ('*Protocols' currentVocabulary haveFullProtocolBrowsed haveFullProtocolBrowsedShowingSelector:) ('*services-base' requestor) ('*60Deprecated-copying' clone) ('*60Deprecated-Tools' exploreAndYourself notifyWithLabel:) ('*MorphicExtras-PartsBin' descriptionForPartsBin) !
| currentChanges | currentChanges := ChangeSet current.
Smalltalk globals removeKey: #References. Smalltalk globals removeKey: #CustomEventsRegistry. Smalltalk globals removeKey: #ScriptingSystem.
ChangeSet newChanges: (ChangeSet new name: 'unload-etoys-more'). (Smalltalk classNamed: #StandardScriptingSystem) removeFromSystem. (Smalltalk classNamed: #Presenter) removeFromSystem. (Smalltalk classNamed: #MethodHolder) removeFromSystem. (Smalltalk classNamed: #PaintInvokingMorph) removeFromSystem. (Smalltalk classNamed: #ViewerFlapTab) removeFromSystem. (Smalltalk classNamed: #AcceptableCleanTextMorph) removeFromSystem. (Smalltalk classNamed: #BrowserCommentTextMorph) removeFromSystem. (Smalltalk classNamed: #BorderedSubpaneDividerMorph) removeFromSystem. (Smalltalk classNamed: #TextFieldMorph) removeFromSystem. (Smalltalk classNamed: #KeyboardBuffer) removeFromSystem. (Smalltalk classNamed: #PluggableTabButtonMorph) removeFromSystem. (Smalltalk classNamed: #MorphWithSubmorphsWrapper) removeFromSystem. (Smalltalk classNamed: #TwoWayScrollPane) removeFromSystem. Preferences removePreference: #noviceMode. Preferences removePreference: #eToyFriendly. Preferences removePreference: #universalTiles. Preferences removePreference: #uniTilesClassic. Preferences removePreference: #tileTranslucentDrag. Preferences removePreference: #typeCheckingInTileScripting. Preferences removePreference: #compactViewerFlaps. Preferences removePreference: #viewersInFlaps. Preferences removePreference: #batchPenTrails. Preferences removePreference: #keepTickingWhilePainting. Preferences removePreference: #unlimitedPaintArea. Preferences removePreference: #mvcProjectsAllowed. Preferences removePreference: #eToyLoginEnabled. Preferences removePreference: #oliveHandleForScriptedObjects. Preferences removePreference: #dropProducesWatcher. Preferences removePreference: #automaticViewerPlacement. Preferences removePreference: #capitalizedReferences. Preferences removePreference: #fenceEnabled. Preferences removePreference: #fenceSoundEnabled. Preferences removePreference: #haloTransitions. Preferences removePreference: #selectiveHalos. Preferences removePreference: #useVectorVocabulary. Preferences removePreference: #simpleMenus. Preferences removePreference: #propertySheetFromHalo. Preferences removePreference: #menuColorFromWorld. Preferences removePreference: #enableVirtualOLPCDisplay. Preferences removePreference: #enablePortraitMode. Preferences removePreference: #magicHalos. Preferences removePreference: #tabAmongFields. Preferences removePreference: #sugarAutoSave. Preferences removePreference: #showAdvancedNavigatorButtons. FileServices removeObsolete. ChangeSet newChanges: currentChanges.
ChangeSet newChanges: (ChangeSet new name: 'clean-up-categories'). SystemChangeNotifier uniqueInstance doSilently: [ Smalltalk allClassesDo: [:cls | cls organization renameCategory: 'stepping and presenter' toBe: 'stepping']]. Smalltalk removeEmptyMessageCategories. ChangeSet newChanges: currentChanges.
Preferences resetHaloSpecifications. TheWorldMainDockingBar updateInstances. Flaps initializeFlapsQuads; initializeStandardFlaps. Vocabulary initializeStandardVocabularies. UserInterfaceTheme cleanUpAndReset.
"Next: Remove Etoys package from update map."!
I have pushed a number of updates to trunk with class and method recategorization for Etoys. I am attaching for reference an updated RecategorizeForEtoys.st that includes scripts that I have been using to make the changes.
So for, the changes do two things: 1) Clean up category names, based the cleanups in Marcel's Etoys removal script. 2) Move classes an methods from Etoys to base packages if they are used outside of Etoys.
I have also made, but not committed, a bunch of updates that move methods into Etoys if they are used only by Etoys. These changes should be safe for trunk, but I want to spend some more time reviewing them before committing them for real.
Meanwhile any feedback is appreciated :-)
Dave
On 2023-10-03 15:24, David T. Lewis wrote:
On Tue, Aug 29, 2023 at 03:47:19PM +0200, Marcel Taeumel via Squeak-dev wrote:
Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
I have been working with Marcel's excellent Etoys removal script and trying to figure out if it might be possible to maintain images with and without Etoys over time. I have been using Monticello with a local disk based repository to look at the differences between trunk images with and without the Etoys removal.
Just for the record, and in case anyone else is playing around with similar ideas, I am attaching RecategorizeExtensionsForEtoys.st which I have been using to move methods that are different into a separate 'Extensions' package. This separates out the methods that are necessarily different between images with and without Etoys. I don't (yet?) see how this helps with maintainability but it does give a view of the methods that could potentially be refactored in better ways. Basically I think the idea would be to make the 'Extensions' package be as small a possible (right now it is rather large).
I was hoping to find that moving these conflicting methods into a separate package would leave the rest of the packages reasonable similar between the full trunk image and the no-Etoys trunk image. But of course it is not quite that simple.
One encouraging thing is that, after moving the conflicting methods (Etoys image versus no-Etoys) I find a large number of methods in other packages that are referenced only by Etoys, even though that would not be obvious just from looking at those methods in the full image. I think that there is a lot of stuff that could be safely moved to the 'EToys' package without impacting the base image.
Just a few observations that may be of interest, hopefully more to follow.
Dave
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras:
- Games
- Sketches and PaintBox
- Flaps
- CalendarMorph
- SpectrumAnalyzerMorph
Here is what would still "work" through the package System:
- Object storage (ImageSegment etc.)
- ProjectLoading
Here is what would still work through the package Protocols:
- Lexicon tool
- Vocabulary framework
Here is what would be gone:
- Tiles, viewers, and scripts
- Players and costumes
- Pen trails, Turtles, ...
- References, CustomEventsRegistry, ScriptingSystem
- Siblings for (Player-only) uni-classes
- DeepCopier support for (Player-only) uni-classes
- Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
So...should we remove Etoys from Trunk at this point?
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel ???'From Squeak6.1alpha of 26 July 2023 [latest update: #22682] on 29 August 2023 at 3:33:41 pm'!| currentChanges |currentChanges := ChangeSet current.MenuIcons addClassVarName: #ScriptingIcons.MenuIcons classPool at: #ScriptingIcons put: ((Smalltalk globals at: #ScriptingSystem) formDictionary associationsSelect: [:assoc | true "keep all for now" "(assoc key beginsWith: 'Halo-') or: [assoc key beginsWith: 'Debugger']"]).ChangeSet newChanges: (ChangeSet new name: 'move-etoys-games-to-morphicextras').#( "Keep the games as standalone example applications"'Etoys-Squeakland-Morphic-Games' 'MorphicExtras-Games''Etoys-Squeakland-Morphic-Games-Chess' 'MorphicExtras-Games-Chess''Etoys-Squeakland-Morphic-Games-Chess960' 'MorphicExtras-Games-Chess960''Etoys-Squeakland-Morphic-Demo' 'MorphicExtras-Demo') pairsDo: [:oldCat :newCat | (SystemOrganization listAtCategoryNamed: oldCat) do: [:className | (self environment classNamed: className) category: newCat]]."Rescue more examples from Etoys over to MorphicExtras"(Smalltalk classNamed: #CalendarMorph) category: 'MorphicExtras-Demo'.(Smalltalk classNamed: #SpectrumAnalyzerMorph) category: 'MorphicExtras-SoundInterface'.ChangeSet newChanges: currentChanges.(MCPackage named: #EToys) unload.!Object subclass: #DeepCopier instanceVariableNames: 'references uniClasses newUniClasses ' classVariableNames: '' poolDictionaries: '' category: 'System-Object Storage'!!DeepCopier commentStamp: 'mt 8/28/2023 15:05' prior: 0!DeepCopier does a veryDeepCopy.It is a complete tree copy using a dictionary. Any object that is 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. See Object|veryDeepCopy which calls (self veryDeepCopyWith: aDeepCopier).When a tree of morphs points at a morph outside of itself, that morph should not be copied. Use our own kind of weak pointers for the 'potentially outside' morphs. Default is that any new class will have all of its fields deeply copied. If a field needs to be weakly copied, define veryDeepInner: and veryDeepFixupWith:. veryDeepInner: has the loop that actually copies the fields. If a class defines its own copy of veryDeepInner: (to leave some fields out), then veryDeepFixupWith: will be called on that object at the end. veryDeepInner: can compute an alternate object to put in a field. (Object veryDeepCopyWith: discovers which superclasses did not define veryDeepInner:, and very deeply copies the variables defined in those classes). To decide if a class needs veryDeepInner: and veryDeepFixupWith:, ask this about an instance: If I duplicate this object, does that mean that I also want to make duplicates of the things it holds onto? If yes, (i.e. a Paragraph does want a new copy of its Text) then do nothing. If no, (i.e. an undo command does not want to copy the objects it acts upon), then define veryDeepInner: and veryDeepFixupWith:. Here is an analysis for the specific case of a morph being held by another morph. Does field X contain a morph? If not, no action needed.Is the morph in field X already a submorph of the object? Is it down lower in the submorph tree? If so, no action needed.Could the morph in field X every appear on the screen (be a submorph of some other morph)? If not, no action needed. If it could, you must write the methods veryDeepFixupWith: and veryDeepInner:, and in them, refrain from sending veryDeepCopyWith: to the contents of field X.----- Things Ted is still considering -----Rule: If object A has object C in a field, and A says (^ C) for the copy, but object B has A in a normal field and it gets deepCopied, and A in encountered first, then there will be two copies of C. (just be aware of it)Dependents are now fixed up. Suppose a model has a dependent view. In the DependentFields dictionary, model -> (view ...). If only the model is copied, no dependents are created (no one knows about the new model). If only the view is copied, it is inserted into DependentFields on the right side. model -> (view copiedView ...). If both are copied, the new model has the new view as its dependent. If additional things depend on a model that is copied, the caller must add them to its dependents.August 2023: There is no support for uni-classes at this time!!!Model subclass: #FancyMailComposition instanceVariableNames: 'messageText theLinkToInclude to subject' classVariableNames: '' poolDictionaries: '' category: 'Nebraska-Network-Mail'!Object subclass: #MenuIcons instanceVariableNames: '' classVariableNames: 'Icons TranslatedIcons TranslationLocale ScriptingIcons ' poolDictionaries: '' category: 'Morphic-Menus'!Object subclass: #MorphExtension instanceVariableNames: 'locked visible sticky balloonText balloonTextSelector externalName isPartsDonor actorState player eventHandler otherProperties ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Kernel'!BorderedMorph subclass: #PasteUpMorph instanceVariableNames: 'presenter model cursor padding turtleTrailsForm turtlePen lastTurtlePositions isPartsBin indicateCursor wantsMouseOverHalos worldState ' classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler ' poolDictionaries: '' category: 'Morphic-Worlds'!AbstractLauncher subclass: #ProjectLauncher instanceVariableNames: 'showSplash splashURL whichFlaps eToyAuthentificationServer ' classVariableNames: 'SplashMorph ' poolDictionaries: '' category: 'System-Download'!Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl eToyUserListUrl eToyUserList keepAlive encodingName ' classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers ' poolDictionaries: '' category: 'Network-RemoteDirectory'!!SmartRefStream commentStamp: 'mt 8/28/2023 15:44' prior: 0!Ordinary ReferenceStreams assume that the names and order of instance variables is exactly the same when an object file is written and read. SmartRefStream allows object files to be read even after instance variables have changed or the entire class has been renamed.When an object file is written, no one knows how the classes will change in the future. Therefore, all conversion must be done when the file is read. The key is to store enough information in the file about the names of the instance variables of all outgoing classes. SmartRefStream works best with only one tree of objects per file. You can nextPut: more than once, but each object tree gets its own class structure description, which is big. Conversion of old objects is done by a method in each class called (convertToCurrentVersion: varDict refStream: smartRefStrm). At fileOut time, ChangeSet>>checkForConversionMethods creates a prototype of this method (if Preference #conversionMethodsAtFileOut is true). The programmer must edit this method to (1) test if the incoming object needs conversion, (2) put non-nil values into any new inst vars that need them, and (3) save the data of any inst vars that are being deleted. Determining which old version is represented by the incoming object can be done in several ways: - noticing that a current inst var is nil when it should have data, - noticing that there is an older inst var name in the variable dictionary (varDict), - checking kinds of objects in one or more inst vars, or - retrieving the classVersion of the incoming object from the ref stream. If a class is renamed, a method goes into SmartRefStream telling the new name. The conversion method of the new class must be prepared to accept instances of the old class also. If no inst var names have changed, the conversion method does nothing.An example: Suppose we change the representation of class Rectangle from ('origin' 'corner') to ('origin' 'extent'). Suppose lots of Rectangle instances are already out on files (in .pr project files, especially). The programmer changes the class definition, modifies all the methods, and filesOut. A series of dialogs appear, asking if instances Rectangle might be in an object file, if 'extent' needs to be non-nil (yes), and if the info in 'corner' needs to be preserved (yes). This method appears:Rectangle >> convertToCurrentVersion: varDict refStream: smartRefStrm "These variables are automatically stored into the new instance: #('origin'). Test for this particular conversion. Get values using expressions like (varDict at: 'foo')." "New variables: #('extent'). If a non-nil value is needed, please assign it." "These are going away #('corner'). Possibly store their info in some other variable?" "Move your code above the ^ super... Delete extra comments." ^ super convertToCurrentVersion: varDict refStream: smartRefStrmThe programmer modifies it to be:Rectangle >> convertToCurrentVersion: varDict refStream: smartRefStrm(varDict includesKey: 'extent') ifFalse: ["old version!!" "Create the new extent, and preserve the info from the old corner" extent := (varDict at: 'corner') - origin. ].^ super convertToCurrentVersion: varDict refStream: smartRefStrm This conversion method stays in the system and is ready to convert the old format of Rectangle whenever one is encountered in an object file. Note that the subclasses of Rectangle, (B3DViewport, CharacterBlock, and Quadrangle) do not need conversion methods. Their instances will be converted by the code in Rectangle. Files written by SmartRefStream are in standard fileout format. You can mix raw objects with code to be filed in. The file starts out in the normal fileOut format. Definitions of new classes on the front.structures Dictionary of (#Rectangle -> #(<classVersionInteger> 'origin' 'corner')). Inst var names are strings.steady Set of Classes who have the same structure now as on the incoming file. Includes classes with same inst vars except for new ones added on the end.reshaped Dictionary of Classes who have a different structure now from the incoming file. Includes those with same inst vars but new version number. (old class name -> method selector to fill in data for version to version)renamed Dictionary of Classes who have a different name. Make an instance of the new class, and send it the conversion call. (old class name symbol -> new class name). renamedConv Dictionary of conversion selector for Classes who have a different name. (old class name symbol -> conversion selector). topCall Tells if next or nextPut: are working on the top object in the tree. nil if outside, the top object if deep inside.See DataStream.typeIDFor: for where the tangle of objects is clipped, so the whole system will not be written on the file.No object that is written on the file is ever a class. All class definitions are filed in. A class may be stored inside an ImageSegment that itself is stored in a SmartRefStream.UniClasses are classes for the instance specific behavior of just one instance. See #newSubclass. When a UniClass is read in, and a class of the same name already exists, the incoming one is renamed. ObjectScanner converts the filed-in code.Values in instance variables of UniClasses are stored in the array that tells the class structure. It is the fourth of the four top level objects. #(version (class-structure) the-object ((#Player25 scripts slotInfo costumeDictionary) (#Player26 scripts slotInfo costumeDictionary))).There is a separate subclass for doing veryDeepCopy (in memory). Currently, any object for which objectToStoreOnDataStream return an object other than self, does this: The new object (a DiskProxy) is traced. When it comes time to go through the fields of the old object, they are not found as keys in references (DiskProxies are there instead). So the old field value is left in the new object. That is OK for StrikeFont, Class, MetaClass, DisplayScreen. But the DiskProxies are evaluated, which takes a lot of time.Some metaclasses are put into the structures table. This is for when a block has a receiver that is a class. See checkFatalReshape:.ImageSegments: A ReferenceStream is used to enumerate objects to put inside an ImageSegment. If an instance of a UniClass is seen, the class is put in also. A SmartRefStream is used to store the ImageSegment. Roots are nil, and the segment is a wordArray. We are encoding the outPointers. Structures contains all classes from both places. Must filter out UniClasses for some things, and do include them for putting source code at end of file. Do not write any class inst vars in file.--Ted Kaehler and Bob Arning.How are the selectors in the '*Morphic-conversion' protocol ending with something like ttfclpomsswfpp0constructed and what does it mean?Answer:It is the initials of all instance variables followed by the class version integer. The initials allow to detect most changes to the instance variables, but if this is not sufficient (perhaps because the new var had the same initial, or the vars did not change in name at all) we still have the class version.Most classes are still at version 0, but if you check implementers of classVersion you can find a few that were incremented to force a conversion on load.!!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:05'!veryDeepCopy "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." | copier new | copier := DeepCopier new: self initialDeepCopierSize. new := self veryDeepCopyWith: copier. copier references associationsDo: [:assoc | assoc value veryDeepFixupWith: copier]. copier fixDependents. ^ new! !!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:05'!veryDeepCopyUsing: copier "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. Same as veryDeepCopy except copier (with dictionary) is supplied. ** do not delete this method, even if it has no callers **" | new refs | new := self veryDeepCopyWith: copier. copier references associationsDo: [:assoc | assoc value veryDeepFixupWith: copier]. "Fix dependents" refs := copier references. DependentsFields associationsDo: [:pair | pair value do: [:dep | | newDep newModel | (newDep := refs at: dep ifAbsent: [nil]) ifNotNil: [ newModel := refs at: pair key ifAbsent: [pair key]. newModel addDependent: newDep]]]. ^ new! !!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:07'!veryDeepCopyWith: deepCopier "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." | class index sub subAss new sup has mine | deepCopier references at: self ifPresent: [:newer | ^ newer]. "already did him" class := self class. class isMeta ifTrue: [^ self]. "a class" new := self shallowCopy. deepCopier references at: self put: new. "remember" (class isVariable and: [class isPointers]) ifTrue: [index := self basicSize. [index > 0] whileTrue: [sub := self basicAt: index. (subAss := deepCopier references associationAt: sub ifAbsent: [nil]) ifNil: [new basicAt: index put: (sub veryDeepCopyWith: deepCopier)] ifNotNil: [new basicAt: index put: subAss value]. index := index - 1]]. "Ask each superclass if it wants to share (weak copy) any inst vars" new veryDeepInner: deepCopier. "does super a lot" "other superclasses want all inst vars deep copied" sup := class. index := class instSize. [has := sup compiledMethodAt: #veryDeepInner: ifAbsent: [nil]. has := has ifNil: [class isSystemDefined not "is a uniClass"] ifNotNil: [true]. mine := sup instVarNames. has ifTrue: [index := index - mine size] "skip inst vars" ifFalse: [1 to: mine size do: [:xx | sub := self instVarAt: index. (subAss := deepCopier references associationAt: sub ifAbsent: [nil]) "use association, not value, so nil is an exceptional value" ifNil: [new instVarAt: index put: (sub veryDeepCopyWith: deepCopier)] ifNotNil: [new instVarAt: index put: subAss value]. index := index - 1]]. (sup := sup superclass) == nil] whileFalse. new rehash. "force Sets and Dictionaries to rehash" ^ new! !!Object methodsFor: 'testing' stamp: 'mt 3/8/2023 10:43'!knownName ^ nil! !!Class methodsFor: 'testing' stamp: 'mt 8/28/2023 14:56'!officialClass "I am not a UniClass. (See MorphicModel officialClass). Return the class you use to make new subclasses." ^ self! !!Class methodsFor: 'fileIn/Out' stamp: 'mt 8/28/2023 14:56'!objectForDataStream: refStrm "I am about to be written on an object file. Write a reference to a class in Smalltalk instead." refStrm insideASegment ifFalse: ["Normal use" ^ DiskProxy global: self theNonMetaClass name selector: #withClassVersion: args: {self classVersion}] ifTrue: ["recording objects to go into an ImageSegment" self isSystemDefined ifFalse: [^ self]. "do trace uni-classes" (refStrm rootObject includes: self) ifTrue: [^ self]. "is in roots, intensionally write out, ^ self" "A normal class. remove it from references. Do not trace." refStrm references removeKey: self ifAbsent: []. "already there" ^ nil]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!toggleDiffing "Toggle whether diffs should be shown in the code pane. If any kind of diffs were being shown, stop showing diffs. If no kind of diffs were being shown, start showing whatever kind of diffs are called for by default." | wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingAnyKindOfDiffs. self showDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!togglePlainSource "Toggle whether plain source shown in the code pane" | wasShowingPlainSource | self okToChange ifTrue: [wasShowingPlainSource := self showingPlainSource. wasShowingPlainSource ifTrue: [self showDocumentation: true] ifFalse: [contentsSymbol := #source]. self setContentsToForceRefetch. self changed: #contents]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!togglePrettyDiffing "Toggle whether pretty-diffing should be shown in the code pane" | wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingPrettyDiffs. self showPrettyDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!togglePrettyPrint "Toggle whether pretty-print is in effectin the code pane" self okToChange ifTrue: [self showingPrettyPrint ifTrue: [contentsSymbol := #source] ifFalse: [contentsSymbol := #prettyPrint]. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!toggleRegularDiffing "Toggle whether regular-diffing should be shown in the code pane" | wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingRegularDiffs. self showRegularDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'misc' stamp: 'mt 3/23/2023 11:24'!refusesToAcceptCode "Answer whether receiver, given its current contentsSymbol, could accept code happily if asked to" ^ (#(byteCodes documentation) includes: self contentsSymbol)! !!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'!toggleDecompile "Toggle the setting of the showingDecompile flag, unless there are unsubmitted edits that the user declines to discard" | wasShowing | self okToChange ifTrue: [wasShowing := self showingDecompile. self showDecompile: wasShowing not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'!toggleShowDocumentation "Toggle the setting of the showingDocumentation flag, unless there are unsubmitted edits that the user declines to discard" | wasShowing | self okToChange ifTrue: [wasShowing := self showingDocumentation. self showDocumentation: wasShowing not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'!toggleShowingByteCodes "Toggle whether the receiver is showing bytecodes" self showByteCodes: self showingByteCodes not. self setContentsToForceRefetch. self contentsChanged! !!Command class methodsFor: 'dog simple ui' stamp: 'mt 7/31/2023 11:10'!undoRedoButtons "Answer a morph that offers undo and redo buttons" | wrapper | "self currentHand attachMorph: Command undoRedoButtons" wrapper := AlignmentMorph newColumn. wrapper color: Color veryVeryLightGray lighter; borderWidth: 0; layoutInset: 0; vResizing: #shrinkWrap; hResizing: #shrinkWrap. #((CrudeUndo undoLastCommand 'undo last command done' undoEnabled CrudeUndoDisabled CrudeUndoDisabled) (CrudeRedo redoNextCommand 'redo last undone command' redoEnabled CrudeRedoDisabled CrudeRedoDisabled)) do: [:tuple | | aButton | wrapper addTransparentSpacerOfSize: (8@0). aButton := UpdatingThreePhaseButtonMorph new. aButton onImage: (MenuIcons formAtKey: tuple first); offImage: (MenuIcons formAtKey: tuple fifth); pressedImage: (MenuIcons formAtKey: tuple sixth); getSelector: tuple fourth; color: Color transparent; target: self; actionSelector: tuple second; setNameTo: tuple second; setBalloonText: tuple third; extent: aButton onImage extent. wrapper addMorphBack: aButton. wrapper addTransparentSpacerOfSize: (8@0)]. ^ wrapper! !!Debugger methodsFor: 'toolbuilder' stamp: 'mt 3/10/2023 11:26'!buildNotifierWith: builder label: label message: messageString | windowSpec listSpec textSpec panelSpec quads | windowSpec := builder pluggableWindowSpec new model: self; extent: self initialExtentForNotifier; label: label asString; children: OrderedCollection new. panelSpec := builder pluggablePanelSpec new. panelSpec children: OrderedCollection new. quads := self preDebugButtonQuads. (self interruptedContext selector == #doesNotUnderstand:) ifTrue: [ quads := quads copyWith: { 'Create'. #createMethod. #magenta. 'create the missing method' } ]. (#(#notYetImplemented #shouldBeImplemented #requirement) includes: self interruptedContext selector) ifTrue: [ quads := quads copyWith: { 'Create'. #createImplementingMethod. #magenta. 'implement the marked method' } ]. (self interruptedContext selector == #subclassResponsibility) ifTrue: [ quads := quads copyWith: { 'Create'. #createOverridingMethod. #magenta. 'create the missing overriding method' } ]. quads do:[:spec| | buttonSpec | buttonSpec := builder pluggableButtonSpec new. buttonSpec model: self. buttonSpec label: spec first. buttonSpec action: spec second. buttonSpec help: spec fourth. spec size >= 5 ifTrue: [buttonSpec enabled: spec fifth]. panelSpec children add: buttonSpec. ]. panelSpec layout: #horizontal. "buttons" panelSpec frame: self preDebugButtonQuadFrame. windowSpec children add: panelSpec. messageString notNil ifFalse:[ listSpec := builder pluggableListSpec new. listSpec model: self; list: #contextStackList; getIndex: #contextStackIndex; setIndex: #debugAt:; icon: #messageIconAt:; helpItem: #messageHelpAt:; frame: self contextStackFrame. windowSpec children add: listSpec. ] ifTrue:[ message := messageString. textSpec := builder pluggableTextSpec new. textSpec model: self; getText: #preDebugMessageString; setText: nil; selection: nil; menu: #debugProceedMenu:; frame: self contextStackFrame. windowSpec children add: textSpec. ]. ^windowSpec! !!Debugger methodsFor: 'initialize' stamp: 'mt 3/10/2023 11:26'!preDebugButtonQuads ^{ {'Proceed' translated. #proceed. #blue. 'continue execution' translated. #interruptedProcessShouldResume}. self class showTerminateButton ifTrue: [ {'Terminate' translated. #terminateProcess. #black. 'terminate this execution and close this window' translated}]. self class showAbandonButton ifTrue: [ {'Abandon' translated. #abandon. #black. 'terminate this execution aggressively and close this window' translated}]. {'Debug' translated. #debug. #red. 'bring up a debugger' translated}} reject: [:quad | quad isNil]! !!DeepCopier methodsFor: 'like fullCopy' stamp: 'mt 3/10/2023 15:37'!checkBasicClasses "Check that no indexes of instance vars have changed in certain classes. If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated. The idea is to catch a change while it is still in the system of the programmer who made it. DeepCopier new checkVariables " | str objCls morphCls | str := '|veryDeepCopyWith: or veryDeepInner: is out of date.'. (objCls := self objInMemory: #Object) ifNotNil: [ objCls instSize = 0 ifFalse: [self error: 'Many implementers of veryDeepCopyWith: are out of date']]. (morphCls := self objInMemory: #Morph) ifNotNil: [ morphCls superclass == Object ifFalse: [self error: 'Morph', str]. (morphCls instVarNames copyFrom: 1 to: 6) = #('bounds' 'owner' 'submorphs' 'fullBounds' 'color' 'extension') ifFalse: [self error: 'Morph', str]]. "added ones are OK"! !!DeepCopier methodsFor: 'like fullCopy' stamp: 'mt 8/28/2023 15:08'!initialize: size references := IdentityDictionary new: size.! !!ExtendedClipboardUnixInterface methodsFor: 'general-api-read' stamp: 'mt 8/11/2023 15:20'!readHTMLClipboardData | bytes source | "Answer a HTMLDocument object" bytes := self readClipboardData: 'text/html'. (bytes beginsWith: '<!!DOCTYPE' asByteArray) ifTrue: ["BAD HACK for Abiword" source := bytes asString convertFromWithConverter: UTF8TextConverter new] ifFalse: ["BAD HACK for mozilla" source := bytes asString convertFromWithConverter: (UTF16TextConverter new useLittleEndian: SmalltalkImage current isLittleEndian)]. ^ source asTextFromHtml! !!FileList2 methodsFor: 'volume list and pattern' stamp: 'mt 8/16/2023 15:54'!listForPattern: pat "Make the list be those file names which match the pattern." | sizePad newList entries | directory ifNil: [^#()]. entries := directory entries. (fileSelectionBlock isKindOf: MessageSend) ifTrue: [ fileSelectionBlock arguments: {entries}. newList := fileSelectionBlock value. fileSelectionBlock arguments: #(). ] ifFalse: [ newList := entries select: [:entry | fileSelectionBlock value: entry value: pat]. ]. newList := newList asArray sort: self sortBlock. sizePad := (newList inject: 0 into: [:mx :entry | mx max: entry fileSize]) asStringWithCommas size - 1. ^newList collect: [ :e | self fileNameFormattedFrom: e sizePad: sizePad ]! !!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'!morphicViewGeneralLoaderInWorld: aWorld"FileList2 morphicViewGeneralLoaderInWorld: self currentWorld" | window aFileList buttons treePane textColor1 fileListPane pane2a pane2b fileTypeInfo fileTypeButtons fileTypeRow actionRow | fileTypeInfo := self endingSpecs. window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new directory: FileDirectory default. aFileList fileSelectionBlock: self projectOnlySelectionBlock; modalView: window. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1 px; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners. fileTypeButtons := fileTypeInfo collect: [ :each | (self blueButtonText: each first textColor: Color gray inWindow: window) setProperty: #enabled toValue: true; hResizing: #shrinkWrap; useSquareCorners ]. buttons := {{'OK'. Color lightGreen}. {'Cancel'. Color lightRed}} collect: [ :each | self blueButtonText: each first textColor: textColor1 color: each second inWindow: window ]. treePane := aFileList morphicDirectoryTreePane extent: 250 px @ 300 px; retractable: false; borderWidth: 0. fileListPane := aFileList morphicFileListPane extent: 350 px @ 300 px; retractable: false; borderWidth: 0. window addARow: {window fancyText: 'Find...' translated font: Preferences standardWindowTitleFont color: textColor1}. fileTypeRow := window addARowCentered: fileTypeButtons cellInset: 2 px. actionRow := window addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second } cellInset: 2 px. window addARow: { (window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2a fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). pane2b fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35)." buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]." fileTypeButtons do: [ :each | each on: #mouseUp send: #value:value: to: [ :evt :morph | self update: actionRow in: window fileTypeRow: fileTypeRow morphUp: morph. ] ]. buttons first on: #mouseUp send: #okHit to: aFileList. buttons second on: #mouseUp send: #cancelHit to: aFileList. aFileList postOpen. window position: aWorld topLeft + (aWorld extent - window extent // 2). aFileList directoryChangeBlock: [ :newDir | self update: actionRow in: window fileTypeRow: fileTypeRow morphUp: nil. self enableTypeButtons: fileTypeButtons info: fileTypeInfo forDir: newDir. ]. aFileList directory: aFileList directory. window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window openInWorld: aWorld.! !!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'!morphicViewProjectLoader2InWorld: aWorld reallyLoad: aBoolean dirFilterType: aSymbol | window aFileList buttons treePane textColor1 fileListPane pane2a pane2b treeExtent filesExtent | window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new. aFileList optionalButtonSpecs: aFileList servicesForProjectLoader; fileSelectionBlock: ( aSymbol == #limitedSuperSwikiDirectoryList ifTrue: [ MessageSend receiver: Project current selector: #latestProjectVersionsFromFileEntries: ] ifFalse: [ self projectOnlySelectionBlock ] ); "dirSelectionBlock: self hideSqueakletDirectoryBlock;" modalView: window. aFileList directory: FileDirectory default. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1 px; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners. buttons := {{'OK'. Color lightGreen}. {'Cancel'. Color lightRed}} collect: [ :each | self blueButtonText: each first textColor: textColor1 color: each second inWindow: window ]. aWorld width < 800 px ifTrue: [ treeExtent := 150 px @ 300 px. filesExtent := 350 px @ 300 px. ] ifFalse: [ treeExtent := 350 px @ 500 px. filesExtent := 550 px @500 px. ]. (treePane := aFileList morphicDirectoryTreePaneFiltered: aSymbol) extent: treeExtent; retractable: false; borderWidth: 0. fileListPane := aFileList morphicFileListPane extent: filesExtent; retractable: false; borderWidth: 0. window addARow: { window fancyText: 'Load A Project' translated font: Preferences standardWindowTitleFont color: textColor1 }; addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second }; addARow: { window fancyText: 'Please select a project' translated font: Preferences standardButtonFont color: textColor1 }; addARow: { (window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2a fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). pane2b fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35)." buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]." buttons first on: #mouseUp send: (aBoolean ifTrue: [#okHitForProjectLoader] ifFalse: [#okHit]) to: aFileList. buttons second on: #mouseUp send: #cancelHit to: aFileList. aFileList postOpen. window position: aWorld topLeft + (aWorld extent - window extent // 2). window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window openInWorld: aWorld.! !!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'!morphicViewProjectSaverFor: aProject"(FileList2 morphicViewProjectSaverFor: Project current) openInWorld" | window aFileList buttons treePane pane2 textColor1 option treeExtent buttonData buttonRow | textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new directory: ServerDirectory projectDefaultDirectory. aFileList dirSelectionBlock: self hideSqueakletDirectoryBlock. window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. aFileList modalView: window. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners. buttonData := Preferences enableLocalSave ifTrue: [{ {'Save'. #okHit. 'Save in the place specified below, and in the Squeaklets folder on your local disk'. Color lightGreen}. {'Save on local disk only'. #saveLocalOnlyHit. 'saves in the Squeaklets folder'. Color lightGreen}. {'Cancel'. #cancelHit. 'return without saving'. Color lightRed} }] ifFalse: [{ {'Save'. #okHit. 'Save in the place specified below, and in the Squeaklets folder on your local disk'. Color lightGreen}. {'Cancel'. #cancelHit. 'return without saving'. Color lightRed} }]. buttons := buttonData collect: [ :each | (self blueButtonText: each first textColor: textColor1 color: each fourth inWindow: window) setBalloonText: each third translated; hResizing: #shrinkWrap; on: #mouseUp send: each second to: aFileList ]. option := aProject world valueOfProperty: #SuperSwikiPublishOptions ifAbsent: [#initialDirectoryList]. aProject world removeProperty: #SuperSwikiPublishOptions. treeExtent := Project current world height < 500 px ifTrue: [ 350 px @ 150 px ] ifFalse: [ 350 px @ 300 px ]. (treePane := aFileList morphicDirectoryTreePaneFiltered: option) extent: treeExtent; retractable: false; borderWidth: 0. window addARowCentered: { window fancyText: 'Publish This Project' translated font: Preferences standardWindowTitleFont color: textColor1 }. buttonRow := OrderedCollection new. buttons do: [:button | buttonRow add: button] separatedBy: [buttonRow add: ((Morph new extent: 30 px @ 5 px) color: Color transparent)]." addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second. (Morph new extent: 30 px@ 5 px) color: Color transparent. buttons third };" window addARowCentered: buttonRow; addARowCentered: { (window inAColumn: {(ProjectViewMorph on: aProject) lock}) layoutInset: 4 px}; addARowCentered: { window fancyText: 'Please select a folder' translated font: Preferences standardButtonFont color: textColor1 }; addARow: { ( window inAColumn: { (pane2 := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) } ) layoutInset: 10 px }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2 fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35)." buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]." window morphicLayerNumber: window class dialogLayer. aFileList postOpen. window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window ! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:52'!defaultsQuadsDefiningStackToolsFlap "Answer a structure defining the items on the default system Stack Tools flap. previously in quadsDefiningStackToolsFlap" ^ { {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}. {#StackMorph. #stackHelpWindow. 'Stack Help' translatedNoop. 'Some hints about how to use Stacks' translatedNoop}. {#TextMorph . #authoringPrototype. 'Simple Text' translatedNoop. 'Text that you can edit into anything you wish' translatedNoop}. {#TextMorph . #fancyPrototype. 'Fancy Text' translatedNoop. 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop}. {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}. {#StackMorph. #previousCardButton. 'Previous Card' translatedNoop. 'A button that takes the user to the previous card in the stack' translatedNoop}. {#StackMorph. #nextCardButton. 'Next Card' translatedNoop. 'A button that takes the user to the next card in the stack' translatedNoop} } asOrderedCollection! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:52'!defaultsQuadsDefiningSuppliesFlap "Answer a list of quads which define the objects to appear in the default Supplies flap. previously in quadsDefiningSuppliesFlap" ^ { {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}. {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}. {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}. {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}. {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}. {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}. {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}. {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}. {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}. {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}. {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}. {#TabbedPalette. #authoringPrototype. 'TabbedPalette' translatedNoop. 'A structure with tabs' translatedNoop}. {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}. {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}. {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}. {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}} asOrderedCollection! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 14:38'!defaultsQuadsDefiningToolsFlap "Answer a structure defining the default Tools flap. previously in quadsDefiningToolsFlap" ^ OrderedCollection new addAll: #( (Browser prototypicalToolWindow 'Browser' 'A Browser is a tool that allows you to view all the code of all the classes in the system') (TranscriptStream openMorphicTranscript 'Transcript' 'A Transcript is a window usable for logging and debugging; browse references to #Transcript for examples of how to write to it.') (Workspace prototypicalToolWindow 'Workspace' 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.')); add: { FileList2 . #prototypicalToolWindow. 'File List'. 'A File List is a tool for browsing folders and files on disks and FTP servers.' }; addAll: #( (DualChangeSorter prototypicalToolWindow 'Change Sorter' 'Shows two change sets side by side') (SelectorBrowser prototypicalToolWindow 'Method Finder' 'A tool for discovering methods by providing sample values for arguments and results') (MessageNames prototypicalToolWindow 'Message Names' 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.') (PreferencesBrowser prototypicalToolWindow 'Preferences' 'Allows you to control numerous options') (Utilities recentSubmissionsWindow 'Recent' 'A message browser that tracks the most recently-submitted methods') (ProcessBrowser prototypicalToolWindow 'Processes' 'A Process Browser shows you all the running processes') (PackagePaneBrowser prototypicalToolWindow 'Packages' 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"') (ChangeSorter prototypicalToolWindow 'Change Set' 'A tool that allows you to view and manipulate all the code changes in a single change set')); yourself! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:53'!defaultsQuadsDefiningWidgetsFlap "Answer a structure defining the default Widgets flap. previously in quadsDefiningWidgetsFlap" ^ #( (TrashCanMorph new 'Trash' 'A tool for discarding objects') (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there') (GeeMailMorph new 'Gee-Mail' 'A place to present annotated content') (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.') (FrameRateMorph authoringPrototype 'FrameRate' 'An indicator of how fast your system is running') (MagnifierMorph newRound 'Magnifier' 'A magnifying glass') (ObjectsTool newStandAlone 'ObjectCatalog' 'A tool that lets you browse the catalog of objects') ) asOrderedCollection! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:50'!initializeFlapsQuads "initialize the list of dynamic flaps quads. self initializeFlapsQuads" FlapsQuads := nil. self registeredFlapsQuads at: 'Stack Tools' put: self defaultsQuadsDefiningStackToolsFlap; at: 'Supplies' put: self defaultsQuadsDefiningSuppliesFlap; at: 'Tools' put: self defaultsQuadsDefiningToolsFlap; at: 'Widgets' put: self defaultsQuadsDefiningWidgetsFlap. ^ self registeredFlapsQuads! !!Flaps class methodsFor: 'new flap' stamp: 'mt 8/4/2023 14:02'!addLocalFlap: anEvent titled: title onEdge: edge | flapTab menu world | flapTab := self newFlapTitled: title onEdge: edge. (world := anEvent hand world) addMorphFront: flapTab. menu := flapTab buildHandleMenu: anEvent hand. flapTab addTitleForHaloMenu: menu. flapTab computeEdgeFraction. menu popUpEvent: anEvent in: world.! !!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 8/10/2023 11:29'!addStandardFlaps "Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed. " SharedFlapTabs ifNil: [SharedFlapTabs := OrderedCollection new]. SharedFlapTabs add: self newSqueakFlap. SharedFlapTabs add: self newSuppliesFlap. SharedFlapTabs add: self newToolsFlap. SharedFlapTabs add: self newWidgetsFlap. SharedFlapTabs add: self newStackToolsFlap. Preferences showProjectNavigator ifTrue:[SharedFlapTabs add: self newNavigatorFlap]. SharedFlapTabs add: self newObjectsFlap. self disableGlobalFlapWithID: 'Stack Tools' translated. Preferences showProjectNavigator ifTrue:[self disableGlobalFlapWithID: 'Navigator' translated]. ^ SharedFlapTabs! !!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 7/31/2023 11:11'!newSqueakFlap "Answer a new default 'Squeak' flap for the left edge of the screen" | aFlap aFlapTab aButton aClock buttonColor anOffset bb aFont | aFlap := PasteUpMorph newSticky borderWidth: 0. aFlapTab := FlapTab new referent: aFlap. aFlapTab setName: 'Squeak' translated edge: #left color: Color brown lighter lighter. aFlapTab position: (0 @ ((Display height - aFlapTab height) // 2)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. aFlap cellInset: 14@14. aFlap beFlap: true. aFlap color: (Color brown muchLighter lighter "alpha: 0.3"). aFlap extent: 150 @ self currentWorld height. aFlap layoutPolicy: TableLayout new. aFlap wrapCentering: #topLeft. aFlap layoutInset: 2. aFlap listDirection: #topToBottom. aFlap wrapDirection: #leftToRight. "self addProjectNavigationButtonsTo: aFlap." anOffset := 16. aClock := ClockMorph newSticky. aClock color: Color red. aClock showSeconds: false. aClock font: (TextStyle default fontAt: 3). aClock step. aClock setBalloonText: 'The time of day. If you prefer to see seconds, check out my menu.' translated. aFlap addCenteredAtBottom: aClock offset: anOffset. buttonColor := Color cyan muchLighter. bb := SimpleButtonMorph new target: Smalltalk. bb color: buttonColor. aButton := bb copy. aButton actionSelector: #saveSession. aButton setBalloonText: 'Make a complete snapshot of the current state of the image onto disk.' translated. aButton label: 'save' translated font: (aFont := Preferences standardButtonFont). aFlap addCenteredAtBottom: aButton offset: anOffset. aButton := bb copy target: MCMcmUpdater. aButton actionSelector: #updateFromServer. aButton label: 'load code updates' translated font: aFont. aButton color: buttonColor. aButton setBalloonText: 'Check the Squeak server for any new code updates, and load any that are found.' translated. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton := SimpleButtonMorph new target: Smalltalk; actionSelector: #aboutThisSystem; label: 'about this system' translated font: aFont. aButton color: buttonColor. aButton setBalloonText: 'click here to find out version information' translated. aFlap addCenteredAtBottom: aButton offset: anOffset. aFlap addCenteredAtBottom: (Preferences themeChoiceButtonOfColor: buttonColor font: aFont) offset: anOffset. aButton := TrashCanMorph newSticky. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton startStepping. ^ aFlapTab"Flaps replaceGlobalFlapwithID: 'Squeak' translated "! !!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 8/28/2023 14:29'!newSuppliesFlapFromQuads: quads positioning: positionSymbol "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen. Use #center as the positionSymbol to have it centered at the bottom of the screen, or #right to have it placed off near the right edge." | aFlapTab aStrip hPosition | aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: quads. "self twiddleSuppliesButtonsIn: aStrip." aFlapTab := FlapTab new referent: aStrip beSticky. aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter. hPosition := positionSymbol == #center ifTrue: [(Display width // 2) - (aFlapTab width // 2)] ifFalse: [Display width - (aFlapTab width + 22)]. aFlapTab position: (hPosition @ (self currentWorld height - aFlapTab height)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. aStrip extent: self currentWorld width @ 136. aStrip beFlap: true. aStrip autoLineLayout: true. ^ aFlapTab"Flaps replaceGlobalFlapwithID: 'Supplies' translated"! !!Flaps class methodsFor: 'replacement' stamp: 'mt 8/4/2023 15:19'!replaceGlobalFlapwithID: flapID "If there is a global flap with flapID, replace it with an updated one." | replacement tabs | (tabs := self globalFlapTabsWithID: flapID) size = 0 ifTrue: [^ self]. tabs do: [:tab | self removeFlapTab: tab keepInList: false]. flapID = 'Stack Tools' translated ifTrue: [replacement := self newStackToolsFlap]. flapID = 'Supplies' translated ifTrue: [replacement := self newSuppliesFlap]. flapID = 'Tools' translated ifTrue: [replacement := self newToolsFlap]. flapID = 'Widgets' translated ifTrue: [replacement := self newWidgetsFlap]. flapID = 'Navigator' translated ifTrue: [replacement := self newNavigatorFlap]. flapID = 'Squeak' translated ifTrue: [replacement := self newSqueakFlap]. replacement ifNil: [^ self]. self addGlobalFlap: replacement. self currentWorld ifNotNil: [self currentWorld addGlobalFlaps]"Flaps replaceFlapwithID: 'Widgets' translated "! !!FontSubstitutionDuringLoading methodsFor: 'accessing' stamp: 'mt 8/11/2023 13:59'!defaultAction familyName ifNil: [ familyName := 'NoName' ]. pixelSize ifNil: [ pixelSize := 12 ]. ^((familyName beginsWith: 'Comic') ifTrue: [ TextStyle named: (Preferences standardDefaultTextFont familyName) ] ifFalse: [ TextStyle default ]) fontOfSize: pixelSize.! !!Form methodsFor: 'converting' stamp: 'mt 8/16/2023 16:54'!blendColor: aTranslucentColor | form canvas | form := self deepCopy asFormOfDepth: 32. canvas := form getCanvas. canvas stencil: form at: 0 @ 0 sourceRect: (0 @ 0 extent: form extent) color: aTranslucentColor. ^ canvas form! !!Form methodsFor: 'scaling, rotation' stamp: 'sw 4/16/2008 00:13'!scaledToHeight: newHeight "Answer the receiver, scaled such that it has the desired height." newHeight = self height ifTrue: [^ self]. ^self magnify: self boundingBox by: (newHeight / self height) smoothing: 2.! !!Form methodsFor: 'scaling, rotation' stamp: 'ct 9/17/2019 18:50'!scaledToWidth: newWidth "Answer the receiver, scaled such that it has the desired width." newWidth = self width ifTrue: [^ self]. ^self magnify: self boundingBox by: (newWidth / self width) smoothing: 2.! !!Form class methodsFor: '*MorphicExtras-examples' stamp: 'mt 8/14/2023 16:21'!gridFormExample "Original was in Morph
#setStandardTexture and #textureParameters and #makeGraphPaperGrid:... Morph new color: Form gridFormExample; extent: 500@500; openInHand " ^ self gridFormOrigin: 0@0 grid: 16 px background: Color black line: Color lightGreen lighter lighter ! !!Form class methodsFor: '*MorphicExtras-sprites' stamp: 'mt 8/14/2023 16:20'!gridFormOrigin: origin grid: smallGrid background: backColor line: lineColor | bigGrid gridForm gridOrigin | gridOrigin := origin \ smallGrid. bigGrid := (smallGrid asPoint x) @ (smallGrid asPoint y). gridForm := Form extent: bigGrid depth: Display depth. backColor ifNotNil: [gridForm fillWithColor: backColor]. gridOrigin x to: gridForm width by: smallGrid asPoint x do: [:x | gridForm fill: (x@0 extent: 1@gridForm height) fillColor: lineColor]. gridOrigin y to: gridForm height by: smallGrid asPoint y do: [:y | gridForm fill: (0@y extent: gridForm width@1) fillColor: lineColor].
^ InfiniteForm with: gridForm! !!GetTextExporter class methodsFor: 'utilities' stamp: 'mt 8/4/2023 13:49'!listAllHelp "self listAllHelp" | spec specs oCatalog flap flapSelectors allKeys oCatalogHelp flapHelp | oCatalog := Dictionary new. Morph withAllSubclasses do: [:aClass | (aClass class includesSelector: #descriptionForPartsBin) ifTrue: [spec := aClass descriptionForPartsBin. oCatalog at: spec formalName put: spec documentation]]. Morph withAllSubclasses do: [:aClass | (aClass class includesSelector: #supplementaryPartsDescriptions) ifTrue: [specs := aClass supplementaryPartsDescriptions. specs do: [:each | oCatalog at: each formalName put: each documentation]]]. flap := Dictionary new. flapSelectors := #( #defaultsQuadsDefiningStackToolsFlap #defaultsQuadsDefiningSuppliesFlap #defaultsQuadsDefiningToolsFlap #defaultsQuadsDefiningWidgetsFlap ). flapSelectors do: [:selector | specs := Flaps perform: selector. specs do: [:each | flap at: each third put: each fourth]]. allKeys := oCatalog keys intersection: flap keys. allKeys asArray sort do: [:each | oCatalogHelp := oCatalog at: each ifAbsent: ['']. flapHelp := flap at: each ifAbsent: ['']. oCatalogHelp = flapHelp ifFalse: [Transcript cr; show: 'Name: ' , each. Transcript cr; show: 'O: ' , oCatalogHelp. Transcript cr; show: 'F: ' , flapHelp. Transcript cr.]]! !!ImageSegment methodsFor: 'fileIn' stamp: 'mt 8/16/2023 16:51'!declareAndPossiblyRename: classThatIsARoot | existing catInstaller | "The class just arrived in this segment. How fit it into the Smalltalk dictionary? If it had an association, that was installed with associationDeclareAt:." catInstaller := [ classThatIsARoot category: Object categoryForUniclasses. ]. classThatIsARoot superclass addSubclass: classThatIsARoot. (Smalltalk includesKey: classThatIsARoot name) ifFalse: [ "Class entry in Smalltalk not referred to in Segment, install anyway." catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. existing := Smalltalk at: classThatIsARoot name. existing xxxClass == ImageSegmentRootStub ifTrue: [ "We are that segment!! Must ask it carefully!!" catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. existing == false | (existing == nil) ifTrue: [ "association is in outPointers, just installed" catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. "Conflict with existing global or copy of the class" (existing isKindOf: Class) ifTrue: [ classThatIsARoot isSystemDefined not ifTrue: [ "UniClass. give it a new name" classThatIsARoot setName: MorphicModel chooseUniqueClassName. catInstaller value. "must be after new name" ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. "Take the incoming one" self inform: 'Using newly arrived version of ', classThatIsARoot name. classThatIsARoot superclass removeSubclass: classThatIsARoot. "just in case" (Smalltalk at: classThatIsARoot name) becomeForward: classThatIsARoot. catInstaller value. ^ classThatIsARoot superclass addSubclass: classThatIsARoot]. self error: 'Name already in use by a non-class: ', classThatIsARoot name.! !!ImageSegment class methodsFor: 'fileIn/Out' stamp: 'mt 8/28/2023 15:10'!copyFromRootsLocalFileFor: rootArray sizeHint: segSize ^ NativeImageSegment new copyFromRootsLocalFileFor: rootArray sizeHint: segSize! !!Inspector methodsFor: 'menu' stamp: 'mt 8/28/2023 14:33'!inspectorKey: aChar from: view "Respond to a Command key issued while the cursor is over my field list" ^ aChar caseOf: { [$x] -> [self removeSelection]. [$i] -> [self inspectSelection]. [$I] -> [self exploreSelection]. [$b] -> [self browseClass]. [$h] -> [self browseClassHierarchy]. [$p] -> [self browseFullProtocol]. [$r] -> [self browseVariableReferences]. [$a] -> [self browseVariableAssignments]. [$N] -> [self browseClassRefs]. [$c] -> [self copyName] } otherwise: [self arrowKey: aChar from: view]! !!Inspector methodsFor: 'menu' stamp: 'mt 3/10/2023 15:12'!mainFieldListMenu: aMenu "Arm the supplied menu with items for the field-list of the receiver" <fieldListMenu> aMenu addStayUpItemSpecial. self addObjectItemsTo: aMenu. (#(self ellipsis element nil) includes: self typeOfSelection) ifTrue: [self addCollectionItemsTo: aMenu]. self typeOfSelection = #instVar ifTrue: [self addInstVarItemsTo: aMenu]. self addFieldItemsTo: aMenu. self addClassItemsTo: aMenu. ^ aMenu! !!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 7/31/2023 10:45'!formAtKey: aString "Answer the form saved under the given key" ^(Symbol lookup: aString) ifNotNil: [ :aKey | ScriptingIcons at: aKey ifAbsent: [ self blankIcon ] ] ifNil: [ self blankIcon ]! !!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:08'!formPressedAtKey: aSymbol "Answer the form for pressed button. It is automatically generated if unavailable." "(ScriptingSystem formPressedAtKey: #TryIt) asMorph openInHand" | pressedName pressedImage | pressedName := (aSymbol , 'Pressed') asSymbol. ((ScriptingIcons includesKey: aSymbol) and: [(ScriptingIcons includesKey: pressedName) not]) ifTrue: [pressedImage := ((self formAtKey: aSymbol) blendColor: (Color black alpha: 0.3)) colorReduced. ScriptingIcons at: pressedName put: pressedImage]. ^ self formAtKey: pressedName! !!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:11'!saveForm: aForm atKey: aKey ScriptingIcons at: aKey asSymbol put: aForm! !!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:05'!scriptingIcons ^ ScriptingIcons ifNil: [ScriptingIcons := IdentityDictionary new]! !!MessageSet methodsFor: 'filtering' stamp: 'mt 8/28/2023 15:11'!filterMessageList "Allow the user to refine the list of messages." | builder menuSpec | builder := ToolBuilder default. menuSpec := builder pluggableMenuSpec new model: self; yourself. menuSpec addList: #( ('unsent messages' filterToUnsentMessages 'filter to show only messages that have no senders') - ('messages that send...' filterToSendersOf 'filter to show only messages that send a selector I specify') ('messages that do not send...' filterToNotSendersOf 'filter to show only messages that do not send a selector I specify') - ('messages whose selector is...' filterToImplementorsOf 'filter to show only messages with a given selector I specify') ('messages whose selector is NOT...' filterToNotImplementorsOf 'filter to show only messages whose selector is NOT a seletor I specify') - ('messages in current change set' filterToCurrentChangeSet 'filter to show only messages that are in the current change set') ('messages not in current change set' filterToNotCurrentChangeSet 'filter to show only messages that are not in the current change set') - ('messages in any change set' filterToAnyChangeSet 'filter to show only messages that occur in at least one change set') ('messages not in any change set' filterToNotAnyChangeSet 'filter to show only messages that do not occur in any change set in the system') - ('messages authored by me' filterToCurrentAuthor 'filter to show only messages whose authoring stamp has my initials') ('messages not authored by me' filterToNotCurrentAuthor 'filter to show only messages whose authoring stamp does not have my initials') - ('messages logged in .changes file' filterToMessagesInChangesFile 'filter to show only messages whose latest source code is logged in the .changes file') ('messages only in .sources file' filterToMessagesInSourcesFile 'filter to show only messages whose latest source code is logged in the .sources file') - ('messages with prior versions' filterToMessagesWithPriorVersions 'filter to show only messages that have at least one prior version') ('messages without prior versions' filterToMessagesWithoutPriorVersions 'filter to show only messages that have no prior versions') - ('uncommented messages' filterToUncommentedMethods 'filter to show only messages that do not have comments at the beginning') ('commented messages' filterToCommentedMethods 'filter to show only messages that have comments at the beginning') - ('messages in hardened classes' filterToMessagesWithHardenedClasses 'filter to show only messages of established classes (as opposed to Uniclasses such as MorphicModel23)') - ('methods in classes with matching names' filterToMatchingClassesNames 'filter to show only methods of classes with names that match the given criteria (wildcards are allowed)') ('methods in package...' filterToPackage 'filter to show only methods of a given package') ('methods not in package...' filterToNotPackage 'filter to show only methods not of a given package') - ('messages that...' filterToMessagesThat 'let me type in a block taking a class and a selector, which will specify yea or nay concerning which elements should remain in the list')). builder runModal: (builder open: menuSpec).! !!Lexicon methodsFor: 'toolbuilder' stamp: 'mt 7/31/2023 11:13'!addSpecialButtonsTo: buttonPanelSpec with: builder | homeCatBtnSpec menuBtnSpec mostGenericBtnSpec | homeCatBtnSpec := builder pluggableButtonSpec new model: self; action: #showHomeCategory; label: MenuIcons smallHomeIcon scaleIconToDisplay; help: 'show this method''s home category'; yourself. menuBtnSpec := builder pluggableButtonSpec new model: self; action: #offerMenu; label: (MenuIcons formAtKey: #TinyMenu) asMorph; help: 'click here to get a menu with further options'; yourself. mostGenericBtnSpec :=builder pluggableButtonSpec new model: self; action: #chooseLimitClass; label: #limitClassString; help: 'Governs which classes'' methods should be shown. If this is the same as the viewed class, then only methods implemented in that class will be shown. If it is ProtoObject, then methods of all classes in the vocabulary will be shown.'. buttonPanelSpec children add: homeCatBtnSpec; addFirst: mostGenericBtnSpec; addFirst: menuBtnSpec.! !!InstanceBrowser methodsFor: 'menu commands' stamp: 'mt 8/16/2023 16:52'!offerMenu "Offer a menu to the user, in response to the hitting of the menu button on the tool pane" | aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu title: ('Messages of {1}' translated format: {objectViewed nameForViewer}). aMenu addStayUpItem. aMenu addTranslatedList: #( ('vocabulary...' chooseVocabulary) ('what to show...' offerWhatToShowMenu) - ('inst var refs (here)' setLocalInstVarRefs) ('inst var defs (here)' setLocalInstVarDefs) ('class var refs (here)' setLocalClassVarRefs) - ('navigate to a sender...' navigateToASender) ('recent...' navigateToRecentMethod) ('show methods in current change set' showMethodsInCurrentChangeSet) ('show methods with initials...' showMethodsWithInitials) - "('toggle search pane' toggleSearch)" - - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' browseClassHierarchy) ('browse protocol (p)' browseFullProtocol) - ('fileOut' fileOutMessage) ('printOut' printOutMessage) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('versions (v)' browseVersions) ('inheritance (i)' methodHierarchy) - ('references... (r)' browseVariableReferences) ('assignments... (a)' browseVariableAssignments) - ('inspector on me' inspectViewee) - ('more...' shiftedYellowButtonActivity)). ^ aMenu popUpInWorld: self currentWorld! !!MethodCall methodsFor: 'initialization' stamp: 'mt 8/28/2023 14:54'!receiver: aReceiver methodInterface: aMethodInterface "Initialize me to have the given receiver and methodInterface" receiver := aReceiver. selector := aMethodInterface selector. methodInterface := aMethodInterface. arguments := aMethodInterface defaultArguments. lastValue := nil.! !!MethodFinder methodsFor: 'initialize' stamp: 'mt 3/10/2023 15:58'!initialize "The methods we are allowed to use. (MethodFinder new initialize) " Approved := Set new. AddAndRemove := Set new. Blocks := Set new. "These modify an argument and are not used by the MethodFinder: longPrintOn: printOn: storeOn: sentTo: storeOn:base: printOn:base: absPrintExactlyOn:base: absPrintOn:base: absPrintOn:base:digitCount: writeOn: writeScanOn: possibleVariablesFor:continuedFrom: printOn:format:""Object" #("in class, instance creation" categoryForUniclasses chooseUniqueClassName initialInstance isSystemDefined newFrom: officialClass readCarefullyFrom:"accessing" at: basicAt: basicSize bindWithTemp: in: size yourself "testing" basicType ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: isColor isFloat isFraction isInMemory isInteger isMorph isNil isNumber isPoint isText isTransparent isWebBrowser knownName notNil pointsTo: wantsSteps "comparing" = == closeTo: hash identityHash identityHashPrintString ~= ~~ "copying" copy shallowCopy "dependents access" canDiscardEdits dependents hasUnacceptedEdits "updating" changed changed: okToChange update: windowIsClosing "printing" fullPrintString isLiteral longPrintString printString storeString stringForReadout stringRepresentation "class membership" class isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass "error handling" "user interface" addModelMenuItemsTo:forMorph:hand: defaultLabelForInspector fullScreenSize initialExtent modelWakeUp mouseUpBalk: newTileMorphRepresentative windowActiveOnFirstClick windowReqNewLabel: "system primitives" asOop instVarAt: instVarNamed: "private" "associating" -> "converting" as: asOrderedCollection asString "casing" caseOf: caseOf:otherwise: "binding" bindingOf: "macpal" contentsChanged currentEvent currentHand currentWorld flash instanceVariableValues "flagging" flag: "translation support" "objects from disk" "finalization" ) do: [:sel | Approved add: sel]. #(at:add: at:modify: at:put: basicAt:put: "NOT instVar:at:""message handling" perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: ) do: [:sel | AddAndRemove add: sel]."Boolean, True, False, UndefinedObject" #("logical operations" & eqv: not xor: |"controlling" and: ifFalse: ifFalse:ifTrue: ifTrue: ifTrue:ifFalse: or:"copying" "testing" isEmptyOrNil) do: [:sel | Approved add: sel]."Behavior" #("initialize-release""accessing" compilerClass decompilerClass evaluatorClass format methodDict parserClass sourceCodeTemplate subclassDefinerClass"testing" instSize instSpec isBits isBytes isFixed isPointers isVariable isWeak isWords"copying""printing" printHierarchy"creating class hierarchy""creating method dictionary""instance creation" basicNew basicNew: new new:"accessing class hierarchy" allSubclasses allSubclassesWithLevelDo:startingLevel: allSuperclasses subclasses superclass withAllSubclasses withAllSuperclasses"accessing method dictionary" allSelectors changeRecordsAt: compiledMethodAt: compiledMethodAt:ifAbsent: firstCommentAt: lookupSelector: selectors selectorsDo: selectorsWithArgs: "slow but useful ->" sourceCodeAt: sourceCodeAt:ifAbsent: sourceMethodAt: sourceMethodAt:ifAbsent:"accessing instances and variables" allClassVarNames allInstVarNames allSharedPools classVarNames instVarNames instanceCount sharedPools someInstance subclassInstVarNames"testing class hierarchy" inheritsFrom: kindOfSubclass"testing method dictionary" canUnderstand: classThatUnderstands: hasMethods includesSelector: whichClassIncludesSelector: whichSelectorsAccess: whichSelectorsReferTo: whichSelectorsReferTo:special:byte: whichMethodsStoreInto:"enumerating""user interface") do: [:sel | Approved add: sel]."ClassDescription" #("initialize-release" "accessing" classVersion isMeta name theNonMetaClass"copying" "printing" classVariablesString instanceVariablesString sharedPoolsString"instance variables" checkForInstVarsOK: "method dictionary" "organization" category organization whichCategoryIncludesSelector:"compiling" acceptsLoggingOfCompilation wantsChangeSetLogging"fileIn/Out" definition"private" ) do: [:sel | Approved add: sel]."Class" #("initialize-release" "accessing" classPool"testing""copying" "class name" "instance variables" "class variables" classVarAt: classVariableAssociationAt:"pool variables" "compiling" "subclass creation" "fileIn/Out" ) do: [:sel | Approved add: sel]. "Metaclass" #("initialize-release" "accessing" isSystemDefined soleInstance"copying" "instance creation" "instance variables" "pool variables" "class hierarchy" "compiling""fileIn/Out" nonTrivial ) do: [:sel | Approved add: sel]."Context, BlockContext" #(receiver client method receiver tempAt: "debugger access" pc selector sender shortStack sourceCode tempNames tempsAndValues"controlling" "printing" "system simulation" "initialize-release" "accessing" hasMethodReturn home numArgs"evaluating" value value:ifError: value:value: value:value:value: value:value:value:value: valueWithArguments:"controlling" "scheduling" "instruction decoding" "printing" "private" "system simulation" ) do: [:sel | Approved add: sel]. #(value: "<- Association has it as a store" ) do: [:sel | AddAndRemove add: sel]."Message" #("inclass, instance creation" selector: selector:argument: selector:arguments:"accessing" argument argument: arguments sends:"printing" "sending" ) do: [:sel | Approved add: sel]. #("private" setSelector:arguments:) do: [:sel | AddAndRemove add: sel]."Magnitude" #("comparing" < <= > >= between:and:"testing" max: min: min:max: ) do: [:sel | Approved add: sel]."Date, Time" #("in class, instance creation" fromDays: fromSeconds: fromString: newDay:month:year: newDay:year: today "in class, general inquiries" dateAndTimeNow dayOfWeek: daysInMonth:forYear: daysInYear: firstWeekdayOfMonth:year: indexOfMonth: leapYear: nameOfDay: nameOfMonth:"accessing" day leap monthIndex monthName weekday year"arithmetic" addDays: subtractDate: subtractDays:"comparing""inquiries" dayOfMonth daysInMonth daysInYear daysLeftInYear firstDayOfMonth previous:"converting" asSeconds"printing" mmddyyyy printFormat: "private" weekdayIndex "in class, instance creation" fromSeconds: now "in class, general inquiries" dateAndTimeFromSeconds: dateAndTimeNow millisecondClockValue millisecondsToRun: totalSeconds"accessing" hours minutes seconds"arithmetic" addTime: subtractTime:"comparing""printing" intervalString print24 "converting") do: [:sel | Approved add: sel]. #("private" ) do: [:sel | AddAndRemove add: sel]."Number" #("in class" readFrom:base: "arithmetic" * + - / // \ abs negated quo: reciprocal rem:"mathematical functions" arcCos arcSin arcTan arcTan: cos exp floorLog: ln log log: raisedTo: raisedToInteger: sin sqrt squared tan"truncation and round off" ceiling detentBy:atMultiplesOf:snap: floor roundTo: roundUpTo: rounded truncateTo: truncated"comparing""testing" even isDivisibleBy: isInfinite isNaN isZero negative odd positive sign strictlyPositive"converting" @ asInteger asNumber asPoint asSmallAngleDegrees degreesToRadians radiansToDegrees"intervals" to: to:by: "printing" printStringBase: storeStringBase: ) do: [:sel | Approved add: sel]."Integer" #("in class" primesUpTo:"testing" isPowerOfTwo"arithmetic" alignedTo:"comparing""truncation and round off" atRandom normalize"enumerating" timesRepeat:"mathematical functions" degreeCos degreeSin factorial gcd: lcm: take:"bit manipulation" << >> allMask: anyMask: bitAnd: bitClear: bitInvert bitInvert32 bitOr: bitShift: bitXor: lowBit noMask:"converting" asCharacter asColorOfDepth: asFloat asFraction asHexDigit"printing" asStringWithCommas hex hex8 radix:"system primitives" lastDigit replaceFrom:to:with:startingAt:"private" "benchmarks" ) do: [:sel | Approved add: sel]."SmallInteger, LargeNegativeInteger, LargePositiveInteger" #("arithmetic" "bit manipulation" highBit "testing" "comparing" "copying" "converting" "printing" "system primitives" digitAt: digitLength "private" fromString:radix: ) do: [:sel | Approved add: sel]. #(digitAt:put: ) do: [:sel | AddAndRemove add: sel]."Float" #("arithmetic""mathematical functions" reciprocalLogBase2 timesTwoPower:"comparing" "testing""truncation and round off" exponent fractionPart integerPart significand significandAsInteger"converting" asApproximateFraction asIEEE32BitWord asTrueFraction"copying") do: [:sel | Approved add: sel]."Fraction, Random" #(denominator numerator reduced next nextValue) do: [:sel | Approved add: sel]. #(setNumerator:denominator:) do: [:sel | AddAndRemove add: sel]."Collection" #("accessing" anyOne"testing" includes: includesAllOf: includesAnyOf: includesSubstringAnywhere: isEmpty isSequenceable occurrencesOf:"enumerating" collect: collect:thenSelect: count: detect: detect:ifNone: detectMax: detectMin: detectSum: inject:into: reject: select: select:thenCollect: intersection:"converting" asBag asCharacterSet asSet asSortedArray asSortedCollection asSortedCollection:"printing""private" maxSize"arithmetic""math functions" average max median min range sum) do: [:sel | Approved add: sel]. #("adding" add: addAll: addIfNotPresent:"removing" remove: remove:ifAbsent: removeAll: removeAllFoundIn: removeAllSuchThat: remove:ifAbsent:) do: [:sel | AddAndRemove add: sel]."SequenceableCollection" #("comparing" hasEqualElements:"accessing" allButFirst allButLast at:ifAbsent: atAll: atPin: atRandom: atWrap: fifth first fourth identityIndexOf: identityIndexOf:ifAbsent: indexOf: indexOf:ifAbsent: indexOf:startingAt:ifAbsent: indexOfSubCollection:startingAt: indexOfSubCollection:startingAt:ifAbsent: last second sixth third"removing""copying" , copyAfterLast: copyAt:put: copyFrom:to: copyReplaceAll:with: copyReplaceFrom:to:with: copyUpTo: copyUpToLast: copyWith: copyWithout: copyWithoutAll: forceTo:paddingWith: shuffled sorted:"enumerating" withIndexCollect: findFirst: findLast: pairsCollect: with:collect: withIndexCollect: polynomialEval:"converting" asArray asDictionary asFloat32Array asFloat64Array asIntegerArray asStringWithCr asWordArray reversed"private" copyReplaceAll:with:asTokens: ) do: [:sel | Approved add: sel]. #( swap:with:) do: [:sel | AddAndRemove add: sel]."ArrayedCollection, Bag" #("private" defaultElement "sorting" isSorted"accessing" cumulativeCounts sortedCounts sortedElements "testing" "adding" add:withOccurrences: "removing" "enumerating" ) do: [:sel | Approved add: sel]. #( mergeSortFrom:to:by: sort sort: add: add:withOccurrences:"private" setDictionary ) do: [:sel | AddAndRemove add: sel]."Other messages that modify the receiver" #(atAll:put: atAll:putAll: atAllPut: atWrap:put: replaceAll:with: replaceFrom:to:with: removeFirst removeLast) do: [:sel | AddAndRemove add: sel]. self initialize2."MethodFinder new initialize.MethodFinder new organizationFiltered: Set"! !!MissingFont methodsFor: 'handling' stamp: 'mt 3/7/2023 15:07'!defaultAction familyName ifNil: [ familyName := 'NoName' ]. pixelSize ifNil: [ pixelSize := 12 ]. ^((familyName beginsWith: 'Comic') ifTrue: [ TextStyle named: (Preferences standardButtonFont familyName) ] ifFalse: [ TextStyle default ]) fontOfSize: pixelSize.! !!Morph methodsFor: 'accessing' stamp: 'mt 8/11/2023 16:29'!balloonText "Answer balloon help text or nil, if no help is available." "NB: subclasses may override such that they programatically construct the text, for economy's sake, such as model phrases in a Viewer." | balloonSelector | extension ifNil: [^ nil]. extension balloonText ifNotNil: [:balloonText | ^ balloonText]. balloonSelector := extension balloonTextSelector ifNil: [^ nil]. balloonSelector isUnary ifTrue: [ (self respondsTo: balloonSelector) ifTrue: [^ self perform: balloonSelector]. (self model respondsTo: balloonSelector) ifTrue: [^ self model perform: balloonSelector]]. ^ nil! !!Morph methodsFor: 'copying' stamp: 'mt 3/10/2023 14:51'!duplicate "Make and return a duplicate of the receiver" | newMorph aName w topRend | ((topRend := self topRendererOrSelf) ~~ self) ifTrue: [^ topRend duplicate]. self okayToDuplicate ifFalse: [^ self]. aName := (w := self world) ifNotNil: [w nameForCopyIfAlreadyNamed: self]. newMorph := self veryDeepCopy. aName ifNotNil: [newMorph setNameTo: aName]. newMorph arrangeToStartStepping. newMorph privateOwner: nil. "no longer in world" newMorph isPartsDonor: false. "no longer parts donor" ^ newMorph! !!Morph methodsFor: 'debug and other' stamp: 'mt 3/10/2023 15:09'!buildDebugMenu: aHand "Answer a debugging menu for the receiver. The hand argument is seemingly historical and plays no role presently" | aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu addStayUpItem. (self hasProperty: #errorOnDraw) ifTrue: [aMenu add: 'start drawing again' translated action: #resumeAfterDrawError. aMenu addLine]. (self hasProperty: #errorOnStep) ifTrue: [aMenu add: 'start stepping again' translated action: #resumeAfterStepError. aMenu addLine]. (self hasProperty: #errorOnLayout) ifTrue: [aMenu add: 'start layouting again' translated action: #resumeAfterLayoutError. aMenu addLine]. aMenu add: 'inspect morph' translated action: #inspectInMorphic:. aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain. Smalltalk isMorphic ifFalse: [aMenu add: 'inspect morph (in MVC)' translated action: #inspect]. self isMorphicModel ifTrue: [aMenu add: 'inspect model' translated target: self model action: #inspect; add: 'explore model' translated target: self model action: #explore]. aMenu add: 'explore morph' translated target: self selector: #exploreInMorphic:. aMenu addLine. aMenu add: 'browse morph class' translated target: self selector: #browseHierarchy. (self isMorphicModel) ifTrue: [aMenu add: 'browse model class' target: self model selector: #browseHierarchy]. aMenu addLine. self addViewingItemsTo: aMenu. aMenu add: 'make own subclass' translated action: #subclassMorph; add: 'save morph in file' translated action: #saveOnFile; addLine; add: 'call #tempCommand' translated action: #tempCommand; add: 'define #tempCommand' translated action: #defineTempCommand; addLine; add: 'control-menu...' translated target: self selector: #invokeMetaMenu:; add: 'edit balloon help' translated action: #editBalloonHelpText. ^ aMenu! !!Morph methodsFor: 'debug and other' stamp: 'mt 8/16/2023 17:11'!deleteAnyMouseActionIndicators self changed. (self valueOfProperty: #mouseActionIndicatorMorphs ifAbsent: [#()]) do: [ :each | each delete "one is probably enough, but be safe" ]. self removeProperty: #mouseActionIndicatorMorphs. self hasRolloverBorder: false. self removeProperty: #rolloverWidth. self removeProperty: #rolloverColor. self layoutChanged. self changed.! !!Morph methodsFor: 'dropping/grabbing' stamp: 'mt 8/4/2023 14:49'!justDroppedInto: aMorph event: anEvent "This message is sent to a dropped morph after it has been dropped on -- and been accepted by -- a drop-sensitive morph" | partsBinCase cmd | (self formerOwner notNil and: [self formerOwner ~~ aMorph]) ifTrue: [self removeHalo]. self formerOwner: nil. self formerPosition: nil. cmd := self valueOfProperty: #undoGrabCommand. cmd ifNotNil:[aMorph rememberCommand: cmd. self removeProperty: #undoGrabCommand]. (partsBinCase := aMorph isPartsBin) ifFalse: [self isPartsDonor: false]. (self isInWorld and: [partsBinCase not]) ifTrue: [self world startSteppingSubmorphsOf: self]. "Note an unhappy inefficiency here: the startStepping... call will often have already been called in the sequence leading up to entry to this method, but unfortunately the isPartsDonor: call often will not have already happened, with the result that the startStepping... call will not have resulted in the startage of the steppage."! !!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:54'!handleMouseDown: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseDown: and #mouseDown: in your custom morphs. See #handlerForMouseDown: and #mouseDownPriority." anEvent wasHandled ifTrue:[^self]. "not interested" anEvent hand removePendingBalloonFor: self. anEvent wasHandled: true. "Make me modal during mouse transitions" anEvent hand newMouseFocus: self event: anEvent. "this mouse down could be the start of a gesture, or the end of a gesture focus" (self isGestureStart: anEvent) ifTrue: [^ self gestureStart: anEvent]. self mouseDown: anEvent. (self handlesMouseStillDown: anEvent) ifTrue:[ self startStepping: #handleMouseStillDown: at: Time millisecondClockValue + self mouseStillDownThreshold arguments: {anEvent copy resetHandlerFields} stepTime: self mouseStillDownStepRate ].! !!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:54'!handleMouseEnter: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseOver: and #mouseEnter: in your custom morphs. Also see/use #handlesMouseOverDragging: and #mouseEnterDragging:." (anEvent isDraggingEvent) ifTrue:[ (self handlesMouseOverDragging: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseEnterDragging: anEvent]. ^self]. self wantsBalloon ifTrue:[anEvent hand triggerBalloonFor: self after: self balloonHelpDelayTime]. (self handlesMouseOver: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseEnter: anEvent. ].! !!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:55'!handleMouseLeave: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseOver: and #mouseLeave: in your custom morphs. Also see/use #handlesMouseOverDragging: and #mouseLeaveDragging:." anEvent hand removePendingBalloonFor: self. anEvent isDraggingEvent ifTrue:[ (self handlesMouseOverDragging: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseLeaveDragging: anEvent]. ^self]. (self handlesMouseOver: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseLeave: anEvent. ].! !!Morph methodsFor: 'halos and balloon help' stamp: 'mt 8/14/2023 15:59'!addHandlesTo: aHaloMorph box: box "Add halo handles to the halo. Apply the halo filter if appropriate." aHaloMorph haloBox: box. Preferences haloSpecifications do: [:aSpec | (self wantsHaloHandleWithSelector: aSpec addHandleSelector inHalo: aHaloMorph) ifTrue: [aHaloMorph perform: aSpec addHandleSelector with: aSpec]]. aHaloMorph innerTarget addOptionalHandlesTo: aHaloMorph box: box! !!Morph methodsFor: 'halos and balloon help' stamp: 'mt 8/11/2023 16:50'!balloonHelpTextForHandle: aHandle "Answer a string providing balloon help for the given halo handle" | itsSelector | itsSelector := aHandle eventHandler firstMouseSelector. itsSelector == #doRecolor:with: ifTrue: [^ 'Change color']. itsSelector == #mouseDownInDimissHandle:with: ifTrue: [^ TrashCanMorph preserveTrash ifTrue: ['Move to trash'] ifFalse: ['Remove from screen']]. #(#(#addFullHandles 'More halo handles') #(#addSimpleHandles 'Fewer halo handles') #(#chooseEmphasisOrAlignment 'Emphasis & alignment') #(#chooseFont 'Change font') #(#chooseStyle 'Change style') #(#dismiss 'Remove') #(#doDebug:with: 'Debug') #(#doDirection:with: 'Choose forward direction') #(#doDup:with: 'Duplicate') #(#doMenu:with: 'Menu') #(#doGrab:with: 'Pick up') #(#editButtonsScript 'See the script for this button') #(#editDrawing 'Repaint') #(#mouseDownInCollapseHandle:with: 'Collapse') #(#mouseDownOnHelpHandle: 'Help') #(#paintBackground 'Paint background') #(#prepareToTrackCenterOfRotation:with: 'Move object or set center of rotation') #(#presentViewMenu 'Present the Viewing menu') #(#startDrag:with: 'Move') #(#startGrow:with: 'Change size (Ctrl + drag blue button)') #(#startRot:with: 'Rotate') #(#startScale:with: 'Change scale') #(#tearOffTile 'Make a tile representing this object') #(#trackCenterOfRotation:with: 'Set center of rotation') ) do: [:pair | itsSelector == pair first ifTrue: [^ pair last]]. ^ 'unknown halo handle'translated! !!Morph methodsFor: 'menu' stamp: 'mt 8/11/2023 14:44'!addYellowButtonMenuItemsTo: aMenu event: evt "Populate aMenu with appropriate menu items for a yellow-button (context menu) click." aMenu defaultTarget: self. "" aMenu addStayUpItem. "" self addModelYellowButtonItemsTo: aMenu event: evt. "" Preferences generalizedYellowButtonMenu ifFalse: [^ self]. "" aMenu addLine. aMenu add: 'inspect' translated action: #inspect. "" aMenu addLine. self world selectedObject == self ifTrue: [aMenu add: 'deselect' translated action: #removeHalo] ifFalse: [aMenu add: 'select' translated action: #addHalo]. "" self isWorldMorph ifFalse: ["" aMenu addLine. aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: evt hand]. "" self isWorldMorph ifFalse: ["" Smalltalk at: #NCAAConnectorMorph ifPresent: [:connectorClass | aMenu addLine. aMenu add: 'connect to' translated action: #startWiring. aMenu addLine]. "" self isFullOnScreen ifFalse: [aMenu add: 'move onscreen' translated action: #goHome]]. "" self addLayoutMenuItems: aMenu hand: evt hand. (owner notNil and: [owner isTextMorph]) ifTrue: [self addTextAnchorMenuItems: aMenu hand: evt hand]. "" self isWorldMorph ifFalse: ["" aMenu addLine. self addToggleItemsToHaloMenu: aMenu]. "" aMenu addLine. self isWorldMorph ifFalse: [aMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:]. self hasStrings ifTrue: [ aMenu add: 'copy text' translated action: #clipText]. "" self addExportMenuItems: aMenu hand: evt hand. "" self isWorldMorph not ifTrue: ["" aMenu addLine. aMenu add: 'adhere to edge...' translated action: #adhereToEdge]. "" self addCustomMenuItems: aMenu hand: evt hand! !!Morph methodsFor: 'menu' stamp: 'mt 3/10/2023 16:07'!wantsYellowButtonMenu "Answer true if the receiver wants a yellow button menu" self valueOfProperty: #wantsYellowButtonMenu ifPresentDo: [:value | ^ value]. "" self isInSystemWindow ifTrue: [^ false]."" ^ Preferences generalizedYellowButtonMenu! !!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:59'!absorbStateFromRenderer: aRenderer "Transfer knownName, actorState, visible over from aRenderer, which was formerly imposed above me as a transformation shell but is now going away." | current | (current := aRenderer actorStateOrNil) ifNotNil: [self actorState: current. aRenderer actorState: nil]. (current := aRenderer knownName) ifNotNil: [self setNameTo: current. aRenderer setNameTo: nil]. self visible: aRenderer visible! !!Morph methodsFor: 'menus' stamp: 'mt 3/10/2023 14:25'!addHaloActionsTo: aMenu "Add items to aMenu representing actions requestable via halo" | subMenu | subMenu := MenuMorph new defaultTarget: self. subMenu addTitle: self externalName. subMenu addStayUpItemSpecial. subMenu addLine. subMenu add: 'delete' translated action: #dismissViaHalo. subMenu balloonTextForLastItem: 'Delete this object -- warning -- can be destructive!!' translated. self maybeAddCollapseItemTo: subMenu. subMenu add: 'grab' translated action: #openInHand. subMenu balloonTextForLastItem: 'Pick this object up -- warning, since this removes it from its container, it can have adverse effects.' translated. subMenu addLine. subMenu add: 'resize' translated action: #resizeFromMenu. subMenu balloonTextForLastItem: 'Change the size of this object' translated. subMenu add: 'duplicate' translated action: #maybeDuplicateMorph. subMenu balloonTextForLastItem: 'Hand me a copy of this object' translated. "Note that this allows access to the non-instancing duplicate even when this is a uniclass instance" subMenu addLine. subMenu add: 'set color' translated target: self renderedMorph action: #changeColor. subMenu balloonTextForLastItem: 'Change the color of this object' translated. subMenu addLine. subMenu add: 'inspect' translated target: self action: #inspect. subMenu balloonTextForLastItem: 'Open an Inspector on this object' translated. aMenu add: 'halo actions...' translated subMenu: subMenu! !!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:47'!addMiscExtrasTo: aMenu "Add a submenu of miscellaneous extra items to the menu." | realOwner realMorph subMenu | subMenu := MenuMorph new defaultTarget: self. self isWorldMorph ifFalse: [subMenu add: 'adhere to edge...' translated action: #adhereToEdge. subMenu addLine]. realOwner := (realMorph := self topRendererOrSelf) owner. (realOwner isKindOf: TextPlusPasteUpMorph) ifTrue: [subMenu add: 'GeeMail stuff...' translated subMenu: (realOwner textPlusMenuFor: realMorph)]. subMenu add: 'add mouse up action' translated action: #addMouseUpAction; add: 'remove mouse up action' translated action: #removeMouseUpAction; add: 'hand me tiles to fire this button' translated action: #handMeTilesToFire. subMenu addLine. subMenu add: 'arrowheads on pen trails...' translated action: #setArrowheads. subMenu addLine. subMenu defaultTarget: self topRendererOrSelf. subMenu add: 'draw new path' translated action: #definePath. subMenu add: 'follow existing path' translated action: #followPath. subMenu add: 'delete existing path' translated action: #deletePath. subMenu addLine. self addGestureMenuItems: subMenu hand: self currentHand. aMenu add: 'extras...' translated subMenu: subMenu! !!Morph methodsFor: 'menus' stamp: 'mt 8/16/2023 15:58'!addStandardHaloMenuItemsTo: aMenu hand: aHandMorph "Add standard halo items to the menu" | unlockables | self isWorldMorph ifTrue: [^ self addWorldHaloMenuItemsTo: aMenu hand: aHandMorph]. aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: aHandMorph. aMenu addLine. self addFillStyleMenuItems: aMenu hand: aHandMorph. self addBorderStyleMenuItems: aMenu hand: aHandMorph. self addDropShadowMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph. self addHaloActionsTo: aMenu. owner isTextMorph ifTrue:[self addTextAnchorMenuItems: aMenu hand: aHandMorph]. aMenu addLine. self addToggleItemsToHaloMenu: aMenu. aMenu addLine. self addCopyItemsTo: aMenu. self addExportMenuItems: aMenu hand: aHandMorph. self addMiscExtrasTo: aMenu. self addDebuggingItemsTo: aMenu hand: aHandMorph. aMenu addLine. aMenu defaultTarget: self. aMenu addLine. unlockables := self submorphs select: [:m | m isLocked]. unlockables size = 1 ifTrue: [aMenu add: ('unlock "{1}"' translated format: unlockables first externalName) action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' translated action: #unlockContents]. aMenu defaultTarget: aHandMorph.! !!Morph methodsFor: 'menus' stamp: 'mt 3/10/2023 16:06'!addToggleItemsToHaloMenu: aMenu "Add standard true/false-checkbox items to the memu" #( (resistsRemovalString toggleResistsRemoval 'whether I should be reistant to easy deletion via the pink X handle') (stickinessString toggleStickiness 'whether I should be resistant to a drag done by mousing down on me') (lockedString lockUnlockMorph 'when "locked", I am inert to all user interactions') (hasClipSubmorphsString changeClipSubmorphs 'whether the parts of objects within me that are outside my bounds should be masked.') (hasDirectionHandlesString changeDirectionHandles 'whether direction handles are shown with the halo') (hasDragEnabledString changeDrag 'whether I am open to having objects dragged out of me') (hasDropEnabledString changeDrop 'whether I am open to having objects dropped into me') ) do: [:each | aMenu addUpdating: each first action: each second. aMenu balloonTextForLastItem: each third translated]. self couldHaveRoundedCorners ifTrue: [aMenu addUpdating: #roundedCornersString action: #toggleCornerRounding. aMenu balloonTextForLastItem: 'whether my corners should be rounded' translated]! !!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:59'!transferStateToRenderer: aRenderer "Transfer knownName, actorState, visible over to aRenderer, which is being imposed above me as a transformation shell" | current | (current := self actorStateOrNil) ifNotNil: [aRenderer actorState: current. self actorState: nil]. (current := self knownName) ifNotNil: [aRenderer setNameTo: current. self setNameTo: nil]. aRenderer simplySetVisible: self visible ! !!Morph methodsFor: 'meta-actions' stamp: 'mt 3/10/2023 16:06'!buildHandleMenu: aHand "Build the morph menu for the given morph's halo's menu handle. This menu has two sections. The first section contains commands that are interpreted by the hand; the second contains commands provided by the target morph. This method allows the morph to decide which items should be included in the hand's section of the menu." | menu | menu := MenuMorph new defaultTarget: self. menu addStayUpItem. menu addLine. self addStandardHaloMenuItemsTo: menu hand: aHand. menu defaultTarget: aHand. self addAddHandMenuItemsForHalo: menu hand: aHand. menu defaultTarget: self. self addCustomHaloMenuItems: menu hand: aHand. menu defaultTarget: aHand. ^ menu! !!Morph methodsFor: 'naming' stamp: 'mt 3/8/2023 10:49'!renameTo: aName self knownName = aName ifTrue: [^ aName]. self topRendererOrSelf setNameTo: aName. ^ aName! !!Morph methodsFor: 'stepping' stamp: 'mt 8/28/2023 15:14'!step "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message."! !!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:53'!stepAt: millisecondClockValue "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message. The millisecondClockValue parameter gives the value of the millisecond clock at the moment of dispatch. Default is to dispatch to the parameterless step method for the morph, but this protocol makes it possible for some morphs to do differing things depending on the clock value" self step! !!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:53'!stepTime "Answer the desired time between steps in milliseconds. This default implementation requests that the 'step' method be called once every second." ^ 1000! !!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:57'!wantsSteps "Return true if the receiver overrides the default Morph step method." "Details: Find first class in superclass chain that implements #step and return true if it isn't class Morph." | c | self isPartsDonor ifTrue: [^ false]. c := self class. [c includesSelector: #step] whileFalse: [c := c superclass]. ^ c ~= Morph! !!Morph methodsFor: 'thumbnail' stamp: 'mt 8/14/2023 17:40'!representativeNoTallerThan: maxHeight norWiderThan: maxWidth thumbnailHeight: thumbnailHeight "Return a morph representing the receiver but which is no taller than aHeight. If the receiver is already small enough, just return it, else return a MorphThumbnail companioned to the receiver, enforcing the maxWidth. If the receiver personally *demands* thumbnailing, do it even if there is no size-related reason to do it." self permitsThumbnailing ifFalse: [^ self]. (self fullBounds height <= maxHeight and: [self fullBounds width <= maxWidth]) ifTrue: [^ self]. ^ MorphThumbnail new extent: maxWidth @ (thumbnailHeight min: self fullBounds height); morphRepresented: self! !!Morph methodsFor: 'WiW support' stamp: 'mt 3/7/2023 15:07'!eToyRejectDropMorph: morphToDrop event: evt | tm am | tm := TextMorph new beAllFont: ((TextStyle named: Preferences standardButtonFont familyName) fontOfSize: 24); contents: 'GOT IT!!'. (am := AlignmentMorph new) color: Color yellow; layoutInset: 10; useRoundedCorners; vResizing: #shrinkWrap; hResizing: #shrinkWrap; addMorph: tm; fullBounds; position: (self bounds center - (am extent // 2)); openInWorld: self world. SoundService default playSoundNamed: 'yum' ifAbsentReadFrom: 'yum.aif'. morphToDrop rejectDropMorphEvent: evt. "send it back where it came from" am delete! !!Morph methodsFor: 'private' stamp: 'mt 3/10/2023 14:53'!privateMoveBy: delta "Private!! Use 'position:' instead." | fill | bounds := bounds translateBy: delta. fullBounds ifNotNil: [fullBounds := fullBounds translateBy: delta]. fill := self fillStyle. fill isOrientedFill ifTrue: [fill origin: fill origin + delta]! !!Morph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/10/2023 14:50'!delete "Remove the receiver as a submorph of its owner and make its new owner be nil." | oldWorld | self removeHalo. (oldWorld := self world) ifNotNil: [ self disableSubmorphFocusForHand: self activeHand. self activeHand releaseKeyboardFocus: self; releaseMouseFocus: self]. owner ifNotNil: [ self privateDelete. "remove from world"].! !!Morph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/10/2023 14:27'!goBehind "Move the receiver to bottom z-order." | topRend | topRend := self topRendererOrSelf. topRend owner ifNotNil: [:own | own addMorphBack: topRend]! !!Morph methodsFor: 'submorphs - layers' stamp: 'dgd 8/31/2004 16:21'!wantsToBeTopmost "Answer if the receiver want to be one of the topmost objects in its owner" ^ self isFlapOrTab! !!BorderedMorph methodsFor: 'menu' stamp: 'mt 4/11/2018 08:30'!changeBorderWidth: evt | handle origin aHand newWidth oldWidth | aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand]. origin := aHand position. oldWidth := self borderWidth. (handle := HandleMorph new) forEachPointDo: [:newPoint | handle removeAllMorphs. handle addMorph: (LineMorph from: origin to: newPoint color: Color black width: 1). newWidth := (newPoint - origin) r asInteger // 5. self borderWidth: newWidth] lastPointDo: [:newPoint | handle deleteBalloon. self halo ifNotNil: [:halo | halo addHandles]. self rememberCommand: (Command new cmdWording: 'border change' translated; undoTarget: self selector: #borderWidth: argument: oldWidth; redoTarget: self selector: #borderWidth: argument: newWidth)]. aHand attachMorph: handle. handle setProperty: #helpAtCenter toValue: true. handle showBalloon:'Move cursor farther fromthis point to increase border width.Click when done.' translated hand: evt hand. handle startStepping! !!AlignmentMorph methodsFor: 'geometry' stamp: 'mt 3/7/2023 14:37'!addTransparentSpacerOfSize: aPoint "Required for several MorphicExtras and other non-Etoys stuff." self addMorphBack: ((Morph new extent: aPoint asPoint) color: Color transparent)! !!BookPageSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'!addControls "Add the control bar at the top of the tool." | bb r str aCheckbox aWrapper | r := AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0. r wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. bb := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort)). bb setBalloonText: 'Accept the changes made here as the new page-order for this book' translated. r addTransparentSpacerOfSize: 12. bb := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #delete)). bb setBalloonText: 'Forgot any changes made here, and dismiss this sorter' translated. "eliminate the parts-bin button on the book-page sorters... r addTransparentSpacerOfSize: 24 @ 0. aCheckbox := UpdatingThreePhaseButtonMorph checkBox. aCheckbox target: self; actionSelector: #togglePartsBinStatus; arguments: #(); getSelector: #getPartsBinStatus. str := StringMorph contents: 'Parts bin' translated font: Preferences standardButtonFont. aWrapper := AlignmentMorph newRow beTransparent. aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0. aWrapper addMorphBack: (self wrapperFor: aCheckbox); addMorphBack: (self wrapperFor: str lock). r addMorphBack: aWrapper." self addMorphFront: r! !!BookPageSorterMorph methodsFor: 'initialization' stamp: 'mt 8/16/2023 13:52'!initialize "initialize the state of the receiver" super initialize. "" self extent: Display extent - 100; listDirection: #topToBottom; wrapCentering: #topLeft; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 3. pageHolder := PasteUpMorph new. pageHolder vResizeToFit: true; autoLineLayout: true. pageHolder extent: self extent - self borderWidth. pageHolder hResizing: #shrinkWrap. "pageHolder cursor: 0." "causes a walkback as of 5/25/2000" self addControls. self addMorphBack: pageHolder! !!BooklikeMorph methodsFor: 'misc' stamp: 'mt 8/4/2023 13:41'!playPageFlipSound: soundName PageFlipSoundOn "mechanism to suppress sounds at init time" ifTrue: [self playSoundNamed: soundName].! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:39'!addBookMenuItemsTo: aMenu hand: aHandMorph | controlsShowing subMenu | subMenu := MenuMorph new defaultTarget: self. subMenu add: 'previous page' translated action: #previousPage. subMenu add: 'next page' translated action: #nextPage. subMenu add: 'goto page' translated action: #goToPage. subMenu add: 'insert a page' translated action: #insertPage. subMenu add: 'delete this page' translated action: #deletePage. controlsShowing := self hasSubmorphWithProperty: #pageControl. controlsShowing ifTrue: [subMenu add: 'hide page controls' translated action: #hidePageControls. subMenu add: 'fewer page controls' translated action: #fewerPageControls] ifFalse: [subMenu add: 'show page controls' translated action: #showPageControls]. self isInFullScreenMode ifTrue: [ subMenu add: 'exit full screen' translated action: #exitFullScreen. ] ifFalse: [ subMenu add: 'show full screen' translated action: #goFullScreen. ]. subMenu addLine. subMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:. subMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:. subMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:. subMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:. subMenu addLine. subMenu add: 'sort pages' translated action: #sortPages:. subMenu add: 'uncache page sorter' translated action: #uncachePageSorter. (self hasProperty: #dontWrapAtEnd) ifTrue: [subMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true] ifFalse: [subMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false]. subMenu addLine. subMenu add: 'search for text' translated action: #textSearch. (aHandMorph pasteBuffer class isKindOf: PasteUpMorph class) ifTrue: [subMenu add: 'paste book page' translated action: #pasteBookPage]. subMenu add: 'send all pages to server' translated action: #savePagesOnURL. subMenu add: 'send this page to server' translated action: #saveOneOnURL. subMenu add: 'reload all from server' translated action: #reload. subMenu add: 'copy page url to clipboard' translated action: #copyUrl. subMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype. newPagePrototype ifNotNil: [subMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype]. aMenu add: 'book...' translated subMenu: subMenu! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/11/2023 14:44'!invokeBookMenu "Invoke the book's control panel menu." | aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'Book' translated. aMenu addStayUpItem. aMenu add: 'find...' translated action: #textSearch. aMenu add: 'go to page...' translated action: #goToPage. aMenu addLine. aMenu addList: { {'sort pages' translated. #sortPages}. {'uncache page sorter' translated. #uncachePageSorter}}. (self hasProperty: #dontWrapAtEnd) ifTrue: [aMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true] ifFalse: [aMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false]. aMenu addList: { {'make bookmark' translated. #bookmarkForThisPage}. {'make thumbnail' translated. #thumbnailForThisPage}}. aMenu addUpdating: #showingPageControlsString action: #toggleShowingOfPageControls. aMenu addUpdating: #showingFullScreenString action: #toggleFullScreen. aMenu addLine. aMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:. aMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:. aMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:. aMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:. aMenu addLine. (self primaryHand pasteBuffer class isKindOf: PasteUpMorph class) ifTrue: [aMenu add: 'paste book page' translated action: #pasteBookPage]. aMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype. newPagePrototype ifNotNil: [ aMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype]. aMenu add: (self dragNDropEnabled ifTrue: ['close dragNdrop'] ifFalse: ['open dragNdrop']) translated action: #changeDragAndDrop. aMenu add: 'make all pages this size' translated action: #makeUniformPageSize. aMenu addUpdating: #keepingUniformPageSizeString target: self action: #toggleMaintainUniformPageSize. aMenu addLine. aMenu add: 'send all pages to server' translated action: #savePagesOnURL. aMenu add: 'send this page to server' translated action: #saveOneOnURL. aMenu add: 'reload all from server' translated action: #reload. aMenu add: 'copy page url to clipboard' translated action: #copyUrl. aMenu addLine. aMenu add: 'load PPT images from slide #1' translated action: #loadImagesIntoBook. aMenu add: 'background color for all pages...' translated action: #setPageColor. aMenu add: 'make a thread of projects in this book' translated action: #buildThreadOfProjects. aMenu popUpEvent: self world activeHand lastEvent in: self world! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:38'!saveAsNumberedURLs "Write out all pages in this book that are not showing, onto a server. The local disk could be the server. For any page that does not have a SqueakPage and a url already, name that page file by its page number. Any pages that are already totally out will stay that way." | stem list firstTime | firstTime := (self valueOfProperty: #url) isNil. stem := self getStemUrl. "user must approve" stem isEmpty ifTrue: [^self]. firstTime ifTrue: [self setProperty: #futureUrl toValue: stem , '.bo']. self reserveUrlsIfNeeded. pages withIndexDo: [:aPage :ind | "does write the current page too" aPage isInMemory ifTrue: ["not out now" aPage saveOnURL: stem , ind printString , '.sp']]. list := pages collect: [:aPage | aPage sqkPage prePurge]. "knows not to purge the current page" list := (list select: [:each | each notNil]) asArray. "do bulk become:" (list collect: [:each | each contentsMorph]) elementsExchangeIdentityWith: (list collect: [:spg | MorphObjectOut new xxxSetUrl: spg url page: spg]). self saveIndexOnURL. firstTime ifTrue: ["Put a thumbnail into the hand" URLMorph grabForBook: self. self setProperty: #futureUrl toValue: nil "clean up"]! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:39'!saveOnUrlPage: pageMorph "Write out this single page in this book onto a server. See savePagesOnURL. (Don't compute the texts, only this page's is written.)" | stem ind response rand newPlace dir | "Don't give the chance to put in a different place. Assume named by number" ((self valueOfProperty: #url) isNil and: [pages first url notNil]) ifTrue: [response := Project uiManager chooseOptionFrom: {'Old book' translated. 'New book sharing old pages' translated} title: 'Modify the old book, or make a new book sharing its pages?' translated. response = 2 ifTrue: ["Make up new url for .bo file and confirm with user." "Mark as shared" [rand := String new: 4. 1 to: rand size do: [:ii | rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)]. (newPlace := self getStemUrl) ifEmpty: [^ self]. newPlace := (newPlace copyUpToLast: $/), '/BK', rand, '.bo'. dir := ServerFile new fullPath: newPlace. (dir includesKey: dir fileName)] whileTrue. "keep doing until a new file" self setProperty: #url toValue: newPlace]. response = 0 ifTrue: [^ self]]. stem := self getStemUrl. "user must approve" stem ifEmpty: [^ self]. ind := pages identityIndexOf: pageMorph ifAbsent: [self error: 'where is the page?' translated]. pageMorph isInMemory ifTrue: "not out now" [pageMorph saveOnURL: stem,(ind printString),'.sp']. self saveIndexOfOnly: pageMorph.! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:40'!savePagesOnURL "Write out all pages in this book onto a server. For any page that does not have a SqueakPage and a url already, ask the user for one. Give the option of naming all page files by page number. Any pages that are not in memory will stay that way. The local disk could be the server." | response list firstTime newPlace rand dir bookUrl | self getAllText. "stored with index later" response := Project uiManager chooseOptionFrom: {'Use page numbers' translated. 'Type in file names' translated. 'Save in a new place (using page numbers)' translated. 'Save in a new place (typing names)' translated. 'Save new book sharing old pages' translated. } title: 'Each page will be a file on the server. Do you want to page numbers be the names of the files? or name each one yourself?' translated. response = 1 ifTrue: [self saveAsNumberedURLs. ^ self]. response = 3 ifTrue: [self forgetURLs; saveAsNumberedURLs. ^ self]. response = 4 ifTrue: [self forgetURLs]. response = 5 ifTrue: ["Make up new url for .bo file and confirm with user." "Mark as shared" [rand := String new: 4. 1 to: rand size do: [:ii | rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)]. (newPlace := self getStemUrl) isEmpty ifTrue: [^ self]. newPlace := (newPlace copyUpToLast: $/), '/BK', rand, '.bo'. dir := ServerFile new fullPath: newPlace. (dir includesKey: dir fileName)] whileTrue. "keep doing until a new file" self setProperty: #url toValue: newPlace. self saveAsNumberedURLs. bookUrl := self valueOfProperty: #url. (SqueakPage stemUrl: bookUrl) = (SqueakPage stemUrl: currentPage url) ifTrue: [bookUrl := true]. "not a shared book" (URLMorph grabURL: currentPage url) book: bookUrl. ^ self]. response = 0 ifTrue: [^ self]. "self reserveUrlsIfNeeded. Need two passes here -- name on one, write on second" pages do: [:aPage | "does write the current page too" aPage isInMemory ifTrue: "not out now" [aPage saveOnURLbasic]]. "ask user if no url" list := pages collect: [:aPage | aPage sqkPage prePurge]. "knows not to purge the current page" list := (list select: [:each | each notNil]) asArray. "do bulk become:" (list collect: [:each | each contentsMorph]) elementsExchangeIdentityWith: (list collect: [:spg | MorphObjectOut new xxxSetUrl: spg url page: spg]). firstTime := (self valueOfProperty: #url) isNil. self saveIndexOnURL. firstTime ifTrue: "Put a thumbnail into the hand" [URLMorph grabForBook: self. self setProperty: #futureUrl toValue: nil]. "clean up"! !!BookMorph methodsFor: 'navigation' stamp: 'mt 8/4/2023 13:34'!goToPageMorph: aMorph "Set the given morph as the current page; run closing and opening scripts as appropriate" self goToPage: (pages identityIndexOf: aMorph ifAbsent: [^ self "abort"]) transitionSpec: nil! !!BookMorph methodsFor: 'navigation' stamp: 'mt 8/4/2023 13:30'!goToPageMorph: newPage transitionSpec: transitionSpec "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly. Apply the transitionSpec provided." | pageIndex aWorld oldPageIndex ascending tSpec readIn | pages isEmpty ifTrue: [^self]. self setProperty: #searchContainer toValue: nil. "forget previous search" self setProperty: #searchOffset toValue: nil. self setProperty: #searchKey toValue: nil. pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"]. readIn := newPage isInMemory not. oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil]. ascending := (oldPageIndex isNil or: [newPage == currentPage]) ifTrue: [nil] ifFalse: [oldPageIndex < pageIndex]. tSpec := transitionSpec ifNil: ["If transition not specified by requestor..." newPage valueOfProperty: #transitionSpec ifAbsent: [" ... then consult new page" self transitionSpecFor: self " ... otherwise this is the default"]]. self flag: #arNote. "Probably unnecessary" (aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus]. currentPage ifNotNil: [currentPage updateCachedThumbnail]. self currentPage notNil ifTrue: [(((pages at: pageIndex) owner isKindOf: TransitionMorph) and: [(pages at: pageIndex) isInWorld]) ifTrue: [^self "In the process of a prior pageTurn"]. ascending ifNotNil: ["Show appropriate page transition and start new page when done" currentPage stopStepping. (pages at: pageIndex) position: currentPage position. ^(TransitionMorph effect: tSpec second direction: tSpec third inverse: (ascending or: [transitionSpec notNil]) not) showTransitionFrom: currentPage to: (pages at: pageIndex) in: self whenStart: [self playPageFlipSound: tSpec first] whenDone: [currentPage delete; fullReleaseCachedState. self insertPageMorphInCorrectSpot: (pages at: pageIndex). self adjustCurrentPageForFullScreen. self snapToEdgeIfAppropriate. aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. aWorld := self world. readIn ifTrue: [currentPage updateThumbnailUrlInBook: self url. currentPage sqkPage computeThumbnail "just store it"]]]. "No transition, but at least decommission current page" currentPage delete; fullReleaseCachedState]. self insertPageMorphInCorrectSpot: (pages at: pageIndex). "sets currentPage" self adjustCurrentPageForFullScreen. self snapToEdgeIfAppropriate. aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. aWorld := self world. readIn ifTrue: [currentPage updateThumbnailUrl. currentPage sqkPage computeThumbnail "just store it"].! !!DockingBarMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 16:05'!wantsYellowButtonMenu "Answer true if the receiver wants a yellow button menu" ^ true! !!EventRecorderMorph methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:52'!makeStatusLightIn: aPoint ^statusLight := EllipseMorph new extent: aPoint; color: Color green; borderWidth: 0! !!GraphMorph methodsFor: 'accessing'!valueAtCursor: aPointOrNumber data isEmpty ifTrue: [^ 0]. data at: ((cursor truncated max: 1) min: data size) put: (self asNumber: aPointOrNumber). self flushCachedForm.! !!GraphMorph methodsFor: 'commands'!appendValue: aPointOrNumber | newVal | (data isKindOf: OrderedCollection) ifFalse: [data := data asOrderedCollection]. newVal := self asNumber: aPointOrNumber. data addLast: newVal. newVal < minVal ifTrue: [minVal := newVal]. newVal > maxVal ifTrue: [maxVal := newVal]. self cursor: data size. self flushCachedForm.! !!GraphMorph methodsFor: 'private' stamp: 'mt 8/14/2023 16:25'!asNumber: aPointOrNumber ^ aPointOrNumber isPoint ifTrue: [aPointOrNumber r] ifFalse: [aPointOrNumber]! !!GraphicalDictionaryMenu methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'!initializeFor: aTarget fromDictionary: aDictionary "Initialize me for a target and a dictionary." | anIndex aButton | self baseDictionary: aDictionary. target := aTarget. coexistWithOriginal := true. self extent: 210 @ 210. self clipSubmorphs: true. self layoutPolicy: ProportionalLayout new. aButton := (IconicButton new) borderWidth: 0; labelGraphic: (MenuIcons formAtKey: 'TinyMenu'); color: Color transparent; actWhen: #buttonDown; actionSelector: #showMenu; target: self; setBalloonText: 'menu'. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (-50 @ 6 extent: aButton extent)). aButton := (SimpleButtonMorph new) target: self; borderColor: Color black; label: 'Prev'; actionSelector: #downArrowHit; actWhen: #whilePressed; setBalloonText: 'show previous picture'; yourself. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (-24 @ 4 extent: aButton extent)). aButton := (SimpleButtonMorph new) target: self; borderColor: Color black; label: 'Next'; actionSelector: #upArrowHit; actWhen: #whilePressed; setBalloonText: 'show next pictutre'. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (24 @ 4 extent: aButton extent)). self addMorph: ((UpdatingStringMorph new) contents: ' '; target: self; putSelector: #renameGraphicTo:; getSelector: #truncatedNameOfGraphic; useStringFormat; setBalloonText: 'The name of the current graphic'; yourself) fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ 0) offsets: (10 @ 40 corner: -10 @ 60)). self addMorph: ((Morph new) extent: 100 @ 4; color: Color black) fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ 0) offsets: (0 @ 60 corner: 0 @ 64)). formDisplayMorph := (Thumbnail new) extent: 100 @ 100; useInterpolation: true; maxWidth: 300 minHeight: 100; yourself. formDisplayMorph layoutFrame: (LayoutFrame fractions: (0 @ 0 extent: 0@0) offsets: (8 @ 72 corner: 108 @ 172)). self addMorph: formDisplayMorph. self minimumExtent: 116@180. target ifNotNil: [(anIndex := formChoices indexOf: target form ifAbsent: []) ifNotNil: [currentIndex := anIndex]]. self updateThumbnail! !!GraphicalDictionaryMenu methodsFor: 'menu commands' stamp: 'mt 8/16/2023 13:50'!repaintEntry "Let the user enter into painting mode to repaint the item and save it back." | aWorld bnds sketchEditor aPaintBox formToEdit | (aWorld := self world) assureNotPaintingElse: [^ self]. formToEdit := formChoices at: currentIndex. bnds := (submorphs second boundsInWorld origin extent: formToEdit extent) intersect: aWorld bounds. bnds := bnds expandBy: 60@60. sketchEditor := SketchEditorMorph new. aWorld addMorphFront: sketchEditor. sketchEditor initializeFor: ((aWorld drawingClass withForm: formToEdit) position: submorphs second positionInWorld) inBounds: bnds pasteUpMorph: aWorld paintBoxPosition: bnds topRight. sketchEditor afterNewPicDo: [:aForm :aRect | formChoices at: currentIndex put: aForm. baseDictionary at: (entryNames at: currentIndex) put: aForm. self updateThumbnail. (aPaintBox := aWorld paintBoxOrNil) ifNotNil: [aPaintBox delete]] ifNoBits: [(aPaintBox := aWorld paintBoxOrNil) ifNotNil: [aPaintBox delete]]. ! !!HandMorph methodsFor: 'paste buffer' stamp: 'mt 3/10/2023 14:49'!pasteMorph | aPastee | PasteBuffer ifNil: [^ self inform: 'Nothing to paste.' translated]. self attachMorph: (aPastee := self objectToPaste). aPastee align: aPastee center with: self position.! !!HandMorphForReplay methodsFor: 'event handling' stamp: 'mt 8/28/2023 14:05'!processEvents "Play back the next event" | evt hadMouse hadAny tracker | suspended == true ifTrue: [^ self]. hadMouse := hadAny := false. tracker := recorder objectTrackingEvents. [(evt := recorder nextEventToPlay) isNil] whileFalse: [ ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self]. tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp]. evt type == #EOF ifTrue: [recorder pauseIn: self currentWorld. ^ self]. evt type == #startSound ifTrue: [evt argument play. recorder synchronize. ^ self]. evt isMouse ifTrue: [hadMouse := true]. (evt isMouse or: [evt isKeyboard]) ifTrue: [self handleEvent: (evt setHand: self) resetHandlerFields. hadAny := true]]. (mouseClickState notNil and: [hadMouse not]) ifTrue: ["No mouse events during this cycle. Make sure click states time out accordingly" mouseClickState handleEvent: lastMouseEvent asMouseMove from: self]. hadAny ifFalse: ["No pending events. Make sure z-order is up to date" self mouseOverHandler processMouseOver: lastMouseEvent]! !!ImageMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:15'!setNewImageFrom: formOrNil "Change the receiver's image to be one derived from the supplied form. If nil is supplied, clobber any existing image in the receiver, and in its place put a default graphic, either the one known to the receiver as its default value" formOrNil ifNotNil: [^ self image: formOrNil]. self image: (Form extent: 16@16 depth: 32)! !!GrabPatchMorph methodsFor: 'dropping' stamp: 'mt 8/14/2023 17:31'!wantsToBeDroppedInto: aMorph "Only into PasteUps that are not part bins" ^ aMorph isWorldMorph! !!GrabPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:11'!initialize "Initialize the receiver. Emblazon the GrabPatch icon on its face" super initialize. self image: (MenuIcons formAtKey: 'GrabPatch'). self setProperty: #ignorePartsBinDrop toValue: true! !!GrabPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:11'!initializeToStandAlone "Initialize the receiver. Emblazon the GrabPatch icon on its face" super initializeToStandAlone. self image: (MenuIcons formAtKey: 'GrabPatch')! !!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'mt 8/23/2023 13:48'!insertNewProject [MorphicProject openViewOn: nil] on: ProjectViewOpenNotification do: [ :ex | ex resume: false].! !!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'mt 8/11/2023 14:44'!moreCommands "Put up a menu of options" | allThreads aMenu others target | allThreads := self class knownThreads. aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'navigation' translated. self flag: #deferred. "Probably don't want that stay-up item, not least because the navigation-keystroke stuff is not dynamically handled" aMenu addStayUpItem. others := (allThreads keys reject: [ :each | each = threadName]) asArray sort. others do: [ :each | aMenu add: ('switch to <{1}>' translated format:{each}) selector: #switchToThread: argument: each ]. aMenu addList: { {'switch to recent projects' translated. #getRecentThread}. #-. {'create a new thread' translated. #threadOfNoProjects}. {'edit this thread' translated. #editThisThread}. {'create thread of all projects' translated. #threadOfAllProjects}. #-. {'First project in thread' translated. #firstPage}. {'Last project in thread' translated. #lastPage} }. (target := self currentIndex + 2) > listOfPages size ifFalse: [ aMenu add: ('skip over next project ({1})' translated format:{(listOfPages at: target - 1) first}) action: #skipOverNext ]. aMenu addList: { {'jump within this thread' translated. #jumpWithinThread}. {'insert new project' translated. #insertNewProject}. #-. {'simply close this navigator' translated. #delete}. {'destroy this thread' translated. #destroyThread}. #- }. (self currentWorld keyboardNavigationHandler == self) ifFalse:[ aMenu add: 'start keyboard navigation with this thread' translated action: #startKeyboardNavigation ] ifTrue: [ aMenu add: 'stop keyboard navigation with this thread' translated action: #stopKeyboardNavigation ]. aMenu popUpInWorld.! !!LassoPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'!initialize "Initialize the receiver. Sets its image to the lasso picture" super initialize. self image: (MenuIcons formAtKey: 'Lasso')! !!LassoPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'!initializeToStandAlone "Initialize the receiver such that it can live on its own. Sets its image to the lasso picture" super initializeToStandAlone. self image: (MenuIcons formAtKey: 'Lasso')! !!Morph class methodsFor: 'fileIn/Out' stamp: 'mt 3/8/2023 09:07'!fromFileName: fullName "Reconstitute a Morph from the file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world" | aFileStream morphOrList | aFileStream := (MultiByteBinaryOrTextStream with: ((FileStream readOnlyFileNamed: fullName) binary contentsOfEntireFile)) binary reset. morphOrList := aFileStream fileInObjectAndCode. Project current world addMorphsAndModel: morphOrList.! !!Morph class methodsFor: '*MorphicExtras-parts bin' stamp: 'mt 8/4/2023 14:43'!supplementaryPartsDescriptions "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol" ^ {DescriptionForPartsBin formalName: 'NextPage' translatedNoop categoryList: {'Multimedia' translatedNoop} documentation: 'A button which, when clicked, takes the reader to the next page of a book' translatedNoop globalReceiverSymbol: #BookMorph nativitySelector: #nextPageButton. DescriptionForPartsBin formalName: 'PreviousPage' translatedNoop categoryList: {'Multimedia'} documentation: 'A button which, when clicked, takes the reader to the previous page of a book' translatedNoop globalReceiverSymbol: #BookMorph nativitySelector: #previousPageButton.}! !!GraphicalDictionaryMenu class methodsFor: 'example' stamp: 'mt 7/31/2023 11:13'!example "GraphicalDictionaryMenu example" | aDict | aDict := Dictionary new. #('ColorTilesOff' 'ColorTilesOn' 'Controls') do: [:aString | aDict at: aString put: (MenuIcons formAtKey: aString)]. self openOn: aDict withLabel: 'Testing One Two Three'! !!ImageMorph class methodsFor: 'scripting' stamp: 'mt 3/15/2023 14:10'!authoringPrototype | aMorph aForm | aMorph := super authoringPrototype. aForm := MenuIcons formAtKey: 'Image'. aForm ifNil: [aForm := aMorph image rotateBy: 90]. aMorph image: aForm. ^ aMorph! !!GrabPatchMorph class methodsFor: 'instance creation' stamp: 'mt 7/31/2023 11:11'!authoringPrototype "Answer a prototype for use in a parts bin" ^ self new image: (MenuIcons formAtKey: 'GrabPatch'); markAsPartsDonor; setBalloonText: 'Use this to grab a rectangular patch from the screen'; yourself! !!LassoPatchMorph class methodsFor: 'instance creation' stamp: 'mt 7/31/2023 11:13'!authoringPrototype "Answer a prototype for use in a parts bin" ^ self new image: (MenuIcons formAtKey: 'Lasso'); markAsPartsDonor; setBalloonText: 'Drop this on the desktop and you can then grab a patch from the screen with a lasso.'; yourself! !!MorphExtension methodsFor: 'accessing - other properties' stamp: 'mt 3/10/2023 14:57'!sortedPropertyNames "answer the receiver's property names in a sorted way" | props | props := WriteStream on: (Array new: 10). locked == true ifTrue: [props nextPut: #locked]. visible == false ifTrue: [props nextPut: #visible]. sticky == true ifTrue: [props nextPut: #sticky]. balloonText isNil ifFalse: [props nextPut: #balloonText]. balloonTextSelector isNil ifFalse: [props nextPut: #balloonTextSelector]. externalName isNil ifFalse: [props nextPut: #externalName]. isPartsDonor == true ifTrue: [props nextPut: #isPartsDonor]. actorState isNil ifFalse: [props nextPut: #actorState]. eventHandler isNil ifFalse: [props nextPut: #eventHandler]. otherProperties ifNotNil: [otherProperties associationsDo: [:a | props nextPut: a key]]. ^props contents sort: [:s1 :s2 | s1 <= s2]! !!MorphExtension methodsFor: 'connectors-copying' stamp: 'mt 3/10/2023 16:11'!veryDeepInner: deepCopier "Copy all of my instance variables. Some otherProperties need to be not copied at all, but shared. Their names are given by copyWeakly. Some otherProperties should not be copied or shared. Their names are given by propertyNamesNotCopied. This is special code for the dictionary. See DeepCopier, and veryDeepFixupWith:." | namesOfWeaklyCopiedProperties weaklyCopiedValues | super veryDeepInner: deepCopier. locked := locked veryDeepCopyWith: deepCopier. visible := visible veryDeepCopyWith: deepCopier. sticky := sticky veryDeepCopyWith: deepCopier. balloonText := balloonText veryDeepCopyWith: deepCopier. balloonTextSelector := balloonTextSelector veryDeepCopyWith: deepCopier. externalName := externalName veryDeepCopyWith: deepCopier. isPartsDonor := isPartsDonor veryDeepCopyWith: deepCopier. actorState := actorState veryDeepCopyWith: deepCopier. eventHandler := eventHandler veryDeepCopyWith: deepCopier. "has its own restrictions" otherProperties ifNil: [ ^self ]. otherProperties := otherProperties copy. self propertyNamesNotCopied do: [ :propName | otherProperties removeKey: propName ifAbsent: [] ]. namesOfWeaklyCopiedProperties := self copyWeakly. weaklyCopiedValues := namesOfWeaklyCopiedProperties collect: [ :propName | otherProperties removeKey: propName ifAbsent: [] ]. "Now copy all the others." otherProperties := otherProperties veryDeepCopyWith: deepCopier. "And replace the weak ones." namesOfWeaklyCopiedProperties with: weaklyCopiedValues do: [ :name :value | value ifNotNil: [ otherProperties at: name put: value ]].! !!MorphExtension methodsFor: 'other' stamp: 'mt 3/10/2023 16:11'!isDefault "Return true if the receiver is a default and can be omitted" locked == true ifTrue: [^ false]. visible == false ifTrue: [^ false]. sticky == true ifTrue: [^ false]. balloonText isNil ifFalse: [^ false]. balloonTextSelector isNil ifFalse: [^ false]. externalName isNil ifFalse: [^ false]. isPartsDonor == true ifTrue: [^ false]. actorState isNil ifFalse: [^ false]. eventHandler isNil ifFalse: [^ false]. otherProperties ifNotNil: [otherProperties isEmpty ifFalse: [^ false]]. ^ true! !!MorphExtension methodsFor: 'printing' stamp: 'mt 3/10/2023 16:11'!printOn: aStream "Append to the argument, aStream, a sequence of characters that identifies the receiver." super printOn: aStream. aStream nextPutAll: ' ' , self identityHashPrintString. locked == true ifTrue: [aStream nextPutAll: ' [locked] ']. visible == false ifTrue: [aStream nextPutAll: '[not visible] ']. sticky == true ifTrue: [aStream nextPutAll: ' [sticky] ']. balloonText ifNotNil: [aStream nextPutAll: ' [balloonText] ']. balloonTextSelector ifNotNil: [aStream nextPutAll: ' [balloonTextSelector: ' , balloonTextSelector printString , '] ']. externalName ifNotNil: [aStream nextPutAll: ' [externalName = ' , externalName , ' ] ']. isPartsDonor == true ifTrue: [aStream nextPutAll: ' [isPartsDonor] ']. eventHandler ifNotNil: [aStream nextPutAll: ' [eventHandler = ' , eventHandler printString , '] ']. (otherProperties isNil or: [otherProperties isEmpty ]) ifTrue: [^ self]. aStream nextPutAll: ' [other: '. self otherProperties keysDo: [:aKey | aStream nextPutAll: ' (' , aKey , ' -> ' , (self otherProperties at: aKey) printString , ')']. aStream nextPut: $]! !!MorphHierarchy class methodsFor: 'opening' stamp: 'mt 8/4/2023 14:46'!openOrDelete | oldMorph | oldMorph := Project current world submorphs detect: [:each | each hasProperty: #morphHierarchy] ifNone: [| newMorph | newMorph := self new asMorph. newMorph bottomLeft: self currentHand position. newMorph openInWorld. ^ self]. "" oldMorph delete! !!MorphListItemWrapper methodsFor: 'accessing' stamp: 'mt 3/10/2023 16:07'!contents "Answer the receiver's contents" | tentative submorphs | tentative := item submorphs collect: [:each | each renderedMorph]. submorphs := tentative reject: [:each | each isKindOf: HaloMorph]. ^ submorphs collect: [:each | self class with: each]! !!MorphicModel methodsFor: 'submorphs - accessing' stamp: 'mt 3/10/2023 14:52'!allKnownNames "Return a list of all known names based on the scope of the receiver. If the receiver is a member of a uniclass, incorporate the original 1997 logic that queries the known names of the values of all the instance variables." | superNames | superNames := super allKnownNames. "gather them from submorph tree" ^self class isUniClass ifTrue: [superNames , (self instanceVariableValues select: [:e | e notNil and: [e knownName notNil]] thenCollect: [:e | e knownName])] ifFalse: [superNames]! !!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 3/8/2023 11:01'!copyFromRootsForExport: rootArray "When possible, use copySmartRootsExport:. This way may not copy a complete tree of objects. Add to roots: all of the methods pointed to from the outside by blocks." | newRoots segSize symbolHolder | arrayOfRoots := rootArray. "self halt." symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers, so they will be in outPointers" "Creation of the segment happens here" self copyFromRoots: arrayOfRoots sizeHint: 0. segSize := segment size. [(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize]. "with methods pointed at from outside" [(newRoots := self rootsIncludingBlocks) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize]. "with methods, blocks from outPointers" "Zap sender of a homeContext. Can't send live stacks out." "Why not? eem 7/3/2017 15:31" 1 to: outPointers size do: [:ii | | outPointer | outPointer := outPointers at: ii. (outPointer isBlock or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil]]. symbolHolder size "Keep reference to symbolHolder until the last"! !!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/28/2023 15:10'!copyFromRootsLocalFileFor: rootArray sizeHint: segSize arrayOfRoots := rootArray. self copyFromRoots: arrayOfRoots sizeHint: segSize.! !!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/28/2023 15:40'!copySmartRootsExport: rootArray "Use SmartRefStream to find the object. Make them all roots. Create the segment in memory. Project should be in first five objects in rootArray." | newRoots segSize symbolHolder replacements naughtyBlocks allClasses sizeHint proj dummy world | world := Project current world. symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers, so they will be in outPointers" dummy := ReferenceStream on: (DummyStream on: nil). "Write to a fake Stream, not a file" "Collect all objects" dummy insideASegment: true. "So Uniclasses will be traced" dummy rootObject: rootArray. "inform him about the root" dummy nextPut: rootArray. (proj :=dummy project) ifNotNil: [self dependentsSave: dummy]. allClasses := SmartRefStream new uniClassInstVarsRefs: dummy. "catalog the extra objects in UniClass inst vars. Put into dummy" allClasses do: [:cls | dummy references at: cls class put: false. "put MorphicModel5 class in roots" dummy blockers removeKey: cls class ifAbsent: []]. "refs := dummy references." arrayOfRoots := self smartFillRoots: dummy. "guaranteed none repeat" replacements := dummy blockers. dummy project "recompute it" ifNil: [self error: 'lost the project!!']. dummy project class == DiskProxy ifTrue: [self error: 'saving the wrong project']. dummy := nil. "Allow dummy to be GC'ed below (bytesLeft)." naughtyBlocks := arrayOfRoots select: [ :each | each isContext and: [each hasInstVarRef]]. "since the caller switched ActiveWorld, put the real one back temporarily" naughtyBlocks isEmpty ifFalse: [world becomeActiveDuring: [world firstHand becomeActiveDuring: [ | goodToGo | goodToGo := (Project uiManager chooseOptionFrom: #('keep going' 'stop and take a look') title: 'Some block(s) which reference instance variables are included in this segment. These may fail when the segment is loaded if the class has been reshaped. What would you like to do?') = 1. goodToGo ifFalse: [naughtyBlocks inspect. self error: 'Here are the bad blocks']]]]. "Creation of the segment happens here" "try using one-quarter of memory min: four megs to publish (will get bumped up later if needed)" sizeHint := (Smalltalk bytesLeft // 4 // 4) min: 1024*1024. self copyFromRoots: arrayOfRoots sizeHint: sizeHint areUnique: true. segSize := segment size. [(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true]. "with methods pointed at from outside" [(newRoots := self rootsIncludingBlocks) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true]. "with methods, blocks from outPointers" 1 to: outPointers size do: [:ii | | outPointer | outPointer := outPointers at: ii. (outPointer isBlock or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil]. "substitute new object in outPointers" (replacements includesKey: outPointer) ifTrue: [outPointers at: ii put: (replacements at: outPointer)]]. proj ifNotNil: [self dependentsCancel: proj]. symbolHolder. "hold onto symbolHolder until the last."! !!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/16/2023 16:58'!smartFillRoots: dummy | refs known ours ww blockers | "Put all traced objects into my arrayOfRoots. Remove somethat want to be in outPointers. Return blockers, anIdentityDictionary of objects to replace in outPointers." blockers := dummy blockers. known := (refs := dummy references) size. refs keys do: [:obj | "copy keys to be OK with removing items" (obj isSymbol) ifTrue: [refs removeKey: obj. known := known-1]. (obj class == PasteUpMorph) ifTrue: [ obj isWorldMorph & (obj owner == nil) ifTrue: [ (dummy project ~~ nil and: [obj == dummy project world]) ifFalse: [ refs removeKey: obj. known := known-1. blockers at: obj put: (StringMorph contents: 'The worldMorph of a different world')]]]. "Make a ProjectViewMorph here" "obj class == Project ifTrue: [Transcript show: obj; cr]." (blockers includesKey: obj) ifTrue: [ refs removeKey: obj ifAbsent: [known := known+1]. known := known-1]. ]. ours := (dummy project ifNil: [Project current]) world. refs keysDo: [:obj | obj isMorph ifTrue: [ ww := obj world. (ww == ours) | (ww == nil) ifFalse: [ refs removeKey: obj. known := known-1. blockers at: obj put: (StringMorph contents: obj printString, ' from another world')]]]. "keep original roots on the front of the list" dummy rootObject do: [:rr | refs removeKey: rr ifAbsent: []]. ^dummy rootObject, refs keys asArray! !!NativeImageSegment methodsFor: 'testing' stamp: 'mt 3/8/2023 11:01'!findRogueRootsImSeg: rootArray "This is a tool to track down unwanted pointers into the segment. If we don't deal with these pointers, the segment turns out much smaller than it should. These pointers keep a subtree of objects out of the segment.1) Break all owner pointers in submorphs and all scripts.2) Create the segment and look at outPointers.3) Remove those we expect.4) Remember to quit without saving -- the owner pointers are smashed."| suspects bag1 bag2 |arrayOfRoots := rootArray.self findRogueRootsPrep. "and free that context!!"Smalltalk garbageCollect.self copyFromRoots: arrayOfRoots sizeHint: 0.suspects := outPointers select: [:oo | oo isMorph].suspects size > 0 ifTrue: [suspects inspect].bag1 := Bag new. bag2 := Bag new.outPointers do: [:key | (key isKindOf: Class) ifTrue: [bag2 add: key class name] ifFalse: [(#(Symbol Point Rectangle True False String Float Color Form ColorForm StrikeFont Metaclass UndefinedObject TranslucentColor) includes: key class name) ifTrue: [bag2 add: key class name] ifFalse: [bag1 add: key class name]]]."(bag sortedCounts) is the SortedCollection"(StringHolder new contents: bag1 sortedCounts printString, '', bag2 sortedCounts printString) openLabel: 'Objects pointed at by the outside'.self halt: 'Examine local variables pointIn and inSeg'."Use this in inspectors: outPointers select: [:oo | oo class == <a Class>]. "! !!NativeImageSegment methodsFor: 'testing' stamp: 'mt 3/10/2023 15:12'!findRogueRootsPrep "Part of the tool to track down unwanted pointers into the segment. Break all owner pointers in submorphs, scripts, and viewers in flaps."| wld morphs |wld := arrayOfRoots detect: [:obj | obj isMorph ifTrue: [obj isWorldMorph] ifFalse: [false]] ifNone: [nil].wld ifNil: [wld := arrayOfRoots detect: [:obj | obj isMorph] ifNone: [^ self error: 'can''t find a root morph']].morphs := IdentitySet new: 400.wld allMorphsDo: [:m | morphs add: m].morphs do: [:mm | "break the back pointers" mm isInMemory ifTrue: [ (mm respondsTo: #target) ifTrue: [ mm nearestOwnerThat: [:ow | ow == mm target ifTrue: [mm target: nil. true] ifFalse: [false]]]. (mm respondsTo: #arguments) ifTrue: [ mm arguments do: [:arg | arg ifNotNil: [ mm nearestOwnerThat: [:ow | ow == arg ifTrue: [mm arguments at: (mm arguments indexOf: arg) put: nil. true] ifFalse: [false]]]]]. mm eventHandler ifNotNil: ["recipients point back up" (morphs includesAllOf: (mm eventHandler allRecipients)) ifTrue: [ mm eventHandler: nil]]. "temporary, until using Model for PartsBin" (mm isMorphicModel) ifTrue: [ (mm model isMorphicModel) ifTrue: [ mm model breakDependents]]. (mm isTextMorph) ifTrue: [mm setContainer: nil]]].(Smalltalk includesKey: #Owners) ifTrue: [Smalltalk at: #Owners put: nil]. "in case findOwnerMap: is commented out""self findOwnerMap: morphs."morphs do: [:mm | "break the back pointers" mm isInMemory ifTrue: [mm privateOwner: nil]]."more in extensions?"! !!NebraskaCommunicatorMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/11/2023 13:59'!textEntryFieldNamed: aSymbol with: aString help: helpString | f col | f := (StringMorph new contents: aString; font: Preferences standardDefaultTextFont; yourself) setBalloonText: helpString; on: #mouseUp send: #editEvent:for: to: self. self field: aSymbol is: f. col := (self inAColumn: {f}) color: Color white; hResizing: #shrinkWrap. ^col! !!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:52'!acceptTo: someText forMorph: aMorph | betterText | betterText := self improveText: someText forMorph: aMorph. self transmitStreamedObject: (SmartRefStream streamedRepresentationOf: betterText) to: self ipAddress. aMorph setText: '' asText. self appendMessage: self startOfMessageFromMe, ' - ', betterText, String cr. ^true! !!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:56'!appendMessage: aText receivingPane setText: (receivingPane text append: aText).! !!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:54'!improveText: someText forMorph: aMorph | betterText conversions fontForAll | fontForAll := TextStyle default. betterText := someText veryDeepCopy. conversions := OrderedCollection new. betterText runs withStartStopAndValueDo: [:start :stop :attributes | attributes do: [:att | (att isMemberOf: TextFontChange) ifTrue: [ conversions add: {att. start. stop} ] ] ]. conversions do: [ :old | | newAttr | betterText removeAttribute: old first from: old second to: old third. newAttr := TextFontReference toFont: (fontForAll fontAt: old first fontNumber). newAttr fontNumber: old first fontNumber. betterText addAttribute: newAttr from: old second to: old third. ]. ^betterText! !!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:57'!reportError: aString receivingPane setText: (receivingPane text append: (aString asText addAttribute: TextColor red), String cr).! !!NebraskaFridgeMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:52'!acceptDroppingMorph: morphToDrop event: evt | outData | (morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt ]. self eToyRejectDropMorph: morphToDrop event: evt. "we will keep a copy" (morphToDrop isKindOf: NebraskaSenderMorph) ifTrue: [ self class addRecipient: morphToDrop. ^self rebuild ]. self stopFlashing. "7 mar 2001 - remove #veryDeepCopy" outData := SmartRefStream streamedRepresentationOf: morphToDrop. self resetIndicator: #working. self class fridgeRecipients do: [ :each | self transmitStreamedObject: outData to: each ipAddress ].! !!NebraskaMorphsWelcomeMorph methodsFor: 'initialization' stamp: 'mt 8/11/2023 13:59'!initialize "initialize the state of the receiver" | earMorph | super initialize. "" self layoutInset: 8 @ 8. "earMorph := (EToyListenerMorph makeListeningToggle: true) asMorph." earMorph := TextMorph new contents: 'Morphswelcomehere'; fontName: Preferences standardDefaultTextFont familyName size: 18; centered; lock. self addARow: {earMorph}. self setBalloonText: 'My presence in this world means received morphs may appear automatically' translated! !!NebraskaMultiChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:52'!acceptTo: someText forMorph: aMorph | streamedMessage betterText | betterText := self improveText: someText forMorph: aMorph. streamedMessage := SmartRefStream streamedRepresentationOf: {targetIPAddresses. betterText}. targetIPAddresses do: [ :each | self transmitStreamedObject: streamedMessage to: each. ]. aMorph setText: '' asText. self appendMessage: self startOfMessageFromMe, ' - ', betterText, String cr. ^true! !!NebraskaSenderMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:53'!acceptDroppingMorph: morphToDrop event: evt | myCopy outData | (morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it" "7 mar 2001 - remove #veryDeepCopy" myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position. self stopFlashing. outData := SmartRefStream streamedRepresentationOf: myCopy. self resetIndicator: #working. self transmitStreamedObject: outData to: self ipAddress.! !!NebraskaSenderMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:53'!sendStatusReply | null | null := String with: 0 asCharacter. NebraskaPeerToPeer new sendSomeData: { NebraskaIncomingMessage typeStatusReply,null. Preferences defaultAuthorName,null. (SmartRefStream streamedRepresentationOf: (NebraskaGateKeeperMorph acceptableTypesFor: self ipAddress)). } to: self ipAddress for: self.! !!NebraskaServerMorph methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:54'!rebuild | myServer toggle closeBox font | font := StrikeFont familyName: #Palatino size: 14. self removeAllMorphs. self setColorsAndBorder. self updateCurrentStatusString. toggle := SimpleHierarchicalListMorph new perform: ( fullDisplay ifTrue: [#expandedForm] ifFalse: [#notExpandedForm] ). closeBox := SimpleButtonMorph new borderWidth: 0; label: 'X' font: Preferences standardButtonFont; color: Color transparent; actionSelector: #delete; target: self; extent: 14@14; setBalloonText: 'End Nebraska session' translated. self addARow: { self inAColumn: {closeBox}. self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentStatusString; contents: self currentStatusString; stepTime: 2000; lock. }. self inAColumn: { toggle asMorph on: #mouseUp send: #toggleFull to: self; setBalloonText: 'Show more or less of Nebraska Status' translated }. }. myServer := self server. (myServer isNil or: [fullDisplay not]) ifTrue: [ ^self world startSteppingSubmorphsOf: self ]. "--- the expanded display ---" self addARow: { self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentBacklogString; contents: self currentBacklogString; stepTime: 2000; lock. }. }. self addARow: { self inAColumn: { (StringMorph contents: '--clients--' translated) lock; font: font. }. }. myServer clients do: [ :each | self addARow: { UpdatingStringMorph new useStringFormat; target: each; font: font; getSelector: #currentStatusString; contents: each currentStatusString; stepTime: 2000; lock. } ]. self world startSteppingSubmorphsOf: self.! !!NebraskaServerMorph methodsFor: 'initialization' stamp: 'mt 8/23/2023 13:26'!setColorsAndBorder self color: (Color r: 0.9 g: 0.9 b: 0.9). self borderStyle: (BorderStyle raised width: 1). self useRoundedCorners! !!NetworkTerminalMorph methodsFor: 'events-processing' stamp: 'mt 8/14/2023 11:29'!handleMouseDown: anEvent anEvent wasHandled ifTrue:[^self]. anEvent hand removePendingBalloonFor: self. anEvent wasHandled: true. anEvent hand newMouseFocus: self event: anEvent. anEvent hand removeHaloFromClick: anEvent on: self. self sendEventAsIs: anEvent.! !!NetworkTerminalMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:53'!acceptDroppingMorph: morphToDrop event: evt | myCopy outData null | (morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it" "7 mar 2001 - remove #veryDeepCopy" myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position. outData := SmartRefStream streamedRepresentationOf: myCopy. null := String with: 0 asCharacter. NebraskaPeerToPeer new sendSomeData: { NebraskaIncomingMessage typeMorph,null. Preferences defaultAuthorName,null. outData } to: connection remoteSocketAddress hostNumber for: self.! !!NewHandleMorph methodsFor: 'initialization' stamp: 'mt 3/10/2023 16:07'!initialize"initialize the state of the receiver" super initialize."" waitingForClickInside := true.! !!ObjectExplorer methodsFor: 'menus' stamp: 'mt 8/28/2023 14:40'!explorerKey: aChar from: view event: event event anyModifierKeyPressed ifFalse: [^ false]. self object ifNotNil: [ aChar == $i ifTrue: [self inspectSelection. ^ true]. aChar == $I ifTrue: [self exploreSelection. ^ true]. aChar == $b ifTrue: [self browseFull. ^ true]. aChar == $h ifTrue: [self browseClassHierarchy. ^ true]. aChar == $c ifTrue: [self copyName. ^ true]. aChar == $p ifTrue: [self browseFullProtocol. ^ true]. aChar == $N ifTrue: [self browseClassRefs. ^ true]]. ^ false! !!ObjectlandMorph methodsFor: 'projects' stamp: 'mt 8/11/2023 15:16'!fillObjectlandProject ^ self fillObjectlandProjectWith: { self createGamesProject. self createGraphicsProject. self createToolsProject. self createSoundsProject }! !!ObjectsTool methodsFor: 'search' stamp: 'mt 8/11/2023 13:59'!newSearchPane "Answer a type-in pane for searches" | aTextMorph | aTextMorph := TextMorph new setProperty: #defaultContents toValue: ('' asText allBold addAttribute: (TextFontChange font3)); setTextStyle: (TextStyle fontArray: { Preferences standardDefaultTextFont }); setDefaultContentsIfNil; on: #keyStroke send: #searchPaneCharacter: to: self; setNameTo: 'SearchPane'; setBalloonText: 'Type here and all entries that match will be shown.' translated; vResizing: #shrinkWrap; hResizing: #spaceFill; margins: 4 px @ 6 px; backgroundColor: Color white. ^ aTextMorph! !!PackageDependencyTest methodsFor: 'tests' stamp: 'mt 3/15/2023 14:59'!testMorphic self testPackage: #Morphic dependsExactlyOn: #( Balloon #'Chronology-Core' Collections Compiler Compression Files Graphics 'Installer-Core' "Because of TheWorldMainDockingBar's install feature ..." Kernel MonticelloConfigurations MorphicExtras Multilingual Network Sound System SystemReporter #'ToolBuilder-Kernel' #'ToolBuilder-Morphic' Tools TrueType ).! !!PackageDependencyTest methodsFor: 'failures' stamp: 'mt 3/15/2023 14:58'!expectedFailures ^ #(testSystem testTools)! !!PaintBoxMorph methodsFor: 'actions' stamp: 'mt 8/10/2023 15:31'!currentColor: aColor currentColor := aColor.! !!PaintBoxMorph methodsFor: 'initialization' stamp: 'mt 8/28/2023 14:39'!addLabels self addGraphicLabels ifFalse: [self addTextualLabels].! !!PaintBoxMorph methodsFor: 'initialization' stamp: 'mt 8/10/2023 15:30'!beSupersized "Not supported."! !!PaintBoxMorph methodsFor: 'other' stamp: 'mt 8/28/2023 14:39'!offsetFromMaxBounds "location of normal PaintBox within maxBounds." | left | left := self left. self flag: #useBiggerPaintingBox. left := left - (( self width * 1.5)- self width). ^ left - colorMemory left @ 0! !!PaintBoxMorph class methodsFor: 'instance creation' stamp: 'mt 8/28/2023 15:42'!new | pb | pb := self prototype veryDeepCopy. pb stampHolder normalize. "Get the stamps to show" "Get my own copies of the brushes so I can modify them" #(brush1: brush2: brush3: brush4: brush5: brush6:) do: [:sel | | dualUse button | button := pb submorphNamed: sel. button offImage: button offImage deepCopy. dualUse := button onImage == button pressedImage. "sometimes shared" button onImage: button onImage deepCopy. dualUse ifTrue: [button pressedImage: button onImage] ifFalse: [button pressedImage: button pressedImage deepCopy]. ]. pb showColor. pb fixUpRecentColors. pb addLabels. ^ pb! !!ParagraphEditor methodsFor: 'editing keys' stamp: 'mt 8/11/2023 14:44'!changeEmphasis: characterStream "Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change. Keeps typeahead." | keyCode attribute oldAttributes index thisSel colors extras | "control 0..9 -> 0..9" keyCode := ('0123456789' indexOf: sensor keyboard ifAbsent: [1]) - 1. oldAttributes := paragraph text attributesAt: self pointIndex forStyle: paragraph textStyle. thisSel := self selection. "Decipher keyCodes for Command 0-9..." "(keyCode between: 1 and: 5) ifTrue: [ attribute := TextFontChange fontNumber: keyCode ]." keyCode = 5 ifTrue: [ | labels lines | colors := #(#black #magenta #red #yellow #green #blue #cyan #white ). extras := #('Link to comment of class' 'Link to definition of class' 'Link to hierarchy of class' 'Link to method' ). labels := colors , #('choose color...' 'Do it' 'Print it' ) , extras , #('be a web URL link' 'Edit hidden info' 'Copy hidden info' ). lines := Array with: colors size + 1. "index := (PopUpMenu labelArray: labels lines: lines) startUp. " index := UIManager default chooseFrom: labels lines: lines. index = 0 ifTrue: [ ^ true]. index <= colors size ifTrue: [ attribute := TextColor color: (Color perform: (colors at: index)) ] ifFalse: [ index := index - colors size - 1. "Re-number!!!!!!" index = 0 ifTrue: [ attribute := self chooseColor ]. index = 1 ifTrue: [ attribute := TextDoIt new. thisSel := attribute analyze: self selection asString ]. index = 2 ifTrue: [ attribute := TextPrintIt new. thisSel := attribute analyze: self selection asString ]. extras size = 0 & (index > 2) ifTrue: [ index := index + 4 "skip those" ]. index = 3 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Comment' ]. index = 4 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Definition' ]. index = 5 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Hierarchy' ]. index = 6 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString ]. index = 7 ifTrue: [ attribute := TextURL new. thisSel := attribute analyze: self selection asString ]. index = 8 ifTrue: [ "Edit hidden info" thisSel := self hiddenInfo. "includes selection" attribute := TextEmphasis normal ]. index = 9 ifTrue: [ "Copy hidden info" self copyHiddenInfo. ^ true ]. "no other action" thisSel ifNil: [ ^ true ] ] ]. (keyCode between: 6 and: 9) ifTrue: [ sensor leftShiftDown ifTrue: [ keyCode = 6 ifTrue: [ attribute := TextKern kern: -1 ]. keyCode = 7 ifTrue: [ attribute := TextKern kern: 1 ] ] ifFalse: [ "And remember this: nine is fine for underline, obliter-eight it as you see fit, seven has been bold for ever'n, which leaves six as the obivous fix to emphasize your poetics." attribute := TextEmphasis perform: (#(italic bold struckOut underlined) at: keyCode - 5). oldAttributes do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]] ] ]. keyCode = 0 ifTrue: [attribute := TextEmphasis normal]. attribute ifNil: [^ true]. beginTypeInBlock ~~ nil ifTrue: [ "only change emphasisHere while typing" self insertTypeAhead: characterStream. emphasisHere := Text addAttribute: attribute toArray: oldAttributes. ^ true ]. self replaceSelectionWith: (thisSel asText addAttribute: attribute). ^ true! !!ParagraphEditor class methodsFor: 'class initialization' stamp: 'mt 8/11/2023 14:47'!yellowButtonMenu ^ SelectionMenu fromArray: StringHolder yellowButtonMenuItems! !!ParagraphEditor class methodsFor: 'keyboard shortcut tables' stamp: 'mt 8/11/2023 14:45'!initializeCmdKeyShortcuts "Initialize the (unshifted) command-key (or alt-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "ParagraphEditor initialize" | cmdMap | cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash" cmdMap at: 1 + 1 put: #cursorHome:. "home key" cmdMap at: 4 + 1 put: #cursorEnd:. "end key" cmdMap at: 8 + 1 put: #backspace:. "ctrl-H or delete key" cmdMap at: 11 + 1 put: #cursorPageUp:. "page up key" cmdMap at: 12 + 1 put: #cursorPageDown:. "page down key" cmdMap at: 13 + 1 put: #crWithIndent:. "cmd-Return" cmdMap at: 27 + 1 put: #offerMenuFromEsc:. "escape key" cmdMap at: 28 + 1 put: #cursorLeft:. "left arrow key" cmdMap at: 29 + 1 put: #cursorRight:. "right arrow key" cmdMap at: 30 + 1 put: #cursorUp:. "up arrow key" cmdMap at: 31 + 1 put: #cursorDown:. "down arrow key" cmdMap at: 32 + 1 put: #selectWord:. "space bar key" cmdMap at: 127 + 1 put: #forwardDelete:. "del key" '0123456789' do: [:char | cmdMap at: char asciiValue + 1 put: #changeEmphasis:]. "triplet = {character. comment selector. novice appropiated}" #( ($a #selectAll: ) ($b #browseIt: ) ($c #copySelection: ) ($d #doIt: ) ($e #exchange: ) ($f #find: ) ($g #findAgain: ) ($h #setSearchString: ) ($i #inspectIt: ) ($j #doAgainOnce: ) ($k #offerFontMenu: ) ($l #cancel: ) ($m #implementorsOfIt: ) ($n #sendersOfIt: ) ($o #spawnIt: ) ($p #printIt: ) ($q #querySymbol: ) ($s #save: ) ($t #tempCommand: ) ($u #align: ) ($v #paste: ) ($w #backWord: ) ($x #cut: ) ($y #swapChars: ) ($z #undo: ) ) do:[:triplet | cmdMap at: triplet first asciiValue + 1 put: triplet second]. CmdActions := cmdMap.! !!ParagraphEditor class methodsFor: 'keyboard shortcut tables' stamp: 'mt 8/11/2023 14:46'!initializeShiftCmdKeyShortcuts "Initialize the shift-command-key (or control-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the capitalized versions of the letters. TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values." | cmdMap | "shift-command and control shortcuts" cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash" cmdMap at: ( 1 + 1) put: #cursorHome:. "home key" cmdMap at: ( 4 + 1) put: #cursorEnd:. "end key" cmdMap at: ( 8 + 1) put: #forwardDelete:. "ctrl-H or delete key" cmdMap at: (11 + 1) put: #cursorPageUp:. "page up key" cmdMap at: (12 + 1) put: #cursorPageDown:. "page down key" cmdMap at: (13 + 1) put: #crWithIndent:. "ctrl-Return" cmdMap at: (27 + 1) put: #offerMenuFromEsc:. "escape key" cmdMap at: (28 + 1) put: #cursorLeft:. "left arrow key" cmdMap at: (29 + 1) put: #cursorRight:. "right arrow key" cmdMap at: (30 + 1) put: #cursorUp:. "up arrow key" cmdMap at: (31 + 1) put: #cursorDown:. "down arrow key" cmdMap at: (32 + 1) put: #selectWord:. "space bar key" cmdMap at: (45 + 1) put: #changeEmphasis:. "cmd-sh-minus" cmdMap at: (61 + 1) put: #changeEmphasis:. "cmd-sh-plus" cmdMap at: (127 + 1) put: #forwardDelete:. "del key" "triplet = {character. comment selector. novice appropiated}" #( ($a argAdvance: ) ($b browseItHere: ) ($c compareToClipboard: ) ($d debugIt: ) ($e methodStringsContainingIt:) ($f displayIfFalse: ) ($g fileItIn: ) ($h cursorTopHome: ) ($i exploreIt: ) ($j doAgainMany: ) ($k changeStyle: ) ($m selectCurrentTypeIn: ) ($n referencesToIt: ) ($p makeProjectLink: ) ($s search: ) ($t displayIfTrue: ) ($u changeLfToCr: ) ($v pasteInitials: ) ($w methodNamesContainingIt:) ($x makeLowercase: ) ($y makeUppercase: ) ($z makeCapitalized: ) ) do:[:triplet | cmdMap at: (triplet first asciiValue + 1) put: triplet second. "plain keys" cmdMap at: (triplet first asciiValue - 32 + 1) put: triplet second. "shifted keys" cmdMap at: (triplet first asciiValue - 96 + 1) put: triplet second. "ctrl keys" ]. ShiftCmdActions := cmdMap! !!PasteUpMorph methodsFor: 'accessing' stamp: 'mt 8/11/2023 16:19'!flapTab "Answer the tab affilitated with the receiver. Normally every flap tab is expected to have a PasteUpMorph which serves as its 'referent.'" self isFlap ifFalse: [^ nil]. ^ self flapTabs detect: [:any| any referent == self] ifNone: [nil]! !!PasteUpMorph methodsFor: 'caching' stamp: 'mt 3/10/2023 15:07'!releaseCachedState super releaseCachedState. self isWorldMorph ifTrue:[self cleanseStepList].! !!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'mt 8/14/2023 17:42'!acceptDroppingMorph: dropped event: evt "The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied" | aMorph | (self isWorldMorph and: [dropped isTransferMorph] and: [self hasTransferMorphConverter not]) ifTrue: [ dropped dragTransferType = #filesAndDirectories ifTrue: [^ self dropFiles: dropped passenger event: evt]. dropped dragTransferType = #sourceCode ifTrue: [^ self dropSourceCode: dropped passenger event: evt]. dropped dragTransferType = #inspectorField "See Tools-Inspector" ifTrue: [^ self dropInspectorField: dropped passenger event: evt]. dropped dragTransferType = #explorerField "See Tools-Explorer" ifTrue: [^ self dropExplorerField: dropped passenger from: dropped source model event: evt]]. aMorph := self morphToDropFrom: dropped. self isWorldMorph ifFalse: [super acceptDroppingMorph: aMorph event: evt] ifTrue: ["Add the given morph to this world and start stepping it if it wants to be." aMorph isInWorld ifFalse: [aMorph position: evt position]. self addMorphFront: aMorph. (aMorph fullBounds intersects: self viewBox) ifFalse: [Beeper beep. aMorph position: self bounds center]]. aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]]. self isPartsBin ifTrue: [aMorph isPartsDonor: true. aMorph stopSteppingSelfAndSubmorphs. aMorph suspendEventHandler] ifFalse: [self world startSteppingSubmorphsOf: aMorph]. self bringTopmostsToFront.! !!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'mt 8/14/2023 17:41'!morphToDropFrom: aMorph "Given a morph being carried by the hand which the hand is about to drop, answer the actual morph to be deposited. Normally this would be just the morph itself, but several unusual cases arise, which this method is designed to service." | aNail representee handy posBlock | handy := self isWorldMorph ifTrue: [self primaryHand] ifFalse: [self currentHand]. posBlock := [:z | | tempPos | tempPos := handy position - ((handy targetOffset - aMorph formerPosition) * (z extent / aMorph extent)) rounded. self pointFromWorld: tempPos]. self alwaysShowThumbnail ifTrue: [aNail := aMorph representativeNoTallerThan: self maxHeightToAvoidThumbnailing norWiderThan: self maximumThumbnailWidth thumbnailHeight: self heightForThumbnails. aNail == aMorph ifFalse: [aMorph formerPosition: aMorph position. aNail position: (posBlock value: aNail)]. ^aNail]. ((aMorph isKindOf: MorphThumbnail) and: [(representee := aMorph morphRepresented) owner isNil]) ifTrue: [representee position: (posBlock value: representee). ^representee]. ^aMorph morphToDropInPasteUp: self! !!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/15/2023 13:45'!handlesKeyboard: evt ^self isWorldMorph! !!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/15/2023 13:45'!keyStroke: anEvent "A keystroke has been made. Service event handlers and, if it's a keystroke presented to the world, dispatch it to #unfocusedKeystroke:" | selected | super keyStroke: anEvent. "Give event handlers a chance" selected := self selectedObject. selected isNil ifFalse:[ selected moveOrResizeFromKeystroke: anEvent ]. self isWorldMorph ifTrue: [self keystrokeInWorld: anEvent]! !!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 16:08'!mouseDown: evt "Handle a mouse down event." | grabbedMorph handHadHalos | (Preferences generalizedYellowButtonMenu and: [evt yellowButtonPressed]) ifTrue: [^ self yellowButtonActivity: evt shiftPressed]. grabbedMorph := self morphToGrab: evt. grabbedMorph ifNotNil:[ grabbedMorph isSticky ifTrue:[^self]. self isPartsBin ifFalse:[^evt hand grabMorph: grabbedMorph]. grabbedMorph := grabbedMorph partRepresented duplicate. grabbedMorph restoreSuspendedEventHandler. (grabbedMorph fullBounds containsPoint: evt position) ifFalse:[grabbedMorph position: evt position]. "Note: grabbedMorph is ownerless after duplicate so use #grabMorph:from: instead" ^ evt hand grabMorph: grabbedMorph from: self]. (super handlesMouseDown: evt) ifTrue:[^super mouseDown: evt]. handHadHalos := evt hand halo notNil. evt hand removeHalo. "shake off halos" evt hand releaseKeyboardFocus. "shake of keyboard foci" self submorphs select:[:each | each hasProperty: #morphHierarchy] thenDo:[:each | each delete]. (evt shiftPressed not and:[ self isWorldMorph not and:[ self wantsEasySelection not ]]) ifTrue:[ "explicitly ignore the event if we're not the world and we'll not select, so that we could be picked up if need be" evt wasHandled: false. ^ self. ]. ( evt shiftPressed or: [ self wantsEasySelection ] ) ifTrue:[ "We'll select on drag, let's decide what to do on click" | clickSelector | clickSelector := nil. evt shiftPressed ifTrue:[ clickSelector := #findWindow:. ] ifFalse:[ self isWorldMorph ifTrue:[ clickSelector := handHadHalos ifTrue: [ #delayedInvokeWorldMenu: ] ifFalse: [ #invokeWorldMenu: ] ] ]. evt hand waitForClicksOrDrag: self event: evt selectors: { clickSelector. nil. nil. #dragThroughOnDesktop: } threshold: HandMorph dragThreshold. ] ifFalse:[ "We wont select, just bring world menu if I'm the world" self isWorldMorph ifTrue:[ handHadHalos ifTrue: [ self delayedInvokeWorldMenu: evt ] ifFalse: [ self invokeWorldMenu: evt ] ] ].! !!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/7/2023 18:18'!windowEvent: anEvent self windowEventHandler ifNotNil: [^self windowEventHandler windowEvent: anEvent]. anEvent type caseOf: { [#windowClose] -> [TheWorldMenu basicNew quitSession]. [#windowDeactivated] -> [ "The host window has been deactivated. Until it regains the focus, honor the fact that we will not receive keyboard events again by changing the current keyboard focus morph. windowHostFocusMorph represents the host system which now holds the keyboard focus instead of the previousFocus." (self valueOfProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | "There is currently no exact-once guarantee for this event type from the VM. Mark any older host focus morph as inactive, it will be held as the previousFocus of the next host focus morph." hostFocus active: false]. self setProperty: #windowHostFocusMorph toValue: (WindowHostFocusMorph new in: [:hostFocus | hostFocus previousFocus: anEvent hand keyboardFocus. anEvent hand newKeyboardFocus: hostFocus.]; yourself)]. [#windowActivated] -> [ "Alright, the spook is over!! We have back control over the keyboard focus, delete the windowHostFocusMorph and restore the previous focus holder." (self removeProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | hostFocus active: false. (anEvent hand keyboardFocus == hostFocus and: [hostFocus previousFocus notNil]) ifTrue: [anEvent hand newKeyboardFocus: hostFocus previousFocus]]]. } otherwise: []! !!PasteUpMorph methodsFor: 'events-processing' stamp: 'mt 3/10/2023 16:09'!tryInvokeHalo: aUserInputEvent Morph haloForAll ifFalse: [ ^ self ]. (self transferHalo: aUserInputEvent) ifTrue: "The event was handled, don't let it cause any further side-effects." [ aUserInputEvent ignore ].! !!PasteUpMorph methodsFor: 'events-processing' stamp: 'mt 3/10/2023 11:27'!tryInvokeMetaMenu: anEvent | innerMost target | Morph metaMenuForAll ifFalse: [^ self]. innerMost := (self morphsAt: anEvent position unlocked: true) first. "Traverse the owner chain if some morph does not want to show its meta menu." target := innerMost. [target isNil or: [target wantsMetaMenu]] whileFalse: [target := target owner]. target ifNil: [^ self]. target invokeMetaMenu: anEvent. anEvent ignore.! !!PasteUpMorph methodsFor: 'halos and balloon help' stamp: 'mt 3/7/2023 17:39'!wantsHaloFromClick (owner isSystemWindow) ifTrue: [^ false]. ^ true.! !!PasteUpMorph methodsFor: 'initialization' stamp: 'mt 3/10/2023 15:29'!initialize"initialize the state of the receiver" super initialize."" padding := 3. self enableDragNDrop. self clipSubmorphs: true. self initializeKeyboardShortcuts. self initializeMouseShortcuts.! !!PasteUpMorph methodsFor: 'menu & halo' stamp: 'mt 8/11/2023 16:18'!addCustomMenuItems: menu hand: aHandMorph "Add morph-specific menu itemns to the menu for the hand" super addCustomMenuItems: menu hand: aHandMorph. self isWorldMorph ifTrue: [ | twm | menu addLine. menu addUpdating: #showWorldMainDockingBarString action: #toggleShowWorldMainDockingBar. menu addLine. Flaps sharedFlapsAllowed ifTrue: [ menu addUpdating: #suppressFlapsString target: Project current action: #toggleFlapsSuppressed. ]. twm := TheWorldMenu new. twm world: self project: Project current hand: aHandMorph. menu add: 'old desktop menu... (W)' translated subMenu: twm buildWorldMenu. ].! !!PasteUpMorph methodsFor: 'menu & halo' stamp: 'mt 8/16/2023 16:02'!addWorldHaloMenuItemsTo: aMenu hand: aHandMorph "Add standard halo items to the menu, given that the receiver is a World" | unlockables | self addFillStyleMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph. aMenu addLine. self addWorldToggleItemsToHaloMenu: aMenu. aMenu addLine. self addCopyItemsTo: aMenu. self addExportMenuItems: aMenu hand: aHandMorph. self addMiscExtrasTo: aMenu. self addDebuggingItemsTo: aMenu hand: aHandMorph. aMenu addLine. aMenu defaultTarget: self. aMenu addLine. unlockables := self submorphs select: [:m | m isLocked]. unlockables size = 1 ifTrue: [aMenu add: ('unlock "{1}"' translated format:{unlockables first externalName})action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' translated action: #unlockContents]. aMenu defaultTarget: aHandMorph.! !!PasteUpMorph methodsFor: 'options' stamp: 'mt 8/4/2023 14:08'!autoLineLayout: aBoolean "Make the receiver be viewed with auto-line-layout, which means that its submorphs will be laid out left-to-right and then top-to-bottom in the manner of a word processor, or (if aBoolean is false,) cease applying auto-line-layout" aBoolean ifTrue:[ self layoutPolicy: TableLayout new. self layoutInset: 8; cellGap: 4. self listDirection: #leftToRight; wrapDirection: #topToBottom. ] ifFalse:[ self layoutPolicy: nil. self layoutInset: 0; cellGap: 0. ].! !!PasteUpMorph methodsFor: 'undo' stamp: 'fbs 12/31/2013 12:08'!onceAgainDismiss: aMorph "Occasioned by a redo of a dismiss-via-halo" aMorph dismissMorph. TrashCanMorph preserveTrash ifTrue: [TrashCanMorph slideDismissalsToTrash ifTrue:[aMorph slideToTrash: nil] ifFalse:[TrashCanMorph moveToTrash: aMorph]]! !!PasteUpMorph methodsFor: 'undo' stamp: 'mt 8/4/2023 14:45'!reintroduceIntoWorld: aMorph "The given morph is being raised from the dead. Bring it back to life." (aMorph valueOfProperty: #lastPosition) ifNotNil: [:pos | aMorph position: pos]. aMorph openInWorld ! !!PasteUpMorph methodsFor: 'WiW support' stamp: 'raa 11/14/2017 07:47'!installAsActiveSubprojectIn: enclosingWorld at: newBounds titled: aString | window howToOpen tm boundsForWorld | howToOpen := self embeddedProjectDisplayMode. "#scaled may be the only one that works at the moment" submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." boundsForWorld := howToOpen == #naked ifTrue: [newBounds] ifFalse: [bounds]. worldState canvas: nil. worldState viewBox: boundsForWorld. self bounds: boundsForWorld. "self viewBox: Display boundingBox." "worldState handsDo: [:h | h initForEvents]." self installFlaps. "SystemWindow noteTopWindowIn: self." "self displayWorldSafely." howToOpen == #naked ifTrue: [enclosingWorld addMorphFront: self]. howToOpen == #window ifTrue: [window := (SystemWindow labelled: aString) model: self. window addMorph: self frame: (0 @ 0 extent: 1.0 @ 1.0). window openInWorld: enclosingWorld]. howToOpen == #frame ifTrue: [window := (AlignmentMorphBob1 new) minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color green; bounds: newBounds. window addMorph: self. window openInWorld: enclosingWorld]. howToOpen == #scaled ifTrue: [self position: 0 @ 0. window := (EmbeddedWorldBorderMorph new) minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color green; bounds: newBounds. tm := BOBTransformationMorph new. window addMorph: tm. tm addMorph: self. window openInWorld: enclosingWorld. tm changeWorldBoundsToShow: bounds. self arrangeToStartSteppingIn: enclosingWorld "tm scale: (tm width / self width min: tm height / self height) asFloat."]! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 8/14/2023 17:32'!findWindow: evt "Present a menu names of windows and naked morphs, and activate the one that gets chosen. Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo." | menu expanded collapsed nakedMorphs | menu := MenuMorph new. expanded := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed not]. collapsed := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed]. nakedMorphs := self submorphsSatisfying: [:m | m isSystemWindow not and: [(m isFlapTab) not]]. (expanded isEmpty & (collapsed isEmpty & nakedMorphs isEmpty)) ifTrue: [^ Beeper beep]. (expanded sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: (w label contractTo: 80) target: w action: #beKeyWindow. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. (expanded isEmpty | (collapsed isEmpty & nakedMorphs isEmpty)) ifFalse: [menu addLine]. (collapsed sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: (w label contractTo: 80) target: w action: #collapseOrExpand. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. nakedMorphs isEmpty ifFalse: [menu addLine]. (nakedMorphs sort: [:w1 :w2 | w1 nameForFindWindowFeature caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) do: [:w | menu add: (w nameForFindWindowFeature contractTo: 80) target: w action: #comeToFrontAndAddHalo]. menu addTitle: 'find window' translated. menu popUpEvent: evt in: self.! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 11:27'!invokeWorldMenu: evt "Put up the world menu, triggered by the passed-in event." self putUpWorldMenu: evt.! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 11:27'!keystrokeInWorld: evt "A keystroke was hit when no keyboard focus was set, so it is sent here to the world instead." | aChar isCmd ascii | aChar := evt keyCharacter. (ascii := aChar asciiValue) = Character escape asciiValue ifTrue: [evt commandKeyPressed ifFalse: [^ self putUpWorldMenuFromEscapeKey]]. (evt controlKeyPressed not and: [(#(1 4 8 28 29 30 31 32) includes: ascii) "home, end, backspace, arrow keys, space" and: [self keyboardNavigationHandler notNil]]) ifTrue: [self keyboardNavigationHandler navigateFromKeystroke: aChar]. isCmd := evt commandKeyPressed and: [Preferences cmdKeysInText]. (isCmd and: [Preferences honorDesktopCmdKeys]) ifTrue: [^ self dispatchCommandKeyInWorld: aChar event: evt]. "It was unhandled. Remember the keystroke." self lastKeystroke: evt keyString. self triggerEvent: #keyStroke! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/8/2023 10:36'!putUpNewMorphMenu "Put up the New Morph menu in the world" TheWorldMenu new world: self project: Project current hand: self currentHand; newMorph! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 16:08'!putUpWorldMenuFromEscapeKey self putUpWorldMenu: self currentEvent.! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/10/2023 13:57'!allNonWindows "Answer all non-window submorphs" ^submorphs select: [:m | (m isSystemWindow) not and: [m wantsToBeTopmost not]]! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/10/2023 15:29'!beWorldForProject: aProject self privateOwner: nil. worldState := WorldState new. self addHand: HandMorph new. self setProperty: #optimumExtentFromAuthor toValue: Display extent. self startSteppingSubmorphsOf: self! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/15/2023 13:18'!initForProject: aWorldState worldState := aWorldState. self viewBox: Display boundingBox. self color: Preferences defaultWorldColor. self addHand: HandMorph new. self setProperty: #optimumExtentFromAuthor toValue: Display extent. self borderWidth: 0. model := nil.! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 8/11/2023 16:20'!install owner := nil. "since we may have been inside another world previously" submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." self viewBox: Display boundingBox. EventSensor default flushEvents. worldState handsDo: [:h | h initForEvents]. self installFlaps. self borderWidth: 0. "default" (Preferences showSecurityStatus and: [SecurityManager default isInRestrictedMode]) ifTrue: [self borderWidth: 2; borderColor: Color red]. SystemWindow noteTopWindowIn: self.! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 8/10/2023 15:27'!paintBox "Return the painting controls widget (PaintBoxMorph) to be used for painting in this world. If there is not already a PaintBox morph, or if it has been deleted from this world, create a new one." | newPaintBox refPoint | self allMorphsDo: [:m | (m isKindOf: PaintBoxMorph) ifTrue: [^ m]]. refPoint := self topRight. newPaintBox := PaintBoxMorph new. newPaintBox position: (refPoint - (newPaintBox width @ 0)). self addMorph: newPaintBox. ^ newPaintBox! !!PasteUpMorph methodsFor: 'world state' stamp: 'sw 9/2/1999 12:01'!paintBoxOrNil "Return the painting controls widget (PaintBoxMorph) to be used for painting in this world. If there is not already a PaintBox morph return nil" self allMorphsDo: [:m | (m isKindOf: PaintBoxMorph) ifTrue: [^ m]]. ^ nil! !!PasteUpMorph methodsFor: '*Tools' stamp: 'mt 3/10/2023 16:08'!defaultDesktopCommandKeyTriplets "Answer a list of triplets of the form <key> <receiver> <selector> [+ optional fourth element, a <description> for use in desktop-command-key-help] that will provide the default desktop command key handlers. If the selector takes an argument, that argument will be the command-key event" "World initializeDesktopCommandKeySelectors" | noviceKeys expertKeys | noviceKeys := { {$r. self. #restoreMorphicDisplay. 'Redraw the screen' translated}. {$M. self. #toggleShowWorldMainDockingBar. 'Show/Hide the Main Docking Bar' translated}. {$]. Smalltalk. #saveSession. 'Save the image.' translated}. }. expertKeys := { {$b. SystemBrowser. #defaultOpenBrowser. 'Open a new System Browser' translated}. {$k. Workspace. #open. 'Open a new Workspace' translated}. {$m. self. #putUpNewMorphMenu. 'Put up the "New Morph" menu' translated}. {$O. self. #findAMonticelloBrowser. 'Bring a Monticello window into focus.' translated}. {$t. self. #findATranscript:. 'Make a System Transcript visible' translated}. {$w. SystemWindow. #closeTopWindow. 'Close the topmost window' translated}. {Character escape. SystemWindow. #closeTopWindow. 'Close the topmost window' translated}. {$C. self. #findAChangeSorter:. 'Make a Change Sorter visible' translated}. {$L. self. #findAFileList:. 'Make a File List visible' translated}. {$P. self. #findAPreferencesPanel:. 'Activate the Preferences tool' translated}. {$R. Utilities. #browseRecentSubmissions. 'Make a Recent Submissions browser visible' translated}. {$W. self. #findAMessageNamesWindow:. 'Make a MessageNames tool visible' translated}. {$Z. ChangeList. #browseRecentLog. 'Browse recently-logged changes' translated}. {$. SystemWindow. #sendTopWindowToBack. 'Send the top window to the back' translated}. {$_. Smalltalk. #quitPrimitive. 'Quit the image immediately.' translated}. {$-. Preferences. #decreaseFontSize. 'Decrease all font sizes' translated}. {$+. Preferences. #increaseFontSize. 'Increase all font sizes' translated}. }. ^ noviceKeys, expertKeys! !!PasteUpMorph methodsFor: 'flaps' stamp: 'mt 8/4/2023 14:02'!addGlobalFlaps "Must make global flaps adapt to world. Do this even if not shown, so the old world will not be pointed at by the flaps." | use thisWorld | use := Flaps sharedFlapsAllowed. Project current flapsSuppressed ifTrue: [use := false]. "Smalltalk isMorphic ifFalse: [use := false]." thisWorld := use ifTrue: [self] ifFalse: [PasteUpMorph new initForProject: "fake to be flap owner" WorldState new; bounds: (0@0 extent: 4000@4000); viewBox: (0@0 extent: 4000@4000)]. Flaps globalFlapTabsIfAny do: [:aFlapTab | (Project current isFlapEnabled: aFlapTab) ifTrue: [(aFlapTab world == thisWorld) ifFalse: [thisWorld addMorphFront: aFlapTab]. "always do" use ifTrue: [aFlapTab spanWorld. aFlapTab adjustPositionAfterHidingFlap. aFlapTab flapShowing ifTrue: [aFlapTab showFlap]]]]! !!PasteUpMorph methodsFor: 'flaps' stamp: 'nice 12/27/2009 20:14'!localFlapTabs "Answer a list of local flap tabs in the current project" | globalList aList | globalList := Flaps globalFlapTabsIfAny. aList := OrderedCollection new. submorphs do: [:m | | aFlapTab | ((m isFlapTab) and: [(globalList includes: m) not]) ifTrue: [aList add: m] ifFalse: [((m isFlap) and: [(aFlapTab := m submorphs detect: [:n | n isFlapTab] ifNone: [nil]) notNil]) ifTrue: [aList add: aFlapTab]]]. ^ aList! !!PasteUpMorph methodsFor: '*services-base' stamp: 'mt 8/4/2023 14:03'!openWorldMenu | menu | menu := (TheWorldMenu new world: self project: nil hand: self primaryHand) buildWorldMenu. menu addTitle: Preferences desktopMenuTitle translated. menu openInHand! !!PasteUpMorph methodsFor: '*services-base' stamp: 'mt 8/28/2023 14:42'!worldMenu ^ TheWorldMenu new world: self project: nil hand: self primaryHand! !!PasteUpMorph class methodsFor: 'scripting' stamp: 'mt 3/15/2023 13:30'!authoringPrototype "Answer an instance of the receiver suitable for placing in a parts bin for authors" | proto | proto := self new markAsPartsDonor. proto color: Color green muchLighter; extent: 100 @ 80; borderColor: (Color r: 0.645 g: 0.935 b: 0.161). proto extent: 300 @ 240. proto beSticky. ^ proto! !!PasteUpMorph class methodsFor: '*MorphicExtras-class initialization' stamp: 'mt 7/31/2023 11:14'!initialize "Initialize the class" self registerInFlapsRegistry.! !!PolygonMorph methodsFor: 'stepping' stamp: 'mt 3/10/2023 15:01'!stepTime "Answer the desired time between steps in milliseconds." ^ 100! !!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:59'!printStandardSystemFonts "self printStandardSystemFonts" | string | string := String streamContents: [ :s | #(standardDefaultTextFont standardListFont standardFlapFont standardMenuFont windowTitleFont standardBalloonHelpFont standardCodeFont standardButtonFont) do: [:selector | | font | font := Preferences perform: selector. s nextPutAll: selector; space; nextPutAll: font familyName; space; nextPutAll: (AbstractFont emphasisStringFor: font emphasis); nextPutAll: ' points: '; print: font pointSize; nextPutAll: ' height: '; print: font height; cr ]]. (StringHolder new) contents: string; openLabel: 'Current system font settings' translated.! !!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:58'!refreshFontSettings "Try to update all the current font settings to make things consistent." UserInterfaceTheme current applyAfter: [ self setFlapsFontTo: (self standardFlapFont); setWindowTitleFontTo: (self windowTitleFont); setListFontTo: (self standardListFont); setMenuFontTo: (self standardMenuFont); setSystemFontTo: (TextStyle defaultFont); setCodeFontTo: (self standardCodeFont); setBalloonHelpFontTo: (BalloonMorph balloonFont)]. SystemWindow allSubInstancesDo: [ :s | | rawLabel | rawLabel := s getRawLabel. rawLabel owner vResizing: #spaceFill. rawLabel font: rawLabel font. s setLabel: s label. s replaceBoxes ].! !!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:59'!restoreFontsAfter: aBlock "Restore the currently chosen set of standard fonts after evaluating aBlock. Used for tests that modify the default fonts." | standardDefaultTextFont standardListFont standardMenuFont windowTitleFont standardBalloonHelpFont standardCodeFont standardButtonFont | standardDefaultTextFont := Preferences standardDefaultTextFont. standardListFont := Preferences standardListFont. standardMenuFont := Preferences standardMenuFont. windowTitleFont := Preferences windowTitleFont. standardBalloonHelpFont := Preferences standardBalloonHelpFont. standardCodeFont := Preferences standardCodeFont. standardButtonFont := Preferences standardButtonFont. ^ UserInterfaceTheme current applyAfter: [ aBlock ensure: [ Preferences setSystemFontTo: standardDefaultTextFont. Preferences setListFontTo: standardListFont. Preferences setMenuFontTo: standardMenuFont. Preferences setWindowTitleFontTo: windowTitleFont. Preferences setBalloonHelpFontTo: standardBalloonHelpFont. Preferences setCodeFontTo: standardCodeFont. Preferences setButtonFontTo: standardButtonFont]].! !!Preferences class methodsFor: 'support - misc' stamp: 'mt 3/7/2023 15:42'!personalizeUserMenu: aMenu "The user has clicked on the morphic desktop with the yellow mouse button (option+click on the Mac); a menu is being constructed to present to the user in response; its default target is the current world. In this method, you are invited to add items to the menu as per personal preferences. The default implementation, for illustrative purposes, sets the menu title to 'personal', and adds items for go-to-previous-project, show/hide flaps, and load code updates" aMenu addTitle: 'personal' translated. "Remove or modify this as per personal choice" aMenu addStayUpItem. aMenu add: 'previous project' translated action: #goBack. aMenu add: 'load latest code updates' translated target: MCMcmUpdater action: #updateFromServer. aMenu add: 'about this system...' translated target: Smalltalk action: #aboutThisSystem.! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'!classicHaloSpecs "Non-iconic halos with traditional placements" "Preferences installClassicHaloSpecs" "Preferences resetHaloSpecifications" " <- will result in the standard default halos being reinstalled" "NB: listed below in clockwise order" ^ #( " selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addMenuHandle: left top (red) none) (addDismissHandle: leftCenter top (red muchLighter) 'Halo-Dismiss') (addGrabHandle: center top (black) none) (addDragHandle: rightCenter top (brown) none) (addDupHandle: right top (green) none) (addDebugHandle: right topCenter (blue veryMuchLighter) none) (addGrowHandle: right bottom (yellow) none) (addScaleHandle: right bottom (lightOrange) none) (addFontEmphHandle: rightCenter bottom (lightBrown darker) none) (addFontStyleHandle: center bottom (lightRed) none) (addFontSizeHandle: leftCenter bottom (lightGreen) none) (addRecolorHandle: right bottomCenter (magenta darker) none) (addRotateHandle: left bottom (blue) none))! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/8/2023 11:41'!customHaloSpecs "Intended for you to modify to suit your personal preference. What is implemented in the default here is just a skeleton; in comment at the bottom of this method are some useful lines you may wish to paste in to the main body here, possibly modifying positions, colors, etc.. Note that in this example, we include: Dismiss handle, at top-left Menu handle, at top-right Resize handle, at bottom-right Rotate handle, at bottom-left Drag handle, at top-center Recolor handle, at left-center. (this one is NOT part of the standard formulary -- it is included here to illustrate how to add non-standard halos) Note that the optional handles for specialized morphs, such as Sketch, Text, PasteUp, are also included" ^ #( (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addMenuHandle: right top (red) 'Halo-Menu') (addDragHandle: center top (brown) 'Halo-Drag') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale') (addRecolorHandle: left center (green muchLighter lighter) 'Halo-Recolor') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') ) " Other useful handles... selector horiz vert color info icon key --------- ------ ----------- ------------------------------- --------------- (addTileHandle: left bottomCenter (lightBrown) 'Halo-Tile') (addViewHandle: left center (cyan) 'Halo-View') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addFewerHandlesHandle: left topCenter (paleBuff) 'Halo-FewerHandles') (addPaintBgdHandle: right center (lightGray) 'Halo-Paint') (addRepaintHandle: right center (lightGray) 'Halo-Paint') "! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/8/2023 11:30'!haloSpecificationsForWorld | desired | "Answer a list of HaloSpecs that describe which halos are to be used on a world halo, what they should look like, and where they should be situated" "Preferences resetHaloSpecifications" desired := #(addDebugHandle: addMenuHandle: addHelpHandle: addRecolorHandle:). ^ self haloSpecifications select: [:spec | desired includes: spec addHandleSelector]! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'!iconicHaloSpecifications "Answer an array that characterizes the locations, colors, icons, and selectors of the halo handles that may be used in the iconic halo scheme" "Preferences resetHaloSpecifications" ^ #( " selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addCollapseHandle: left topCenter (tan) 'Halo-Collapse') (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addMenuHandle: leftCenter top (red) 'Halo-Menu') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor') ) ! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'!simpleFullHaloSpecifications "This method gives the specs for the 'full' handles variant when simple halos are in effect" "Preferences resetHaloSpecifications" ^ #( " selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addMenuHandle: leftCenter top (red) 'Halo-Menu') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale') (addFewerHandlesHandle: left topCenter (paleBuff) 'Halo-FewerHandles') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor') ) ! !!Preferences class methodsFor: 'defaults' stamp: 'mt 8/29/2023 15:25'!defaultValueTableForCurrentRelease "Answer a table defining default values for all the preferences in the release. Returns a list of (pref-symbol, boolean-symbol) pairs" ^ #( (alternativeBrowseIt false) (annotationPanes false) (areaFillsAreTolerant false) (areaFillsAreVeryTolerant false) (automaticKeyGeneration false) (balloonHelpEnabled true) (balloonHelpInMessageLists false) (caseSensitiveFinds false) (changeSetVersionNumbers true) (checkForSlips true) (checkForUnsavedProjects true) (cmdDotEnabled true) (collapseWindowsInPlace false) (confirmFirstUseOfStyle true) (conversionMethodsAtFileOut false) (debugHaloHandle true) (debugPrintSpaceLog false) (debugShowDamage false) (decorateBrowserButtons true) (diffsInChangeList true) (diffsWithPrettyPrint false) (dismissAllOnOptionClose false) (fastDragWindowForMorphic true) (fullScreenLeavesDeskMargins true) (higherPerformance false) (honorDesktopCmdKeys true) (logDebuggerStackToFile true) (menuKeyboardControl false) (modalColorPickers true) (mouseOverForKeyboardFocus false) (navigatorOnLeftEdge true) (optionalButtons true) (passwordsOnPublish false) (personalizedWorldMenu true) (postscriptStoredAsEPS false) (projectViewsInWindows true) (projectZoom true) (projectsSentToDisk false) (readDocumentAtStartup true) (restartAlsoProceeds false) (reverseWindowStagger true) (roundedMenuCorners true) (scrollBarsNarrow false) (scrollBarsOnRight true) (securityChecksEnabled false) (showBoundsInHalo false) (showDirectionForSketches false) (showDirectionHandles false) (showProjectNavigator false) (showSecurityStatus true) (signProjectFiles true) (smartUpdating true) (startInUntrustedDirectory false) (systemWindowEmbedOK false) (timeStampsInMenuTitles true) (turnOffPowerManager false) (twentyFourHourFileStamps true) (uniqueNamesInHalos false) (useButtonPropertiesToFire false) (warnAboutInsecureContent true) (warnIfNoChangesFile true) (warnIfNoSourcesFile true))"Preferences defaultValueTableForCurrentRelease do: [:pair | (Preferences preferenceAt: pair first ifAbsent: [nil]) ifNotNilDo: [:pref | pref defaultValue: (pair last == true)]].Preferences chooseInitialSettings."! !!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/10/2023 16:09'!disableProgrammerFacilities "Warning: do not call this lightly!! It disables all access to menus, debuggers, halos. There is no guaranteed return from this, which is to say, you cannot necessarily reenable these things once they are disabled -- you can only use whatever the UI of the current project affords, and you cannot even snapshot -- you can only quit. You can completely reverse the work of this method by calling the dual Preferences method enableProgrammerFacilities, provided you have left yourself leeway to bring about a call to that method. To set up a system that will come up in such a state, you have to request the snapshot in the same breath as you disable the programmer facilities. To do this, put the following line into the 'do' menu and then evaluate it from that 'do' menu: Preferences disableProgrammerFacilities.You will be prompted for a new image name under which to save the resulting image." Beeper beep. (self confirm: 'CAUTION!!!!This is a drastic step!!Do you really want to do this?') ifFalse: [Beeper beep. ^self inform: 'whew!!']. self disable: #cmdDotEnabled. "No user-interrupt-into-debugger" self compileAccessorForPreferenceNamed: #cmdGesturesEnabled value: false. "No halos, etc." self compileAccessorForPreferenceNamed: #cmdKeysInText value: false. "No user commands invokable via cmd-key combos in text editor" self disable: #warnIfNoSourcesFile. self disable: #warnIfNoChangesFile. Smalltalk saveAs! !!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/10/2023 16:09'!enableProgrammerFacilities "Meant as a one-touch recovery from a #disableProgrammerFacilities call." "Preferences enableProgrammerFacilities" self enable: #cmdDotEnabled. self compileAccessorForPreferenceNamed: #cmdGesturesEnabled value: true. self compileAccessorForPreferenceNamed: #cmdKeysInText value: true. self enable: #warnIfNoSourcesFile. self enable: #warnIfNoChangesFile.! !!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/15/2023 13:50'!setNotificationParametersForStandardPreferences "Set up the notification parameters for the standard preferences that require need them. When adding new Preferences that require use of the notification mechanism, users declare the notifcation info as part of the call that adds the preference, or afterwards -- the two relevant methods for doing that are: Preferences.addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: and Preference changeInformee:changeSelector:" "Preferences setNotificationParametersForStandardPreferences" #( (annotationPanes annotationPanesChanged) (optionalButtons optionalButtonsChanged) (smartUpdating smartUpdatingChanged) ) do: [:pair | | aPreference | aPreference := self preferenceAt: pair first. aPreference changeInformee: self changeSelector: pair second]! !!Preferences class methodsFor: 'initialization - save/load' stamp: 'mt 3/7/2023 13:27'!loadPreferencesFrom: aFile | stream params dict desktopColor patternsToIgnore | patternsToIgnore := #('*updateMapName' '*defaultUpdateURL'). stream := ReferenceStream fileNamed: aFile. params := stream next. self assert: (params isKindOf: IdentityDictionary). params removeKey: #PersonalDictionaryOfPreferences. dict := stream next. self assert: (dict isKindOf: IdentityDictionary). desktopColor := stream next. stream close. dict rehash. "See http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217817.html" dict keys reject: [:key | patternsToIgnore anySatisfy: [:pattern | pattern match: key]] thenDo: [:key | | value | value := dict at: key. (self preferenceAt: key ifAbsent: [nil]) ifNotNil: [:pref | [pref preferenceValue: value preferenceValue] on: Deprecation do: [ : err | "Ignore preferences which may not be supported anymore."]]]. params keysAndValuesDo: [ :key :value | self setParameter: key to: value ]. Project current world fillStyle: desktopColor.! !!ProgressMorph methodsFor: 'private' stamp: 'mt 8/11/2023 14:00'!fontOfPointSize: size ^ (TextConstants at: Preferences standardDefaultTextFont familyName ifAbsent: [TextStyle default]) fontOfPointSize: size! !!Project methodsFor: 'displaying' stamp: 'mt 8/28/2023 14:08'!displayZoom: entering "Show the project transition when entering a new project" | newDisplay vanishingPoint | "Show animated zoom to new display" newDisplay := self imageForm. entering ifTrue: [vanishingPoint := Sensor cursorPoint] ifFalse: [vanishingPoint := self viewLocFor: CurrentProject]. Display zoomIn: entering orOutTo: newDisplay at: 0@0 vanishingPoint: vanishingPoint.! !!Project methodsFor: 'file in/out' stamp: 'mt 8/16/2023 15:46'!exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: noInteraction | exportChangeSet | "An experimental version to fileout a changeSet first so that a project can contain its own classes" "Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target image. Name it <project name>.extSeg. Player classes are included automatically." exportChangeSet := nil. (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [ (noInteraction or: [self confirm: 'Would you like to include all the changes in the change set as part of this publishing operation?' translated]) ifTrue: [ exportChangeSet := changeSet ]. ]. ^ self exportSegmentWithChangeSet: exportChangeSet fileName: aFileName directory: aDirectory withoutInteraction: noInteraction! !!Project methodsFor: 'menu messages' stamp: 'mt 8/23/2023 13:50'!validateProjectNameIfOK: aBlock | details | details := world valueOfProperty: #ProjectDetails. details ifNotNil: ["ensure project info matches real project name" details at: 'projectname' put: self name. ]. self doWeWantToRename ifTrue: [self notify: 'Please choose another name!!'] ifFalse: [aBlock value: details]! !!MorphicProject methodsFor: 'initialize' stamp: 'mt 3/8/2023 09:42'!initialize "Initialize a new Morphic Project" super initialize. world := PasteUpMorph newWorldForProject: self. self setWorldBackground: true. Locale switchToID: CurrentProject localeID. Project current isMorphic ifTrue: [ "Only trigger tool builders etc. if we are already in the same kind of project because there is global state that cannot yet be configured in a dynamic scope such as 'ToolBuilder default'." self assureMainDockingBarPresenceMatchesPreference].! !!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/16/2023 17:02'!exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileNamedirectory: aDirectory withoutInteraction: noInteraction "Store my project out on the disk as an *exported*ImageSegment. All outPointers will be in a form that can be resolvedin the target image. Name it <project name>.extSeg. Whatdo we doabout subProjects, especially if they are out as local imagesegments? Force them to come in? Player classes are included automatically." | is str ans revertSeg roots holder collector fd mgr stacks | "Files out a changeSet first, so that a project can containits own classes" world ifNil: [^ false]. ScrapBook default emptyScrapBook. world currentHand pasteBuffer: nil. "don't write the paste buffer." world currentHand mouseOverHandler initialize. "forget about any references here" "Display checkCurrentHandForObjectToPaste." Command initialize. world clearCommandHistory. world fullReleaseCachedState. world cleanseStepList. world localFlapTabs size = world flapTabs size ifFalse: [noInteraction ifTrue: [^ false]. self error: 'Still holding onto Global flaps']. world releaseSqueakPages. holder := Project allProjects. "force them in to outPointers, where DiskProxys are made" "Just export me, not my previous version" revertSeg := self parameterAt: #revertToMe. self removeParameter: #revertToMe. roots := OrderedCollection new. roots add: self; add: world; add: transcript; add: aChangeSetOrNil; add: thumbnail; add: world activeHand. roots := roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail" fd := aDirectory directoryNamed: self resourceDirectoryName. fd assureExistence. "Clean up resource references before writing out" mgr := self resourceManager. self resourceManager: nil. ResourceCollector current: ResourceCollector new. ResourceCollector current localDirectory: fd. ResourceCollector current baseUrl: self resourceUrl. ResourceCollector current initializeFrom: mgr. ProgressNotification signal: '2:findingResources' extra:'(collecting resources...)' translated. "Must activate old world because this is run at #armsLength. Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent will not be captured correctly if referenced from blocks or user code." world becomeActiveDuring: [is := ImageSegment copySmartRootsExport: roots asArray. "old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)"]. self resourceManager: mgr. collector := ResourceCollector current. ResourceCollector current: nil. ProgressNotification signal: '2:foundResources' extra: ''. is state = #tooBig ifTrue: [collector replaceAll. ^ false]. str := ''. "considered legal to save a project that has never been entered" (is outPointers includes: world) ifTrue: [str := str, '\Project''s own world is not in the segment.' translated withCRs]. str isEmpty ifFalse: [ans := Project uiManager chooseOptionFrom: {'Do not write file' translated. 'Write file anyway' translated. 'Debug' translated} title: str. ans = 1 ifTrue: [revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. ^ false]. ans = 3 ifTrue: [collector replaceAll. self halt: 'Segment not written' translated]]. stacks := is findStacks. is writeForExportWithSources: aFileName inDirectory: fd changeSet: aChangeSetOrNil. SecurityManager default signFile: aFileName directory: fd. "Compress all files and update check sums" collector forgetObsolete. self storeResourceList: collector in: fd. self storeHtmlPageIn: fd. self storeManifestFileIn: fd. self writeStackText: stacks in: fd registerIn: collector. "local proj.005.myStack.t" self compressFilesIn: fd to: aFileName in: aDirectory resources: collector. "also deletes the resource directory" "Now update everything that we know about" mgr updateResourcesFrom: collector. revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. world flapTabs do: [:ft | (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. ^ true! !!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/11/2023 16:06'!storeSegment "Store my project out on the disk as an ImageSegment. Keep the outPointers in memory. Name it <project name>.seg. *** Caller must be holding (Project alInstances) to keep subprojects from going out. ***" | currentWorld is sizeHint | currentWorld := Project current world. (currentWorld == world) ifTrue: [^ false]. "self inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ false]. "already done" world ifNil: [^ false]. ScrapBook default emptyScrapBook. currentWorld checkCurrentHandForObjectToPaste. world releaseSqueakPages. sizeHint := self projectParameters at: #segmentSize ifAbsent: [0]. is := ImageSegment copyFromRootsLocalFileFor: {world} sizeHint: sizeHint. is state = #tooBig ifTrue: [^ false]. is segment size < 2000 ifTrue: ["debugging" Transcript show: self name, ' only ', is segment size printString, 'bytes in Segment.'; cr]. self projectParameters at: #segmentSize put: is segment size. is extract; writeToFile: self name. ^ true! !!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/11/2023 16:08'!storeSegmentNoFile "For testing. Make an ImageSegment. Keep the outPointers in memory. Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)" | is currentWorld | currentWorld := Project current world. (currentWorld == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ self]. "already done" world ifNil: [^ self]. "Do this on project enter" ScrapBook default emptyScrapBook. currentWorld checkCurrentHandForObjectToPaste2. is := ImageSegment copyFromRootsLocalFileFor: {world} sizeHint: 0. is segment size < 800 ifTrue: ["debugging" Transcript show: self name, ' did not get enough objects'; cr. ^ Beeper beep]. is extract. "is instVarAt: 2 put: is segment clone." "different memory"! !!MorphicProject methodsFor: 'enter' stamp: 'mt 3/10/2023 15:01'!enterAsActiveSubprojectWithin: enclosingWorld "Install my ChangeSet, Transcript, and scheduled views as current globals. If returningFlag is true, we will return to the project from whence the current project was entered; don't change its previousProject link in this case. If saveForRevert is true, save the ImageSegment of the project being left. If revertFlag is true, make stubs for the world of the project being left. If revertWithoutAsking is true in the project being left, then always revert." "Experimental mods for initial multi-project work: 1. assume in morphic (this eliminated need for <showZoom>) 2. assume <saveForRevert> is false (usual case) - removed <old> 3. assume <revertFlag> is false 4. assume <revertWithoutAsking> is false - <forceRevert> now auto false <seg> n.u. 5. no zooming 6. assume <projectsSentToDisk> false - could be dangerous here 7. assume no isolation problems (isolationHead ==) 8. no closing scripts " self isCurrentProject ifTrue: [^ self]. "guards ifNotNil: [ guards := guards reject: [:obj | obj isNil]. guards do: [:obj | obj okayToEnterProject ifFalse: [^ self]] ]." "CurrentProject makeThumbnail." "--> Display bestGuessOfCurrentWorld triggerClosingScripts." CurrentProject displayDepth: Display depth. displayDepth == nil ifTrue: [displayDepth := Display depth]. "Display newDepthNoRestore: displayDepth." "(world hasProperty: #letTheMusicPlay) ifTrue: [world removeProperty: #letTheMusicPlay] ifFalse: [Smalltalk at: #ScorePlayer ifPresent: [:playerClass | playerClass allSubInstancesDo: [:player | player pause]]]." "returningFlag ifTrue: [nextProject := CurrentProject] ifFalse: [previousProject := CurrentProject]." "CurrentProject saveState." "CurrentProject := self." "Smalltalk newChanges: changeSet." "TranscriptStream newTranscript: transcript." "Sensor flushKeyboard." "recorderOrNil := Display pauseMorphicEventRecorder." "Display changeMorphicWorldTo: world." "Signifies Morphic" world installAsActiveSubprojectIn: enclosingWorld titled: self name. "recorderOrNil ifNotNil: [recorderOrNil resumeIn: world]." self removeParameter: #exportState. "self spawnNewProcessAndTerminateOld: true"! !!MorphicProject methodsFor: 'enter' stamp: 'mt 8/28/2023 14:28'!finalEnterActions: leavingProject "Perform the final actions necessary as the receiver project is entered" | navigator armsLengthCmd navType thingsToUnhibernate | "If this image has a global World variable, update it now" Smalltalk globals at: #World ifPresent: [ :w | Smalltalk globals at: #World put: world ]. world install. world transferRemoteServerFrom: leavingProject world. "(revertFlag | saveForRevert | forceRevert) ifFalse: [ (Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [ self storeSomeSegment]]." "Transfer event recorder to me." leavingProject isMorphic ifTrue: [ leavingProject world pauseEventRecorder ifNotNil: [:rec | rec resumeIn: world]]. self initializeMenus. self projectParameters at: #projectsToBeDeleted ifPresent: [ :projectsToBeDeleted | self removeParameter: #projectsToBeDeleted. projectsToBeDeleted do: [:each | each delete]]. Locale switchToID: self localeID. thingsToUnhibernate := world valueOfProperty: #thingsToUnhibernate ifAbsent: [#()]. thingsToUnhibernate do: [:each | each unhibernate]. world removeProperty: #thingsToUnhibernate. navType := ProjectNavigationMorph preferredNavigator. armsLengthCmd := self parameterAt: #armsLengthCmd ifAbsent: [nil]. navigator := world findA: navType. (Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator and: [navigator isNil]]) ifTrue: [(navigator := navType new) bottomLeft: world bottomLeft; openInWorld: world]. navigator notNil & armsLengthCmd notNil ifTrue: [navigator color: Color lightBlue]. armsLengthCmd notNil ifTrue: [self flapsSuppressed: true. navigator ifNotNil: [navigator visible: false]. armsLengthCmd openInWorld: world]. world reformulateUpdatingMenus. self assureMainDockingBarPresenceMatchesPreference. world repairEmbeddedWorlds.! !!MorphicProject methodsFor: 'enter' stamp: 'mt 8/11/2023 16:05'!finalExitActions: enteringProject "Pause sound players, subject to preference settings" (world hasProperty: #letTheMusicPlay) ifTrue: [world removeProperty: #letTheMusicPlay] ifFalse: [SoundService stop]. world sleep. (world findA: ProjectNavigationMorph) ifNotNil: [:navigator | navigator retractIfAppropriate]. self clearGlobalState. EventSensor default flushEvents. self world submorphsDo: [:ea | ea removeProperty: #dropShadow].! !!MorphicProject methodsFor: 'release' stamp: 'mt 3/10/2023 15:10'!prepareForDelete "The window in which the project is housed is about to deleted. Perform any necessary actions to prepare for deletion." Smalltalk at: #WonderlandCameraMorph ifPresent:[:aClass | world submorphs do: "special release for wonderlands" [:m | (m isKindOf: aClass) and: [m getWonderland release]]].! !!MorphicProject methodsFor: 'language' stamp: 'mt 3/10/2023 16:07'!chooseNaturalLanguage "Put up a menu allowing the user to choose the natural language for the project" | aMenu availableLanguages | aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'choose language' translated. aMenu lastItem setBalloonText: 'This controls the human language in which tiles should be viewed. It is potentially extensible to be a true localization mechanism, but initially it only works in the classic tile scripting system. Each project has its own private language choice' translated. aMenu addStayUpItem. availableLanguages := NaturalLanguageTranslator availableLanguageLocaleIDs sorted:[:x :y | x displayName < y displayName]. availableLanguages do: [:localeID | aMenu addUpdating: #stringForLanguageNameIs: target: Locale selector: #switchToID: argumentList: {localeID}]. aMenu popUpInWorld"Project current chooseNaturalLanguage"! !!MorphicProject methodsFor: 'language' stamp: 'mt 8/4/2023 15:20'!updateLocaleDependents "Set the project's natural language as indicated" Flaps disableGlobalFlaps: false. Flaps enableGlobalFlaps. (self isFlapIDEnabled: 'Navigator' translated) ifFalse: [Flaps enableDisableGlobalFlapWithID: 'Navigator' translated]. ScrapBook default emptyScrapBook. MenuIcons initializeTranslations. super updateLocaleDependents. "self setFlaps. self setPaletteFor: aLanguageSymbol."! !!MorphicProject methodsFor: 'scheduling & debugging' stamp: 'mt 3/10/2023 11:26'!interruptCleanUpFor: interruptedProcess "Clean up things in case of a process interrupt." super interruptCleanUpFor: interruptedProcess. self uiProcess == interruptedProcess ifTrue: [ self currentHand ifNotNil: [:hand | hand interrupted]. world removeProperty: #shouldDisplayWorld].! !!Project class methodsFor: 'utilities' stamp: 'mt 3/15/2023 14:01'!removeAll: projects "Project removeAll: (Project allSubInstances copyWithout: Project current)" AllProjects := nil. Smalltalk garbageCollect. ProjectHistory currentHistory initialize. projects do: [:project | Project deletingProject: project]. Smalltalk garbageCollect. Smalltalk garbageCollect.! !!ProjectLauncher methodsFor: 'initialization' stamp: 'mt 8/4/2023 13:21'!setupFlaps "Only called when the image has been launched in a browser. If I am requested to show all flaps, then if flaps already exist, use them as is, else set up to show the default set of standard flaps." whichFlaps = 'all' ifTrue: [Flaps sharedFlapsAllowed ifFalse: [Flaps enableGlobalFlaps]]! !!ProjectLauncher methodsFor: 'running' stamp: 'mt 8/4/2023 13:23'!startUp | scriptName loader isUrl | self setupFlaps. Smalltalk firstArgMightBeDocument ifTrue: [scriptName := Smalltalk documentPath. scriptName := scriptName convertFromSystemString. scriptName isEmpty ifFalse: ["figure out if script name is a URL by itself" isUrl := (scriptName asLowercase beginsWith: 'http://') or: [(scriptName asLowercase beginsWith: 'file://') or: [scriptName asLowercase beginsWith: 'ftp://']]. isUrl ifFalse: [| encodedPath pathTokens | "Allow for ../dir/scriptName arguments" pathTokens := scriptName splitBy: FileDirectory slash. pathTokens := pathTokens collect: [:s | s encodeForHTTP]. encodedPath := pathTokens reduce: [:acc :each | acc , FileDirectory slash , each]. scriptName := (FileDirectory default uri resolveRelativeURI: encodedPath) asString]]] ifFalse: [scriptName := '']. scriptName isEmptyOrNil ifTrue: [^ self]. loader := CodeLoader new. loader loadSourceFiles: (Array with: scriptName). (scriptName asLowercase endsWith: '.pr') ifTrue: [self installProjectFrom: loader] ifFalse: [loader installSourceFiles]! !!ProjectLoading class methodsFor: 'accessing' stamp: 'mt 8/28/2023 13:46'!projectStreamFromArchive: archive | ext prFiles entry unzipped | ext := FileDirectory dot, Project projectExtension. prFiles := archive members select:[:any| any fileName endsWith: ext]. prFiles isEmpty ifTrue: ['']. entry := prFiles first. unzipped := MultiByteBinaryOrTextStream on: (ByteArray new: entry uncompressedSize). entry extractTo: unzipped. ^unzipped reset! !!ProjectLoading class methodsFor: 'loading' stamp: 'mt 8/28/2023 13:51'!openName: aFileName stream: preStream fromDirectory: aDirectoryOrNilwithProjectView: existingView clearOriginFlag: clearOriginFlag "Reconstitute a Morph from the selected file, presumed torepresent a Morph saved via the SmartRefStream mechanism, and open itin an appropriate Morphic world." | morphOrList archive mgr substituteFont numberOfFontSubstitutes resultArray anObject project manifests dict | ProgressNotification signal: '0.2'. archive := preStream isZipArchive ifTrue:[ZipArchive new readFrom: preStream] ifFalse:[nil]. archive ifNotNil:[ manifests := (archive membersMatching: '*manifest'). (manifests size = 1 and: [((dict := self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression']) ifTrue: [^ self notify: 'S-Expression format projects not supported. Use Squeak 6.0 or older.']]. morphOrList := self morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive. morphOrList ifNil: [^ self]. ProgressNotification signal: '0.4'. resultArray := self fileInName: aFileName archive: archive morphOrList: morphOrList. anObject := resultArray first. numberOfFontSubstitutes := resultArray second. substituteFont := resultArray third. mgr := resultArray fourth. preStream close. ProgressNotification signal: '0.7'. "the hard part is over" (anObject isKindOf: ImageSegment) ifTrue: [ project := self loadImageSegment: anObject fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr. project noteManifestDetailsIn: dict. clearOriginFlag ifTrue: [project forgetExistingURL]. ProgressNotification signal: '0.8'. ^ project ifNil: [self inform: 'No project found in this file' translated] ifNotNil: [ProjectEntryNotification signal: project]]. Project current openViewAndEnter: anObject! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'tak 9/3/2006 11:00'!checkSecurity: aFileName preStream: preStream projStream: projStream "Answer true if passed" | trusted enterRestricted | trusted := SecurityManager default positionToSecureContentsOf:projStream. trusted ifFalse: [enterRestricted := (preStream isTypeHTTP or:[aFileName isNil]) ifTrue: [Preferences securityChecksEnabled] ifFalse: [Preferences standaloneSecurityChecksEnabled]. enterRestricted ifTrue: [SecurityManager default enterRestrictedMode ifFalse: [preStream close. ^ false]]]. ^ true! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'mt 8/28/2023 13:49'!fileInName: aFileName archive: archive morphOrList: morphOrList | baseChangeSet substituteFont numberOfFontSubstitutes exceptions anObject mgr | ResourceCollector current: ResourceCollector new. baseChangeSet := ChangeSet current. self useTempChangeSet. "named zzTemp" "The actual reading happens here" substituteFont := Preferences standardDefaultTextFont copy. numberOfFontSubstitutes := 0. exceptions := Set new. [[anObject := morphOrList fileInObjectAndCodeForProject] on: MissingFont do: [ :ex | exceptions add: ex. numberOfFontSubstitutes := numberOfFontSubstitutes + 1. ex resume: substituteFont ]] ensure: [ ChangeSet newChanges: baseChangeSet]. mgr := ResourceManager new initializeFrom: ResourceCollector current. mgr fixJISX0208Resource. mgr registerUnloadedResources. archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName]. ResourceCollector current: nil. ^ {anObject. numberOfFontSubstitutes. substituteFont. mgr}! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'mt 8/28/2023 14:00'!loadImageSegment: morphOrList fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr | proj projectsToBeDeleted f | (f := (Flaps globalFlapTabWithID: 'Navigator' translated)) ifNotNil: [f hideFlap]. proj := morphOrList arrayOfRoots detect: [:mm | mm isKindOf: Project] ifNone: [^ nil]. proj projectParameterAt: #substitutedFont put: substituteFont. proj projectParameters at: #MultiSymbolInWrongPlace put: false. "Yoshiki did not put MultiSymbols into outPointers in older images!!" morphOrList arrayOfRoots do: [:obj | obj fixUponLoad: proj seg: morphOrList "imageSegment"]. (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [ morphOrList arrayOfRoots do: [:obj | (obj isKindOf: HashedCollection ) ifTrue: [obj rehash]]]. proj resourceManager: mgr. "proj versionFrom: preStream." proj lastDirectory: aDirectoryOrNil. proj setParent: Project current. projectsToBeDeleted := OrderedCollection new. existingView == #none ifFalse: [ self makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted]. ChangeSet allChangeSets add: proj changeSet. Project current projectParameters at: #deleteWhenEnteringNewProject ifPresent: [ :ignored | projectsToBeDeleted add: Project current. Project current removeParameter: #deleteWhenEnteringNewProject. ]. projectsToBeDeleted isEmpty ifFalse: [ proj projectParameters at: #projectsToBeDeleted put: projectsToBeDeleted. ]. ^ proj! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'pre 8/22/2019 15:03'!makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted existingView ifNil: [ Smalltalk isMorphic ifTrue: [ proj createViewIfAppropriate. ] ifFalse: [ ChangeSet allChangeSets add: proj changeSet. Project current openProject: proj. "Note: in MVC we get no further than the above" ]. ] ifNotNil: [ (existingView project isKindOf: DiskProxy) ifFalse: [ existingView project changeSet name: ChangeSet defaultName. projectsToBeDeleted add: existingView project. ]. (existingView owner isSystemWindow) ifTrue: [ existingView owner model: proj ]. existingView project: proj. ].! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'cmm 10/23/2013 16:24'!morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive "Answer morphOrList or nil if problem happened" | projStream localDir morphOrList | projStream := archive ifNil: [preStream] ifNotNil: [self projectStreamFromArchive: archive]. (self checkSecurity: aFileName preStream: preStream projStream: projStream) ifFalse: [^nil]. localDir := Project squeakletDirectory. aFileName ifNotNil: [ (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName~= localDir pathName]) ifTrue: [ localDir deleteFileNamed: aFileName. (localDir fileNamed: aFileName) binary nextPutAll: preStream remainingContents; close. ]. ]. morphOrList := projStream asUnZippedStream. preStream sleep. "if ftp, let the connection close" ^ morphOrList! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'yo 2/5/2008 17:15'!parseManifest: aString | dict line index key value aStream | aStream := aString readStream. dict := Dictionary new. [(line := aStream nextLine) notNil] whileTrue: [ index := line indexOf: $:. index > 0 ifTrue: [ key := line copyFrom: 1 to: index - 1. value := (line copyFrom: index + 1 to: line size) withBlanksTrimmed. dict at: key put: value. ]. ]. ^ dict.! !!ProjectNavigationMorph methodsFor: 'buttons' stamp: 'mt 8/10/2023 11:32'!makeTheAdvancedButtons ^{ self buttonNewProject. self buttonShare. self buttonPrev. self buttonNext. self buttonPublish. self buttonNewer. self buttonTell. self buttonFind. self buttonFullScreen. "self buttonFlaps." }, ( Preferences includeSoundControlInNavigator ifTrue: [{self buttonSound}] ifFalse: [#()] ), { self buttonLanguage. self buttonUndo. self buttonQuit. }! !!ProjectNavigationMorph methodsFor: 'buttons' stamp: 'mt 8/28/2023 14:27'!makeTheButtons ^ self makeTheAdvancedButtons! !!ProjectNavigationMorph methodsFor: 'the actions' stamp: 'mt 8/23/2023 13:51'!doPublishButtonMenuEvent: evt | selection | selection := UIManager default chooseFrom: { 'Publish' translated. 'Publish As...' translated. 'Publish to Different Server' translated. } values: { [self publishProject]. [self publishProjectAs]. [self publishDifferent]. } title: 'Publish options' translated. selection ifNil: [^self]. selection value.! !!ProjectSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'!addControls "Add the control bar at the top of the tool." | b r partsBinButton newButton aWrapper | newButton := ImageMorph new image: (Project current makeThumbnail scaledToSize: 48@36). newButton on: #mouseDown send: #insertNewProject: to: self. newButton setBalloonText: 'Make a new Project' translated. (partsBinButton := UpdatingThreePhaseButtonMorph checkBox) target: self; actionSelector: #togglePartsBinStatus; arguments: #(); getSelector: #getPartsBinStatus. (r := AlignmentMorph newRow) color: Color transparent; borderWidth: 0; layoutInset: 0; cellInset: 10@0; wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. b := SimpleButtonMorph new target: self; color: self defaultColor darker; borderColor: Color black. r addMorphBack: (self wrapperFor: (b label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort)). b := SimpleButtonMorph new target: self; color: self defaultColor darker; borderColor: Color black. r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #delete)); addTransparentSpacerOfSize: 8 @ 0; addMorphBack: (self wrapperFor: (newButton)); addTransparentSpacerOfSize: 8 @ 0. aWrapper := AlignmentMorph newRow beTransparent. aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0. aWrapper addMorphBack: (self wrapperFor: partsBinButton); addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated font: Preferences standardButtonFont) lock). r addMorphBack: aWrapper. self addMorphFront: r.! !!ProjectSorterMorph methodsFor: 'initialization' stamp: 'mt 8/14/2023 16:22'!initialize "initialize the state of the receiver" super initialize. self useRoundedCorners. pageHolder useRoundedCorners; borderWidth: 0; color: (Form gridFormOrigin: 0 @ 0 grid: 32 @ 32 background: Color white line: Color blue muchLighter)! !!ProjectSorterMorph methodsFor: 'controls' stamp: 'mt 8/23/2023 13:50'!insertNewProject: evt [MorphicProject openViewOn: nil] on: ProjectViewOpenNotification do: [ :ex | ex resume: false].! !!RecordingControlsMorph methodsFor: 'button commands' stamp: 'mt 8/22/2023 15:53'!makeTile "Make a tile representing my sound. Get a sound-name from the user by which the sound is to be known." | tile | recorder verifyExistenceOfRecordedSound ifFalse: [^ self]. recorder pause. tile := InterimSoundMorph new sound: (SampledSound samples: recorder condensedSamples samplingRate: recorder samplingRate). tile bounds: tile fullBounds. tile openInHand! !!ReferenceMorph methodsFor: 'menu' stamp: 'mt 8/14/2023 17:24'!changeTabGraphic | aGraphicalMenu | aGraphicalMenu := GraphicalMenu new initializeFor: submorphs first withForms: submorphs first reasonableForms coexist: true. self primaryHand attachMorph: aGraphicalMenu.! !!ReferenceMorph methodsFor: 'menu' stamp: 'mt 7/31/2023 11:15'!graphicalMorphForTab | formToUse | formToUse := self valueOfProperty: #priorGraphic ifAbsent: [MenuIcons formAtKey: 'squeakyMouse']. ^ SketchMorph withForm: formToUse! !!FlapTab methodsFor: 'show & hide' stamp: 'mt 8/4/2023 14:02'!showFlap "Open the flap up" | thicknessToUse flapOwner | "19 sept 2000 - going for all paste ups <- raa note" flapOwner := self pasteUpMorph. self referentThickness <= 0 ifTrue: [thicknessToUse := lastReferentThickness ifNil: [100]. self orientation == #horizontal ifTrue: [referent height: thicknessToUse] ifFalse: [referent width: thicknessToUse]]. inboard ifTrue: [self stickOntoReferent]. "makes referent my owner, and positions me accordingly" referent pasteUpMorph == flapOwner ifFalse: [flapOwner accommodateFlap: self. "Make room if needed" flapOwner addMorphFront: referent. flapOwner startSteppingSubmorphsOf: referent. self positionReferent]. inboard ifFalse: [self adjustPositionVisAVisFlap]. flapShowing := true. self pasteUpMorph hideFlapsOtherThan: self ifClingingTo: edgeToAdhereTo. flapOwner bringTopmostsToFront! !!ReferenceStream class methodsFor: 'accessing' stamp: 'mt 8/28/2023 15:43'!versionCode "Answer a number representing the 'version' of the ReferenceStream facility; this is stashed at the beginning of ReferenceStreams, as a secondary versioning mechanism (the primary one is the fileTypeCode). At present, it serves for information only, and is not checked for compatibility at reload time, but could in future be used to branch to variant code. " " 1 = original version 1992" " 2 = HyperSqueak. PathFromHome used for Objs outside the tree. SqueakSupport SysLibrary for shared globals like Display and StrikeFonts. File has version number, class structure, then an IncomingObjects manager. 8/16/96 tk. Extended to SmartRefStream. class structure also keeps superclasse chain. Does analysis on structure to see when translation methods are needed. Embedable in file-ins. (factored out HyperSqueak support) Feb-May 97 tk" " 3 = Reference objects are byte offsets relative to the start of the object portion of the file. Rectangles with values -2048 to 2047 are encoded compactly." " 4 = If UniClasses have class instance variables, append their values in the form (#Class43 (val1 val2 vla3)). An array of those. Can still read version 3." ^ 4! !!ReleaseBuilder class methodsFor: 'scripts' stamp: 'mt 8/16/2023 15:43'!configureTools "Initialize well-known tools and other resources." FileList initialize. FileServices initialize. "register file reader services" RealEstateAgent standardSize: 650@425. SMLoaderPlus setDefaultFilters: #(filterSafelyAvailable). "Default applications and tools." SystemBrowser default: TreeBrowser. MailSender default: nil. SoundService default: BaseSoundSystem. ToolSet default: StandardToolSet. WebBrowser default: nil.! !!ReleaseBuilder class methodsFor: 'scripts - support' stamp: 'mt 3/7/2023 14:05'!discardUserObjects "Remove the classes." MorphicModel removeUninstantiatedSubclassesSilently. "Clean-up environment hick-ups." Environment default allClassesDo: [:cls | (cls isUniClass and: [cls environment ~~ Environment default]) ifTrue: [Environment default forgetClass: cls logged: false]]. Environment default declarations select: [:binding | (binding value isBehavior and: [binding value isUniClass]) and: [binding value isObsolete]] thenDo: [:binding | SystemOrganization removeElement: binding key. Environment default removeKey: binding key]. "Remove auto-generated accessors. See Preferences." (MCPackage named: 'Autogenerated') unload. "Remove empty categories for user objects. See Object class >> #categoryForUniclasses." SystemOrganizer cleanUp: true.! !!RemoteHandMorph methodsFor: 'event handling' stamp: 'mt 8/28/2023 14:35'!transmitEvent: aMorphicEvent "Transmit the given event to all remote connections." | firstEvt | self readyToTransmit ifFalse: [^ self]. self lastEventTransmitted = aMorphicEvent ifTrue: [^ self]. sendBuffer ifNil: [sendBuffer := WriteStream on: (String new: 10000)]. sendBuffer nextPutAll: aMorphicEvent storeString; cr. self lastEventTransmitted: aMorphicEvent. sendSocket isConnected ifTrue:[ sendState = #opening ifTrue: [ "connection established; disable TCP delays on sends" sendSocket setOption: 'TCP_NODELAY' value: true. "send worldExtent as first event" firstEvt := MorphicUnknownEvent new setType: #worldBounds argument: self worldBounds extent. sendSocket sendData: firstEvt storeString, (String with: Character cr). Transcript show: 'Connection established with remote WorldMorph at '; show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. sendState := #connected]. sendSocket sendData: sendBuffer contents. ] ifFalse: [ owner primaryHand removeEventListener: self. sendState = #connected ifTrue: [ "other end has closed; close our end" Transcript show: 'Closing connection with remote WorldMorph at '; show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. sendSocket close. sendState := #closing]]. sendBuffer reset.! !!ResourceCollector methodsFor: 'initialize' stamp: 'mt 3/15/2023 14:07'!initialize originalMap := IdentityDictionary new. stubMap := IdentityDictionary new. locatorMap := IdentityDictionary new. internalStubs := IdentityDictionary new.! !!ScreenController methodsFor: 'nested menus' stamp: 'mt 7/31/2023 11:19'!helpMenu "Answer the help menu to be put up as a screen submenu" ^ SelectionMenu labelList: #( 'about this system...' 'update code from server' 'preferences...' 'command-key help' 'font size summary' 'useful expressions' 'view graphical imports' 'standard graphics library'), (Array with: (SoundService soundEnablingString)) , #( 'set author initials...' 'vm statistics' 'space left') lines: #(1 4 6 11) selections: #( aboutThisSystem absorbUpdatesFromServereditPreferences openCommandKeyHelp fontSizeSummary openStandardWorkspace viewImageImportssoundOnOrOff setAuthorInitials vmStatistics garbageCollect)"ScreenController new helpMenu startUp"! !!ScrollableField methodsFor: 'menu' stamp: 'mt 8/11/2023 14:47'!getMenu: shiftKeyState ^ shiftKeyState not ifTrue: [TextEditor yellowButtonMenu] ifFalse: [TextEditor shiftedYellowButtonMenu]! !!SelectionMorph methodsFor: 'halo commands' stamp: 'mt 3/10/2023 15:26'!duplicate "Make a duplicate of the receiver and havbe the hand grab it" selectedItems := self duplicateMorphCollection: selectedItems. selectedItems reverseDo: [:m | (owner ifNil: [self currentWorld]) addMorph: m]. dupLoc := self position. self currentHand grabMorph: self.! !!ServerDirectory class methodsFor: 'school support' stamp: 'mt 3/10/2023 11:45'!projectDefaultDirectory ^ FileDirectory default! !!ServerDirectory class methodsFor: 'server prefs' stamp: 'mt 8/16/2023 15:50'!parseServerEntryFrom: stream | server type directory entries serverName | entries := ExternalSettings parseServerEntryArgsFrom: stream. serverName := entries at: 'name' ifAbsent: [^nil]. directory := entries at: 'directory' ifAbsent: [^nil]. type := entries at: 'type' ifAbsent: [^nil]. type = 'file' ifTrue: [ server := self determineLocalServerDirectory: directory. entries at: 'userListUrl' ifPresent:[:value | "Ignore" ]. entries at: 'baseFolderSpec' ifPresent:[:value | "Ignore" ]. ^self addLocalProjectDirectory: server]. type = 'bss' ifTrue: [server := SuperSwikiServer new type: #http]. type = 'http' ifTrue: [server := HTTPServerDirectory new type: #ftp]. type = 'ftp' ifTrue: [server := ServerDirectory new type: #ftp]. server directory: directory. entries at: 'server' ifPresent: [:value | server server: value]. entries at: 'user' ifPresent: [:value | server user: value]. entries at: 'group' ifPresent: [:value | server groupName: value]. entries at: 'passwdseq' ifPresent: [:value | server passwordSequence: value asNumber]. entries at: 'url' ifPresent: [:value | server altUrl: value]. entries at: 'loaderUrl' ifPresent: [:value | server loaderUrl: value]. entries at: 'acceptsUploads' ifPresent: [:value | server acceptsUploads: value asLowercase = 'true']. entries at: 'userListUrl' ifPresent:[:value | "Ignore" ]. entries at: 'encodingName' ifPresent:[:value | server encodingName: value]. ServerDirectory addServer: server named: serverName.! !!IconicButton methodsFor: 'initialization' stamp: 'mt 3/7/2023 15:06'!initializeWithThumbnail: aThumbnail withLabel: aLabel andColor: aColor andSend: aSelector to: aReceiver "Initialize the receiver to show aThumbnail on its face, giving it the label supplied and arranging for it, when the button goes down on it, to obtain a new morph by sending the supplied selector to the supplied receiver" | labeledItem nonTranslucent | nonTranslucent := aColor asNontranslucentColor. labeledItem := AlignmentMorph newColumn. labeledItem color: nonTranslucent. labeledItem borderWidth: 0. labeledItem layoutInset: 4@0; cellPositioning: #center. labeledItem addMorph: aThumbnail. labeledItem addMorphBack: (Morph new extent: (4@4)) beTransparent. labeledItem addMorphBack: (TextMorph new backgroundColor: nonTranslucent; contentsAsIs: aLabel; beAllFont: Preferences standardButtonFont; centered). self beTransparent; labelGraphic: ((labeledItem imageForm: 32 backgroundColor: nonTranslucent forRectangle: labeledItem fullBounds) replaceColor: nonTranslucent withColor: Color transparent); borderWidth: 0; target: aReceiver; actionSelector: #launchPartVia:label:; arguments: {aSelector. aLabel}; actWhen: #buttonDown. self stationarySetup.! !!IconicButton methodsFor: 'initialization' stamp: 'mt 3/15/2023 14:10'!setDefaultLabel self labelGraphic: (MenuIcons formAtKey: 'squeakyMouse')! !!HaloMorph methodsFor: 'handles' stamp: 'mt 3/15/2023 13:34'!addDismissHandle: handleSpec "Add the dismiss handle according to the spec, unless my target resists dismissal" | dismissHandle | target okayToAddDismissHandle ifTrue: [dismissHandle := self addHandle: handleSpec on: #mouseDown send: #mouseDownInDimissHandle:with: to: self. dismissHandle on: #mouseUp send: #maybeDismiss:with: to: self. dismissHandle on: #mouseDown send: #setDismissColor:with: to: self. dismissHandle on: #mouseMove send: #setDismissColor:with: to: self]! !!HaloMorph methodsFor: 'handles' stamp: 'mt 8/11/2023 14:24'!addDupHandle: haloSpec "Add the halo that offers duplication" self addHandle: haloSpec on: #mouseDown send: #doDup:with: to: self! !!HaloMorph methodsFor: 'handles' stamp: 'sw 1/26/2000 16:16'!addHelpHandle: haloSpec target balloonText ifNotNil: [(self addHandle: haloSpec on: #mouseDown send: #mouseDownOnHelpHandle: to: innerTarget) on: #mouseUp send: #deleteBalloon to: innerTarget]! !!HaloMorph methodsFor: 'handles' stamp: 'RAA 3/15/2001 11:24'!addRecolorHandle: haloSpec "Add a recolor handle to the receiver, if appropriate" | recolorHandle | "since this halo now opens a more general properties panel, allow it in all cases" "innerTarget canSetColor ifTrue:" recolorHandle := self addHandle: haloSpec on: #mouseUp send: #doRecolor:with: to: self. recolorHandle on: #mouseUp send: #doRecolor:with: to: self! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/15/2023 14:10'!addGraphicalHandleFrom: formKey at: aPoint "Add the supplied form as a graphical handle centered at the given point. Return the handle." | handle aForm | aForm := (MenuIcons formAtKey: formKey) ifNil: [MenuIcons formAtKey: #SolidMenu]. handle := ImageMorph new image: aForm; bounds: (Rectangle center: aPoint extent: aForm extent). handle borderColor: Color black; borderWidth: 2. handle wantsYellowButtonMenu: false. self addMorph: handle. handle on: #mouseUp send: #endInteraction: to: self. ^ handle! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/15/2023 14:10'!createHandleAt: aPoint color: aColor iconName: iconName | bou handle | bou := Rectangle center: aPoint extent: self handleSize asPoint. Preferences alternateHandlesLook ifTrue: [handle := RectangleMorph newBounds: bou color: aColor. handle useRoundedCorners. self setColor: aColor toHandle: handle] ifFalse: [handle := EllipseMorph newBounds: bou color: aColor]. handle borderWidth: 0; wantsYellowButtonMenu: false. "" iconName isNil ifFalse: [| form | form := MenuIcons formAtKey: iconName. form isNil ifFalse: [| image | image := ImageMorph new. image image: form scaleIconToDisplay. image color: aColor makeForegroundColor. image lock. handle addMorphCentered: image]]. "" ^ handle! !!HaloMorph methodsFor: 'private' stamp: 'mt 2/19/2021 14:52'!doGrow: evt with: growHandle "Called while the mouse is down in the grow handle" | newExtent extentToUse scale | evt hand obtainHalo: self. newExtent := (target pointFromWorld: evt cursorPoint - positionOffset) - target topLeft. evt shiftPressed ifTrue: [ scale := (newExtent x / (originalExtent x max: 1)) min: (newExtent y / (originalExtent y max: 1)). newExtent := (originalExtent x * scale) asInteger @ (originalExtent y * scale) asInteger ]. (newExtent x < 1 or: [newExtent y < 1 ]) ifTrue: [^ self]. target renderedMorph setExtentFromHalo: (extentToUse := newExtent). growHandle position: evt cursorPoint - (growHandle extent // 2). self layoutChanged. (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | "Update the final extent" cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: extentToUse]! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/8/2023 11:29'!doRecolor: evt with: aHandle "The mouse went down in the 'recolor' halo handle. Allow the user to change the color of the innerTarget" evt hand obtainHalo: self. (aHandle containsPoint: evt cursorPoint) ifFalse: "only do it if mouse still in handle on mouse up" [self delete. target addHalo: evt] ifTrue: [innerTarget changeColor. self showingDirectionHandles ifTrue: [self addHandles]]! !!HaloMorph methodsFor: 'private' stamp: 'ul 12/12/2009 14:11'!doRot: evt with: rotHandle "Update the rotation of my target if it is rotatable. Keep the relevant command object up to date." | degrees | evt hand obtainHalo: self. degrees := (evt cursorPoint - (target pointInWorld: target referencePosition)) degrees. degrees := degrees - angleOffset degrees. degrees := degrees detentBy: 10.0 atMultiplesOf: 90.0 snap: false. degrees = 0.0 ifTrue: [self setColor: Color lightBlue toHandle: rotHandle] ifFalse: [self setColor: Color blue toHandle: rotHandle]. rotHandle submorphsDo: [:m | m color: rotHandle color makeForegroundColor]. self removeAllHandlesBut: rotHandle. self showingDirectionHandles ifFalse: [self showDirectionHandles: true addHandles: false]. self addDirectionHandles. target rotationDegrees: degrees. rotHandle position: evt cursorPoint - (rotHandle extent // 2). (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | "Update the final rotation" cmd redoTarget: target renderedMorph selector: #heading: argument: degrees]. self layoutChanged! !!HaloMorph methodsFor: 'private' stamp: 'ul 12/12/2009 14:11'!doScale: evt with: scaleHandle "Update the scale of my target if it is scalable." | newHandlePos colorToUse | evt hand obtainHalo: self. newHandlePos := evt cursorPoint - (scaleHandle extent // 2). target scaleToMatch: newHandlePos. colorToUse := target scale = 1.0 ifTrue: [Color yellow] ifFalse: [Color orange]. self setColor: colorToUse toHandle: scaleHandle. scaleHandle submorphsDo: [:m | m color: colorToUse makeForegroundColor]. scaleHandle position: newHandlePos. self layoutChanged. (self valueOfProperty: #commandInProgress) ifNotNil:[:cmd | "Update the final extent" cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent ].! !!HaloMorph methodsFor: 'private' stamp: 'mt 8/11/2023 17:00'!endInteraction: event "Clean up after a user interaction with the a halo control" | m | (target isInWorld not or: [owner isNil]) ifTrue: [^self]. [target isFlexMorph and: [target hasNoScaleOrRotation]] whileTrue: [m := target firstSubmorph. target removeFlexShell. target := m]. self restoreTargetDropShadows. target changedViaHalo: self. self isInWorld ifTrue: ["make sure handles show in front, even if flex shell added" self flag: #tofix. "mt: Try to avoid deleting and re-creating an event handler (here: the handle) while handling the event." self comeToFront. self addHandles. event hand newMouseFocus: self]. (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | self rememberCommand: cmd. self removeProperty: #commandInProgress].! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/10/2023 15:08'!maybeDismiss: evt with: dismissHandle "Ask hand to dismiss my target if mouse comes up in it." evt hand obtainHalo: self. (dismissHandle containsPoint: evt cursorPoint) ifFalse: [self delete. target addHalo: evt] ifTrue: [target resistsRemoval ifTrue: [(Project uiManager chooseOptionFrom: {'Yes' translated. 'Um, no, let me reconsider' translated.} title: 'Really throw this away?' translated) = 1 ifFalse: [^ self]]. evt hand removeHalo. self delete. target dismissViaHalo].! !!HaloMorph methodsFor: 'private' stamp: 'HenrikSperreJohansen 1/21/2011 18:34'!mouseDownInDimissHandle: evt with: dismissHandle evt hand obtainHalo: self. SoundService soundEnabled ifTrue: [TrashCanMorph playMouseEnterSound]. self removeAllHandlesBut: dismissHandle. self setColor: Color darkGray toHandle: dismissHandle.! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/10/2023 13:51'!startDrag: evt with: dragHandle "Drag my target without removing it from its owner." self obtainHaloForEvent: evt andRemoveAllHandlesBut: dragHandle. target aboutToBeDraggedViaHalo. positionOffset := dragHandle center - (target point: target position in: owner).! !!HaloMorph methodsFor: 'private' stamp: 'ct 2/28/2022 16:24'!startGrow: evt with: growHandle "Initialize resizing of my target. Launch a command representing it, to support Undo" | botRt | self obtainHaloForEvent: evt andRemoveAllHandlesBut: growHandle. self backupAndHideTargetDropShadows. target aboutToBeGrownViaHalo. botRt := target point: target bottomRight in: owner. positionOffset := (self world viewBox containsPoint: botRt) ifTrue: [evt cursorPoint - botRt] ifFalse: [0@0]. self setProperty: #commandInProgress toValue: (Command new cmdWording: ('resize ' translated, target nameForUndoWording); undoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent). originalExtent := target extent! !!HaloMorph methodsFor: 'private' stamp: 'mt 8/11/2023 16:59'!startRot: evt with: rotHandle "Initialize rotation of my target if it is rotatable. Launch a command object to represent the action" self obtainHaloForEvent: evt andRemoveAllHandlesBut: rotHandle. self backupAndHideTargetDropShadows. target aboutToBeRotatedViaHalo. target isFlexMorph ifFalse: [target addFlexShellIfNecessary]. growingOrRotating := true. self removeAllHandlesBut: rotHandle. "remove all other handles" angleOffset := evt cursorPoint - (target pointInWorld: target referencePosition). angleOffset := Point r: angleOffset r degrees: angleOffset degrees - target rotationDegrees. self setProperty: #commandInProgress toValue: (Command new cmdWording: ('rotate ' translated, target nameForUndoWording); undoTarget: target renderedMorph selector: #heading: argument: target rotationDegrees)! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/7/2023 16:46'!startScale: evt with: scaleHandle "Initialize scaling of my target." self obtainHaloForEvent: evt andRemoveAllHandlesBut: scaleHandle. self backupAndHideTargetDropShadows. target aboutToBeScaledViaHalo. target isFlexMorph ifFalse: [target addFlexShellIfNecessary]. growingOrRotating := true. positionOffset := 0@0. originalExtent := target extent! !!HaloMorph methodsFor: 'pop up' stamp: 'mt 3/15/2023 13:40'!popUpFor: morph at: position hand: hand super popUpFor: morph at: position hand: hand. self startStepping.! !!HaloMorph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/15/2023 13:40'!delete "Delete the halo. Tell the target that it no longer has the halo; accept any pending edits to the name; and then actually delete myself" self acceptNameEdit. super delete.! !!SketchEditorMorph methodsFor: 'initialization' stamp: 'mt 8/10/2023 15:28'!initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph." | paintBoxBounds worldBounds | self setProperty: #recipientPasteUp toValue: aPasteUpMorph. paintBoxBounds := self world paintBox bounds. worldBounds := self world bounds. self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: ((boundsToUse topRight extent: paintBoxBounds extent) translatedToBeWithin: worldBounds) topLeft.! !!SketchEditorMorph methodsFor: 'start & finish' stamp: 'mt 8/10/2023 15:34'!cancelOutOfPainting "The user requested to back out of a painting session without saving" self deleteSelfAndSubordinates. emptyPicBlock ifNotNil: [emptyPicBlock value]. "note no args to block!!" hostView ifNotNil: [hostView changed]. ^ nil! !!SketchEditorMorph methodsFor: 'start & finish' stamp: 'mt 8/10/2023 15:34'!deliverPainting: result evt: evt "Done painting. May come from resume, or from original call. Execute user's post painting instructions in the block. Always use this standard one. 4/21/97 tk" | newBox newForm ans | palette ifNotNil: "nil happens" [palette setAction: #paint: evt: evt]. "Get out of odd modes" "rot := palette getRotations." "rotate with heading, or turn to and fro" "palette setRotation: #normal." result == #cancel ifTrue: [ ans := Project uiManager chooseOptionFrom: { 'throw it away' translated. 'keep painting it' translated} title: 'Do you really want to throw away what you just painted?' translated. ^ ans = 1 ifTrue: [self cancelOutOfPainting] ifFalse: [nil]]. "cancelled out of cancelling." "hostView rotationStyle: rot." "rotate with heading, or turn to and fro" newBox := paintingForm rectangleEnclosingPixelsNotOfColor: Color transparent. registrationPoint ifNotNil: [registrationPoint := registrationPoint - newBox origin]. "relative to newForm origin" newForm := Form extent: newBox extent depth: paintingForm depth. newForm copyBits: newBox from: paintingForm at: 0@0 clippingBox: newForm boundingBox rule: Form over fillColor: nil. newForm isAllWhite ifTrue: [(self valueOfProperty: #background) == true ifFalse: [^ self cancelOutOfPainting]]. newForm fixAlpha. "so alpha channel stays intact for 32bpp" self delete. "so won't find me again" dimForm ifNotNil: [dimForm delete]. newPicBlock value: newForm value: (newBox copy translateBy: bounds origin).! !!SketchMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:15'!setNewFormFrom: formOrNil "Set the receiver's form as indicated. If nil is provided, then a default form will be used" formOrNil ifNotNil: [^ self form: formOrNil]. self form: (Form extent: 16@16 depth: 32)! !!SketchMorph methodsFor: 'initialization' stamp: 'mt 3/15/2023 14:10'!initialize"initialize the state of the receiver" ^ self initializeWith: (MenuIcons formAtKey: 'Painting') deepCopy! !!SketchMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 14:30'!addPaintingItemsTo: aMenu hand: aHandMorph | subMenu movies | subMenu := MenuMorph new defaultTarget: self. subMenu add: 'repaint' translated action: #editDrawing; add: 'set rotation center' translated action: #setRotationCenter; add: 'reset forward-direction' translated action: #resetForwardDirection; add: 'set rotation style' translated action: #setRotationStyle; add: 'erase pixels of color' translated action: #erasePixelsUsing:; add: 'recolor pixels of color' translated action: #recolorPixelsUsing:; add: 'reduce color palette' translated action: #reduceColorPalette:; add: 'detect edges' translated action: #edgeDetect; add: 'sharpen' translated action: #sharpen; add: 'blur' translated action: #blur; add: 'emboss' translated action: #emboss; add: 'add a border around this shape...' translated action: #addBorderToShape:. movies := (self world rootMorphsAt: aHandMorph targetPoint) select: [:m | (m isKindOf: MovieMorph) or: [m isSketchMorph]]. movies size > 1 ifTrue: [subMenu add: 'insert into movie' translated action: #insertIntoMovie:]. aMenu add: 'painting...' translated subMenu: subMenu! !!SketchMorph methodsFor: 'menu' stamp: 'mt 8/10/2023 15:33'!editDrawingIn: aPasteUpMorph forBackground: forBackground "Edit an existing sketch." | w bnds sketchEditor rotCenter aWorld aPaintBox | self world assureNotPaintingElse: [^self]. w := aPasteUpMorph world. w displayWorld. self visible: false. bnds := forBackground ifTrue: [aPasteUpMorph boundsInWorld] ifFalse: [self boundsInWorld expandBy: 60 @ 60]. sketchEditor := SketchEditorMorph new. forBackground ifTrue: [sketchEditor setProperty: #background toValue: true]. w addMorphFront: sketchEditor. sketchEditor initializeFor: self inBounds: bnds pasteUpMorph: aPasteUpMorph. rotCenter := self rotationCenter. sketchEditor afterNewPicDo: [:aForm :aRect | | tfx | self visible: true. self form: aForm. tfx := aPasteUpMorph transformFrom: aPasteUpMorph world. self topRendererOrSelf position: (tfx globalPointToLocal: aRect origin). self rotationStyle: sketchEditor rotationStyle. self forwardDirection: sketchEditor forwardDirection. (rotCenter notNil and: [(rotCenter = (0.5 @ 0.5)) not]) ifTrue: [self rotationCenter: rotCenter]. aWorld := self world. (aPaintBox := aWorld paintBox) ifNotNil: [aPaintBox delete]. forBackground ifTrue: [self goBehind "shouldn't be necessary"]] ifNoBits: []! !!SketchMorph methodsFor: 'menus' stamp: 'mt 3/10/2023 16:09'!addToggleItemsToHaloMenu: aCustomMenu "Add toggle-items to the halo menu" super addToggleItemsToHaloMenu: aCustomMenu. aCustomMenu addUpdating: #useInterpolationString target: self action: #toggleInterpolation.! !!SketchMorph methodsFor: 'menus' stamp: 'mt 8/11/2023 13:42'!chooseNewGraphic "Allow the user to choose a different form for her form-based morph" | aGraphicalMenu | aGraphicalMenu := GraphicalMenu new initializeFor: self withForms: self reasonableForms coexist: true. self primaryHand attachMorph: aGraphicalMenu.! !!SketchMorph methodsFor: 'parts bin' stamp: 'mt 3/15/2023 14:10'!initializeToStandAlone super initializeToStandAlone. self initializeWith: (MenuIcons formAtKey: 'Painting') deepCopy! !!ColorPickerMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 14:01'!mouseUp: evt self stopStepping. sourceHand := nil. deleteOnMouseUp ifTrue: [self delete]. self updateTargetColor.! !!ColorPickerMorph methodsFor: 'menu' stamp: 'mt 3/15/2023 14:09'!pickUpColorFor: aMorph "Show the eyedropper cursor, and modally track the mouse through a mouse-down and mouse-up cycle" | aHand localPt | aHand := aMorph ifNil: [self activeHand] ifNotNil: [aMorph activeHand]. aHand ifNil: [aHand := self currentHand]. self addToWorld: aHand world near: (aMorph ifNil: [aHand world]) fullBounds. self owner ifNil: [^ self]. aHand showTemporaryCursor: (MenuIcons formAtKey: #Eyedropper) hotSpotOffset: 2@14. "<<<< the form was changed a bit??" self updateContinuously: false. [Sensor anyButtonPressed] whileFalse: [self trackColorUnderMouse]. self deleteAllBalloons. localPt := Sensor cursorPoint - self topLeft. self inhibitDragging ifFalse: [ (DragBox containsPoint: localPt) ifTrue: ["Click or drag the drag-dot means to anchor as a modeless picker" ^ self anchorAndRunModeless: aHand]. ]. (clickedTranslucency := TransparentBox containsPoint: localPt) ifTrue: [selectedColor := originalColor]. self updateContinuously: true. [Sensor anyButtonPressed] whileTrue: [self updateTargetColorWith: self indicateColorUnderMouse]. aHand newMouseFocus: nil; showTemporaryCursor: nil; flushEvents. self delete. ! !!ColorPickerMorph methodsFor: 'private' stamp: 'mt 3/10/2023 14:01'!pickColorAt: aGlobalPoint | alpha selfRelativePoint pickedColor | clickedTranslucency ifNil: [clickedTranslucency := false]. selfRelativePoint := (self globalPointToLocal: aGlobalPoint) - self topLeft. (FeedbackBox containsPoint: selfRelativePoint) ifTrue: [^ self]. (RevertBox containsPoint: selfRelativePoint) ifTrue: [^ self updateColor: originalColor feedbackColor: originalColor]. "check for transparent color and update using appropriate feedback color " (TransparentBox containsPoint: selfRelativePoint) ifTrue: [clickedTranslucency ifFalse: [^ self]. "Can't wander into translucency control" alpha := (selfRelativePoint x - TransparentBox left - 10) asFloat / (TransparentBox width - 20) min: 1.0 max: 0.0. "(alpha roundTo: 0.01) printString , ' ' displayAt: 0@0." " -- debug" self updateColor: (selectedColor alpha: alpha) feedbackColor: (selectedColor alpha: alpha). ^ self]. "pick up color, either inside or outside this world" clickedTranslucency ifTrue: [^ self]. "Can't wander out of translucency control" self locationIndicator visible: false. self refreshWorld. pickedColor := Display colorAt: aGlobalPoint. self locationIndicator visible: true. self refreshWorld. self updateColor: ( (selectedColor isColor and: [selectedColor isTranslucentColor]) ifTrue: [pickedColor alpha: selectedColor alpha] ifFalse: [pickedColor] ) feedbackColor: pickedColor! !!SmartRefStream methodsFor: 'read write' stamp: 'mt 3/10/2023 15:43'!initKnownRenames renamed at: #FlasherMorph put: #Flasher; at: #AlansTextPlusMorph put: #TextPlusMorph; at: #Project put: #MorphicProject; at: #InputSensor put: #EventSensor; yourself! !!SmartRefStream methodsFor: 'read write' stamp: 'mt 3/10/2023 15:43'!restoreClassInstVars "Install the values of the class instance variables of UniClasses." self flag: #todo. "mt: See EToys in Squeak 6.0 and before."! !!SqueakToolsDebuggerHelp class methodsFor: 'pages' stamp: 'mt 3/15/2023 14:10'!showForm: aSymbol | form contents | form := MenuIcons formAtKey: aSymbol. contents := (String with: Character cr) asText, (Text string: ' ' attribute: (TextFontReference toFont: (FormSetFont new fromFormArray: (Array with: form) asciiStart: Character space asInteger ascent: form height))), (String with: Character cr) asText. ^contents! !!SystemWindow methodsFor: 'initialization' stamp: 'mt 3/10/2023 16:09'!initializeLabelArea "Initialize the label area (titlebar) for the window." labelString ifNil: [labelString := 'Untitled Window']. label := StringMorph new contents: labelString; font: (self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont]); yourself. "Add collapse box so #labelHeight will work" collapseBox := self createCollapseBox. stripes := Array with: (RectangleMorph newBounds: bounds) with: (RectangleMorph newBounds: bounds). "see extent:" self addLabelArea. self setLabelWidgetAllowance. self addCloseBox. self class moveMenuButtonRight ifTrue: [self addLabel. self addMenuControl] ifFalse: [self addMenuControl. self addLabel]. self addExpandBox. labelArea addMorphBack: collapseBox. self setFramesForLabelArea.! !!SystemWindow methodsFor: 'menu' stamp: 'dao 10/1/2004 12:57'!fullScreenMaximumExtent "Zoom Window to Full World size with possible DeskMargins obey the maximum extent rules" | left right possibleBounds | left := right := 0. self paneMorphs do: [:pane | ((pane isKindOf: ScrollPane) and: [pane retractableScrollBar]) ifTrue: [pane scrollBarOnLeft ifTrue: [left := left max: pane scrollBarThickness] ifFalse: [right := right max: pane scrollBarThickness]]]. possibleBounds := self worldBounds insetBy: (left @ 0 corner: right @ 0). self maximumExtent ifNotNil: [possibleBounds := possibleBounds origin extent: ( self maximumExtent min: ( possibleBounds extent ))]. ((Flaps sharedFlapsAllowed and: [Project current flapsSuppressed not]) or: [Preferences fullScreenLeavesDeskMargins]) ifTrue: [possibleBounds := possibleBounds insetBy: 22]. self bounds: possibleBounds! !!SystemWindow methodsFor: 'menu' stamp: 'mt 3/10/2023 14:27'!sendToBack | aWorld nextWindow | aWorld := self world. nextWindow := aWorld submorphs detect: [:m | (m isSystemWindow) and: [m ~~ self]] ifNone: [^self]. nextWindow beKeyWindow. aWorld addMorphBack: self! !!SystemWindow methodsFor: 'open/close' stamp: 'mt 3/7/2023 17:40'!delete | thisWorld | self mustNotClose ifTrue: [^self]. model okToClose ifFalse: [^self]. thisWorld := self world. self activeHand removeKeyboardListener: self. self isFlexed ifTrue: [owner delete] ifFalse: [super delete]. model windowIsClosing; release. model := nil. SystemWindow noteTopWindowIn: thisWorld! !!SystemWindow methodsFor: 'stepping' stamp: 'mt 8/28/2023 15:51'!stepAt: millisecondClockValue "If the receiver is not collapsed, step it, after first stepping the model." (isCollapsed not or: [self wantsStepsWhenCollapsed]) ifTrue: [model ifNotNil: [model stepAt: millisecondClockValue in: self]. super stepAt: millisecondClockValue]"Since this method ends up calling step, the model-stepping logic should not be duplicated there."! !!SystemWindow methodsFor: 'stepping' stamp: 'mt 3/10/2023 15:01'!wantsSteps "Return true if the model wants its view to be stepped. For an open system window, we give the model to offer an opinion" self isPartsDonor ifTrue: [^ false]. ^ isCollapsed not and: [model wantsStepsIn: self]! !!SystemWindow methodsFor: 'top window' stamp: 'mt 3/7/2023 17:40'!comeToFront "Modal windows: Walk along the modal owner chain, the bring all to top." self modalOwner ifNotNil: [:mo | mo isSystemWindow ifTrue: [ ^ mo modalOwner ifNil: [mo comeToFrontModally] ifNotNil: [:omo | omo comeToFront]]]. self modalChild ifNotNil: [^ self comeToFrontModally]. "Now show me." super comeToFront. "Label should be visible to interact with." self assureLabelAreaVisible.! !!TabMorph methodsFor: 'tabs' stamp: 'mt 8/4/2023 13:36'!tabSelected "Called when the receiver is hit. First, bulletproof against someone having taken the structure apart. My own action basically requires that my grand-owner be a TabbedPalette" (owner isKindOf: IndexTabs) ifFalse: [^ Beeper beep]. (owner owner isKindOf: TabbedPalette) ifFalse: [^ Beeper beep]. owner owner selectTab: self! !!TabSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'!addControls "Add the control bar at the top of the tool." | b r | b := SimpleButtonMorph new target: self; borderColor: Color black. r := AlignmentMorph newRow. r color: b color; borderWidth: 0; layoutInset: 0. r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. r wrapCentering: #topLeft. r addMorphBack: (b label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort). b := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (b label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #cancelSort). self addMorphFront: r.! !!TabSorterMorph methodsFor: 'initialization' stamp: 'mt 8/16/2023 13:52'!initialize "Initialize the receiver." super initialize. self removeAllMorphs. self extent: 300@100. pageHolder := PasteUpMorph new. pageHolder vResizeToFit: true; autoLineLayout: true. pageHolder extent: self extent - self borderWidth. pageHolder padding: 8. pageHolder cursor: 0. self addControls. self addMorphBack: pageHolder! !!TabbedPalette methodsFor: 'palette menu' stamp: 'mt 8/4/2023 13:42'!addBookMenuItemsTo: aCustomMenu hand: aHandMorph aCustomMenu add: 'add palette menu' translated action: #addMenuTab.! !!TabbedPalette methodsFor: 'palette menu' stamp: 'mt 7/31/2023 11:20'!addMenuTab "Add the menu tab. This is ancient code, not much in the spirit of anything current" | aMenu aTab aGraphic sk | aMenu := MenuMorph new defaultTarget: self. aMenu stayUp: true. "aMenu add: 'clear' translated action: #showNoPalette." aMenu add: 'sort tabs' translated action: #sortTabs:. aMenu add: 'choose new colors for tabs' translated action: #recolorTabs. aMenu setProperty: #paletteMenu toValue: true. "aMenu add: 'make me the Standard palette' translated action: #becomeStandardPalette." aTab := self addTabForBook: aMenu withBalloonText: 'a menu of palette-related controls' translated. aTab highlightColor: tabsMorph highlightColor; regularColor: tabsMorph regularColor. tabsMorph laySubpartsOutInOneRow; layoutChanged. aGraphic := MenuIcons formAtKey: 'TinyMenu'. aGraphic ifNotNil: [aTab removeAllMorphs. aTab addMorph: (sk := Project current world drawingClass withForm: aGraphic). sk position: aTab position. sk lock. aTab fitContents]. self layoutChanged! !!TabbedPalette methodsFor: 'user-interface' stamp: 'mt 8/4/2023 13:36'!selectTab: aTab | currentPalette morphToInstall oldTab aSketchEditor | oldTab := tabsMorph highlightedTab. (oldTab notNil and: [(morphToInstall := oldTab morphToInstall) isKindOf: PaintBoxMorph]) ifTrue: [(aSketchEditor := self world submorphOfClass: SketchEditorMorph) ifNotNil: [aSketchEditor cancelOutOfPainting]. morphToInstall delete]. tabsMorph selectTab: aTab. morphToInstall := aTab morphToInstall. (morphToInstall isKindOf: PaintBoxMorph) "special case, maybe generalize this need?" ifFalse: [self goToPageMorph: morphToInstall] ifTrue: [self showNoPaletteAndHighlightTab: aTab. self world addMorphFront: morphToInstall. morphToInstall position: ((self left max: 90) "room for the pop-out-to-left panel" @ (tabsMorph bottom))]. (currentPalette := self currentPalette) ifNotNil: [currentPalette layoutChanged]. self snapToEdgeIfAppropriate! !!TabbedPalette class methodsFor: 'scripting' stamp: 'mt 7/31/2023 11:20'!authoringPrototype | aTabbedPalette aBook aTab | aTabbedPalette := self new markAsPartsDonor. aTabbedPalette pageSize: 200 @ 300. aTabbedPalette tabsMorph highlightColor: Color red regularColor: Color blue. aTabbedPalette addMenuTab. aBook := BookMorph new setNameTo: 'one'; pageSize: aTabbedPalette pageSize. aBook color: Color blue muchLighter. aBook removeEverything; insertPage; showPageControls. aBook currentPage addMorphBack: (Project current world drawingClass withForm: (MenuIcons formAtKey: 'squeakyMouse')). aTab := aTabbedPalette addTabForBook: aBook. aBook := BookMorph new setNameTo: 'two'; pageSize: aTabbedPalette pageSize. aBook color: Color red muchLighter. aBook removeEverything; insertPage; showPageControls. aBook currentPage addMorphBack: CurveMorph authoringPrototype. aTabbedPalette addTabForBook: aBook. aTabbedPalette selectTab: aTab. aTabbedPalette beSticky. aTabbedPalette tabsMorph hResizing: #spaceFill. ^ aTabbedPalette! !!TextMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 16:10'!getMenu: shiftKeyState ^ shiftKeyState not ifTrue: [TextEditor yellowButtonMenu] ifFalse: [TextEditor shiftedYellowButtonMenu]! !!TextMorph methodsFor: 'events-processing' stamp: 'mt 3/15/2023 13:46'!handleKeystroke: anEvent "Overwritten to support tab-among-fields preference." anEvent wasHandled ifTrue:[^self]. (self handlesKeyboard: anEvent) ifFalse: [^ self]. (anEvent hand keyboardFocus ~~ self and: [self handlesKeyboardOnlyOnFocus]) ifTrue: [^ self]. ^ super handleKeystroke: anEvent! !!TextMorph methodsFor: 'menu' stamp: 'mt 8/16/2023 13:54'!addCustomMenuItems: aCustomMenu hand: aHandMorph | outer | super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu add: 'text properties...' translated action: #changeTextColor. aCustomMenu addUpdating: #autoFitString target: self action: #autoFitOnOff. aCustomMenu addUpdating: #wrapString target: self action: #wrapOnOff. aCustomMenu add: 'text margins...' translated action: #changeMargins:. aCustomMenu add: 'add predecessor' translated action: #addPredecessor:. aCustomMenu add: 'add successor' translated action: #addSuccessor:. outer := self owner. outer ifNotNil: [ outer isLineMorph ifTrue: [container isNil ifTrue: [Smalltalk at: #TextOnCurveContainer ifPresent: [:ignored | aCustomMenu add: 'follow owner''s curve' translated action: #followCurve]] ifFalse: [aCustomMenu add: 'reverse direction' translated action: #reverseCurveDirection. aCustomMenu add: 'set baseline' translated action: #setCurveBaseline:]] ifFalse: [self fillsOwner ifFalse: [aCustomMenu add: 'fill owner''s shape' translated action: #fillingOnOff] ifTrue: [aCustomMenu add: 'rectangular bounds' translated action: #fillingOnOff]. self avoidsOcclusions ifFalse: [aCustomMenu add: 'avoid occlusions' translated action: #occlusionsOnOff] ifTrue: [aCustomMenu add: 'ignore occlusions' translated action: #occlusionsOnOff]]].! !!TextMorph class methodsFor: 'parts bin' stamp: 'mt 3/7/2023 15:07'!fancyPrototype | t | t := self authoringPrototype. t autoFit: false; extent: 150@75. t borderWidth: 2; margins: 4@0; useRoundedCorners. "Why not rounded?" "fancy font, shadow, rounded" t fontName: Preferences standardButtonFont familyName size: 18; textColor: Color blue; fillStyle: Color lightBrown. t addDropShadow."Strangeness here in order to avoid two offset copies of the default contents when operating in an mvc project before cursor enters the morphic window" t paragraph. ^ t! !!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 8/11/2023 15:18'!extrasMenuOn: aDockingBar aDockingBar addItem: [ :it| it contents: 'Extras' translated; addSubMenu: [:menu| menu addItem:[:item| item contents: 'Recover Changes' translated; help: 'Recover changes after a crash' translated; icon: MenuIcons smallDocumentClockIcon; target: ChangeList; selector: #browseRecentLog]. menu addItem:[:item| item contents: 'Recover Method Versions' translated; help: 'Recover versions of deleted methods' translated; target: ChangeList; selector: #browseMethodVersions]. menu addLine. menu addItem:[:item| item contents: 'Themes & Colors' translated; subMenuUpdater: self selector: #themesAndWindowColorsOn: ]. menu addItem:[:item| item contents: 'Scale Factor' translated; subMenuUpdater: self selector: #scaleFactorsOn:]. menu addItem:[:item| item contents: 'Language' translated; subMenuUpdater: self selector: #languageTranslatorsOn: ]. menu addItem:[:item| item contents: 'Set Author Initials' translated; help: 'Sets the author initials' translated; icon: MenuIcons smallUserQuestionIcon; target: Utilities; selector: #setAuthorInitials]. menu addItem:[:item| item contents: 'Restore Display (r)' translated; help: 'Redraws the entire display' translated; target: Project current; selector: #restoreDisplay]. menu addItem:[:item| item contents: 'Rebuild Menus' translated; help: 'Rebuilds the menu bar' translated; target: TheWorldMainDockingBar; selector: #updateInstances]. menu addLine. menu addItem:[:item| item contents: 'Start Profiler' translated; help: 'Starts the profiler' translated; icon: MenuIcons smallTimerIcon; target: self; selector: #startMessageTally]. menu addItem:[:item| item contents: 'Collect Garbage' translated; help: 'Run the garbage collector and report space usage' translated; target: Utilities; selector: #garbageCollectAndReport]. menu addItem:[:item| item contents: 'Purge Undo Records' translated; help: 'Save space by removing all the undo information remembered in all projects' translated; target: CommandHistory; selector: #resetAllHistory]. menu addItem:[:item| item contents: 'VM statistics' translated; help: 'Virtual Machine information' translated; target: self; selector: #vmStatistics]. menu addLine. menu addItem:[:item| item contents: 'Graphical Imports' translated; help: 'View the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList' translated; target: (Imports default); selector: #viewImages]. menu addItem:[:item| item contents: 'Browse My Changes' translated; help: 'Browse all of my changes since the last time #condenseSources was run.' translated; target: SystemNavigation new; selector: #browseMyChanges]. ] ]! !!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 3/7/2023 13:59'!themesAndWindowColorsOn: menu | themes | menu addItem:[:item| item contents: 'Fonts' translated; subMenuUpdater: Preferences selector: #fontConfigurationMenu:; icon: MenuIcons smallFontsIcon]. menu addLine. menu addItem:[:item| item contents: (Model useColorfulWindows ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Colorful Windows' translated; target: self; selector: #toggleColorfulWindows]. menu addItem:[:item| item contents: (SystemWindow gradientWindow not ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Flat Widget Look' translated; target: self; selector: #toggleGradients]. menu addLine. menu addItem:[:item | item contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Soft Shadows' translated; target: self; selector: #toggleSoftShadows]. menu addItem:[:item | item contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow not]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Hard Shadows' translated; target: self; selector: #toggleHardShadows]. menu addLine. menu addItem:[:item | item contents: (SystemWindow roundedWindowCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Window/Dialog Look' translated; target: self; selector: #toggleRoundedWindowLook]. menu addItem:[:item | item contents: (PluggableButtonMorph roundedButtonCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Button/Scrollbar/Menu Look' translated; target: self; selector: #toggleRoundedButtonLook]. menu addLine. themes := UserInterfaceTheme allThemes asArray sort: #name ascending. themes := themes select: [ :each | each isGenuine]. themes ifEmpty: [ menu addItem: [ :item | item contents: '(No UI themes found.)' translated; isEnabled: false ] ]. themes do: [ :each | menu addItem: [ :item | item contents: (UserInterfaceTheme current name = each name ifTrue: ['<yes>'] ifFalse: ['<no>']), each name; target: each; selector: #applyScaled ] ]. menu addLine; add: 'Restore UI theme background' translated target: self selector: #restoreThemeBackground; add: 'Reset all UI themes' translated target: self selector: #resetAllThemes; add: 'Edit current UI theme...' translated target: self selector: #editCurrentTheme.! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/4/2023 13:59'!addObjectsAndTools: menu self fillIn: menu from: { nil. { 'objects (o)'. { #myWorld. #activateObjectsTool }. 'A tool for finding and obtaining many kinds of objects' }. { 'new morph...'. { self. #newMorph }. 'Offers a variety of ways to create new objects' }. nil. { 'flaps...'. { self. #flapsDo }. 'A menu relating to use of flaps. For best results, use "keep this menu up"' }. { 'projects...'. { self. #projectDo }. 'A menu of commands relating to use of projects' }. { 'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}. nil }! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:54'!addPrintAndDebug: menu self fillIn: menu from: { { 'make screenshot'. {self. #saveScreenshot}. 'makes a screenshot and saves it to disk'}. "{ 'print PS to file...'. { self. #printWorldOnFile }. 'write the world into a postscript file' }." { 'debug...'. { self. #debugDo }. 'a menu of debugging items' } }! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:58'!addUtilities: menu self fillIn: menu from: { { 'open...'. { self. #openWindow } }. { 'windows...'. { self. #windowsDo } }. { 'changes...'. { self. #changesDo } } }. self fillIn: menu from: { { 'help...'. { self. #helpDo }. 'puts up a menu of useful items for updating the system, determining what version you are running, and much else' }. { 'appearance...'. { self. #appearanceDo }. 'put up a menu offering many controls over appearance.' } }. self fillIn: menu from: { { 'do...'. { Utilities. #offerCommonRequests }. 'put up an editible list of convenient expressions, and evaluate the one selected.' } }! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:57'!appearanceMenu "Build the appearance menu for the world." ^self fillIn: (self menu: 'appearance...') from: { {'preferences...' . { self . #openPreferencesBrowser} . 'Opens a "Preferences Browser" which allows you to alter many settings' } . {'preferences wizard...' . { self . #openPreferencesWizard} . 'Opens a "Preferences Wizard" which allows you to alter many settings in a guided fashion' } . {'choose set of preferences...' . { Preferences . #offerThemesMenu} . 'Presents you with a menu of sets or preferences; each item''s balloon-help will tell you about the particular set. If you choose one, many different preferences that come along are set at the same time; you can subsequently change any settings by using a Preferences Panel'} . nil . {'system fonts...' . { self . #standardFontDo} . 'Choose the standard fonts to use for code, lists, menus, window titles, etc.'}. nil. {'full screen on' . { DisplayScreen . #fullScreenOn} . 'puts you in full-screen mode, if not already there.'}. {'full screen off' . { DisplayScreen . #fullScreenOff} . 'if in full-screen mode, takes you out of it.'}. nil. {'set display depth...' . {self. #setDisplayDepth} . 'choose how many bits per pixel.'}. {'set desktop color...' . {self. #changeBackgroundColor} . 'choose a uniform color to use as desktop background.'}. {'set gradient color...' . {self. #setGradientColor} . 'choose second color to use as gradient for desktop background.'}. }! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 7/31/2023 11:19'!helpMenu "Build the help menu for the world." | menu | menu := self menu: 'help...'. self fillIn: menu from: { {'about this system...'. {Smalltalk. #aboutThisSystem}. 'current version information.'}. {'update code from server'. {MCMcmUpdater. #updateFromServer}. 'load latest code updates via the internet'}. {'preferences...'. {self. #openPreferencesBrowser}. 'view and change various options.'}. {'set language...' . {Project. #chooseNaturalLanguage}. 'choose the language in which tiles should be displayed.'} . nil. {'command-key help'. { TheWorldMainDockingBar instance . #commandKeyHelp}. 'summary of keyboard shortcuts.'} }. self addGestureHelpItemsTo: menu. self fillIn: menu from: { {'world menu help'. { self . #worldMenuHelp}. 'helps find menu items buried in submenus.'}. "{'info about flaps' . { Utilities . #explainFlaps}. 'describes how to enable and use flaps.'}." {'font size summary' . { TextStyle . #fontSizeSummary}. 'summary of names and sizes of available fonts.'}. {'useful expressions' . { Utilities . #openStandardWorkspace}. 'a window full of useful expressions.'}. {'annotation setup...' . { Preferences . #editAnnotations}. 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools'}. nil. {'graphical imports' . { Imports default . #viewImages}. 'view the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList'}. nil. {'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}. {#soundEnablingString . { SoundService . #toggleSoundEnabled}. 'turning sound off will completely disable Squeak''s use of sound.'}. nil. {'set author initials...' . { Utilities . #setAuthorInitials }. 'supply initials to be used to identify the author of code and other content.'}. {'vm statistics' . { self . #vmStatistics}. 'obtain some intriguing data about the vm.'}. nil. {'purge undo records' . { CommandHistory . #resetAllHistory }. 'save space by removing all the undo information remembered in all projects.'}. {'space left' . { self . #garbageCollect}. 'perform a full garbage-collection and report how many bytes of space remain in the image.'}. }. ^menu! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/16/2023 11:24'!newMorph "The user requested 'new morph' from the world menu. Put up a menu that allows many ways of obtaining new morphs." | menu | menu := self menu: 'Add a new morph'. menu add: 'from paste buffer' translated target: myHand action: #pasteMorph; add: 'from alphabetical list' translated subMenu: self alphabeticalMorphMenu; add: 'from a file...' translated target: self action: #readMorphFromAFile. menu addLine. menu add: 'grab rectangle from screen' translated target: myWorld action: #grabDrawingFromScreen:; add: 'grab with lasso from screen' translated target: myWorld action: #grabLassoFromScreen:; add: 'grab rubber band from screen' translated target: myWorld action: #grabRubberBandFromScreen:; add: 'grab flood area from screen' translated target: myWorld action: #grabFloodFromScreen:. menu addLine. menu add: 'make link to project...' translated target: self action: #projectThumbnail. self doPopUp: menu.! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/11/2023 16:37'!openMenu "Build the open window menu for the world." | menu | menu := self menu: 'open...'. menu defaultTarget: ToolSet default. menu addList: ToolSet menuItems. menu defaultTarget: self. self fillIn: menu from: { nil. {'file...' . { self . #openFileDirectly} . 'Lets you open a window on a single file'}. {'transcript (t)' . {self . #openTranscript}. 'A window used to report messages sent to Transcript' }. "{'inner world' . { WorldWindow . #test1} }." nil. }. self fillIn: menu from: self class registeredOpenCommands. menu addLine. self fillIn: menu from: { {'morphic project' . {self. #openMorphicProject} . 'Creates a new morphic project'}. {'mvc project' . {self. #openMVCProject} . 'Creates a new project of the classic "mvc" style'} }. ^menu! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/11/2023 16:37'!projectMenu "Build the project menu for the world." | menu | self flag: #bob0302. menu := self menu: 'projects...'. self fillIn: menu from: { { 'save on server (also makes a local copy)' . { #myProject . #storeOnServer } }. { 'save to a different server' . { #myProject . #saveAs } }. { 'save project on local file only' . { #myWorld . #saveOnFile } }. { 'see if server version is more recent...' . { #myProject . #loadFromServer } }. { 'load project from file...' . { self . #loadProject } }. nil. }. self fillIn: menu from: { { 'create new morphic project' . { self . #openMorphicProject } }. { 'create new mvc project'. { self . #openMVCProject } }. }. self fillIn: menu from: { nil. { 'go to previous project' . { Project . #returnToPreviousProject } }. { 'go to next project' . { Project . #advanceToNextProject } }. { 'jump to project...' . { #myWorld . #jumpToProject } }. }. self fillIn: menu from: { nil. { 'save for future revert' . { #myProject . #saveForRevert } }. { 'revert to saved copy' . { #myProject . #revert } }. }. ^ menu! !!TheWorldMenu methodsFor: '*MorphicExtras-windows & flaps menu' stamp: 'mt 8/4/2023 15:18'!formulateFlapsMenu: aMenu "Fill aMenu with appropriate content" aMenu addTitle: 'flaps' translated. aMenu addStayUpItem. Preferences classicNavigatorEnabled ifTrue: [aMenu addUpdating: #navigatorShowingString enablementSelector: #enableProjectNavigator target: Preferences selector: #toggle: argumentList: #(showProjectNavigator). aMenu balloonTextForLastItem: (Preferences preferenceAt: #showProjectNavigator) helpString translated]. Flaps sharedFlapsAllowed ifTrue: [self fillIn: aMenu from: {{#suppressFlapsString. {Project current. #toggleFlapsSuppressed}. 'Whether prevailing flaps should be shown in the project right now or not.'}}. aMenu addUpdating: #automaticFlapLayoutString target: Preferences selector: #toggle: argumentList: #(automaticFlapLayout). aMenu balloonTextForLastItem: (Preferences preferenceAt: #automaticFlapLayout) helpString translated. aMenu addLine. Flaps addIndividualGlobalFlapItemsTo: aMenu]. self fillIn: aMenu from: { nil. {'make a new flap'. {Flaps. #addLocalFlap}. 'Create a new flap. You can later make it into a shared flap is you wish.'}. nil.}. Flaps sharedFlapsAllowed ifTrue: [aMenu addWithLabel: 'put shared flaps on bottom' translated enablementSelector: #showSharedFlaps target: Flaps selector: #sharedFlapsAlongBottom argumentList: #(). aMenu balloonTextForLastItem: 'Group all the standard shared flaps along the bottom edge of the screen' translated. self fillIn: aMenu from: { {'destroy all shared flaps'. {Flaps. #disableGlobalFlaps}. 'Destroy all the shared flaps and disable their use in all projects.'}}] ifFalse: [aMenu add: 'install default shared flaps' translated target: Flaps action: #enableGlobalFlaps. aMenu balloonTextForLastItem: 'Create the default set of shared flaps' translated. aMenu addLine]. self fillIn: aMenu from: { nil. {'about flaps...'. {Flaps . #explainFlaps}. 'Gives a window full of details about how to use flaps.'}}! !!ThreePhaseButtonMorph class methodsFor: 'class initialization' stamp: 'mt 3/15/2023 14:11'!initialize "ThreePhaseButtonMorph initialize" | extent inset | extent := 12@12. inset := 3. #('CheckBoxOff' 'CheckBoxOn' 'CheckBoxPressed') do: [:button | | f r | f := ColorForm extent: extent depth: 1. f colors: {Color transparent. Color black}. f borderWidth: 1. r := f boundingBox insetBy: inset. button = 'CheckBoxPressed' ifTrue: [f border: r width: 1]. button = 'CheckBoxOn' ifTrue: [f fillBlack: r]. MenuIcons saveForm: f atKey: button]. #('RadioButtonOff' 'RadioButtonOn' 'RadioButtonPressed') do: [:button | | f r c | f := ColorForm extent: extent depth: 1. f colors: {Color transparent. Color black}. r := f boundingBox. c := f getCanvas. c frameOval: r color: Color black. r := r insetBy: inset. button = 'RadioButtonPressed' ifTrue: [c frameOval: r color: Color black]. button = 'RadioButtonOn' ifTrue: [c fillOval: r color: Color black]. MenuIcons saveForm: f atKey: button]! !!ThreePhaseButtonMorph class methodsFor: 'instance creation' stamp: 'mt 3/15/2023 14:09'!labelSymbol: aSymbol "(self labelSymbol: #TryIt) openInHand" | aButton form | aButton := ThreePhaseButtonMorph new. form := MenuIcons formAtKey: aSymbol. aButton offImage: form. aButton image: form. aButton pressedImage: (MenuIcons formPressedAtKey: aSymbol). ^ aButton! !!ThumbnailMorph methodsFor: 'stepping' stamp: 'mt 8/28/2023 14:37'!stepTime "Adjust my step time to the time it takes drawing my referent" drawTime ifNil:[^ 250]. ^(20 * drawTime) max: 250.! !!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'!actualViewee "Return the actual morph to be viewed, or nil if there isn't an appropriate morph to view." | aMorph actualViewee | aMorph := self morphToView ifNil: [^ nil]. aMorph isInWorld ifFalse: [^ nil]. actualViewee := viewSelector ifNil: [aMorph] ifNotNil: [objectToView perform: viewSelector]. actualViewee == 0 ifTrue: [^ nil]. "valueAtCursor result for an empty HolderMorph" actualViewee ifNil: [actualViewee := objectToView]. (actualViewee isMorph and: [actualViewee isFlexMorph and: [actualViewee submorphs size = 1]]) ifTrue: [actualViewee := actualViewee firstSubmorph]. ^ actualViewee! !!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'!formOrMorphToView "Answer the form to be viewed, or the morph to be viewed, or nil" | actualViewee | (objectToView isForm) ifTrue: [^objectToView]. actualViewee := viewSelector ifNil: [objectToView] ifNotNil: [objectToView perform: viewSelector]. ^actualViewee == 0 ifTrue: [nil "valueAtCursor result for an empty HolderMorph"] ifFalse: [actualViewee]! !!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'!morphToView "If the receiver is viewing some object, answer a morph can be thought of as being viewed; A gesture is made toward generalizing this beyond the morph/player regime, in that a plain blue rectangle is returned rather than simply failing if the referent is not itself displayable." objectToView ifNil: [^ nil]. ^ objectToView isMorph ifTrue: [objectToView] ifFalse: [RectangleMorph new color: Color blue]! !!TransformationMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 15:02'!removeFlexShell "Remove the shell used to make a morph rotatable and scalable." | oldHalo unflexed myWorld refPos aPosition | self isInWorld ifFalse: [^self]. refPos := self referencePosition. myWorld := self world. oldHalo := self halo. submorphs isEmpty ifTrue: [^ self delete]. aPosition := (owner submorphIndexOf: self) ifNil: [1]. unflexed := self firstSubmorph. self submorphs do: [:m | m position: self center - (m extent // 2). owner addMorph: m asElementNumber: aPosition]. unflexed absorbStateFromRenderer: self. oldHalo ifNotNil: [oldHalo setTarget: unflexed]. myWorld ifNotNil: [myWorld startSteppingSubmorphsOf: unflexed]. self delete. unflexed referencePosition: refPos. ^ unflexed! !!TransformationMorph methodsFor: 'private' stamp: 'mt 3/10/2023 11:18'!adjustAfter: changeBlock "Cause this morph to remain centered where it was before, and choose appropriate smoothing, after a change of scale or rotation." | oldRefPos | oldRefPos := self referencePosition. changeBlock value. self chooseSmoothing. self layoutChanged. owner ifNotNil: [owner invalidRect: bounds]! !!TranslucentProgessMorph methodsFor: 'drawing' stamp: 'mt 3/7/2023 15:07'!drawOn: aCanvas | revealPercentage revealingStyle revealingColor revealingBounds revealToggle x baseColor revealTimes secondsRemaining stringToDraw where fontToUse innerBounds | innerBounds := bounds. opaqueBackgroundColor ifNotNil: [ aCanvas frameAndFillRectangle: bounds fillColor: opaqueBackgroundColor borderWidth: 8 borderColor: Color blue. innerBounds := innerBounds insetBy: 8. ]. revealTimes := (self valueOfProperty: #revealTimes) ifNil: [^self]. revealPercentage := (revealTimes first / revealTimes second) asFloat. revealingStyle := self revealingStyle. x := self valueOfProperty: #progressStageNumber ifAbsent: [1]. baseColor := Color perform: (#(red blue green magenta cyan yellow) atPin: x). revealingColor := baseColor alpha: 0.2. revealingStyle = 3 ifTrue: [ "wrap and change color" revealPercentage > 1.0 ifTrue: [ revealingColor := baseColor alpha: (0.2 + (revealingStyle / 10) min: 0.5). ]. revealPercentage := revealPercentage fractionPart. ]. revealingStyle = 2 ifTrue: [ "peg at 75 and blink" revealPercentage > 0.75 ifTrue: [ revealToggle := self valueOfProperty: #revealToggle ifAbsent: [true]. self setProperty: #revealToggle toValue: revealToggle not. revealToggle ifTrue: [revealingColor := baseColor alpha: 0.8.]. ]. revealPercentage := revealPercentage min: 0.75. ]. revealingBounds := innerBounds withLeft: innerBounds left + (innerBounds width * revealPercentage) truncated. aCanvas fillRectangle: revealingBounds color: revealingColor. secondsRemaining := (revealTimes second - revealTimes first / 1000) rounded. secondsRemaining > 0 ifTrue: [ fontToUse := StrikeFont familyName: Preferences standardButtonFont familyName size: 24. stringToDraw := secondsRemaining printString. where := innerBounds corner - ((fontToUse widthOfString: stringToDraw) @ fontToUse height). aCanvas drawString: stringToDraw in: (where corner: innerBounds corner) font: fontToUse color: Color black. aCanvas drawString: stringToDraw in: (where - (1@1) corner: innerBounds corner) font: fontToUse color: Color white. ]. ! !!TrashCanMorph methodsFor: 'event handling' stamp: 'mt 8/11/2023 13:45'!doubleClick: evt evt hand world addMorphCentered: ScrapBook default scrapBook! !!UpdatingRectangleMorph methodsFor: 'setting' stamp: 'mt 3/10/2023 15:02'!valueProvider "Answer the object to which my get/set messages should be sent. This is inefficient and contorted in order to support grandfathered content for an earlier design" ^ target! !!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:28'!decimalPlaces: aNumber "Set the receiver's number of decimal places to be shown." | constrained | self setProperty: #decimalPlaces toValue: (constrained := aNumber min: 11). self pvtFloatPrecision: (Utilities floatPrecisionForDecimalPlaces: constrained).! !!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 15:45'!target: anObject target := anObject. floatPrecision := 1.! !!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:02'!valueFromContents "Return a new value from the current contents string." format = #symbol ifTrue: [^ lastValue]. format = #string ifTrue: [^ contents]. ^ Compiler evaluate: contents! !!UpdatingStringMorph methodsFor: 'target access' stamp: 'mt 3/10/2023 14:13'!readFromTarget "Update my readout from my target" | v ret | (target isNil or: [getSelector isNil]) ifTrue: [^contents]. ret := self checkTarget. ret ifFalse: [^ '0']. v := target perform: getSelector. "scriptPerformer" (v isKindOf: Text) ifTrue: [v := v asString]. ^self acceptValueFromTarget: v! !!UserInterfaceTheme methodsFor: 'private - fonts' stamp: 'mt 7/31/2023 11:21'!installSystemFont: aFont "Establish the default text font and style. Update the #defaultFontIndex in all known text styles to reflect the system's new default point size." | aStyle | self flag: #todo. "mt: Support derivatives such as bold and italic." aStyle := aFont textStyleOrNil. "mt: Must be installed and thus never be nil!!" aStyle defaultFontIndex: (aStyle fontIndexOfPointSize: aFont pointSize "drop emphasis"). TextStyle setDefault: aStyle. TextStyle actualTextStyles "no defaults" do: [:ea | ea isTTCStyle ifTrue: [ea defaultFont asPointSize: aFont pointSize "May generate new pointSize"]. ea defaultFontIndex: (ea fontIndexOfPointSize: aFont pointSize)]. RealEstateAgent resetScaleFactor. Flaps replaceToolsFlap.! !!CommunityTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addDarkWindowColors: aUserInterfaceTheme "self createDark apply." aUserInterfaceTheme set: #uniformWindowColor for: #Model to: Color darkGray; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color darker] ]; set: #unfocusedLabelColor for: #SystemWindow to: Color veryLightGray; set: #focusedLabelColor for: #SystemWindow to: Color white; set: #customWindowColor for: #Browser to: self dbBlue; set: #customWindowColor for: #ChangeList to: self dbBlue; set: #customWindowColor for: #ChangeSorter to: self dbBlue; set: #customWindowColor for: #ChatNotes to: self dbPurple twiceDarker; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self dbPurple twiceDarker; set: #customWindowColor for: #Debugger to: self dbRed; set: #customWindowColor for: #DualChangeSorter to: self dbOrange twiceDarker; set: #customWindowColor for: #FileContentsBrowser to: self dbGray; set: #customWindowColor for: #FileList to: self dbGray; set: #customWindowColor for: #Inspector to: self dbYellow duller; set: #customWindowColor for: #InstanceBrowser to: self dbYellow duller; set: #customWindowColor for: #Lexicon to: self dbGreen; set: #customWindowColor for: #MCTool to: self dbOrange twiceDarker; set: #customWindowColor for: #MessageNames to: self dbGreen; set: #customWindowColor for: #MessageSet to: self dbGreen; set: #customWindowColor for: #ObjectExplorer to: self dbYellow duller; set: #customWindowColor for: #PackagePaneBrowser to: self dbBlue; set: #customWindowColor for: #PluggableFileList to: self dbGray; set: #customWindowColor for: #PreferenceBrowser to: self dbBlue; set: #customWindowColor for: #ProcesBrowser to: self dbAqua; set: #customWindowColor for: #SMLoader to: self dbOrange twiceDarker; set: #customWindowColor for: #SMLoaderPlus to: self dbOrange twiceDarker; set: #customWindowColor for: #SMReleaseBrowser to: self dbOrange twiceDarker; set: #customWindowColor for: #SelectorBrowser to: self dbBlue; set: #customWindowColor for: #StringHolder to: self dbGray; set: #customWindowColor for: #TestRunner to: self dbPink darker; set: #customWindowColor for: #TranscriptStream to: self dbGray; set: #customWindowColor for: #VersionsBrowser to: self dbPurple twiceDarker; set: #customWindowColor for: #Workspace to: self dbPink darker.! !!MonokaiTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addDarkWindowColors: theme "self createDark apply." theme set: #uniformWindowColor for: #Model to:( self invisibleColor adjustBrightness: 0.16) "lighter twice"; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: -0.16 "darker twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: [ Model useColorfulWindows ifTrue: [(Color r: 0.285 g: 0.282 b: 0.242) "invisible color"] ifFalse: [(Color r: 0.972 g: 0.972 b: 0.948) "foreground color"] ]; set: #focusedLabelColor for: #SystemWindow to: [ Model useColorfulWindows ifTrue: [(Color r: 0.152 g: 0.156 b: 0.133) "background color"] ifFalse: [(Color r: 0.901 g: 0.858 b: 0.455) "yellow"] ]; set: #customWindowColor for: #Browser to: self green duller; set: #customWindowColor for: #ChangeList to: self blue duller; set: #customWindowColor for: #ChangeSorter to: self blue duller; set: #customWindowColor for: #ChatNotes to: self magenta duller; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet duller; set: #customWindowColor for: #Debugger to: self red duller; set: #customWindowColor for: #DualChangeSorter to: self blue duller; set: #customWindowColor for: #FileContentsBrowser to: self yellow duller; set: #customWindowColor for: #FileList to: self yellow duller; set: #customWindowColor for: #InstanceBrowser to: self cyan duller; set: #customWindowColor for: #Lexicon to: self cyan duller; set: #customWindowColor for: #MCTool to: self violet duller; set: #customWindowColor for: #MessageNames to: self green duller; set: #customWindowColor for: #MessageSet to: self cyan duller; set: #customWindowColor for: #PackagePaneBrowser to: self green duller; set: #customWindowColor for: #PluggableFileList to: self yellow duller; set: #customWindowColor for: #PreferenceBrowser to: self cyan duller; set: #customWindowColor for: #SMLoader to: self orange duller; set: #customWindowColor for: #SMLoaderPlus to: self orange duller; set: #customWindowColor for: #SMReleaseBrowser to: self orange duller; set: #customWindowColor for: #SelectorBrowser to: self cyan duller; set: #customWindowColor for: #StringHolder to: self yellow duller; set: #customWindowColor for: #TestRunner to: self orange duller; set: #customWindowColor for: #TranscriptStream to: self orange duller; set: #customWindowColor for: #VersionsBrowser to: self violet duller.! !!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addDarkWindowColors: theme "doIt: [self createDark apply.]" theme set: #uniformWindowColor for: #Model to: (self darkBackgroundHighlights adjustBrightness: 0.16 "lighter twice"); set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: -0.16 "darker twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: self darkContentEmphasized; set: #focusedLabelColor for: #SystemWindow to: self darkContentEmphasizedMore; set: #customWindowColor for: #Browser to: self green; set: #customWindowColor for: #ChangeList to: self blue; set: #customWindowColor for: #ChangeSorter to: self blue; set: #customWindowColor for: #ChatNotes to: self magenta; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet; set: #customWindowColor for: #Debugger to: self red; set: #customWindowColor for: #DualChangeSorter to: self blue; set: #customWindowColor for: #FileContentsBrowser to: self yellow; set: #customWindowColor for: #FileList to: self yellow; set: #customWindowColor for: #InstanceBrowser to: self cyan; set: #customWindowColor for: #Lexicon to: self cyan; set: #customWindowColor for: #MCTool to: self violet; set: #customWindowColor for: #MessageNames to: self green; set: #customWindowColor for: #MessageSet to: self cyan; set: #customWindowColor for: #PackagePaneBrowser to: self green; set: #customWindowColor for: #PluggableFileList to: self yellow; set: #customWindowColor for: #PreferenceBrowser to: self cyan; set: #customWindowColor for: #SMLoader to: self orange; set: #customWindowColor for: #SMLoaderPlus to: self orange; set: #customWindowColor for: #SMReleaseBrowser to: self orange; set: #customWindowColor for: #SelectorBrowser to: self cyan; set: #customWindowColor for: #StringHolder to: self yellow; set: #customWindowColor for: #TestRunner to: self orange; set: #customWindowColor for: #TranscriptStream to: self orange; set: #customWindowColor for: #VersionsBrowser to: self violet.! !!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addLightWindowColors: theme "You have to create dark first. doIt: [self createDark. self createLight apply.]" theme set: #uniformWindowColor for: #Model to: (self lightBackgroundHighlights adjustBrightness: -0.16 "darker twice"); set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: 0.16 "lighter twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: self lightContentEmphasized; set: #focusedLabelColor for: #SystemWindow to: self lightContentEmphasizedMore; set: #customWindowColor for: #Browser to: self green; set: #customWindowColor for: #ChangeList to: self blue; set: #customWindowColor for: #ChangeSorter to: self blue; set: #customWindowColor for: #ChatNotes to: self magenta; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet; set: #customWindowColor for: #Debugger to: (self red adjustSaturation: -0.27 brightness: 0.27); set: #customWindowColor for: #DualChangeSorter to: self blue; set: #customWindowColor for: #FileContentsBrowser to: self yellow; set: #customWindowColor for: #FileList to: self yellow; set: #customWindowColor for: #InstanceBrowser to: self cyan; set: #customWindowColor for: #Lexicon to: self cyan; set: #customWindowColor for: #MCTool to: self violet; set: #customWindowColor for: #MessageNames to: self green; set: #customWindowColor for: #MessageSet to: self cyan; set: #customWindowColor for: #PackagePaneBrowser to: self green; set: #customWindowColor for: #PluggableFileList to: self yellow; set: #customWindowColor for: #PreferenceBrowser to: self cyan; set: #customWindowColor for: #SMLoader to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SMLoaderPlus to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SMReleaseBrowser to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SelectorBrowser to: self cyan; set: #customWindowColor for: #StringHolder to: self yellow; set: #customWindowColor for: #TestRunner to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #TranscriptStream to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #VersionsBrowser to: self violet.! !!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addDullerWindowColors: theme theme set: #uniformWindowColor for: #Model to: Color veryVeryLightGray duller; set: #customWindowColor for: #Browser to: (Color r: 0.764 g: 0.9 b: 0.63) duller; set: #customWindowColor for: #ChangeList to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #ChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #ChatNotes to: (Color r: 1.0 g: 0.7 b: 0.8) duller; set: #customWindowColor for: #ClassCommentVersionsBrowser to: (Color r: 0.753 g: 0.677 b: 0.9) duller; set: #customWindowColor for: #Debugger to: (Color r: 0.9 g: 0.719 b: 0.719) duller; set: #customWindowColor for: #DualChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #FileContentsBrowser to: (Color r: 0.7 g: 0.7 b: 0.508) duller; set: #customWindowColor for: #FileList to: (Color r: 0.65 g: 0.65 b: 0.65) duller; set: #customWindowColor for: #InstanceBrowser to: (Color r: 0.726 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #Lexicon to: (Color r: 0.79 g: 0.9 b: 0.79) duller; set: #customWindowColor for: #MCTool to: (Color r: 0.65 g: 0.691 b: 0.876) duller; set: #customWindowColor for: #MessageNames to: (Color r: 0.639 g: 0.9 b: 0.497) duller; set: #customWindowColor for: #MessageSet to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #PackagePaneBrowser to: (Color r: 0.9 g: 0.9 b: 0.63) duller; set: #customWindowColor for: #PluggableFileList to: Color lightYellow duller; set: #customWindowColor for: #PreferenceBrowser to: (Color r: 0.671 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #SMLoader to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SMLoaderPlus to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SMReleaseBrowser to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SelectorBrowser to: (Color r: 0.45 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #StringHolder to: (Color r: 0.9 g: 0.9 b: 0.719) duller; set: #customWindowColor for: #TestRunner to: (Color r: 0.9 g: 0.576 b: 0.09) duller; set: #customWindowColor for: #TranscriptStream to: (Color r: 0.9 g: 0.75 b: 0.45) duller; set: #customWindowColor for: #VersionsBrowser to: (Color r: 0.782 g: 0.677 b: 0.9) duller.! !!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addWindowColors: theme theme set: #titleFont for: #SystemWindow to: [Preferences windowTitleFont]; set: #borderColorModifier for: #SystemWindow to: [ [:c | c adjustBrightness: -0.3] ]; set: #borderColorModifier for: #ScrollPane to: [ [:c | c adjustBrightness: -0.3] ]; set: #borderWidth for: #SystemWindow to: 1; derive: #resizerColorModifier for: #AbstractResizerMorph from: #SystemWindow at: #borderColorModifier; set: #uniformWindowColor for: #Model to: Color veryVeryLightGray; derive: #uniformWindowColor for: #TranscriptStream from: #Model; derive: #color for: #SystemWindow from: #Model at: #uniformWindowColor; "Fall back for windows without models." set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color darker] ]; set: #unfocusedLabelColor for: #SystemWindow to: Color darkGray; set: #focusedLabelColor for: #SystemWindow to: Color black; set: #customWindowColor for: #Browser to: (Color r: 0.764 g: 0.9 b: 0.63); set: #customWindowColor for: #ChangeList to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #ChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #ChatNotes to: (Color r: 1.0 g: 0.7 b: 0.8); set: #customWindowColor for: #ClassCommentVersionsBrowser to: (Color r: 0.753 g: 0.677 b: 0.9); set: #customWindowColor for: #Debugger to: (Color r: 0.9 g: 0.719 b: 0.719); set: #customWindowColor for: #DualChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #FileContentsBrowser to: (Color r: 0.7 g: 0.7 b: 0.508); set: #customWindowColor for: #FileList to: (Color r: 0.65 g: 0.65 b: 0.65); set: #customWindowColor for: #InstanceBrowser to: (Color r: 0.726 g: 0.9 b: 0.9); set: #customWindowColor for: #Lexicon to: (Color r: 0.79 g: 0.9 b: 0.79); set: #customWindowColor for: #MCTool to: (Color r: 0.65 g: 0.691 b: 0.876); set: #customWindowColor for: #MessageNames to: (Color r: 0.639 g: 0.9 b: 0.497); set: #customWindowColor for: #MessageSet to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #PackagePaneBrowser to: (Color r: 0.9 g: 0.9 b: 0.63); set: #customWindowColor for: #PluggableFileList to: Color lightYellow; set: #customWindowColor for: #PreferenceBrowser to: (Color r: 0.671 g: 0.9 b: 0.9); set: #customWindowColor for: #SMLoader to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SMLoaderPlus to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SMReleaseBrowser to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SelectorBrowser to: (Color r: 0.45 g: 0.9 b: 0.9); set: #customWindowColor for: #StringHolder to: (Color r: 0.9 g: 0.9 b: 0.719); set: #customWindowColor for: #TestRunner to: (Color r: 0.9 g: 0.576 b: 0.09); set: #customWindowColor for: #TranscriptStream to: (Color r: 0.9 g: 0.75 b: 0.45); set: #customWindowColor for: #VersionsBrowser to: (Color r: 0.782 g: 0.677 b: 0.9).! !!TrimTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addWindowColors: theme | windowColorBrightnessAdjustment | windowColorBrightnessAdjustment := -0.35. theme set: #titleFont for: #SystemWindow to: [Preferences windowTitleFont]; set: #borderColorModifier for: #SystemWindow to: [ [:c | c adjustBrightness: -0.1] ]; set: #borderColorModifier for: #ScrollPane to: [ [:c | c adjustBrightness: 0.1] ]; set: #borderWidth for: #SystemWindow to: 1; set: #uniformWindowColor for: #Model to: self gray76; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color alphaMixed: 0.5 with: self gray40] ]; set: #unfocusedLabelColor for: #SystemWindow to: self gray168; set: #focusedLabelColor for: #SystemWindow to: Color white; set: #customWindowColor for: #Browser to: ((Color r: 0.764 g: 0.9 b: 0.63) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChangeList to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChangeSorter to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChatNotes to: ((Color r: 1.0 g: 0.7 b: 0.8) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ClassCommentVersionsBrowser to: ((Color r: 0.753 g: 0.677 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #Debugger to: ((Color r: 0.9 g: 0.719 b: 0.719) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #DualChangeSorter to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #FileContentsBrowser to: ((Color r: 0.7 g: 0.7 b: 0.508) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #FileList to: ((Color r: 0.65 g: 0.65 b: 0.65) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #InstanceBrowser to: ((Color r: 0.726 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #Lexicon to: ((Color r: 0.79 g: 0.9 b: 0.79) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MCTool to: ((Color r: 0.65 g: 0.691 b: 0.876) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MessageNames to: ((Color r: 0.639 g: 0.9 b: 0.497) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MessageSet to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PackagePaneBrowser to: ((Color r: 0.9 g: 0.9 b: 0.63) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PluggableFileList to: (Color lightYellow adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PreferenceBrowser to: ((Color r: 0.671 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMLoader to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMLoaderPlus to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMReleaseBrowser to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SelectorBrowser to: ((Color r: 0.45 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #StringHolder to: ((Color r: 0.9 g: 0.9 b: 0.719) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #TestRunner to: ((Color r: 0.9 g: 0.576 b: 0.09) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #TranscriptStream to: ((Color r: 0.9 g: 0.75 b: 0.45) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #VersionsBrowser to: ((Color r: 0.782 g: 0.677 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment).! !!Utilities class methodsFor: 'common requests' stamp: 'mt 8/11/2023 15:01'!initializeCommonRequestStrings "Initialize the common request strings, a directly-editable list of expressions that can be evaluated from the 'do...' menu." CommonRequestStrings := StringHolder new contents: 'Utilities emergencyCollapse.Utilities closeAllDebuggers.RecentMessages default revertMostRecent.-MCFileBasedRepository flushAllCaches-Sensor keyboard.ParagraphEditor abandonChangeText.Cursor normal show.-CommandHistory resetAllHistory.Project allInstancesDo: [:p | p displayDepth: 16].ScriptingSystem inspectFormDictionary.Form fromUser bitEdit.Display border: (0@0 extent: 640@480) width: 2.-Undeclared inspect.Undeclared removeUnreferencedKeys; inspect.Transcript clear.GIFReadWriter grabScreenAndSaveOnDisk.FrameRateMorph new openInHand.-Utilities reconstructTextWindowsFromFileNamed: ''TW''.Utilities storeTextWindowContentsToFileNamed: ''TW''.ChangeSet removeEmptyUnnamedChangeSets.ChangesOrganizer reorderChangeSets.'"Utilities initializeCommonRequestStrings"! !!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:55'!addControls | slider aWrapper m aButton | aWrapper := AlignmentMorph newRow. aWrapper color: Color transparent; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 @ 5. aWrapper wrapCentering: #topLeft. aButton := self buttonName: 'X' action: #delete. aButton setBalloonText: 'Close WaveEditor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Menu' translated action: #invokeMenu. aButton setBalloonText: 'Open a menu' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play' translated action: #play. aButton setBalloonText: 'Play sound' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play Before' translated action: #playBeforeCursor. aButton setBalloonText: 'Play before cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play After' translated action: #playAfterCursor. aButton setBalloonText: 'Play after cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play Loop' translated action: #playLoop. aButton setBalloonText: 'Play the loop' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Test' translated action: #playTestNote. aButton setBalloonText: 'Test the note' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Save' translated action: #saveInstrument. aButton setBalloonText: 'Save the sound' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set Loop End' translated action: #setLoopEnd. aButton setBalloonText: 'Set loop end at cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set One Cycle' translated action: #setOneCycle. aButton setBalloonText: 'Set one cycle' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set Loop Start' translated action: #setLoopStart. aButton setBalloonText: 'Set the loop start at cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. self addMorphBack: aWrapper. aWrapper := AlignmentMorph newRow. aWrapper color: self color; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5 @ 20; wrapCentering: #center; cellPositioning: #leftCenter. m := StringMorph new contents: 'Index: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #cursor; putSelector: #cursor:; font: Preferences standardButtonFont; growable: false; width: 71; step. aWrapper addMorphBack: m. m := StringMorph new contents: 'Value: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #valueAtCursor; putSelector: #valueAtCursor:; font: Preferences standardButtonFont; growable: false; width: 50; step. aWrapper addMorphBack: m. slider := SimpleSliderMorph new color: color; extent: 200 @ 10; target: self; actionSelector: #scrollTime:. aWrapper addMorphBack: slider. m := Morph new color: aWrapper color; extent: 10 @ 5. "spacer" aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #startIndex; putSelector: #startIndex:; font: Preferences standardButtonFont; width: 40; step. aWrapper addMorphBack: m. self addMorphBack: aWrapper! !!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:56'!addLoopPointControls | m aWrapper | aWrapper := AlignmentMorph newRow. aWrapper color: self color; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter. m := StringMorph new contents: 'Loop end: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopEnd; putSelector: #loopEnd:; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Loop length: ' translated ; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopLength; putSelector: #loopLength:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m.aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Loop cycles: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopCycles; putSelector: #loopCycles:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m.aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Frequency: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #perceivedFrequency; putSelector: #perceivedFrequency:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. self addMorphBack: aWrapper! !!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:53'!buttonName: aString action: aSymbol "Create a button with the given label and action selector, and answer it." ^ SimpleButtonMorph new target: self; label: aString font: Preferences standardButtonFont; actionSelector: aSymbol! !WebCamMorph class removeSelector: #additionsToViewerCategories!SymbolListType removeSelector: #initialValueForASlotFor:!StringType removeSelector: #initialValueForASlotFor:!SoundType removeSelector: #initialValueForASlotFor:!PointType removeSelector: #initialValueForASlotFor:!NumberType removeSelector: #initialValueForASlotFor:!GraphicType removeSelector: #initialValueForASlotFor:!!GraphicType reorganize!('initial value')('initialization' initialize)!ColorType removeSelector: #initialValueForASlotFor:!BooleanType removeSelector: #initialValueForASlotFor:!DataType removeSelector: #initialValueForASlotFor:!Vocabulary removeSelector: #isEToyVocabulary!UpdatingStringMorph removeSelector: #isEtoyReadout!!UpdatingStringMorph reorganize!('accessing' autoAcceptOnFocusLoss autoAcceptOnFocusLoss: decimalPlaces decimalPlaces: floatPrecision format getSelector getSelector: growable growable: maximumWidth maximumWidth: minWidth minWidth: putSelector putSelector: pvtFloatPrecision: target target: valueFromContents)('copying' veryDeepFixupWith: veryDeepInner:)('editing' acceptContents acceptValue: addCustomMenuItems:hand: doneWithEdits lostFocusWithoutAccepting setDecimalPlaces: setFontSize setFontStyle setPrecision setToAllowTextEdit toggleGrowability userEditsAllowed)('event handling' handlesMouseDown: mouseDown: wouldAcceptKeyboardFocus)('events-processing' handlerForMouseDown:)('formats' useDefaultFormat useStringFormat useSymbolFormat)('initialization' defaultMaximumWidth defaultMinimumWidth initialize)('stepping' step stepTime stepTime: updateContentsFrom:)('target access' acceptValueFromTarget: checkTarget informTarget readFromTarget setDecimalPlacesFromTypeIn: stringForNumericValue:)('layout' fitContents)('*MorphicExtras-accessing' floatPrecision:)!UpdatingRectangleMorph removeSelector: #isEtoyReadout!!UpdatingRectangleMorph reorganize!('accessing' contents contents: getSelector getSelector: putSelector putSelector: target target: userEditsAllowed)('copying' veryDeepFixupWith: veryDeepInner:)('event handling' handlesMouseDown: mouseUp:)('initialization' defaultBorderColor)('setting' setTargetColor: valueProvider)('stepping' step stepTime)('target access' readFromTarget)!UpdatingMenuItemMorph removeSelector: #adaptToWorld:!ThumbnailMorph removeSelector: #isEtoyReadout!!ThumbnailMorph reorganize!('accessing' getSelector getSelector: putSelector target)('caching' releaseCachedState)('copying' veryDeepFixupWith: veryDeepInner:)('display' drawForForm:on: drawMeOn: scaleFor:in:)('drawing' drawOn:)('initialization' defaultBorderWidth defaultColor initialize objectToView: objectToView:viewSelector:)('stepping' step stepTime)('texture support' installAsWonderlandTextureOn:)('what to view' actualViewee formOrMorphToView morphToView)!ThreePhaseButtonMorph initialize!!ThreePhaseButtonMorph class reorganize!('class initialization' initialize)('instance creation' checkBox labelSymbol: radioButton)('preferences' themeProperties)!ThreePhaseButtonMorph removeSelector: #adaptToWorld:!TheWorldMenu removeSelector: #adaptToWorld:!TheWorldMenu removeSelector: #menuColorString!TheWorldMenu removeSelector: #mvcProjectsAllowed!TheWorldMenu removeSelector: #roundedCornersString!TheWorldMenu removeSelector: #toggleMenuColorPolicy!!TheWorldMenu reorganize!('action' commandKeyTypedIntoMenu: doMenuItem:with: projectThumbnail saveScreenshot setGradientColor soundEnablingString staggerPolicyString toggleRoundedCorners toggleWindowPolicy)('commands' changeBackgroundColor cleanUpWorld garbageCollect loadProject lookForSlips newMorphOfClass:event: openBrowser openFileDirectly openFileList openMorphicProject openMVCProject openPreferencesBrowser openPreferencesWizard openTranscript openWorkspace projectForMyWorld quitSession readMorphFromAFile saveAndQuit saveWorldInFile setDisplayDepth splitNewMorphList:depth: startMessageTally vmStatistics worldMenuHelp)('construction' addObjectsAndTools: addPrintAndDebug: addProjectEntries: addRestoreDisplay: addSaveAndQuit: addUtilities: alphabeticalMorphMenu appearanceMenu buildWorldMenu changesMenu colorForDebugging: debugMenu fillIn:from: helpMenu makeConvenient: newMorph openMenu projectMenu remoteMenu)('mechanics' menu: world:project:hand:)('menu' addGestureHelpItemsTo:)('popups' appearanceDo changesDo debugDo doPopUp: helpDo openWindow projectDo remoteDo standardFontDo)('windows & flaps menu' suppressFlapsString windowsDo windowsMenu)('*MorphicExtras-action' createStandardPartsBin launchCustomPartsBin toggleFlapSuppressionInProject)('*MorphicExtras-construction' myMenuColor)('*MorphicExtras-mechanics')('*MorphicExtras-windows & flaps menu' flapsDo flapsMenu formulateFlapsMenu: globalFlapsEnabled newGlobalFlapString)('*Tools' browseRecentLog openChangeSorter1 openChangeSorter2 openMessageNames openProcessBrowser openSelectorBrowser startThenBrowseMessageTally)('*MorphicExtras-Postscript Canvases' printWorldOnFile)!TextMorphForEditView removeSelector: #wouldAcceptKeyboardFocusUponTab!!TextMorph class reorganize!('class initialization' cleanUp defaultEditorClass defaultEditorClass: initialize registerInFlapsRegistry unload)('connectorstext-parts bin' boldAuthoringPrototype)('new-morph participation' includeInNewMorphMenu)('parts bin' borderedPrototype exampleBackgroundLabel fancyPrototype)('scripting' authoringPrototype defaultNameStemForInstances)('instance creation' string:fontName: string:fontName:size: string:fontName:size:wrap: string:size:)('*MorphicExtras-parts bin' supplementaryPartsDescriptions)!TextMorph removeSelector: #cursor!TextMorph removeSelector: #cursorWrapped:!TextMorph removeSelector: #getAllButFirstCharacter!TextMorph removeSelector: #holderForCharacters!TextMorph removeSelector: #insertCharacters:!TextMorph removeSelector: #insertContentsOf:!TextMorph removeSelector: #setAllButFirstCharacter:!TextMorph removeSelector: #wouldAcceptKeyboardFocusUponTab!!TextMorph reorganize!('accessing' autoFit: backgroundColor backgroundColor: borderWidth: caretColor caretColor: contents contentsAsIs: contentsWrapped: contents: contents:wrappedTo: crAction crAction: editor elementCount font: getFirstCharacter getLastCharacter hasTranslucentColor isAutoFit isWrapped margins margins: newContents: plainTextOnly plainTextOnly: readOnly readOnly: selectAll selectFrom:to: selectInterval: selection selectionColor selectionColor: selectionInterval selectionInterval: setCharacters: setFirstCharacter: setLastCharacter: text textAlignment textAlignmentSymbol textColor textColor: textStyle textStyle: unfocusedSelectionColor unfocusedSelectionColor: userString wrapFlag:)('alignment' centered justified leftFlush rightFlush)('anchors' adjustTextAnchor: anchorMorph:at:type:)('caching' loadCachedState releaseCachedState)('change reporting' ownerChanged)('classification' isTextMorph)('containment' avoidsOcclusions fillingOnOff fillsOwner fillsOwner: occlusionsOnOff recognizerArena setContainer:)('copying' copy veryDeepFixupWith: veryDeepInner:)('drawing' areasRemainingToFill: debugDrawLineRectsOn: drawNullTextOn: drawOn:)('editing' acceptContents acceptOnCR cancelEdits cancelEditsSafely chooseAlignment chooseEmphasis chooseEmphasisOrAlignment chooseFont chooseStyle handleEdit: handleInteraction:fromEvent: hasUnacceptedEdits: passKeyboardFocusTo: setCompositionWindow xeqLinkText:withParameter:)('event handling' click: getMenu: handlesKeyboard: handlesMouseDown: handlesMouseMove: handlesMouseOver: handlesMouseStillDown: hasFocus keyboardFocusChange: keyStroke: mouseDown: mouseEnter: mouseLeave: mouseMove: mouseUp: startDrag: wantsKeyboardFocus yellowButtonActivity:)('events-processing' handleKeystroke:)('geometry' bounds container defaultLineHeight extent: maximumContainerExtent privateMoveBy: textBounds)('geometry testing' containsPoint:)('initialization' beAllFont: defaultBorderWidth defaultColor fontName:pointSize: fontName:size: initialize setTextStyle: string:fontName:size: string:fontName:size:wrap:)('layout' acceptDroppingMorph:event: averageLineLength averageLineLength: doLayoutIn: layoutChanged minCompositionHeight minCompositionWidth minHeight minWidth)('linked frames' addPredecessor: addSuccessor: firstCharacterIndex firstInChain isLinkedTo: lastCharacterIndex predecessor recomposeChain startingIndex successor withSuccessorsDo:)('menu' addCustomMenuItems:hand: autoFitOnOff autoFitString changeMargins: changeTextColor followCurve reverseCurveDirection setCurveBaseline: wrapOnOff wrapString)('multi level undo' editHistory)('objects from disk' convertToCurrentVersion:refStream: fixUponLoad:seg:)('visual properties' fillStyle fillStyle:)('*MorphicExtras-accessing' getCharacters)('*MorphicExtras-copying' updateReferencesUsing:)('private' adjustLineIndicesBy: clippingRectangle composeToBounds compositionRectangle createParagraph editorClass fit installEditorToReplace: paragraph paragraphClass predecessorChanged predecessor:successor: privateOwner: releaseEditor releaseParagraph releaseParagraphReally removedMorph: selectionChanged selectionChanged: setDefaultContentsIfNil setPredecessor: setSuccessor: text:textStyle: text:textStyle:wrap:color:predecessor:successor: updateFromParagraph)('blinking' blinkStart blinkStart: onBlinkCursor resetBlinkCursor startBlinking stopBlinking)('layout-properties' hResizing hResizing: vResizing vResizing: wrapDirection)('printing' fullPrintOn:)('Multilingual-ImmPlugin' preferredKeyboardPosition)('submorphs - add/remove' addMorphFront:fromWorldPosition: delete goBehind)('converting' asText withNoLineLongerThan:)!TabbedPalette removeSelector: #becomeStandardPalette!!TabbedPalette reorganize!('dropping/grabbing' wantsDroppedMorph:event:)('halos and balloon help' defersHaloOnClickTo:)('initialization' addTabFor:font: addTabForBook: addTabForBook:withBalloonText: defaultColor defaultPageSize initialize newTabs: setInitialState)('misc menu items' recolorTabs showNoPalette showNoPaletteAndHighlightTab: sortTabs:)('miscellaneous' currentPalette tabsMorph)('navigation' transitionSpecFor:)('other' setExtentFromHalo:)('palette menu' addBookMenuItemsTo:hand: addMenuTab)('scraps tab' hasScrapsTab scrapsBook showScrapsTab)('user-interface' selectTab: selectTabNamed: selectTabOfBook: tabMorphs tabNamed:)('submorphs - add/remove' replaceSubmorph:by:)!SystemWindow removeSelector: #extantSketchEditor!SystemWindow removeSelector: #wantsExpandBox!SystemWindow removeSelector: #wantsHalo!!SystemWindow reorganize!('drawing' areasRemainingToFill: colorForInsets makeMeVisible wantsRoundedCorners)('events' doFastFrameDrag: filterEvent:for: handleListenEvent: handleMouseDown: handleMouseUp: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: paneTransition: secondaryPaneTransition:divider: startDragFromLabel: wantsToBeDroppedInto:)('geometry' extent: justDroppedInto:event: labelRect paneMorphs panelRect position: removeMenuBox setPaneRectsFromBounds)('initialization' addCloseBox addExpandBox addGrips addKeyboardShortcuts addLabelArea addMenuControl applyModelExtent boxExtent createBox: createCloseBox createCollapseBox createExpandBox createMenuBox defaultBounds defaultColor initialize initializeKeyboardShortcuts initializeLabelArea initializeWithLabel: maximumExtent maximumExtent: model: removeKeyboardShortcuts replaceBoxes setDefaultParameters setFramesForLabelArea)('label' addLabel getRawLabel knownName label labelArea labelHeight labelWidgetAllowance relabel relabelEvent: setLabel: setLabelWidgetAllowance tryToRenameTo: update: widthOfFullLabelText)('layout' assureLabelAreaVisible changeCellGapOfLayoutFrames: convertAlignment displayScaleChangedBy: layoutBounds putLabelItemsInLabelArea)('menu' addCustomMenuItems:hand: buildWindowMenu changeColor deleteCloseBox fullScreen fullScreenMaximumExtent makeClosable makeSecondTopmost makeUnclosable offerWindowMenu sendToBack setWindowColor takeOutOfWindow wantsYellowButtonMenu)('object fileIn' convertToCurrentVersion:refStream:)('open/close' anyOpenWindowLikeMeIn: closeBoxHit delete initialExtent mustNotClose openAsIs openAsIsIn: openInWorld: openInWorld:extent: openInWorldExtent: postAcceptBrowseFor:)('panes' addMorph:frame: addMorph:fullFrame: holdsTranscript paneMorphSatisfying: replacePane:with: setUpdatablePanesFrom: titleAndPaneText updatablePanes updateBox:color: updateBoxesColor:)('resize/collapse' allowReframeHandles allowReframeHandles: collapse collapseOrExpand collapsedFrame contractToOriginalSize dragToEdgeDistance dragToEdgesSelectorFor:in: expand expandBoxHit expandToFullScreen fastFramingOn fullFrame getBoundsWithFlex getCollapsedFrame isCollapsed isPoint:nearBottomLeftOf: isPoint:nearBottomOf: isPoint:nearBottomRightOf: isPoint:nearLeftOf: isPoint:nearRightOf: isPoint:nearTopLeftOf: isPoint:nearTopOf: isPoint:nearTopRightOf: mouseLeaveEvent:fromPane: paneWithLongestSide:near: reframePanesAdjoining:along:to: setBoundsWithFlex: unexpandedFrame unexpandedFrame:)('stepping' amendSteppingStatus stepAt: stepTime wantsSteps wantsStepsWhenCollapsed)('testing' isSystemWindow isWindowForModel: shouldDropOnMouseUp wantsToBeCachedByHand)('top window' beKeyWindow beKeyWindowIfNeeded: comeToFront comeToFrontModally dimWindowButtons isKeyWindow undimWindowButtons updatePanesFromSubmorphs)('thumbnail' icon)('polymorph' modalChild modalLockTo: modalOwner modalUnlockFrom: rememberedKeyboardFocus)('focus' activate defaultFocusMorph defaultFocusMorph: isActive isActive: isLookingFocused isLookingFocused: lockWindowDecorations lockWindowTitle lookFocused lookUnfocused passivate passivateIfNeeded unlockWindowDecorations unlockWindowTitle updateFocusLookAtHand updateFocusLookForKeyboardFocus windowDecorations)('colors' existingPaneColor gradientWithColor: paneColor paneColor: paneColorToUse paneColorToUseWhenNotActive raisedColor refreshWindowColor restoreDefaultPaneColor setStripeColorsFrom: setWindowColor: updatePaneColors)('user interface' applyUserInterfaceTheme)('*ToolBuilder-Morphic-opening' openAsTool)('*services-base' requestor topWindow)('*60Deprecated-open/close' anyOpenWindowLikeMe)!SuperSwikiServer removeSelector: #matchingEntries:!StringButtonMorph removeSelector: #adaptToWorld:!!StringButtonMorph reorganize!('accessing' actionSelector actionSelector: arguments arguments: target target:)('button' doButtonAction)('copying' updateReferencesUsing: veryDeepFixupWith: veryDeepInner:)('event handling' handlesMouseDown: handlesMouseStillDown: mouseDown: mouseMove: mouseStillDown: mouseUp:)('initialization' initialize)('menu' addCustomMenuItems:hand: addTargetingMenuItems:hand: clearTarget setActWhen setActionSelector setArguments setLabel setTarget:)('submorphs - add/remove' actWhen:)('classification' isButton)!SqueakFurtherCorePackagesHelp class removeSelector: #etoys!!SmartRefStream reorganize!('accessing' structures: superclasses:)('class changed shape' catalogValues:size: conversionMethodsFor: storeInstVarsIn:from: writeClassRename:was: writeClassRenameMethod:was:fromInstVars: writeConversionMethod:class:was:fromInstVars:to: writeConversionMethodIn:fromInstVars:to:renamedFrom:)('conversion' inputSensorx0 worldMorphbosfcebbfgccpmcpbttloiairfidcuwhavcdsll0)('import image segment' applyConversionMethodsTo:className:varMap: checkFatalReshape: convert1:to:allVarMaps: convert2:allVarMaps: mapClass:origName: reshapedClassesIn:)('read write' appendClassDefns checkCrLf initKnownRenames initShapeDicts instVarInfo: mapClass: moreObjects next nextAndClose nextPut: nextPutObjOnly: noHeader readInstance readInstanceSize:clsname:refPosn: readShortInst readWordLike recordImageSegment: renamed renamedConv restoreClassInstVars saveClassInstVars scanFrom: scanFrom:environment: setStream: setStream:reading: structures superclasses uniClasesDo: uniClassInstVarsRefs: verifyStructure versionSymbol:)('*Morphic-conversion' bookPageMorphbosfcepcbbfgcc0 clippingMorphbosfcep0 clippingMorphbosfcepc0 dropShadowMorphbosfces0 layoutMorphbosfcepbbochvimol0 layoutMorphbosfcepcbbochvimol0 morphicEventtcbks0 morphicSoundEventtcbkss0 multiNewParagraphttfclpomsswfpp0 myMorphbosfce0 newMorphicEventts0)('*ST80-conversion' scrollControllermvslrrsmsms0)('*Graphics-conversion' transparentColorrcc0)('strings-conversion' abstractStringx0 multiStringx0 multiSymbolx0)!ColorPickerMorph removeSelector: #delete!ColorPickerMorph removeSelector: #getColorFromKedamaWorldIfPossible:!!ColorPickerMorph reorganize!('accessing' argument argument: deleteOnMouseUp deleteOnMouseUp: locationIndicator originalColor: selectedColor selector selector: sourceHand sourceHand: target target: updateContinuously updateContinuously:)('drawing' drawOn:)('event handling' handlesMouseDown: inhibitDragging mouseDown: mouseUp:)('geometry testing' containsPoint:)('halos and balloon help' isLikelyRecipientForMouseOverHalos)('initialization' buildChartForm choseModalityFromPreference initialize initializeForPropertiesPanel initializeModal: updateSelectorDisplay)('menu' addCustomMenuItems:hand: pickUpColorFor: toggleDeleteOnMouseUp toggleUpdateContinuously)('other' addToWorld:near: bestPositionNear:inWorld: indicateColorUnderMouse putUpFor:near: trackColorUnderMouse)('stepping' step stepTime)('private' anchorAndRunModeless: argumentsWith: deleteAllBalloons modalBalloonHelpAtPoint: pickColorAt: positionOfColor: trackColorAt: updateAlpha: updateColor:feedbackColor: updateTargetColor updateTargetColorWith:)('submorphs - add/remove' delete)!SketchMorph removeSelector: #firstIntersectionWithLineFrom:to:!!SketchMorph reorganize!('accessing' form form: framesToDwell framesToDwell: keepAspectRatio keepAspectRatio: nominalForm: originalForm: rotatedForm scaleFactor scalePoint scalePoint: setNewFormFrom: useInterpolation useInterpolation: wantsSimpleSketchMorphHandles)('caching' releaseCachedState)('drawing' canBeEnlargedWithB3D drawHighResolutionOn:in: drawInterpolatedImage:on: drawOn: generateInterpolatedForm generateRotatedForm)('support' baseGraphic baseGraphic: flipHorizontal flipVertical rotationStyle rotationStyle: wantsRecolorHandle)('geometry' extent:)('geometry testing' containsPoint:)('halos and balloon help' isLikelyRecipientForMouseOverHalos wantsDirectionHandles wantsDirectionHandles:)('initialization' initialize initializeWith:)('layout' layoutChanged)('menu' addBorderToShape: addCustomMenuItems:hand: addPaintingItemsTo:hand: blur callThisBaseGraphic edgeDetect editDrawing editDrawingIn:forBackground: emboss erasePixelsOfColor: erasePixelsUsing: insertIntoMovie: recolorPixelsOfColor:with: recolorPixelsUsing: reduceColorPalette: restoreBaseGraphic restoreBaseGraphicFromMenu setRotationStyle sharpen toggleInterpolation useInterpolationString)('menus' addFillStyleMenuItems:hand: addToggleItemsToHaloMenu: changePixelsOfColor:toColor: chooseNewGraphic collapse)('objects from disk' convertToCurrentVersion:refStream:)('other' newForm: replaceSelfWithMovie)('parts bin' initializeToStandAlone)('pen support' clearExtent:fillColor: penOnMyForm revealPenStrokes)('rotate scale and flex' forwardDirection: heading:)('*MorphicExtras-testing' canDrawAtHigherResolution)!SketchEditorMorph removeSelector: #wantsHaloFromClick!SimpleSliderMorph removeSelector: #isLikelyRecipientForMouseOverHalos!!SimpleSliderMorph reorganize!('accessing' actionSelector actionSelector: arguments arguments: maxVal maxVal: minVal minVal: target target:)('copying' updateReferencesUsing: veryDeepFixupWith: veryDeepInner:)('initialization' initialize)('menu' addCustomMenuItems:hand: addSliderMenuItems:hand: addTargetingMenuItems:hand: clearTarget descendingString setActionSelector setArguments setLabel setMaxVal setMinVal setMinVal: setTarget: toggleDescending toggleTruncate truncateString)('model access' setValue:)('parts bin' initializeToStandAlone)('private' adjustToValue: getScaledValue setMaxVal: setScaledValue: truncate truncate:)!SimpleHierarchicalListMorph class removeSelector: #submorphsExample!!SimpleHierarchicalListMorph class reorganize!('instance creation' expandedForm notExpandedForm on:list:selected:changeSelected: on:list:selected:changeSelected:menu: on:list:selected:changeSelected:menu:keystroke:)('preferences' applyUserInterfaceTheme expandAllLimit expandAllLimit: themeProperties wrappedNavigation wrappedNavigation:)!HaloMorph removeSelector: #addChooseGraphicHandle:!HaloMorph removeSelector: #addMakeSiblingHandle:!HaloMorph removeSelector: #addPaintBgdHandle:!HaloMorph removeSelector: #addPoohHandle:!HaloMorph removeSelector: #addRepaintHandle:!HaloMorph removeSelector: #addScriptHandle:!HaloMorph removeSelector: #addTileHandle:!HaloMorph removeSelector: #addViewHandle:!HaloMorph removeSelector: #addViewingHandle:!HaloMorph removeSelector: #doDupOrMakeSibling:with:!HaloMorph removeSelector: #doMakeSibling:with:!HaloMorph removeSelector: #doMakeSiblingOrDup:with:!HaloMorph removeSelector: #fadeIn!HaloMorph removeSelector: #fadeInInitially!HaloMorph removeSelector: #fadeOut!HaloMorph removeSelector: #fadeOutFinally!HaloMorph removeSelector: #handleEntered!HaloMorph removeSelector: #handleLeft!HaloMorph removeSelector: #isMagicHalo!HaloMorph removeSelector: #isMagicHalo:!HaloMorph removeSelector: #mouseDown:!HaloMorph removeSelector: #openViewerForTarget:with:!HaloMorph removeSelector: #popUpMagicallyFor:hand:!HaloMorph removeSelector: #tearOffTileForTarget:with:!SimpleHaloMorph removeSelector: #isMagicHalo!SimpleHaloMorph removeSelector: #popUpMagicallyFor:hand:!!IconicButton reorganize!('events' mouseEnter: mouseLeave:)('initialization' borderNormal borderThick buttonSetup defaultBorderWidth initialize initializeWithThumbnail:withLabel:andColor:andSend:to: initializeWithThumbnail:withLabel:andSend:to: setDefaultLabel stationarySetup)('menu' addLabelItemsTo:hand:)('button' doButtonAction)('compatibility' dim undim)('ui' darken darkenedForm restoreImage shedSelvedge)('label' labelFromString: labelGraphic: labelMorph)('*MorphicExtras-initialization' initializeToShow:withLabel:andSend:to:)!SimpleButtonMorph removeSelector: #adaptToWorld:!!ServerDirectory class reorganize!('available servers' addLocalProjectDirectory: addServer:named: localProjectDirectories nameForServer: projectServers removeServerNamed: removeServerNamed:ifAbsent: resetLocalProjectDirectories resetServers serverForURL: serverNamed: serverNamed:ifAbsent: serverNames servers)('class initialization' cleanUp: initialize)('misc' defaultStemUrl newFrom: on: parseFTPEntry: secondsForDay:month:yearOrTime:thisMonth:thisYear:)('school support' projectDefaultDirectory)('server prefs' determineLocalServerDirectory: fetchExternalSettingsIn: parseServerEntryFrom: releaseExternalSettings serverConfDirectoryName storeCurrentServersIn: transferServerDefinitionsToExternal)('*UpdateStream-server groups' convertGroupNames groupNames serverInGroupNamed: serversInGroupNamed:)!Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl keepAlive encodingName' classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers' poolDictionaries: '' category: 'Network-RemoteDirectory'!SelectionMorph removeSelector: #couldMakeSibling!SelectionMorph removeSelector: #preferredDuplicationHandleSelector!ScrollableField removeSelector: #cursorWrapped:!ScrollableField removeSelector: #getAllButFirstCharacter!ScrollableField removeSelector: #getNumericValue!ScrollableField removeSelector: #insertCharacters:!ScrollableField removeSelector: #insertContentsOf:!ScrollableField removeSelector: #setNumericValue:!!ScreeningMorph reorganize!('accessing' passElseBlock: passingColor:)('drawing' fullDrawOn:)('halos and balloon help' wantsRecolorHandle)('geometry testing' containsPoint:)('initialization' initialize)('layout' layoutChanged)('menu' addCustomMenuItems:hand: chooseBlockingColor choosePassingColor exchange showScreenOnly showScreenOverSource showScreened showSourceOnly)('private' removedMorph: screenForm screenMorph sourceMorph)('submorphs - add/remove' addMorph:)!ScreenController removeSelector: #standardGraphicsLibrary!ReleaseBuilder class removeSelector: #beautifyEtoys!FlapTab removeSelector: #makeNewDrawing:!FlapTab removeSelector: #startOrFinishDrawing:!FlapTab removeSelector: #thicknessString!Quadrangle class removeSelector: #exampleInViewer!!ProjectSorterMorph reorganize!('initialization' addControls defaultBorderWidth defaultColor initialize navigator:listOfPages:)('event handling' clickFromSorterEvent:morph:)('controls' insertNewProject:)('private' morphsForMyContentsFrom:sizedTo: sorterMorphForProjectNamed:)!ProjectNavigationMorph removeSelector: #buttonPaint!ProjectNavigationMorph removeSelector: #doNewPainting!ProjectNavigationMorph removeSelector: #editProjectInfo!ProjectNavigationMorph removeSelector: #makeTheSimpleButtons!!ProjectLoading class reorganize!('accessing' projectStreamFromArchive: thumbnailFromUrl:)('loading' installRemoteNamed:from:named:in: openFromDirectory:andFileName: openFromFile:fromDirectory:withProjectView: openName:stream:fromDirectory:withProjectView: openName:stream:fromDirectory:withProjectView:clearOriginFlag: openOn:)('utilities' bestAccessToFileName:andDirectory: useTempChangeSet)('loading - support' checkSecurity:preStream:projStream: fileInName:archive:morphOrList: loadImageSegment:fromDirectory:withProjectView:numberOfFontSubstitutes:substituteFont:mgr: makeExistingView:project:projectsToBeDeleted: morphOrList:stream:fromDirectory:archive: parseManifest:)!ProjectLauncher removeSelector: #cancelLogin!ProjectLauncher removeSelector: #doEtoyLogin!ProjectLauncher removeSelector: #loginAs:!ProjectLauncher removeSelector: #prepareForLogin!ProjectLauncher removeSelector: #proceedWithLogin!ProjectLauncher removeSelector: #startUpAfterLogin!AbstractLauncher subclass: #ProjectLauncher instanceVariableNames: 'showSplash splashURL whichFlaps' classVariableNames: 'SplashMorph' poolDictionaries: '' category: 'System-Download'!!ProjectLauncher reorganize!('initialization' initialize setupFlaps setupFromParameters)('running' hideSplashMorph installProjectFrom: showSplashMorph startUp)('private' showSplash)!Project class removeSelector: #publishInSexp!!Project class reorganize!('class initialization' cleanUp: cleanUpProjectPreferences initialize localeChanged rebuildAllProjects)('constants' current uiManager uiProcess)('squeaklet on server' enterIfThereOrFind: fromUrl: isBadNameForStoring: loaderUrl mostRecent:onServer: namedUrl: parseProjectFileName: projectExtension serverDirectoryFromURL: serverFileFromURL: squeakletDirectory sweep:)('utilities' addingProject: advanceToNextProject allNames allNamesAndProjects allProjects allProjectsOrdered canWeLoadAProjectNow chooseNaturalLanguage deletingProject: enter: flattenProjectHierarchy forget: hierarchyOfNamesAndProjects jumpToProject jumpToSelection: maybeForkInterrupt named: named:in: namedWithDepth: ofWorld: projectHierarchy releaseProjectReferences: removeAll: removeAllButCurrent returnToParentProject returnToPreviousProject storeAllInSegments topProject versionForFileName:)('*Morphic-Support' allMorphicProjects)('error recovery' tryEmergencyEvaluatorForRecovery: tryOtherProjectForRecovery:)('shrinking' removeProjectsFromSystem)('snapshots' shutDown: startUp:)('*ST80-Support' allMVCProjects)('preferences')('*60Deprecated-error recovery' handlePrimitiveError:)('*61Deprecated-utilities' resumeProcess:)!MorphicProject removeSelector: #exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction:!MorphicProject removeSelector: #initMorphic!MorphicProject removeSelector: #myPlayerClasses!MorphicProject removeSelector: #setFlaps!!MorphicProject reorganize!('display' displayScaleChangedFrom:to: invalidate noDisplayDuring: previewImageForm restore viewLocFor:)('initialize' initialize installPasteUpAsWorld: openProject: setWorldBackground:)('testing' isMorphic)('menu messages' assureNavigatorPresenceMatchesPreference makeThumbnail)('utilities' addItem:toMenu:selection:color:thumbnail: composeDisplayTextIntoForm: createViewIfAppropriate do:withProgressInfoOn:label: findAFolderForProject:label: findProjectView: jumpToProject launchSystemFiles:event: offerMenu:from:shifted: pointerMoved setAsBackground: showImage:named: textWindows)('docking bars support' assureMainDockingBarPresenceMatchesPreference createOrUpdateMainDockingBar dockingBar dockingBar: removeMainDockingBar showWorldMainDockingBar showWorldMainDockingBar: showWorldMainDockingBarString toggleShowWorldMainDockingBar)('file in/out' acceptProjectDetails: armsLengthCommand:withDescription: compressFilesIn:to:in: compressFilesIn:to:in:resources: exportSegmentWithChangeSet:fileName:directory: exportSegmentWithChangeSet:fileName:directory:withoutInteraction: loadFromServer: noteManifestDetailsIn: storeSegment storeSegmentNoFile)('enter' clearGlobalState enterAsActiveSubprojectWithin: finalEnterActions: finalExitActions: initializeMenus isIncompletelyLoaded resumeEventRecorder: scheduleProcessForEnter startUpActions suspendProcessForDebug terminateProcessForLeave wakeUpTopWindow)('squeaklet on server' enterIfThereOrFind: openBlankProjectNamed:)('release' deletingProject: prepareForDelete)('language' chooseNaturalLanguage updateLocaleDependents)('editors' bitEdit: bitEdit:at:scale: editCharacter:ofFont: formEdit: formViewClass openImage:name:saveResource:)('futures' future:do:at:args: future:send:at:args:)('active process' spawnNewProcess spawnNewProcessAndTerminateOld: spawnNewProcessIfThisIsUI: uiProcess uiProcess:)('transcripter' displayTranscripter: initializeParagraphForTranscripter:)('subprojects' addProject: subProjects)('accessing' color topMorphicProject)('updating' applyUserInterfaceTheme canApplyUserInterfaceTheme)('scheduling & debugging' addDeferredUIMessage: fatalDrawingError: interruptCleanUpFor: lastDeferredUIMessage openDebuggerWindow: recursiveError: restoreDisplay resumeProcessSafely: suspendProcessSafely:)('flaps support' assureFlapIntegrity cleanseDisabledGlobalFlapIDsList enableDisableGlobalFlap: flapsSuppressed: globalFlapEnabledString: globalFlapWithIDEnabledString: isFlapEnabled: isFlapIDEnabled: suppressFlapsString toggleFlapsSuppressed)('protocols' currentVocabulary)!Project removeSelector: #restoreReferences!!Project reorganize!('accessing' changeSet color displayDepth displayDepth: explicitName explicitName: findProjectView: forgetExistingURL labelString lastDirectory: lastSavedAtSeconds name nameAdjustedForDepth nextProject nilParentError previousProject projectChangeSet renameTo: storeNewPrimaryURL: thumbnail thumbnail: topProject transcript uiManager urlList viewSize viewSize: world)('active process' depth spawnNewProcessIfThisIsUI: uiProcess)('displaying' displayDepthChanged displayScaleChangedFrom:to: displaySizeChanged displayZoom: imageForm imageFormOfSize:depth: invalidate noDisplayDuring: previewImageForm restore restoreDisplay showZoom shrinkDisplay viewLocFor:)('file in/out' armsLengthCommand:withDescription: assureIntegerVersion bumpVersion: couldBeSwappedOut currentVersionNumber decideAboutCreatingBlank: doArmsLengthCommand: downloadUrl ensureChangeSetNameUnique exportSegmentFileName:directory: exportSegmentFileName:directory:withoutInteraction: exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction: exportSegmentWithCatagories:classes:fileName:directory: exportSegmentWithChangeSet:fileName:directory: findAFolderToLoadProjectFrom findAFolderToStoreProjectIn fromMyServerLoad: hasBadNameForStoring htmlPagePrototype loadFromServer loadFromServer: objectForDataStream: primaryServer primaryServerIfNil: projectExtension revert saveAs saveForRevert serverList squeakletDirectory storeAttributeKey:value:on: storeAttributesOn: storeDataOn: storeHtmlPageIn: storeManifestFileIn: storeOnServer storeOnServerAssumingNameValid storeOnServerInnards storeOnServerShowProgressOn:forgetURL: storeOnServerWithProgressInfo storeOnServerWithProgressInfoOn: storeSegment storeSegmentNoFile storeSomeSegment storeToMakeRoom tryToFindAServerWithMe url urlForLoading versionForFileName versionFrom: versionedFileName writeFileNamed:fromDirectory:toServer: writeStackText:in:registerIn:)('flaps support' flapsSuppressed flapsSuppressed: showSharedFlaps)('initialization' initialExtent initialProject initialize installNewDisplay:depth: openProject: resetTranscript setChangeSet: setServer windowActiveOnFirstClick windowReqNewLabel:)('language' chooseNaturalLanguage localeChanged localeID naturalLanguage updateLocaleDependents)('menu messages' assureNavigatorPresenceMatchesPreference doWeWantToRename exit fileOut installProjectPreferences makeThumbnail saveProjectPreferences validateProjectNameIfOK:)('printing' addSubProjectNamesTo:indentation: printOn:)('project parameters' initializeProjectParameters initializeProjectPreferences noteThatParameter:justChangedTo: parameterAt: parameterAt:ifAbsent: projectParameterAt: projectParameterAt:ifAbsent: projectParameterAt:ifAbsentPut: projectParameterAt:put: projectParameters projectPreferenceAt: projectPreferenceAt:ifAbsent: projectPreferenceFlagDictionary rawParameters removeParameter:)('release' addDependent: canDiscardEdits close delete deletingProject: forget okToChange prepareForDelete release removeChangeSetIfPossible windowIsClosing)('resources' abortResourceLoading resourceDirectoryName resourceManager resourceManager: resourceUrl startResourceLoading storeResourceList:in:)('SuperSwiki' tellAFriend tellAFriend:)('*sound' beep)('enter' enter enter: enter:revert:saveForRevert: finalEnterActions: finalExitActions: loadState saveState scheduleProcessForEnter shutDownActions startUpActions terminateProcessForLeave wakeUpTopWindow)('utilities' addItem:toMenu:selection:color:thumbnail: buildJumpToMenu: composeDisplayTextIntoForm: do:withProgressInfoOn:label: findAFolderForProject:label: jumpToProject jumpToSelection: offerMenu:from:shifted: pointerMoved setAsBackground: showImage:named: textWindows)('squeaklet on server' enterIfThereOrFind: openBlankProjectNamed:)('futures' future:do:at:args: future:send:at:args:)('editors' bitEdit: bitEdit:at:scale: editCharacter:ofFont: formEdit: formViewClass openImage:name:saveResource:)('transcripter' displayTranscripter: initializeParagraphForTranscripter:)('sub-projects & hierarchy' addProject: beTopProject children isTopProject liftSubProjects parent setParent: subProjects withChildrenDo:)('enter - recovery' enterForEmergencyRecovery suspendProcessForDebug)('testing' isCurrentProject isIncompletelyLoaded isMorphic)('shrinking' removeAllOtherProjects)('*ST80-Testing' isMVC)('*60Deprecated-accessing' setThumbnail: setViewSize:)('scheduling & debugging' addDeferredUIMessage: debugProcess:inDialog: debugProcess:inWindow: guardRecursiveError:during: interruptCleanUpFor: interruptName: interruptName:message: interruptName:message:preemptedProcess: interruptName:preemptedProcess: lastDeferredUIMessage openDebuggerWindow: prepareProcessForDebugger: primitiveError: recursiveError: resumeProcessSafely: suspendProcessSafely:)('*MorphicExtras-accessing' useOwnChangeSetWithCurrentName useParentChangeSetButSetProjectName:)('protocols' currentVocabulary)!Preferences class removeSelector: #annotationEditingWindow!Preferences class removeSelector: #automaticViewerPlacement!Preferences class removeSelector: #batchPenTrails!Preferences class removeSelector: #capitalizedReferences!Preferences class removeSelector: #cautionBeforeClosing!Preferences class removeSelector: #chooseEToysFont!Preferences class removeSelector: #chooseEToysTitleFont!Preferences class removeSelector: #classicTilesSettingToggled!Preferences class removeSelector: #compactViewerFlaps!Preferences class removeSelector: #debugMenuItemsInvokableFromScripts!Preferences class removeSelector: #defaultPaintingExtent!Preferences class removeSelector: #dropProducesWatcher!Preferences class removeSelector: #eToyFriendly!Preferences class removeSelector: #eToyFriendlyChanged!Preferences class removeSelector: #eToyLoginEnabled!Preferences class removeSelector: #editAnnotations!Preferences class removeSelector: #enableLocalSave!Preferences class removeSelector: #expandedPublishing!Preferences class removeSelector: #fenceEnabled!Preferences class removeSelector: #fenceSoundEnabled!Preferences class removeSelector: #fenceSoundEnabled:!Preferences class removeSelector: #haloTransitions!Preferences class removeSelector: #includeSoundControlInNavigator!Preferences class removeSelector: #keepTickingWhilePainting!Preferences class removeSelector: #largeTilesSettingToggled!Preferences class removeSelector: #magicHalos!Preferences class removeSelector: #menuColorFromWorld!Preferences class removeSelector: #menuColorString!Preferences class removeSelector: #messengersInViewers!Preferences class removeSelector: #mouseOverHalos!Preferences class removeSelector: #mouseOverHalosChanged!Preferences class removeSelector: #mvcProjectsAllowed!Preferences class removeSelector: #navigatorOnLeftEdge!Preferences class removeSelector: #noviceMode!Preferences class removeSelector: #noviceModeSettingChanged!Preferences class removeSelector: #okToReinitializeFlaps!Preferences class removeSelector: #oliveHandleForScriptedObjects!Preferences class removeSelector: #propertySheetFromHalo!Preferences class removeSelector: #selectiveHalos!Preferences class removeSelector: #setEToysFontTo:!Preferences class removeSelector: #setEToysTitleFontTo:!Preferences class removeSelector: #showAdvancedNavigatorButtons!Preferences class removeSelector: #showFlapsWhenPublishing!Preferences class removeSelector: #simpleMenus!Preferences class removeSelector: #standardEToysFont!Preferences class removeSelector: #standardEToysTitleFont!Preferences class removeSelector: #tabAmongFields!Preferences class removeSelector: #tileTranslucentDrag!Preferences class removeSelector: #typeCheckingInTileScripting!Preferences class removeSelector: #uniTilesClassic!Preferences class removeSelector: #universalTiles!Preferences class removeSelector: #universalTilesSettingToggled!Preferences class removeSelector: #unlimitedPaintArea!Preferences class removeSelector: #useCategoryListsInViewers!Preferences class removeSelector: #useVectorVocabulary!Preferences class removeSelector: #vectorVocabularySettingChanged!Preferences class removeSelector: #viewersInFlaps!!Preferences class reorganize!('accessing' allPreferences atomicUpdatePreferences: dictionaryOfPreferences pragmaIdFor:getter: pragmaPreferenceFor:getter: preferenceAt: preferenceAt:ifAbsent:)('class initialization' initialize unload)('get/set' doesNotUnderstand: setPreference:toValue: setPreference:toValue:during: valueOfPreference: valueOfPreference:ifAbsent:)('initialization' chooseInitialSettings cleanUp: cleanUpPragmaPreferences initializeDictionaryOfPreferences registerForEvents removeObsolete resetDefaultValues setPreferencesFrom:)('parameters' expungeParameter: initializeParameters inspectParameters parameterAt: parameterAt:ifAbsentPut: parameterAt:ifAbsent: parameters setParameter:to:)('reacting to change' isChangeSelector:)('standard queries' alphabeticalProjectMenu alternateHandlesLook alternativeBrowseIt alternativeWindowBoxesLook alwaysHideHScrollbar alwaysShowHScrollbar alwaysShowVScrollbar annotationPanes areaFillsAreTolerant areaFillsAreVeryTolerant autoIndent automaticFlapLayout automaticKeyGeneration balloonHelpEnabled balloonHelpInMessageLists biggerHandles caseSensitiveFinds changeSetVersionNumbers checkForSlips checkForUnsavedProjects classicNavigatorEnabled cmdDotEnabled cmdGesturesEnabled collapseWindowsInPlace confirmFirstUseOfStyle conversionMethodsAtFileOut debugHaloHandle debugLogTimestamp debugPrintSpaceLog debugShowDamage decorateBrowserButtons diffsInChangeList diffsWithPrettyPrint dismissAllOnOptionClose easySelection extraDebuggerButtons fastDragWindowForMorphic fullScreenLeavesDeskMargins generalizedYellowButtonMenu haloEnclosesFullBounds higherPerformance honorDesktopCmdKeys infiniteUndo logDebuggerStackToFile maintainHalos menuAppearance3d menuKeyboardControl menuWithIcons modalColorPickers mouseOverForKeyboardFocus optionalButtons passwordsOnPublish personalizedWorldMenu postscriptStoredAsEPS projectsSentToDisk projectViewsInWindows projectZoom purgeUndoOnQuit readDocumentAtStartup readDocumentAtStartup: restartAlsoProceeds reverseWindowStagger scrollBarsNarrow scrollBarsOnRight securityChecksEnabled serverMode showBoundsInHalo showDirectionForSketches showDirectionHandles showProjectNavigator showSecurityStatus showSharedFlaps showSplitterHandles signProjectFiles smartUpdating standaloneSecurityChecksEnabled startInUntrustedDirectory swapMouseButtons systemWindowEmbedOK timeStampsInMenuTitles tinyDisplay traceMessages turnOffPowerManager twentyFourHourFileStamps uniqueNamesInHalos useButtonPropertiesToFire useUndo visualExplorer warnAboutInsecureContent warnIfNoChangesFile warnIfNoSourcesFile wordStyleCursorMovement)('themes' outOfTheBox personal)('*PreferenceBrowser' addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:viewRegistry:)('private' compileAccessorForPreference: compileAccessorForPreferenceNamed:value: preference:category:description:type: preference:categoryList:description:type:)('prefs - fonts' aaFontsColormapDepth chooseBalloonHelpFont chooseCodeFont chooseFixedFont chooseFlapsFont chooseFontWithPrompt:andSendTo:withSelector:highlightSelector: chooseHaloLabelFont chooseListFont chooseMenuFont chooseStandardButtonFont chooseSystemFont chooseWindowTitleFont decreaseFontSize fontConfigurationMenu fontConfigurationMenu: increaseFontSize printStandardSystemFonts refreshFontSettings restoreDefaultFonts restoreDefaultFontsForJapanese restoreFontsAfter: setBalloonHelpFontTo: setButtonFontTo: setCodeFontTo: setDemoFonts setFixedFontTo: setFlapFontTo: setFlapsFontTo: setHaloLabelFontTo: setListFontTo: setMenuFontTo: setPaintBoxButtonFontTo: setSystemFontTo: setWindowTitleFontTo: standardBalloonHelpFont standardButtonFont standardCodeFont standardDefaultTextFont standardFixedFont standardFlapFont standardHaloLabelFont standardListFont standardMenuFont standardPaintBoxButtonFont standardSystemFont standardWindowTitleFont subPixelRenderColorFonts subPixelRenderFonts windowTitleFont windowTitleStyle)('support - misc' acceptAnnotationsFrom: addModelItemsToWindowMenu: automaticFlapLayoutString initialExtent inspectPreferences letUserPersonalizeMenu navigatorShowingString personalizeUserMenu: setArrowheads staggerPolicyString wantsChangeSetLogging)('add/remove - specific' addBooleanPreference:categories:default:balloonHelp: addBooleanPreference:category:default:balloonHelp: addColorPreference:categories:default:balloonHelp: addColorPreference:category:default:balloonHelp: addFontPreference:categories:default:balloonHelp: addFontPreference:category:default:balloonHelp: addNumericPreference:categories:default:balloonHelp: addNumericPreference:category:default:balloonHelp: addTextPreference:categories:default:balloonHelp: addTextPreference:category:default:balloonHelp:)('add/remove' addPragmaPreference: addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:type: removeAllPreferencesSuchThat: removePreference:)('add/remove - convenience' addPreference:categories:default:balloonHelp: addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: addPreference:category:default: addPreference:category:default:balloonHelp: addPreference:default:)('prefs - annotations' annotationInfo defaultAnnotationInfo defaultAnnotationRequests defaultAnnotationRequests:)('updating - system' annotationPanesChanged displaySizeChanged infiniteUndoChanged optionalButtonsChanged roundedWindowCornersChanged sharedFlapsSettingChanged showProjectNavigatorChanged smartUpdatingChanged)('prefs - misc' balloonHelpDelayTime borderColorWhenRunning cmdKeysInText defaultAuthorName defaultWorldColor desktopColor desktopColor: desktopMenuTitle enableProjectNavigator maxBalloonHelpLineLength maxBalloonHelpLineLength: metaMenuDisabled preserveCommandExcursions scrollBarColor scrollBarWidth suppressWindowTitlesInInstanceBrowsers useFormsInPaintBox:)('themes - tools' browseThemes installTheme: offerThemesMenu themeChoiceButtonOfColor:font:)('support' categoryList categoryListOfPreference: giveHelpWithPreferences okayToChangeProjectLocalnessOf: preferencesInCategory: typeForValue:)('prefs - halos' classicHaloSpecs classicHalosInForce customHaloSpecs customHalosInForce editCustomHalos haloSpecifications haloSpecificationsForWorld haloTheme iconicHaloSpecifications iconicHalosInForce installClassicHaloSpecs installCustomHaloSpecs installHaloSpecsFromArray: installHaloTheme: installIconicHaloSpecs installSimpleHaloSpecs resetHaloSpecifications showChooseGraphicHaloHandle simpleFullHaloSpecifications simpleHalosInForce)('defaults' defaultValueTableForCurrentRelease unclassifiedCategory)('get/set - flags' disable: enable: setFlag:toValue: setFlag:toValue:during: toggle: valueOfFlag: valueOfFlag:ifAbsent:)('initialization - misc' disableProgrammerFacilities enableProgrammerFacilities setDefaultAnnotationInfo setNotificationParametersForStandardPreferences)('support - file list services' fileReaderServicesForFile:suffix: serviceLoadPreferencesFromDisk services)('initialization - save/load' loadPreferencesFrom: restorePersonalPreferences restorePreferencesFromDisk restorePreferencesFromDisk: savePersonalPreferences storePreferencesIn: storePreferencesToDisk)('updating' localeChanged prefEvent:)('*60Deprecated-menu colors' menuBorderColor menuBorderWidth menuColor menuLineColor menuSelectionColor menuTitleBorderColor menuTitleBorderWidth menuTitleColor)('*morphicextras' rotationAndScaleHandlesInPaintBox)('*60Deprecated-prefs-text' chooseInsertionPointColor chooseKeyboardFocusColor chooseTextHighlightColor initializeTextHighlightingParameters insertionPointColor insertionPointColor: keyboardFocusColor keyboardFocusColor: textHighlightColor textHighlightColor:)('*60Deprecated-Etoys-Squeakland-window colors' windowColorHelp windowSpecificationPanel)('*60Deprecated-parameters' parameterAt:default:)!!PolygonMorph reorganize!('access' isClosed isCurve isOpen makeOpenOrClosed midVertices openOrClosePhrase smoothOrSegmentedPhrase vertices)('accessing' borderColor: borderDashSpec borderStyle: borderWidth: couldHaveRoundedCorners)('caching' loadCachedState releaseCachedState)('dashes' borderDashOffset dashedBorder dashedBorder: removeVertex: vertexAt:)('debug and other' installModelIn: rotateTestFlip:)('drawing' areasRemainingToFill: drawArrowOn:at:from: drawArrowsOn: drawBorderOn: drawBorderOn:usingEnds: drawClippedBorderOn:usingEnds: drawDashedBorderOn: drawDashedBorderOn:usingEnds: drawOnFormCanvas: drawOn:)('editing' addHandles clickVertex:event:fromHandle: deleteVertexAt: dragVertex:event:fromHandle: dragVertex:fromHandle:vertIndex: dropVertex:event:fromHandle: dropVertex:fromHandle:vertIndex: handleColorAt: insertVertexAt:put: newVertex:event:fromHandle: newVertex:fromHandle:afterVert: updateHandles verticesAt:put:)('event handling' handlesMouseDown: mouseDown:)('geometry' arrowsContainPoint: bounds: closestPointTo: closestSegmentTo: extent: flipHAroundX: flipVAroundY: intersectionsWith: intersectionWithLineSegmentFromCenterTo: intersects: isBordered lineBorderColor lineBorderColor: lineBorderWidth lineBorderWidth: lineColor lineColor: lineWidth lineWidth: mergeDropThird:in:from: merge: nextDuplicateVertexIndex reduceVertices straighten transformedBy:)('geometry testing' containsPoint:)('initialization' beSmoothCurve beStraightSegments defaultBorderColor defaultColor initialize vertices:color:borderWidth:borderColor:)('menu' addCustomMenuItems:hand: addPolyArrowMenuItems:hand: addPolyLIneCurveMenuItems:hand: addPolyShapingMenuItems:hand: arrowLength: arrowSpec: arrows customizeArrows: handlesShowingPhrase makeBackArrow makeBothArrows makeClosed makeForwardArrow makeNoArrows makeOpen quickFill: removeHandles setRotationCenterFrom: showingHandles showOrHideHandles specifyDashedLine standardArrows toggleHandles toggleSmoothing unrotatedLength unrotatedLength: unrotatedWidth unrotatedWidth:)('objects from disk' convertToCurrentVersion:refStream:)('rotate scale and flex' addFlexShellIfNecessary heading heading: referencePosition rotationCenter rotationCenter: rotationDegrees rotationDegrees:)('smoothing' coefficients computeNextToEndPoints derivs:first:second:third: lineSegmentsDo: nextToFirstPoint nextToLastPoint slopes: straightLineSegmentsDo:)('stepping' step stepTime wantsSteps)('testing' hasArrows isCurvier isCurvy isLineMorph)('visual properties' canHaveFillStyles fillStyle fillStyle:)('*MorphicExtras-geometry eToy' scale:)('private' arrowBoundsAt:from: arrowForms borderForm computeArrowFormAt:from: computeBounds curveBounds filledForm getVertices includesHandle: lineSegments privateMoveBy: setVertices: transformVerticesFrom:to:)('shaping' diamondOval rectOval)('attachments' defaultAttachmentPointSpecs endShapeColor: endShapeWidth: firstVertex lastVertex midpoint nudgeForLabel: totalLength)('rounding' cornerStyle:)('*MorphicExtras-Postscript Canvases' drawPostscriptOn:)!PluggableTextMorph removeSelector: #tileForIt!PasteUpMorphTest removeSelector: #testCursorWrapped!PasteUpMorphTest removeSelector: #testCursorWrappedWithFraction!PasteUpMorphTest removeSelector: #testGridToGradient!PasteUpMorph initialize!PasteUpMorph class removeSelector: #supplementaryPartsDescriptions!!PasteUpMorph class reorganize!('printing' defaultNameStemForInstances)('project' newWorldForProject:)('scripting' authoringPrototype)('preferences' globalCommandKeysEnabled globalCommandKeysEnabled:)('recompilation' postRecompileAction)('*MorphicExtras-class initialization' initialize registerInFlapsRegistry unload)('*MorphicExtras-project' newWorldTesting)('*MorphicExtras-parts bin')('parts bin' descriptionForPartsBin)!PartsBin removeSelector: #morphToDropFrom:!PasteUpMorph removeSelector: #abandonCostumeHistory!PasteUpMorph removeSelector: #abandonVocabularyPreference!PasteUpMorph removeSelector: #adaptedToWorld:!PasteUpMorph removeSelector: #addPenMenuItems:hand:!PasteUpMorph removeSelector: #addPenTrailsMenuItemsTo:!PasteUpMorph removeSelector: #addPlayfieldMenuItems:hand:!PasteUpMorph removeSelector: #addStackMenuItems:hand:!PasteUpMorph removeSelector: #allScriptEditors!PasteUpMorph removeSelector: #allScriptors!PasteUpMorph removeSelector: #allTileScriptingElements!PasteUpMorph removeSelector: #assureNotPaintingEvent:!PasteUpMorph removeSelector: #automaticPhraseExpansion!PasteUpMorph removeSelector: #automaticViewing!PasteUpMorph removeSelector: #behaveLikeHolder!PasteUpMorph removeSelector: #behaveLikeHolder:!PasteUpMorph removeSelector: #behavingLikeAHolder!PasteUpMorph removeSelector: #browseAllScriptsTextually!PasteUpMorph removeSelector: #buildDebugMenu:!PasteUpMorph removeSelector: #closedViewerFlapTabs!PasteUpMorph removeSelector: #couldMakeSibling!PasteUpMorph removeSelector: #cursor!PasteUpMorph removeSelector: #cursor:!PasteUpMorph removeSelector: #cursorWrapped:!PasteUpMorph removeSelector: #detachableScriptingSpace!PasteUpMorph removeSelector: #drawOn:!PasteUpMorph removeSelector: #dumpPresenter!PasteUpMorph removeSelector: #hideViewerFlaps!PasteUpMorph removeSelector: #hideViewerFlapsOtherThanFor:!PasteUpMorph removeSelector: #indicateCursor!PasteUpMorph removeSelector: #indicateCursor:!PasteUpMorph removeSelector: #indicateCursorString!PasteUpMorph removeSelector: #installVectorVocabulary!PasteUpMorph removeSelector: #isPlayfieldLike!PasteUpMorph removeSelector: #makeNewDrawing:!PasteUpMorph removeSelector: #makeNewDrawing:at:!PasteUpMorph removeSelector: #makeNewDrawingWithin!PasteUpMorph removeSelector: #makeVectorUseConformToPreference!PasteUpMorph removeSelector: #mouseOverHalosString!PasteUpMorph removeSelector: #newDrawingFromMenu:!PasteUpMorph removeSelector: #numberAtCursor!PasteUpMorph removeSelector: #openScrapsBook:!PasteUpMorph removeSelector: #paintArea!PasteUpMorph removeSelector: #paintAreaFor:!PasteUpMorph removeSelector: #paintingBoundsAround:!PasteUpMorph removeSelector: #paintingFlapTab!PasteUpMorph removeSelector: #prepareToBeSaved!PasteUpMorph removeSelector: #prepareToPaint!PasteUpMorph removeSelector: #prepareToPaint:!PasteUpMorph removeSelector: #presentCardAndStackMenu!PasteUpMorph removeSelector: #presentPlayfieldMenu!PasteUpMorph removeSelector: #presenter!PasteUpMorph removeSelector: #printScriptSummary!PasteUpMorph removeSelector: #putUpPenTrailsSubmenu!PasteUpMorph removeSelector: #reasonablePaintingExtent!PasteUpMorph removeSelector: #rectifyCursor!PasteUpMorph removeSelector: #referencePlayfield!PasteUpMorph removeSelector: #referencePool!PasteUpMorph removeSelector: #releaseViewers!PasteUpMorph removeSelector: #removeAllViewers!PasteUpMorph removeSelector: #restoreBoundsOfSubmorphs!PasteUpMorph removeSelector: #resumeScriptsPausedByPainting!PasteUpMorph removeSelector: #roundUpStrays!PasteUpMorph removeSelector: #saveBoundsOfSubmorphs!PasteUpMorph removeSelector: #selectedRect!PasteUpMorph removeSelector: #sendTextContentsBackToDonor!PasteUpMorph removeSelector: #showStatusOfAllScripts!PasteUpMorph removeSelector: #showingListView!PasteUpMorph removeSelector: #sortSubmorphsBy:!PasteUpMorph removeSelector: #standardPlayerHit!PasteUpMorph removeSelector: #startRunningAll!PasteUpMorph removeSelector: #stepAll!PasteUpMorph removeSelector: #stopRunningAll!PasteUpMorph removeSelector: #toggleAutoLineLayout!PasteUpMorph removeSelector: #toggleClassicNavigatorIfAppropriate!PasteUpMorph removeSelector: #toggleMouseOverHalos!PasteUpMorph removeSelector: #triggerClosingScripts!PasteUpMorph removeSelector: #triggerOpeningScripts!PasteUpMorph removeSelector: #updateStatusForAllScriptEditors!PasteUpMorph removeSelector: #valueAtCursor!PasteUpMorph removeSelector: #valueAtCursor:!PasteUpMorph removeSelector: #viewingNormally!PasteUpMorph removeSelector: #wantsHaloFor:!PasteUpMorph removeSelector: #wantsMouseOverHalos!PasteUpMorph removeSelector: #wantsMouseOverHalos:!BorderedMorph subclass: #PasteUpMorph instanceVariableNames: 'model padding isPartsBin worldState' classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler' poolDictionaries: '' category: 'Morphic-Worlds'!!PasteUpMorph reorganize!('accessing' assureFlapWidth: flapTab lastKeystroke lastKeystroke: modelOrNil useRoundedCorners)('alarms-scheduler' addAlarm:withArguments:for:at: removeAlarm:for:)('caching' releaseCachedState)('change reporting' invalidRect:from:)('classification' isWorldMorph)('copying' veryDeepCopyWith:)('display' gradientFillColor: setGradientColor:)('dropping/grabbing' acceptDroppingMorph:event: dropEnabled hasTransferMorphConverter justDroppedInto:event: morphToDropForTransferMorph: morphToDropFrom: originAtCenter positionNear:forExtent:adjustmentSuggestion: repelsMorph:event: resetTransferMorphConverter transferMorphConverter transferMorphConverter: wantsDroppedMorph:event: wantsDroppedTransferMorph:)('event handling' dropExplorerField:from:event: dropFiles:event: dropInspectorField:event: dropSourceCode:event: handleDroppedItem:event: handlesKeyboard: handlesMouseDown: keyStroke: morphToGrab: mouseDown: mouseUp: wantsEasySelection wantsKeyboardFocusFor: wantsWindowEvent: windowEvent: windowEventHandler windowEventHandler:)('events-processing' filterEvent:for: processEvent:using: tryInvokeHalo: tryInvokeKeyboardShortcut: tryInvokeMetaMenu:)('geometry' bringTopmostsToFront extent: position:)('geometry testing' fullContainsPoint:)('halos and balloon help' defersHaloOnClickTo: wantsDirectionHandles wantsHaloFromClick)('initialization' addKeyboardShortcuts addMouseShortcuts becomeActiveDuring: defaultBorderColor defaultBorderWidth defaultColor initialize initializeKeyboardShortcuts initializeMouseShortcuts newResourceLoaded removeKeyboardShortcuts)('interaction loop' doOneCycleNow)('layout' addCenteredAtBottom:offset: convertAlignment laySubpartsOutInOneRow layoutChanged)('menu & halo' addCustomMenuItems:hand: addScalingMenuItems:hand: addWorldHaloMenuItemsTo:hand: addWorldToggleItemsToHaloMenu: autoLineLayoutString currentlyUsingVectorVocabulary defineApplicationView defineFactoryView deleteBalloonTarget: isPartsBinString originAtCenterString reformulateUpdatingMenus showApplicationView showExpandedView showFactoryView showFullView showReducedView showThumbnailString showWorldMainDockingBarString toggleShowWorldMainDockingBar transformToShow:)('misc' alwaysShowThumbnail cachedOrNewThumbnailFrom: cartesianOrigin heightForThumbnails hideFlapsOtherThan:ifClingingTo: innocuousName maxHeightToAvoidThumbnailing maximumThumbnailWidth mouseX mouseY nameForCopyIfAlreadyNamed: padding: smallThumbnailForPageSorter thumbnailForPageSorter unhideHiddenObjects)('model' createCustomModel model setModel:)('name' unusedMorphNameLike:)('objects from disk' convertToCurrentVersion:refStream: fixUponLoad:seg: saveOnFile)('options' autoLineLayout autoLineLayout: isPartsBin: replaceTallSubmorphsByThumbnails resizeToFit resizeToFitString setPartsBinStatusTo: toggleIsPartsBin toggleResizeToFit)('parts bin' initializeToStandAlone isPartsBin residesInPartsBin)('printing' printOn:)('project' project releaseSqueakPages storeProjectsAsSegments)('project state' canvas canvas: firstHand hands handsDo: handsReverseDo: isStepping: isStepping:selector: listOfSteppingMorphs stepListSize stepListSummary steppingMorphsNotInWorld viewBox viewBox:)('stepping' cleanseStepList runLocalStepMethods runStepMethods startStepping: startStepping:at:selector:arguments:stepTime: step stepTime stopStepping: stopStepping:selector:)('structure' primaryHand world)('testing' isEasySelecting)('undo' clearCommandHistory commandHistory onceAgainDismiss: reintroduceIntoWorld:)('update cycle' startBackgroundProcess)('user interface' modelWakeUp)('naming' defaultNameStemForInstances)('visual properties' canHaveFillStyles fillStyle: setAsBackground:)('WiW support' addMorphInLayer: installAsActiveSubprojectIn:at:titled: installAsActiveSubprojectIn:titled: restartWorldCycleWithEvent: shouldGetStepsFrom: validateMouseEvent:)('world menu' activateObjectsTool addUndoItemsTo: bringWindowsFullOnscreen buildWorldMenu: closeUnchangedWindows collapseAll collapseNonWindows commandKeySelectors connectRemoteUser connectRemoteUserWithName:picture:andIPAddress: delayedInvokeWorldMenu: deleteNonWindows disconnectAllRemoteUsers disconnectRemoteUser dispatchCommandKeyInWorld:event: drawingClass expandAll extractScreenRegion:andPutSketchInHand: findAChangeSorter: findAFileList: findAMessageNamesWindow: findAPreferencesPanel: findATranscript: findAWindowSatisfying:orMakeOneUsing: findDirtyBrowsers: findDirtyWindows: findWindow: getWorldMenu: grabDrawingFromScreen: grabFloodFromScreen: grabLassoFromScreen: grabRubberBandFromScreen: initializeDesktopCommandKeySelectors invokeWorldMenu: keyboardNavigationHandler keyboardNavigationHandler: keystrokeInWorld: putUpNewMorphMenu putUpWorldMenu: putUpWorldMenuFromEscapeKey reportLocalAddress respondToCommand:bySending:to: undoOrRedoCommand yellowButtonClickOnDesktopWithEvent:)('world state' abandonAllHalos addHand: addMorph:centeredNear: addMorphsAndModel: allNonFlapRelatedSubmorphs allNonWindows assureNotPaintingElse: assuredCanvas beWorldForProject: checkCurrentHandForObjectToPaste checkCurrentHandForObjectToPaste2 chooseClickTarget colorAt:belowMorph: deEmphasizeViewMVC: deleteAllHalos displayWorld displayWorldAsTwoTone displayWorldNonIncrementally displayWorldSafely doOneCycle doOneCycleInBackground doOneSubCycle dragThroughOnDesktop: embeddedProjectDisplayMode endDrawing: exit flashRects:color: fullRepaintNeeded goBack haloMorphs initForProject: install installFlaps jumpToProject nextPage noDisplayDuring: optimumExtentFromAuthor paintBox paintBoxOrNil patchAt:without:andNothingAbove: pauseEventRecorder previousPage privateOuterDisplayWorld removeHand: repairEmbeddedWorlds repositionFlapsAfterScreenSizeChange restoreFlapsDisplay restoreMainDockingBarDisplay restoreMorphicDisplay saveAsWorld sketchEditorOrNil sleep someHalo specialNameInModelFor: startSteppingSubmorphsOf:)('*Tools' defaultDesktopCommandKeyTriplets findAMonticelloBrowser)('private' privateFullMoveBy: privateMoveBy:)('thumbnail' icon)('polymorph' modalLockTo: modalUnlockFrom:)('recompilation' updateStatePostRecompile)('submorphs - add/remove' addAllMorphs: addMorphFront:)('submorphs - accessing' allMorphsDo: morphsInFrontOf:overlapping:do:)('flaps' accommodateFlap: addGlobalFlaps assureFlapTabsFitOnScreen correspondingFlapTab deleteGlobalFlapArtifacts enableGlobalFlaps flapTabs localFlapTabs offsetForAccommodating:onEdge: removeAccommodationForFlap:)('Nebraska' addRemoteClient: convertRemoteClientToBuffered: hasRemoteServer releaseRemoteServer remoteServer remoteServer: removeRemoteClient: transferRemoteServerFrom:)('*60Deprecated-menu & halo' isOpenForDragNDropString)('*services-base' focusedRequestor openWorldMenu requestor worldMenu)('*60Deprecated-accessing' modalWindow: removeModalWindow)('*MorphicExtras-flaps' deleteAllFlapArtifacts)('*ST80-Support' standardSystemController)('*Protocols' currentVocabulary)!ParagraphEditor class removeSelector: #yellowButtonExpertMenu!ParagraphEditor class removeSelector: #yellowButtonNoviceMenu!PackageDependencyTest removeSelector: #testEtoys!ObjectlandMorph removeSelector: #createEtoysProject!ObjectExplorer removeSelector: #viewerForValue!NativeImageSegment removeSelector: #findRogueRootsAllMorphs:!NativeImageSegment removeSelector: #rootsIncludingPlayers!NativeImageSegment removeSelector: #savePlayerReferences:!MorphicModel removeSelector: #addModelYellowButtonMenuItemsTo:forMorph:hand:!!MorphicModel reorganize!('accessing' model modelOrNil slotName wantsSlot)('caching' releaseCachedState)('classification' isMorphicModel)('compilation' addPartNameLike:withValue: compileAccessForSlot: compilePropagationMethods nameFor: propagate:as: removeAll slotSelectorFor: use:orMakeModelSelectorFor:in:)('debug and other' installModelIn:)('drag and drop' allowSubmorphExtraction isOpen)('geometry' charactersOccluded newBounds: recomputeBounds)('initialization' defaultBorderColor defaultBounds defaultColor duplicate:from: initialize model: model:slotName:)('menu' addCustomMenuItems:hand: closeToEdits openToEdits)('naming' choosePartName)('printing' initString)('submorphs - accessing' allKnownNames)('submorphs - add/remove' delete)('*MorphicExtras-compilation' compileInitMethods)!MorphExtension removeSelector: #player!MorphExtension removeSelector: #player:!Object subclass: #MorphExtension instanceVariableNames: 'locked visible sticky balloonText balloonTextSelector externalName isPartsDonor actorState eventHandler otherProperties' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Kernel'!!MorphExtension reorganize!('accessing' actorState actorState: balloonText balloonTextSelector balloonTextSelector: balloonText: eventHandler eventHandler: externalName: locked locked: sticky sticky: visible visible:)('accessing - layout properties' layoutFrame layoutFrame: layoutPolicy layoutPolicy: layoutProperties layoutProperties:)('accessing - other properties' assureOtherProperties hasOtherProperties hasProperty: initializeOtherProperties otherProperties privateOtherProperties: removeOtherProperties removeProperty: setProperty:toValue: sortedPropertyNames valueOfProperty: valueOfProperty:ifAbsentPut: valueOfProperty:ifAbsent:)('connectors-copying' copyWeakly propertyNamesNotCopied veryDeepFixupWith: veryDeepInner:)('initialization' initialize)('objects from disk' comeFullyUpOnReload:)('other' isDefault)('printing' printOn:)('viewer' externalName)('*MorphicExtras-copying' updateReferencesUsing:)('*MorphicExtras-Undo' removeUndoCommands)('parts bin' isPartsDonor isPartsDonor:)('*60Deprecated-other' inspectElement)!ImageMorph class removeSelector: #descriptionForPartsBin!!ImageMorph class reorganize!('accessing' defaultForm)('class initialization' initialize registerInFlapsRegistry unload)('instance creation' fromString: fromString:font:)('scripting' authoringPrototype)!Morph class removeSelector: #selectionBackground!!Morph class reorganize!('class initialization' initialize)('fileIn/Out' fileReaderServicesForFile:suffix: fromFileName: serviceLoadMorphFromFile services)('initialize-release' unload)('instance creation' initializedInstance newBounds: newBounds:color: newSticky)('misc' morphsUnknownToTheirOwners)('new-morph participation' includeInNewMorphMenu newStandAlone partName:categories:documentation: partName:categories:documentation:sampleImageForm:)('scripting' authoringPrototype)('testing' allSketchMorphClasses allSketchMorphForms isSketchMorphClass)('preferences' haloForAll haloForAll: indicateKeyboardFocus indicateKeyboardFocus: metaMenuForAll metaMenuForAll: preferredCornerRadius preferredCornerRadius: themeProperties useSoftDropShadow useSoftDropShadow:)('*Tools-icons' toolIcon)('defaults')('layer names' backmostLayer balloonLayer defaultLayer dialogLayer frontmostLayer haloLayer menuLayer navigatorLayer progressLayer windowLayer)('*MorphicExtras-arrow head size' defaultArrowheadSize obtainArrowheadFor:defaultValue:)('*MorphicExtras-parts bin' supplementaryPartsDescriptions)('*MorphicExtras-new-morph participation' addPartsDescriptorQuadsTo:if:)!MenuMorph removeSelector: #allWordings!MenuMorph removeSelector: #allWordingsNotInSubMenus:!MenuMorph removeSelector: #undoGrabCommand!!MenuMorph reorganize!('accessing' addBlankIconsIfNecessary: commandKeyHandler commandKeyHandler: defaultTarget hasItems hasSubMenu: itemWithWording: items lastItem lastSelection matchString matchString: popUpOwner popUpOwner: rootMenu stayUp stayUp:)('construction' add:action: add:help:action: add:icon:help:subMenu: add:icon:subMenu: add:selector:argument: add:subMenu: add:subMenu:target:selector:argumentList: add:target:action: add:target:selector: add:target:selector:argument: add:target:selector:argumentList: addAllFrom: addItem: addLine addList: addMenuItem: addService:for: addServices2:for:extraLines: addServices:for:extraLines: addStayUpIcons addStayUpItem addStayUpItemSpecial addTitle: addTitle:icon: addTitle:icon:updatingSelector:updateTarget: addTitle:updatingSelector:updateTarget: addTranslatedList: addUpdating:action: addUpdating:enablement:action: addUpdating:enablementSelector:target:selector:argumentList: addUpdating:target:action: addUpdating:target:selector:argumentList: addUpdatingItem: addWithLabel:enablement:action: addWithLabel:enablementSelector:target:selector:argumentList: balloonTextForLastItem: defaultTarget: labels:lines:selections: title:)('control' activeSubmenu: deleteIfPopUp deleteIfPopUp: popUpAdjacentTo:forHand:from: popUpAt:forHand:in: popUpAt:forHand:in:allowKeyboard: popUpEvent:in: popUpForHand:in: popUpInWorld popUpInWorld: popUpNoKeyboard selectItem:event: updateColor wantsToBeDroppedInto:)('copying' veryDeepFixupWith: veryDeepInner:)('dropping/grabbing' justDroppedInto:event:)('events' activate: deactivate: handlesMouseDown: handlesMouseOver: mouseDown: mouseLeave: mouseMove: mouseUp: processFocusEvent:using: wantsEveryMouseMove)('initialization' delete initialize setDefaultParameters setTitleParameters setTitleParametersFor:)('keyboard control' displayFiltered: handlesKeyboard: keyStroke: matchString:event: moveSelectionDown:event: removeMatchString removeMatchString: selectCurrentItem: selectMoreItem:)('menu' addCustomMenuItems:hand: addItem addTitle detachSubMenu: doButtonAction removeStayUpBox removeStayUpItems setInvokingView: setTarget: target: toggleStayUp: toggleStayUpIgnore:evt: updateItemsWithTarget:orWithHand:)('modal control' informUserAt:during: invokeAt:in:allowKeyboard: invokeModal invokeModal: invokeModalAt:in: invokeModalAt:in:allowKeyboard: isModalInvokationDone isModalInvokationDone: modalSelection modalSelection:)('private' invokeMetaMenu: positionAt:relativeTo:inWorld: selectedItem)('update' applyUserInterfaceTheme updateMenu)('keystroke helpers' handleCRStroke: handleCommandKeyPress: handleDelStroke: handleDownStroke: handleEscStroke: handleFiltering: handleLeftStroke: handlePageDownStroke: handlePageUpStroke: handleRightStroke: handleUpStroke: hideKeyboardHelp keyStrokeHandlers noteRootMenuHasUsedKeyboard showKeyboardHelp stepIntoSubmenu:)('rounding' wantsRoundedCorners)('testing' indicateKeyboardFocus)('*ToolBuilder-Morphic-opening' openAsTool)('*MorphicExtras-accessing')('*60Deprecated-keyboard control' filterListWith: unfilterOrEscape:)!MenuItemMorph removeSelector: #adaptToWorld:!MenuItemMorph removeSelector: #allWordingsNotInSubMenus:!!MenuItemMorph reorganize!('accessing' action: addSubMenu: addUpdatingSubMenu: arguments arguments: colorToUse contentString contentString: contents: contents:withMarkers: contents:withMarkers:inverse: hasIcon hasIconOrMarker hasMarker hasSubMenu hasSubMenu: help: icon icon: isEnabled isEnabled: isStayUpItem itemWithWording: selector selector: subMenu subMenu: subMenuUpdater:selector: subMenuUpdater:selector:arguments: target target:)('copying' veryDeepFixupWith: veryDeepInner:)('drawing' drawBackgroundOn: drawIconOn: drawLabelOn: drawOn: drawSubMenuMarkerOn:)('events' activateOwnerMenu: activateSubmenu: doButtonAction handleMouseUp: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: invokeWithEvent: mouseDown: mouseEnter: mouseEnterDragging: mouseUp:)('grabbing' aboutToBeGrabbedBy: duplicateMorph:)('initialization' defaultBounds deleteIfPopUp: initialize)('layout' doLayoutIn: minHeight minWidth stringMargin)('selecting' adjacentTo deselect: isSelected isSelected: select:)('private' bottomArrow createSubmenu createUpdatingSubmenu deselectItem iconForm leftArrow offImage onImage rightArrow selectionFillStyle subMenuMarker upArrow updateLayoutInDockingBar)('browse' browseImplementationOfActionSelector buildDebugMenu: debugAction effectiveActionSelector effectiveActionTarget)('testing' isMenuItemMorph)('updating' applyUserInterfaceTheme)!!LassoPatchMorph reorganize!('dropping' justDroppedInto:event: wantsToBeDroppedInto:)('initialization' initialize initializeToStandAlone)!!GrabPatchMorph reorganize!('dropping' justDroppedInto:event: wantsToBeDroppedInto:)('initialization' initialize initializeToStandAlone)!!ImageMorph reorganize!('accessing' borderStyle: borderWidth: color: form image image: isOpaque isOpaque: preferredExtent setNewImageFrom: wantsRecolorHandle withSnapshotBorder)('caching' releaseCachedState)('drawing' drawOn:)('geometry' extent:)('initialization' initialize)('menu' changeOpacity opacityString)('menu commands' grabFromScreen readFromFile)('menus' addCustomMenuItems:hand:)('other' newForm:)('parts bin' initializeToStandAlone)('testing' isImageMorph)('*MorphicExtras-Postscript Canvases' drawPostscriptOn:)!HandMorph removeSelector: #removePendingHaloFor:!HandMorph removeSelector: #spawnMagicHaloFor:!HandMorph removeSelector: #triggerHaloFor:after:!!HandMorph reorganize!('accessing' anyButtonPressed colorForInsets lastEvent mouseOverHandler noButtonPressed targetOffset targetPoint userInitials userPicture userPicture:)('balloon help' addBalloonHelp: balloonHelpList deleteBalloonTarget: removePendingBalloonFor: resetBalloonHelp: spawnBalloonFor: triggerBalloonFor:after:)('caching' releaseCachedState)('change reporting' invalidRect:from:)('classification' isHandMorph)('copying' veryDeepCopyWith:)('cursor' cursorBounds showTemporaryCursor: showTemporaryCursor:hotSpotOffset: temporaryCursor)('double click support' resetClickState waitForClicksOrDrag:event: waitForClicksOrDrag:event:selectors:threshold:)('drawing' drawOn: fullDrawOn: hasChanged hasUserInformation needsToBeDrawn nonCachingFullDrawOn: restoreSavedPatchOn: savePatchFrom: shadowForm showHardwareCursor: updateCacheCanvas: visible:)('drop shadows' shadowOffset)('event handling' cursorPoint flushEvents noticeMouseOver:event: processEvents)('events-processing' handleEvent: isCapturingGesturePoints sendFilterEventCaptureAgain:for:)('focus handling' keyboardFocus keyboardFocus: mouseFocus mouseFocus: newKeyboardFocus: newMouseFocus: newMouseFocus:event: releaseAllFoci releaseKeyboardFocus releaseKeyboardFocus: releaseMouseFocus releaseMouseFocus:)('genie-stubs' autoFocusRectangleBoundsFor: disableGenieFocus enableGenie focusStartEvent genieGestureProcessor isGenieAvailable isGenieEnabled isGenieFocused)('geometry' position position: userInitials:andPicture:)('grabbing/dropping' attachMorph: dropMorphs dropMorphs: dropMorph:event: grabMorph:from: targetOffset:)('halo handling' halo: obtainHalo: releaseHalo: removeHalo removeHaloFromClick:on:)('halos and balloon help' halo)('initialization' becomeActiveDuring: initForEvents initialize interrupted resourceJustLoaded)('layout' fullBounds)('meta-actions' copyToPasteBuffer: grabMorph:)('multilingual' clearKeyboardInterpreter keyboardInterpreter)('objects from disk' objectForDataStream:)('paste buffer' objectToPaste pasteBuffer pasteBuffer: pasteMorph)('updating' applyUserInterfaceTheme changed)('private events' generateDropFilesEvent: generateKeyboardEvent: generateMouseEvent: generateMouseWheelEvent: generateMouseWheelEvent:direction: generateWindowEvent: mouseDragTrailFrom: mouseTrailFrom: moveToEvent: sendEvent:focus: sendEvent:focus:clear: sendFocusEvent:to:clear: sendKeyboardEvent: sendListenEvent:to: sendListenEvents: sendMouseEvent:)('selected object' selectedObject)('*MorphicExtras-event handling' pauseEventRecorderIn:)('gridded cursor' gridPointRaw gridTo:origin: griddedPoint: griddingOn turnOffGridding turnOnGridding)('events-listening' addEventListener: addKeyboardListener: addListener:to: addMouseListener: eventListeners eventListeners: keyboardListeners keyboardListeners: mouseListeners mouseListeners: removeEventListener: removeKeyboardListener: removeListener:from: removeMouseListener:)('events-filtering-bubbling' eventBubbleFilters keyboardBubbleFilters mouseBubbleFilters)('events-filtering-capturing' eventCaptureFilters eventCaptureFilters: keyboardCaptureFilters keyboardCaptureFilters: mouseCaptureFilters mouseCaptureFilters:)('events-debugging' logEvent: showEvent:)('events-filtering' filterEvent:for: ignoreEvent:)('Multilingual-ImmPlugin' compositionWindowManager)('initialize-release' cleanUp:)!!GraphMorph reorganize!('accessing' color: cursor cursor: cursorAtEnd cursorColor cursorColor: cursorColorAtZeroCrossing cursorColorAtZeroCrossings: cursorWrapped: data data: dataColor dataColor: interpolatedValueAtCursor lastValue lastValue: startIndex startIndex: valueAtCursor valueAtCursor:)('commands' appendValue: centerCursor clear loadSineWave loadSound: loadSoundData: playOnce reverse)('drawing' drawOn:)('event handling' handlesMouseDown: mouseMove:)('initialization' defaultColor initialize)('layout' layoutChanged)('objects from disk' convertToCurrentVersion:refStream:)('stepping' step)('private' asNumber: drawCursorOn: drawDataOn: flushCachedForm keepIndexInView:)('sound' addCustomMenuItems:hand: openWaveEditor readDataFromFile)!DockingBarMorph removeSelector: #isSticky!DockingBarMorph removeSelector: #resistsRemoval!BookMorph removeSelector: #goToPage:transitionSpec:runTransitionScripts:!BookMorph removeSelector: #goToPageMorph:runTransitionScripts:!BookMorph removeSelector: #goToPageMorph:transitionSpec:runTransitionScripts:!BookMorph removeSelector: #goto:!BookMorph removeSelector: #keepTogether!BooklikeMorph removeSelector: #currentPlayerDo:!!BooklikeMorph reorganize!('menu commands' clearNewPagePrototype firstPage insertPage sortPages)('menus' addCustomMenuItems:hand:)('misc' addBookMenuItemsTo:hand: move pageSize pageSize: playPageFlipSound: showingFullScreenString showingPageControlsString)('page controls' addPageControlMorph: fewerPageControls fullControlSpecs hidePageControls indexForPageControls makeDescriptionViewer makePageControlsFrom: makePageNumberItem setEventHandlerForPageControls: shortControlSpecs showPageControls showPageControls:)!!BookPageSorterMorph reorganize!('copying' veryDeepFixupWith: veryDeepInner:)('dropping/grabbing' wantsToBeDroppedInto:)('initialization' addControls book:morphsToSort: defaultBorderWidth defaultColor initialize)('buttons' acceptSort getPartsBinStatus togglePartsBinStatus)('private' changeExtent: closeButtonOnly columnWith: rowWith: wrapperFor:)('accessing' pageHolder)!!AlignmentMorph reorganize!('classification' isAlignmentMorph)('event handling' wantsKeyboardFocusFor:)('geometry' addTransparentSpacerOfSize:)('initialization' defaultBorderWidth defaultColor initialize openInWindowLabeled:inWorld:)('object fileIn' convertOldAlignmentsNov2000:using:)('objects from disk' convertToCurrentVersion:refStream:)('visual properties' canHaveFillStyles)('*MorphicExtras-initialization' basicInitialize)!!BorderedMorph reorganize!('accessing' borderColor: borderStyle: borderWidth: hasTranslucentColor useRoundedCorners useSquareCorners)('drawing' areasRemainingToFill:)('geometry' acquireBorderWidth: closestPointTo: intersectionWithLineSegmentFromCenterTo:)('initialization' borderInitialize borderInset borderRaised borderSimple defaultBorderColor defaultBorderStyle defaultBorderWidth initialize)('menu' addBorderStyleMenuItems:hand: changeBorderColor: changeBorderWidth:)('resize handling' addCellGapToLayoutFrames addCornerGrips addEdgeGrips addGrips addMorph:fullFrame: addPaneHSplitterAtBottomOfRow: addPaneHSplitters addPaneSplitters addPaneVSplitterAtRightOfColumn: addPaneVSplitters changeCellGapOfLayoutFrames: cornerGrips doFastWindowReframe: edgeGrips fastFramingOn grips linkSubmorphsToSplitters paneMorphs removeCellGapFromLayoutFrames removeCornerGrips removeEdgeGrips removeGrips removePaneSplitters splitters wantsGrips wantsGrips: wantsPaneSplitters wantsPaneSplitters:)('printing' fullPrintOn:)('layout properties' cellGap:)('display scale' displayScaleChangedBy: handlesDisplayScaleChangedBy:)('*MorphicExtras-initialization' basicInitialize)('*60Deprecated-private' setBorderWidth:borderColor: setColor:borderWidth:borderColor:)('*60Deprecated-accessing' doesBevels)!Morph removeSelector: #adaptToWorld:!Morph removeSelector: #addMagicHaloFor:!Morph removeSelector: #addMorphNearBack:!Morph removeSelector: #addPaintingItemsTo:hand:!Morph removeSelector: #allMenuWordings!Morph removeSelector: #allMorphsAndBookPagesInto:!Morph removeSelector: #allMorphsWithPlayersDo:!Morph removeSelector: #applyStatusToAllSiblings:!Morph removeSelector: #asNumber:!Morph removeSelector: #automaticViewing!Morph removeSelector: #bringAllSiblingsToMe:!Morph removeSelector: #chooseNewGraphic!Morph removeSelector: #chooseNewGraphicCoexisting:!Morph removeSelector: #chooseNewGraphicFromHalo!Morph removeSelector: #couldMakeSibling!Morph removeSelector: #currentPlayerDo:!Morph removeSelector: #cursor!Morph removeSelector: #cursor:!Morph removeSelector: #decimalPlacesForGetter:!Morph removeSelector: #defaultValueOrNil!Morph removeSelector: #demandsBoolean!Morph removeSelector: #demandsThumbnailing!Morph removeSelector: #doMenuItem:!Morph removeSelector: #embedInWindow!Morph removeSelector: #embeddedInMorphicWindowLabeled:!Morph removeSelector: #getNumericValue!Morph removeSelector: #gridFormOrigin:grid:background:line:!Morph removeSelector: #handUserASibling!Morph removeSelector: #indicateAllSiblings!Morph removeSelector: #inspectArgumentsPlayerInMorphic:!Morph removeSelector: #isAViewer!Morph removeSelector: #isCompoundTileMorph!Morph removeSelector: #isKedamaMorph!Morph removeSelector: #isLikelyRecipientForMouseOverHalos!Morph removeSelector: #isModalShell!Morph removeSelector: #isNumericReadoutTile!Morph removeSelector: #isPhraseTileMorph!Morph removeSelector: #isPlayfieldLike!Morph removeSelector: #isSoundTile!Morph removeSelector: #isStandardViewer!Morph removeSelector: #isStickySketchMorph!Morph removeSelector: #isSyntaxMorph!Morph removeSelector: #isTileEditor!Morph removeSelector: #isTileMorph!Morph removeSelector: #isTilePadMorph!Morph removeSelector: #isViewer!Morph removeSelector: #makeGraphPaper!Morph removeSelector: #makeGraphPaperGrid:background:line:!Morph removeSelector: #makeMultipleSiblings:!Morph removeSelector: #makeNascentScript!Morph removeSelector: #makeNewPlayerInstance:!Morph removeSelector: #makeSiblings:!Morph removeSelector: #makeSiblingsLookLikeMe:!Morph removeSelector: #menuItemAfter:!Morph removeSelector: #menuItemBefore:!Morph removeSelector: #methodCommentAsBalloonHelp!Morph removeSelector: #mustBeBackmost!Morph removeSelector: #noteDecimalPlaces:forGetter:!Morph removeSelector: #objectViewed!Morph removeSelector: #offerCostumeViewerMenu:!Morph removeSelector: #openAPropertySheet!Morph removeSelector: #openViewerForArgument!Morph removeSelector: #overlapsShadowForm:bounds:!Morph removeSelector: #pasteUpMorphHandlingTabAmongFields!Morph removeSelector: #player!Morph removeSelector: #player:!Morph removeSelector: #playerRepresented!Morph removeSelector: #preferredDuplicationHandleSelector!Morph removeSelector: #presenter!Morph removeSelector: #readoutForField:!Morph removeSelector: #referencePlayfield!Morph removeSelector: #renameInternal:!Morph removeSelector: #rotationStyle!Morph removeSelector: #rotationStyle:!Morph removeSelector: #roundUpStrays!Morph removeSelector: #saveDocPane!Morph removeSelector: #screenLocation!Morph removeSelector: #screenRectangle!Morph removeSelector: #setAsActionInButtonProperties:!Morph removeSelector: #setNumericValue:!Morph removeSelector: #setStandardTexture!Morph removeSelector: #shouldRememberCostumes!Morph removeSelector: #shuffleSubmorphs!Morph removeSelector: #standardPalette!Morph removeSelector: #tabAmongFields!Morph removeSelector: #textureParameters!Morph removeSelector: #unlockOneSubpart!Morph removeSelector: #updateAllScriptingElements!Morph removeSelector: #usableSiblingInstance!Morph removeSelector: #viewMorphDirectly!Morph removeSelector: #wantsHalo!Morph removeSelector: #wantsHaloFor:!Morph removeSelector: #wantsScriptorHaloHandle!Morph removeSelector: #wouldAcceptKeyboardFocusUponTab!Morph removeSelector: #wrappedInWindow:!Morph removeSelector: #wrappedInWindowWithTitle:!!Morph reorganize!('accessing' actorState: actorStateOrNil adoptPaneColor: balloonText balloonText: balloonTextSelector balloonTextSelector: beFlap: beSticky beTransparent beUnsticky borderColor borderColor: borderStyle borderStyle: borderStyleForSymbol: borderWidth borderWidth: borderWidthForRounding clearArea color color: colorForInsets couldHaveRoundedCorners defaultNameStemForInstances eventHandler eventHandler: hasTranslucentColor highlight highlightColor highlightColor: insetColor isFlap isLocked isShared isSticky lock lock: modelOrNil raisedColor regularColor regularColor: rememberedColor rememberedColor: resistsRemoval resistsRemoval: scaleFactor setBorderStyle: sqkPage sticky: toggleLocked toggleResistsRemoval toggleStickiness unHighlight unlock unlockContents url userString viewBox visibleClearArea wantsToBeCachedByHand)('accessing - extension' assureExtension extension hasExtension initializeExtension privateExtension: resetExtension)('accessing - properties' hasProperty: otherProperties removeProperty: setProperties: setProperty:toValue: valueOfProperty: valueOfProperty:ifAbsent: valueOfProperty:ifAbsentPut: valueOfProperty:ifPresentDo:)('caching' fullLoadCachedState fullReleaseCachedState loadCachedState releaseCachedState)('change reporting' addedMorph: colorChangedForSubmorph: invalidRect: invalidRect:from: privateInvalidateMorph: userSelectedColor:)('classification' isAlignmentMorph isBalloonHelp isButton isFlapOrTab isFlapTab isFlexMorph isHandMorph isRenderer isTextMorph isWorldMorph isWorldOrHandMorph)('connectors-scripting' wantsConnectorVocabulary)('converting' asSnapshotThumbnail)('copying' copy deepCopy duplicate duplicateMorphCollection: okayToDuplicate updateReferencesUsing: veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:)('creation' asMorph)('debug and other' addDebuggingItemsTo:hand: addMouseActionIndicatorsWidth:color: addMouseUpAction addMouseUpActionWith: addViewingItemsTo: allStringsAfter: allStringsAfter:do: altSpecialCursor0 altSpecialCursor1 altSpecialCursor2 altSpecialCursor3 altSpecialCursor3: buildDebugMenu: defineTempCommand deleteAnyMouseActionIndicators hasStrings inspectOwnerChain installModelIn: mouseUpCodeOrNil ownerChain programmedMouseDown:for: programmedMouseEnter:for: programmedMouseLeave:for: programmedMouseUp:for: removeMouseUpAction resumeAfterDrawError resumeAfterLayoutError resumeAfterStepError tempCommand)('dispatching' disableSubmorphFocusForHand:)('drawing' areasRemainingToFill: boundingBoxOfSubmorphs boundsWithinCorners changeClipSubmorphs clipLayoutCells clipLayoutCells: clipSubmorphs clipSubmorphs: clippingBounds doesOwnRotation drawDropHighlightOn: drawDropShadowOn: drawErrorOn: drawKeyboardFocusIndicationOn: drawMouseDownHighlightOn: drawOn: drawOverlayOn: drawRolloverBorderOn: drawSubmorphsOn: expandFullBoundsForDropShadow: expandFullBoundsForRolloverBorder: flashBounds fullDrawOn: hasClipSubmorphsString hide highlightedForMouseDown highlightedForMouseDown: imageForm imageForm:backgroundColor:forRectangle: imageForm:forRectangle: imageFormDepth: imageFormForRectangle: imageFormWithout:andStopThere: keyboardFocusColor keyboardFocusWidth refreshWorld shadowForm show updateDropShadowCache visible visible:)('drop shadows' addDropShadow addDropShadowMenuItems:hand: changeShadowColor hasDropShadow hasDropShadow: hasDropShadowString hasRolloverBorder hasRolloverBorder: removeDropShadow setShadowOffset: shadowColor shadowColor: shadowOffset shadowOffset: shadowPoint: toggleDropShadow useSoftDropShadow useSoftDropShadow:)('dropping/grabbing' aboutToBeGrabbedBy: acceptDroppingMorph:event: disableDragNDrop dragEnabled dragEnabled: dragNDropEnabled dragSelectionColor dropEnabled dropEnabled: dropHighlightColor dropSuccessColor enableDrag: enableDragNDrop enableDragNDrop: enableDrop: formerOwner formerOwner: formerPosition formerPosition: grabTransform handledOwnDraggingBy:on: highlightForDrop highlightForDrop: highlightedForDrop justDroppedInto:event: justGrabbedFrom: morphToDropInPasteUp: nameForUndoWording rejectDropMorphEvent: repelsMorph:event: resetHighlightForDrop separateDragAndDrop slideBackToFormerSituation: slideToTrash: startDrag:with: transportedMorph undoGrabCommand vanishAfterSlidingTo:event: wantsDroppedMorph:event: wantsToBeDroppedInto: wantsToBeOpenedInWorld willingToBeDiscarded)('event handling' click click: cursorPoint doubleClick: doubleClickTimeout: firstClickTimedOut: handlerForMouseDown: handlerForYellowButtonDown: handlesKeyboard: handlesKeyboardOnlyOnFocus handlesKeyboardOnlyOnFocus: handlesMouseDown: handlesMouseMove: handlesMouseOver: handlesMouseOverDragging: handlesMouseStillDown: handlesMouseWheel: hasFocus hasKeyboardFocus hasKeyboardFocus: hasMouseFocus hasMouseFocus: keyDown: keyStroke: keyUp: keyboardFocusChange: keyboardFocusDelegate mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: mouseMove: mouseStillDown: mouseStillDownThreshold mouseUp: mouseWheel: moveOrResizeFromKeystroke: on:send:to: on:send:to:withValue: removeLink: restoreSuspendedEventHandler startDrag: suspendEventHandler transformFrom: transformFromOutermostWorld transformFromWorld wantsEveryMouseMove wantsKeyboardFocus wantsKeyboardFocusFor: wantsWindowEvents: windowEvent: wouldAcceptKeyboardFocus yellowButtonActivity:)('events-accessing' actionMap updateableActionMap)('events-alarms' addAlarm:after: addAlarm:at: addAlarm:with:after: addAlarm:with:at: addAlarm:with:with:after: addAlarm:with:with:at: addAlarm:withArguments:after: addAlarm:withArguments:at: alarmScheduler removeAlarm: removeAlarm:at:)('events-processing' containsPoint:event: defaultEventDispatcher handleDropMorph: handleEvent: handleFocusEvent: handleKeyDown: handleKeyUp: handleKeystroke: handleListenEvent: handleMouseDown: handleMouseEnter: handleMouseLeave: handleMouseMove: handleMouseOver: handleMouseStillDown: handleMouseUp: handleMouseWheel: handleUnknownEvent: handleWindowEvent: mouseDownPriority mouseDownPriority: processEvent: processEvent:using: processFocusEvent: processFocusEvent:using: rejectDropEvent: rejectsEvent: sendFilterEvent:for:to: sendFilterEventBubble:for: sendFilterEventBubbleAgain:for: sendFilterEventCapture:for: sendFilterEventCaptureAgain:for: transformedFrom:)('events-removing' releaseActionMap)('fileIn/out' attachToResource prepareToBeSaved reserveUrl: saveAsResource saveOnFile saveOnURL saveOnURL: saveOnURLbasic updateAllFromResources updateFromResource)('filter streaming' drawOnCanvas:)('geometry' bottom bottom: bottomCenter bottomLeft bottomLeft: bottomRight bottomRight: bounds bounds: center center: extent extent: height height: left left: leftCenter pointAtFraction: position position: right right: rightCenter top top: topCenter topLeft topLeft: topRight topRight: width width:)('geometry testing' containsPoint: fullContainsPoint: obtrudesBeyondContainer)('halos and balloon help' addHalo addHalo: addHandlesTo:box: addOptionalHandlesTo:box: addSimpleHandlesTo:box: addWorldHandlesTo:box: balloonColor balloonColor: balloonFont balloonFont: balloonHelpAligner balloonHelpDelayTime balloonHelpTextForHandle: balloonMorphClass boundsForBalloon comeToFrontAndAddHalo createHalo defaultBalloonColor defaultBalloonFont defaultHaloDispatcher defersHaloOnClickTo: deleteBalloon editBalloonHelpContent: editBalloonHelpText halo haloClass haloDelayTime hasHalo hasHalo: mouseDownOnHelpHandle: noHelpString okayToAddDismissHandle okayToAddGrabHandle okayToBrownDragEasily okayToExtractEasily okayToResizeEasily okayToRotateEasily removeHalo setBalloonText: setBalloonText:maxLineLength: setCenteredBalloonText: showBalloon showBalloon: showBalloon:at: showBalloon:hand: transferHalo: transferHalo:using: wantsBalloon wantsDirectionHandles wantsDirectionHandles: wantsHaloFromClick wantsHaloFromClick: wantsHaloHandleWithSelector:inHalo: wantsRecolorHandle wantsSimpleSketchMorphHandles)('initialization' basicInitialize defaultBounds defaultColor inAScrollPane initialize openCenteredInWorld openInHand openInWindow openInWindowLabeled: openInWindowLabeled:inWorld: openInWorld openInWorld: openNear: openNear:in: openNearMorph: resourceJustLoaded)('layout' adjustLayoutBounds checkCellSpacingProperty: checkListSpacingProperty: checkResizingProperty: doLayout doLayoutIn: doLayoutSafely fullBounds layoutChanged layoutComputed layoutInBounds: layoutInBounds:positioning: layoutProportionallyIn: layoutProportionallyInBounds:positioning: minExtent minExtent: minHeight minHeight: minWidth minWidth: ownerChanged ownerChangedHandler ownerChangedHandler: privateFullBounds privateFullBoundsForRedraw setExtentFromLayout: setLayoutBoundsFromLayout: setPositionFromLayout: submorphBounds submorphBoundsForShrinkWrap)('layout-menu' addCellLayoutMenuItems:hand: addLayoutMenuItems:hand: addTableLayoutMenuItems:hand: cellPositioningString: cellSpacingString: changeCellGap: changeCellInset: changeClipLayoutCells changeDisableTableLayout changeHeightForWidth changeLayoutInset: changeListDirection: changeMaxCellSize: changeMinCellSize: changeNoLayout changeProportionalLayout changeReverseCells changeRubberBandCells changeTableLayout changeWidthForHeight changesHeightForWidth changesWidthForHeight hResizingString: hasClipLayoutCellsString hasDisableTableLayoutString hasNoLayoutString hasProportionalLayoutString hasReverseCellsString hasRubberBandCellsString hasTableLayoutString layoutMenuPropertyString:from: listCenteringString: listDirectionString: listSpacingString: vResizingString: wrapCenteringString: wrapDirectionString:)('macpal' flash)('menu' addBorderStyleMenuItems:hand: addGestureMenuItems:hand: addGraphModelYellowButtonItemsTo:event: addModelYellowButtonItemsTo:event: addMyYellowButtonMenuItemsToSubmorphMenus addNestedYellowButtonItemsTo:event: addTitleForHaloMenu: addYellowButtonMenuItemsTo:event: buildYellowButtonMenu: hasYellowButtonMenu outermostOwnerWithYellowButtonMenu startWiring wantsMetaMenu wantsMetaMenu: wantsYellowButtonMenu wantsYellowButtonMenu:)('menus' absorbStateFromRenderer: addAddHandMenuItemsForHalo:hand: addCopyItemsTo: addCustomHaloMenuItems:hand: addCustomMenuItems:hand: addExportMenuItems:hand: addFillStyleMenuItems:hand: addHaloActionsTo: addMiscExtrasTo: addStandardHaloMenuItemsTo:hand: addToggleItemsToHaloMenu: addWorldTargetSightingItems:hand: adhereToEdge adhereToEdge: adjustedCenter adjustedCenter: changeColor changeDirectionHandles changeDrag changeDragAndDrop changeDrop collapse defaultArrowheadSize exploreInMorphic exploreInMorphic: exportAsBMP exportAsBMPNamed: exportAsGIF exportAsGIFNamed: exportAsJPEG exportAsJPEGNamed: exportAsPNG exportAsPNGNamed: hasDirectionHandlesString hasDragAndDropEnabledString hasDragEnabledString hasDropEnabledString helpButton inspectInMorphic inspectInMorphic: lockUnlockMorph lockedString maybeAddCollapseItemTo: model presentHelp reasonableBitmapFillForms reasonableForms resetForwardDirection resistsRemovalString setArrowheads setRotationCenter setRotationCenterFrom: setToAdhereToEdge: snapToEdgeIfAppropriate stickinessString transferStateToRenderer: uncollapseSketch)('meta-actions' addEmbeddingMenuItemsTo:hand: beThisWorldsModel buildHandleMenu: buildMetaMenu: changeColorTarget:selector:originalColor:hand: copyToPasteBuffer: dismissMorph dismissMorph: duplicateMorph: duplicateMorphImage: embedInto: grabMorph: inspectAt:event: invokeMetaMenu: invokeMetaMenuAt:event: maybeDuplicateMorph maybeDuplicateMorph: openATextPropertySheet potentialEmbeddingTargets potentialTargets potentialTargetsAt: resizeFromMenu resizeMorph: saveAsPrototype showActions showHiders sightTargets: sightWorldTargets: subclassMorph targetFromMenu: targetWith:)('miscellaneous' setExtentFromHalo: setFlexExtentFromHalo:)('naming' assureExternalName downshiftedNameOfObjectRepresented externalName innocuousName knownName name: nameForFindWindowFeature nameInModel nameOfObjectRepresented renameTo: setNamePropertyTo: setNameTo: specialNameInModel tryToRenameTo:)('objects from disk' objectForDataStream: storeDataOn:)('other events' menuButtonMouseEnter: menuButtonMouseLeave:)('parts bin' inPartsBin initializeToStandAlone isPartsBin isPartsDonor isPartsDonor: markAsPartsDonor partRepresented residesInPartsBin)('printing' clipText colorString: constructorString fullPrintOn: initString morphReport morphReportFor: morphReportFor:on:indent: pagesHandledAutomatically printConstructorOn:indent: printConstructorOn:indent:nodeDict: printOn: printSpecs printSpecs: printStructureOn:indent: reportableSize structureString textToPaste)('rotate scale and flex' addFlexShell addFlexShellIfNecessary assureFlexShell forwardDirection forwardDirection: heading heading: keepsTransform newTransformationMorph referencePosition referencePosition: referencePositionInWorld referencePositionInWorld: removeFlexShell rotationCenter rotationCenter: rotationDegrees rotationDegrees: setDirectionFrom:)('rounding' cornerRadius cornerRadius: cornerStyle cornerStyle: roundedCorners roundedCornersString toggleCornerRounding wantsRoundedCorners)('stepping' arrangeToStartStepping arrangeToStartSteppingIn: isStepping isSteppingSelector: start startStepping startStepping:at:arguments:stepTime: startSteppingIn: startSteppingSelector: step stepAt: stepTime stop stopStepping stopSteppingSelector: stopSteppingSelfAndSubmorphs wantsSteps)('structure' activeHand allOwners allOwnersDo: containingWindow firstOwnerSuchThat: hasOwner: isInDockingBar isInSystemWindow isInWorld morphPreceding: nearestOwnerThat: orOwnerSuchThat: outermostMorphThat: outermostWorldMorph owner ownerThatIsA: ownerThatIsA:orA: pasteUpMorph primaryHand renderedMorph root rootAt: topPasteUp topRendererOrSelf withAllOwners withAllOwnersDo: world)('testing' canDrawAtHigherResolution canDrawBorder: completeModificationHash indicateKeyboardFocus isDockingBar isFlexed isFullOnScreen isImageMorph isLineMorph isMenuItemMorph isMorph isSafeToServe isSelectionMorph isSketchMorph isTransferMorph modificationHash shouldDropOnMouseUp)('text-anchor' addTextAnchorMenuItems:hand: asTextAnchor textAnchorProperties)('thumbnail' icon iconOrThumbnail iconOrThumbnailOfSize: morphRepresented permitsThumbnailing representativeNoTallerThan:norWiderThan:thumbnailHeight: thumbnail updateThumbnailUrl updateThumbnailUrlInBook:)('undo' commandHistory undoMove:redo:owner:bounds:predecessor:)('updating' applyUserInterfaceTheme changed)('user interface' defaultLabelForInspector doCancel initialExtent playSoundNamed:)('visual properties' canApplyUserInterfaceTheme canHaveFillStyles defaultBitmapFillForm fillStyle fillStyle: fillWithRamp:oriented: useBitmapFill useDefaultFill useGradientFill useSolidFill)('WiW support' eToyRejectDropMorph:event: randomBoundsFor: shouldGetStepsFrom:)('private' canBeEncroached privateAddAllMorphs:atIndex: privateAddMorph:atIndex: privateBounds: privateColor: privateDeleteWithAbsolutelyNoSideEffects privateFullBounds: privateFullMoveBy: privateMoveBy: privateOwner: privateRemove: privateRemoveMorphWithAbsolutelyNoSideEffects: privateSubmorphs privateSubmorphs:)('accessing-backstop' target:)('geniestubs' allowsGestureStart: isGestureStart: mouseStillDownStepRate redButtonGestureDictionaryOrName: yellowButtonGestureDictionaryOrName:)('*morphic-Postscript Canvases' asPostscript clipPostscript drawPostscriptOn: fullDrawPostscriptOn: printPSToFile)('button' doButtonAction)('model access' models)('other' removeAllButFirstSubmorph)('selected object' selectedObject)('polymorph' modalLockTo: modalUnlockFrom: openModal:)('*Morphic-Sound-piano rolls' addMorphsTo:pianoRoll:eventTime:betweenTime:and: encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: justDroppedIntoPianoRoll:event: pauseFrom: resetFrom: resumeFrom: triggerActionFromPianoRoll)('events-filtering-bubbling' addEventBubbleFilter: addKeyboardBubbleFilter: addMouseBubbleFilter: eventBubbleFilters eventBubbleFilters: keyboardBubbleFilters keyboardBubbleFilters: mouseBubbleFilters mouseBubbleFilters: removeEventBubbleFilter: removeKeyboardBubbleFilter: removeMouseBubbleFilter:)('events-filtering-capturing' addEventCaptureFilter: addKeyboardCaptureFilter: addMouseCaptureFilter: eventCaptureFilters eventCaptureFilters: keyboardCaptureFilters keyboardCaptureFilters: mouseCaptureFilters mouseCaptureFilters: removeEventCaptureFilter: removeKeyboardCaptureFilter: removeMouseCaptureFilter:)('events-filtering' addFilter:to: eventFilterDocumentation removeFilter:from:)('*ToolBuilder-Morphic-opening' buildWith: openAsTool)('geometry - misc' align:with: positionSubmorphs setConstrainedPosition:hangOut: shiftSubmorphsOtherThan:by: transformedBy: worldBounds worldBoundsForHalo)('geometry - local/global' bounds:from: bounds:in: boundsIn: boundsInWorld fullBoundsInWorld globalPointToLocal: intersects: localPointToGlobal: point:from: point:in: pointFromWorld: pointInWorld: positionInWorld)('geometry - layout' innerBounds innerBounds: innerExtent innerExtent: innerPosition innerPosition: layoutBounds layoutBounds: layoutExtent layoutExtent: layoutPosition layoutPosition: minimumExtent minimumExtent: minimumHeight minimumHeight: minimumWidth minimumWidth: outerBounds outerBounds: outerExtent outerExtent: outerPosition outerPosition:)('Multilingual-ImmPlugin' preferredKeyboardBounds preferredKeyboardPosition)('*ToolBuilder-Morphic' inspectorClass)('submorphs - add/remove' abandon addAllMorphs: addAllMorphs:after: addAllMorphs:behind: addAllMorphs:inFrontOf: addAllMorphsBack: addAllMorphsFront: addMorph: addMorph:after: addMorph:asElementNumber: addMorph:atIndex: addMorph:behind: addMorph:inFrontOf: addMorphBack: addMorphFront: comeToFront delete goBehind privateDelete removeAllMorphs removeAllMorphsIn: removeMorph:)('submorphs - misc' actWhen actWhen: addMorph:fullFrame: addMorphCentered: addMorphFront:fromWorldPosition: addMorphFrontFromWorldPosition: allNonSubmorphMorphs copyWithoutSubmorph: deleteDockingBars deleteSubmorphsWithProperty: deleteUnlessHasFocus dismissViaHalo dockingBars findA: findDeepSubmorphThat:ifAbsent: findDeeplyA: findSubmorphBinary: hasSubmorphWithProperty: indexOfMorphAbove: mainDockingBars morphsAt:behind:unlocked: morphsInFrontOf:overlapping:do: morphsInFrontOverlapping: morphsInFrontOverlapping:do: replaceSubmorph:by: rootMorphsAt: rootMorphsAtGlobal: submorphAfter submorphBefore submorphOfClass: submorphWithProperty:)('submorphs - layers' addAllMorphsBackInLayers: addAllMorphsFrontInLayers: addAllMorphsInLayers: addMorphBackInLayer: addMorphFrontInLayer: addMorphInLayer: morphicLayerNumber morphicLayerNumber: reorderSubmorphsInLayers wantsToBeTopmost)('submorphs - accessing' allKnownNames allMorphs firstSubmorph lastSubmorph morphsAt: morphsAt:unlocked: morphsAt:unlocked:useFullBounds: submorphCount submorphIndexOf: submorphNamed: submorphNamed:ifNone: submorphThat:ifNone: submorphs submorphsSatisfying:)('submorphs - enumerating' allMorphsBreadthFirstDo: allMorphsBreadthFirstDo:sorted: allMorphsDepthFirstDo: allMorphsDo: allSubmorphNamesDo: morphsAt:unlocked:do: morphsAt:unlocked:useFullBounds:do: submorphsBehind:do: submorphsDo: submorphsInFrontOf:do: submorphsReverseDo:)('layout properties' assureGridLayoutProperties assureLayoutProperties assureTableLayoutProperties copyLayoutProperties disableLayout disableLayout: disableTableLayout disableTableLayout: hResizing hResizing: layoutInset layoutInset: layoutPolicy layoutPolicy: layoutProperties layoutProperties: vResizeToFit: vResizing vResizing:)('layout properties - table' cellGap cellGap: cellInset cellInset: cellPositioning cellPositioning: cellSpacing cellSpacing: listCentering listCentering: listDirection listDirection: listSpacing listSpacing: maxCellSize maxCellSize: minCellSize minCellSize: reverseTableCells reverseTableCells: rubberBandCells rubberBandCells: spaceFillWeight spaceFillWeight: wrapCentering wrapCentering: wrapDirection wrapDirection:)('layout properties - grid' gridModulus gridModulus: gridOrigin gridOrigin:)('submorphs - testing' hasSubmorphs)('submorphs - callbacks' intoWorld: noteNewOwner: outOfWorld: removedMorph:)('layout properties - proportional' layoutFrame layoutFrame:)('halo notification' aboutToBeDraggedViaHalo aboutToBeGrownViaHalo aboutToBeRotatedViaHalo aboutToBeScaledViaHalo changedViaHalo:)('display scale' displayScaleChangedBy: handlesDisplayScaleChangedBy:)('*60Deprecated-events-processing' handleDropFiles:)('*MorphicExtras-menus' dismissButton printPSToFileNamed:)('*60Deprecated-rotate scale and flex' degreesOfFlex)('*60Deprecated-text-anchor' changeDocumentAnchor changeInlineAnchor changeParagraphAnchor hasDocumentAnchorString hasInlineAnchorString hasParagraphAnchorString relativeTextAnchorPosition relativeTextAnchorPosition: textAnchorType textAnchorType:)('*MorphicExtras' nextOwnerPage previousOwnerPage)('*60Deprecated-event handling' dropFiles: wantsDropFiles:)('*60Deprecated-geometry' gridPoint: griddedPoint:)('*services-base' requestor)('*60Deprecated-accessing' doesBevels)('*60Deprecated-meta-actions' blueButtonDown: blueButtonUp: handlerForBlueButtonDown: handlerForMetaMenu:)('*60Deprecated-user-interface' becomeModal)('*MorphicExtras-books' updateCachedThumbnail)('*60Deprecated-initialization' inATwoWayScrollPane)('*MorphicExtras-geometry' shiftSubmorphsBy:)('*60Deprecated-dropping/grabbing' toggleDragNDrop)('*60Deprecated-copying' fullCopy)('*MorphicExtras-postscript' asEPS asPostscriptPrintJob exportAsEPS exportAsEPSNamed:)('*60Deprecated-WiW support' addMorphInFrontOfLayer: morphicLayerNumberWithin:)('*60Deprecated-MorphicExtras-accessing' highlightOnlySubmorph:)('*61Deprecated-drawing' highlightForMouseDown highlightForMouseDown:)!InstanceBrowser removeSelector: #viewViewee!!Lexicon reorganize!('basic operation' annotation displaySelector: messageListIndex:)('category list' categoriesPane categoryDefiningSelector: categoryList categoryListIndex categoryListIndex: categoryListKey:from: categoryListMenu:shifted: categoryListMenuTitle categoryWithNameSpecifiedBy: chooseCategory: mainCategoryListMenu: newCategoryPane reformulateCategoryList selectCategoryAll selectWithinCurrentCategoryIfPossible: selectedCategoryName selectorsReferringToClassVar showCategoriesPane)('contents' contents)('control buttons' customButtonSpecs)('history' navigateToNextMethod navigateToPreviousMethod navigateToRecentMethod removeFromSelectorsVisited removeFromSelectorsVisited: selectorsVisited updateSelectorsVisitedfrom:to:)('initialization' customButtonsFrame: initListFrom:highlighting: listFrame:fromLeft:width:)('limit class' chooseLimitClass initialLimitClass limitClass limitClass: limitClassString setLimitClass:)('menu commands' offerMenu removeMessage showCategory showHomeCategory showMainCategory)('message category functions' canShowMultipleMessageCategories)('message list menu' messageListKey:from:)('model glue' doItReceiver okayToAccept targetObject)('new-window queries' browseVariableAssignments browseVariableReferences)('search' hasSearchPane lastSearchString lastSearchString: lastSendersSearchSelector methodListFromSearchString: obtainNewSearchString selectorsMatching setMethodListFromSearchString showSearchPane toggleSearch)('selection' categoryOfSelector: selectImplementedMessageAndEvaluate: selectSelectorItsNaturalCategory: selectWithinCurrentCategory: selectedClassOrMetaClass selectedMessage setToShowSelector:selectCategory:)('senders' navigateToASender selectorsSendingSelectedSelector setSendersSearch)('transition' maybeReselectClass:selector: noteAcceptanceOfCodeFor: preserveSelectorIfPossibleSurrounding: reformulateList reformulateListNoting: retainMethodSelectionWhileSwitchingToCategory:)('vocabulary' chooseVocabulary switchToVocabulary: useVocabulary:)('window title' addModelItemsToWindowMenu: adjustWindowTitle startingWindowTitle)('within-tool queries' currentQueryParameter methodsWithInitials methodsWithInitials: queryCharacterization seeAlso seeAlso: selectorsChanged selectorsDefiningInstVar selectorsReferringToInstVar selectorsRetrieved setLocalClassVarRefs setLocalInstVarDefs setLocalInstVarRefs showMethodsInCurrentChangeSet showMethodsWithInitials showMethodsWithInitials: showQueryResultsCategory)('toolbuilder' addSpecialButtonsTo:with: buildCategoryListWith: buildCustomButtonsWith: buildWith: openOnClass:inWorld:showingSelector: openOnClass:showingSelector: wantsAnnotationPane)('morphic' representsSameBrowseeAs: targetClass)('message list' formattedLabel:forSelector:inClass: messageHelpAt: messageIconAt:)('user interface' defaultWindowColor)('private' contents:notifying: contents:oldSelector:in:classified:notifying: targetForContents:)!Object subclass: #MenuIcons instanceVariableNames: '' classVariableNames: 'Icons ScriptingIcons TranslatedIcons TranslationLocale' poolDictionaries: '' category: 'Morphic-Menus'!Inspector removeSelector: #addEtoysItemsTo:!!Inspector reorganize!('accessing' context context: customFields doItContext doItReceiver fields object object: selectionIndex selectionIndex:)('private' allInstVarsTranslated)('toolbuilder' buildCodePaneWith: buildExploreButtonWith: buildFieldListWith: buildValuePaneWith: buildWith: replaceInspectorWithExplorer)('*Protocols-Tools' browseFullProtocol spawnFullProtocol spawnProtocol)('*60Deprecated-selecting' selectedSlotName)('user interface - styling' aboutToStyle:requestor: fieldListStyler typeValue: updateStyler: updateStyler:requestor:)('menu - construction' addClassItemsTo: addCollectionItemsTo: addFieldItemsTo: addInstVarItemsTo: addObjectItemsTo:)('fields - custom' addCustomField addCustomField: hasCustomFields newCustomField removeCustomField: requestCustomFieldOrCancel:)('user interface' applyUserInterfaceTheme defaultIntegerBase fieldList getContents representsSameBrowseeAs: textColorForError valuePane)('menu - commands' browseClass browseClassHierarchy browseVariableAssignments browseVariableReferences chaseSelectionPointers copyExpression copyName exploreSelection exploreSelectionPointers inspectOne inspectOneOf: inspectOneOfFrom:to: inspectSelection inspectSelectionBasic objectReferencesToSelection removeSelection)('selection - convenience' classOfSelection selectedClass selectedInstVarName selectionIsReadOnly selectionOrObject typeOfSelection)('accessing - contents' contents:notifying: contentsTyped contentsTyped: expression expression:)('fields - error handling' contentsForErrorDoing: emphasizeError: streamError:on: streamErrorDoing:on:)('fields - truncation' contentsForTruncationOf: streamOn:truncate:collectFields: streamOn:truncate:collectFields:ellipsisFrom: truncationLimit truncationTail)('fields - drag and drop' dragFromFieldList: dragTypeInFieldListAt: dropOnFieldList:at:shouldCopy:)('selection' ensureSelectedField hasSelection noteSelectionIndex:for: replaceSelectionValue: selectField: selectFieldNamed: selectFieldSuchThat: selectedField selectedFieldName selection)('fields' expressionForField: fieldAllInstVars fieldSelf newFieldForType: newFieldForType:key:)('initialization' fieldClass initialExtent initialize inspect: resetContents resetFields setContents: setContentsTyped: setExpression:)('menu' fieldListMenu: fieldListMenu:shifted: inspectorKey:from: mainFieldListMenu: metaFieldListMenu:)('user interface - window' labelString objectOkToClose okToClose okToDiscardCustomFields)('updating - steps' modelWakeUpIn: stepAt:in: stepTimeIn: updateListsAndCodeIn: wantsStepsIn:)('fields - streaming' streamBaseFieldsOn: streamCustomFieldsOn: streamFieldsOn: streamIndexedVariablesOn: streamInstanceVariablesOn: streamVariableFieldsOn:)('updating' update update: update:with: updateContentsSafely updateFieldList updateFields)('*60Deprecated-menu' classHierarchy)('*60Deprecated-toolbuilder' exploreObject)('copying' veryDeepInner:)('private - collections' elementAt: elementGetterAt:)('user edits' okToRevertChanges:)!!ImageSegment reorganize!('access' allObjectsDo: arrayOfRoots arrayOfRoots:)('read/write segment' install loadSegmentFrom:outPointers: localName readFromFile)('error checking' checkAndReportLoadError)('fileIn' comeFullyUpOnReload: declare: declareAndPossiblyRename: dependentsCancel: dependentsRestore: fixCapitalizationOfSymbols processRoots rehashDictionaries: reshapeClasses:refStream: restoreEndianness:)('fileIn/Out' acceptSingleMethodSource: endianness restoreEndianness scanFrom: scanFrom:environment:)('testing' errorWrongState forFile:outPointers:)('private' forgetDoItsInClass: segmentFormatFrom:)!Form removeSelector: #graphicForViewerTab!!Form reorganize!('accessing' bits bitsSize bits: defaultCanvasClass depth depth: extent form getCanvas hasBeenModified hasBeenModified: nativeDepth offset offset: size)('analyzing' cgForPixelValue:orNot: colorsUsed dominantColor innerPixelRectFor:orNot: pixelCompare:with:at: primCountBits rectangleEnclosingPixelsNotOfColor: tallyPixelValues tallyPixelValuesInRect:into: xTallyPixelValue:orNot: yTallyPixelValue:orNot:)('bordering' borderFormOfWidth:sharpCorners: borderWidth: borderWidth:color: borderWidth:fillColor: border:width:rule:fillColor: shapeBorder:width: shapeBorder:width:interiorPoint:sharpCorners:internal:)('color mapping' balancedPatternFor: bitPatternFor: colormapFromARGB colormapIfNeededForDepth: colormapIfNeededFor: colormapToARGB makeBWForm: mapColors:to: mapColor:to: maskingMap newColorMap pixelValueFor: pixelWordFor: reducedPaletteOfSize: rgbaBitMasks)('converting' adjustBrightness: adjustSaturation: as8BitColorForm asCursorForm asFormOfDepth: asGrayScale asSourceForm asTextAnchor blendColor: collectColors: collectPixels: colorReduced copyWithColorsReducedTo: darker dimmed dyed: flipVertically lighter orderedDither32To16)('copying' blankCopyOf:scaledBy: contentsOfArea: contentsOfArea:into: copyBits:at:translucent: copyBits:from:at:clippingBox:rule:fillColor: copyBits:from:at:clippingBox:rule:fillColor:map: copyBits:from:at:colorMap: copy: copy:from:in:rule: copy:from:to:rule: deepCopy postCopy veryDeepCopyWith:)('display box access' boundingBox center computeBoundingBox height width)('displaying' displayInterpolatedIn:on: displayInterpolatedOn: displayOnPort:at: displayOn:at:clippingBox:rule:fillColor: displayOn:transformation:clippingBox:align:with:rule:fillColor: displayResourceFormOn: displayScaledOn: drawLine:from:to:clippingBox:rule:fillColor: paintBits:at:translucent:)('editing' bitEdit bitEditAt:scale: edit)('fileIn/Out' comeFullyUpOnReload: hibernate objectForDataStream: printOn: readAttributesFrom: readBitsFrom: readFromOldFormat: readFrom: replaceByResource: storeBitsOn:base: storeOn: storeOn:base: unhibernate writeAttributesOn: writeBitsOn: writeBMPfileNamed: writeJPEGfileNamed: writeJPEGfileNamed:progressive: writeOnMovie: writeOn: writePNGfileNamed: writeUncompressedOn:)('filling' anyShapeFill bitPatternForDepth: convexShapeFill: eraseShape: fillFromXColorBlock: fillFromXYColorBlock: fillFromYColorBlock: fill:rule:fillColor: findShapeAroundSeedBlock: floodFill2:at: floodFillMapFrom:to:mappingColorsWithin:to: floodFill:at: floodFill:at:tolerance: shapeFill:interiorPoint: shapeFill:seedBlock:)('image manipulation' replaceColor:withColor: smear:distance: trimBordersOfColor:)('initialize-release' allocateForm: finish flush fromDisplay: shutDown swapEndianness)('other' fillAlpha: fixAlpha formForColorCount: preMultiplyAlpha primPrintHScale:vScale:landscape: relativeTextAnchorPosition setAsBackground)('pixel access' colorAt: colorAt:put: isTransparentAt: pixelValueAt: pixelValueAt:put: primPixelValueAtX:y: primPixelValueAtX:y:put:)('postscript generation' bitsPerComponent bytesPerRow decodeArray numComponents paddedWidth printPostscript:operator: rowPadding setColorspaceOn: store15To24HexBitsOn: store32To24HexBitsOn: storeBits:to:on: storeHexBitsOn: storePostscriptHexOn:)('resources' readNativeResourceFrom: readResourceFrom: resourceTag storeResourceOn:)('scaling, rotation' clippedToSize: flipBy:centerAt: magnifyBy: magnify:by: magnify:by:smoothing: rotateBy: rotateBy:centerAt: rotateBy:magnify:smoothing: rotateBy:smoothing: scaledToHeight: scaledToSize: scaledToSize:smoothing: scaledToWidth: shrink:by:)('testing' hasNonStandardPalette isAllWhite isBigEndian isDisplayScreen isForm isGrayScale isLittleEndian isStatic isTranslucent isVirtualScreen shouldPreserveContents)('transitions' fadeImageCoarse:at: fadeImageFine:at: fadeImageHorFine:at: fadeImageHor:at: fadeImageSquares:at: fadeImageVert:at: fadeImage:at:indexAndMaskDo: pageImage:at:corner: pageWarp:at:forward: slideImage:at:delta: wipeImage:at:clippingBox:rectForIndex: wipeImage:at:delta: wipeImage:at:delta:clippingBox: zoomInTo:at: zoomIn:orOutTo:at:vanishingPoint: zoomOutTo:at:)('*MorphicExtras-postscript generation' encodePostscriptOn:)('*nebraska-encoding' addDeltasFrom: deltaFrom: deltaFrom:at: encodeForRemoteCanvas)('private' hackBits: initFromArray: privateFloodFillValue: setExtent:depth: setExtent:depth:bits: setResourceBits:)('*Morphic' asMorph blankCopyOf: iconOrThumbnailOfSize: scaledIntoFormOfSize: scaledIntoFormOfSize:smoothing:)('*Morphic-Support-image manipulation' stencil)('processing' approxGaussianBlur at:bias: dither: edgeDetect emboss processUsingKernel: processUsingKernel:factor:bias: sharpen)('*System-icon scaling' scaleIconToDisplay)('*Morphic-Text Support' textAnchorProperties)('*Tools-Inspector' inspectorClass)('*TrueType-displaying' advanceWidth)!Flaps class removeSelector: #addAndEnableEToyFlaps!Flaps class removeSelector: #defaultsQuadsDefiningPlugInSuppliesFlap!Flaps class removeSelector: #defaultsQuadsDefiningScriptingFlap!Flaps class removeSelector: #enableEToyFlaps!Flaps class removeSelector: #newLoneSuppliesFlap!Flaps class removeSelector: #newPaintingFlap!Flaps class removeSelector: #paintFlapButton!Flaps class removeSelector: #possiblyReplaceEToyFlaps!Flaps class removeSelector: #setUpSuppliesFlapOnly!!Flaps class reorganize!('class initialization' initialize)('construction support' addMorph:asElementNumber:inGlobalFlapSatisfying: addMorph:asElementNumber:inGlobalFlapWithID: addToSuppliesFlap:asElementNumber: deleteMorphsSatisfying:fromGlobalFlapSatisfying:)('flap mechanics' clobberFlapTabList freshFlapsStart reinstateDefaultFlaps removeFlapTab:keepInList:)('flaps registry' defaultsQuadsDefiningStackToolsFlap defaultsQuadsDefiningSuppliesFlap defaultsQuadsDefiningToolsFlap defaultsQuadsDefiningWidgetsFlap initializeFlapsQuads registeredFlapsQuads registeredFlapsQuadsAt: registerQuad:forFlapNamed: unregisterQuadsWithReceiver: unregisterQuadsWithReceiver:fromFlapNamed: unregisterQuad:forFlapNamed:)('menu commands' disableGlobalFlaps disableGlobalFlaps: disableGlobalFlapWithID: enableDisableGlobalFlapWithID: enableGlobalFlapWithID: explainFlaps explainFlapsText)('menu support' addIndividualGlobalFlapItemsTo: enableGlobalFlaps globalFlapWithIDEnabledString: showSharedFlaps suppressFlapsString)('miscellaneous' automaticFlapLayoutChanged doAutomaticLayoutOfFlapsIfAppropriate enableClassicNavigatorChanged fileOutChanges makeNavigatorFlapResembleGoldenBar orientationForEdge: removeFromGlobalFlapTabList:)('new flap' addLocalFlap addLocalFlap: addLocalFlap:titled:onEdge: askForEdgeOfNewFlap defaultColorForFlapBackgrounds newFlapTitled:onEdge: newFlapTitled:onEdge:inPasteUp:)('predefined flaps' addNewDefaultSharedFlaps addStandardFlaps initializeStandardFlaps newNavigatorFlap newObjectsFlap newSqueakFlap newStackToolsFlap newSuppliesFlap newSuppliesFlapFromQuads:positioning: newToolsFlap newWidgetsFlap quadsDefiningPlugInSuppliesFlap quadsDefiningStackToolsFlap quadsDefiningSuppliesFlap quadsDefiningToolsFlap quadsDefiningWidgetsFlap quadsDeiningScriptingFlap twiddleSuppliesButtonsIn:)('replacement' replaceGlobalFlapwithID: replacePartSatisfying:inGlobalFlapSatisfying:with: replacePartSatisfying:inGlobalFlapWithID:with: replaceToolsFlap)('shared flaps' addGlobalFlap: enableOnlyGlobalFlapsWithIDs: globalFlapTabOrDummy: globalFlapTabs globalFlapTabsIfAny globalFlapTabsWithID: globalFlapTabWithID: globalFlapTab: positionNavigatorAndOtherFlapsAccordingToPreference positionVisibleFlapsRightToLeftOnEdge:butPlaceAtLeftFlapsWithIDs: removeDuplicateFlapTabs sharedFlapsAllowed sharedFlapsAlongBottom)('testing' anyFlapsVisibleIn:)!EventHandler removeSelector: #adaptToWorld:!DeepCopier removeSelector: #mapUniClasses!DeepCopier removeSelector: #newUniClasses!DeepCopier removeSelector: #newUniClasses:!DeepCopier removeSelector: #uniClasses!Object subclass: #DeepCopier instanceVariableNames: 'references' classVariableNames: '' poolDictionaries: '' category: 'System-Object Storage'!!DeepCopier reorganize!('like fullCopy' checkBasicClasses checkClass: checkDeep checkVariables fixDependents initialize initialize: objInMemory: references warnIverNotCopiedIn:sel:)!ChangeList removeSelector: #buildMorphicCodePaneWith:!CodeHolder removeSelector: #installTextualCodingPane!CodeHolder removeSelector: #restoreTextualCodingPane!!CodeHolder reorganize!('annotation' addPriorVersionsCountForSelector:ofClass:to: annotation annotation: annotationForClassCommentFor: annotationForClassDefinitionFor: annotationForHierarchyFor: annotationForSelector:ofClass: annotationPaneMenu:shifted: annotationRequests annotationSeparator)('categories' categoryFromUserWithPrompt:for: categoryOfCurrentMethod changeCategory letUserReclassify:in: methodCategoryChanged selectedMessageCategoryName selectedSystemCategoryName)('categories & search pane' listPaneWithSelector: newSearchPane searchTextMorph)('commands' adoptMessageInCurrentChangeset browseImplementors browseSenders copyUpOrCopyDown offerMenu offerShiftedClassListMenu offerUnshiftedClassListMenu shiftedYellowButtonActivity spawn: spawnToClass: spawnToCollidingClass: unshiftedYellowButtonActivity)('construction' buildClassBrowserEditString: buildMessageBrowserEditString: buildMessageCategoryBrowserForCategory:class:selector:editString: buildMorphicCodePaneWith:)('contents' commentContents contents contentsChanged contentsSymbol contentsSymbol: editContents editContentsWithDefault: isModeStyleable)('controls' codePaneProvenanceString contentsSymbolQuints decorateButtons optionalButtonPairs sourceAndDiffsQuintsOnly)('diffs' defaultDiffsSymbol diffFromPriorSourceFor: showDiffs showDiffs: showPrettyDiffs: showRegularDiffs: showingAnyKindOfDiffs showingPrettyDiffs showingPrettyDiffsString showingRegularDiffs showingRegularDiffsString toggleDiffing togglePlainSource togglePrettyDiffing togglePrettyPrint toggleRegularDiffing wantsDiffFeedback)('message category functions' canShowMultipleMessageCategories removeMessageCategory)('message list' decompiledSourceIntoContents decompiledSourceIntoContentsWithTempNames: formattedLabel: formattedLabel:forSelector:inClass: messageHelpForMethod: messageHelpTruncated: selectedBytecodes selectedMessage sourceStringPrettifiedAndDiffed validateMessageSource:forSelector:inClass:)('message list menu' messageListKey:from: messageListMenuMore: shiftedMessageListMore:)('misc' addModelItemsToWindowMenu: getSelectorAndSendQuery:to: getSelectorAndSendQuery:to:with: informPossiblyCorruptSource isThereAnOverride isThisAnOverride modelWakeUpIn: okayToAccept priorSourceOrNil refreshAnnotation refusesToAcceptCode releaseCachedState sampleInstanceOfSelectedClass sendQuery:to: sendQuery:to:with: setClassAndSelectorIn: suggestCategoryToSpawnedBrowser: useSelector:orGetSelectorAndSendQuery:to:)('self-updating' didCodeChangeElsewhere stepIn: updateCodePaneIfNeeded updateListsAndCodeIn: wantsStepsIn:)('toolbuilder' annotationFrame annotationPaneHeight browseButtonEnabled buildAnnotationPaneWith: buildCodePaneWith: buildCodeProvenanceButtonWith: buildOptionalButtonsWith: buttonHeight hierarchyButtonEnabled inheritanceButtonColor inheritanceButtonEnabled optionalButtonsFrame receiverClass textFrame variablesButtonEnabled versionsButtonEnabled)('traits' makeSampleInstance showUnreferencedClassVars showUnreferencedInstVars spawnHierarchy)('what to show' offerWhatToShowMenu prettyPrintString setContentsToForceRefetch showByteCodes: showDecompile: showDocumentation: showingByteCodes showingByteCodesString showingDecompile showingDecompileString showingDocumentation showingDocumentationString showingEditContentsOption showingPlainSource showingPlainSourceString showingPrettyPrint showingSource toggleDecompile toggleShowDocumentation toggleShowingByteCodes wantsCodeProvenanceButton)('*services-base' messageListMenuServices: requestor)('*Protocols-Tools' spawnFullProtocol spawnProtocol)('multi-window support' multiWindowState multiWindowState:)('message functions' exploreMethod inspectMethod removeMessage)('*SUnitTools-running' testAskToCreateNewTest: testBinarySelectorNames testBrowseClassNamed:possibleMessageNamed: testFindTest testFindTested testRunSuite: testSelectorFrom:)('*SUnitTools-message list functions' testDebugTest testRunTest)('*SUnitTools-menus' testsMessageListMenu: testsTestFindingMenu:)('breakpoints' isBreakOnEntry toggleBreakOnEntry)('code pane' aboutToStyle: compileMessage:notifying:)('accessing' contents:notifying: doItReceiver metaClassIndicated selectedClass selectedClassOrMetaClass selectedMessageName systemOrganizer)('initialize-release' defaultBrowserTitle labelString setClass:selector:)('*monticello-revisions' classListMenuMonticello: messageListMenuMonticello:)('class functions' removeClass)('system category functions' removeSystemCategory)('*60Deprecated-annotation' defaultAnnotationPaneHeight defaultButtonPaneHeight)('*60Deprecated-categories & search pane' searchPane)!Object removeSelector: #adaptedToWorld:!Object removeSelector: #beViewed!Object removeSelector: #belongsToUniClass!Object removeSelector: #costumes!Object removeSelector: #defaultFloatPrecisionFor:!Object removeSelector: #evaluateUnloggedForSelf:!Object removeSelector: #isPlayer!Object removeSelector: #isPrimitiveCostume!Object removeSelector: #isScriptEditorMorph!Object removeSelector: #isUniversalTiles!Object removeSelector: #methodInterfacesForCategory:inVocabulary:limitClass:!Object removeSelector: #methodInterfacesForInstanceVariablesCategoryIn:!Object removeSelector: #methodInterfacesForScriptsCategoryIn:!Object removeSelector: #presenter!Object removeSelector: #renameInternal:!Object removeSelector: #scriptPerformer!Object removeSelector: #selfWrittenAsIll!Object removeSelector: #selfWrittenAsIm!Object removeSelector: #selfWrittenAsMe!Object removeSelector: #selfWrittenAsMy!Object removeSelector: #selfWrittenAsThis!Object removeSelector: #slotInfo!Object removeSelector: #veryDeepCopySibling!!Object reorganize!('accessing' at: at:modify: at:put: basicAt: basicAt:put: basicSize bindWithTemp: enclosedSetElement in: readFromString: size yourself)('associating' ->)('binding' bindingOf:)('casing' caseOf: caseOf:otherwise:)('class membership' class inheritsFromAnyIn: isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass)('comparing' = closeTo: hash identityHashPrintString literalEqual: ~=)('converting' adaptToFloat:andCompare: adaptToFloat:andSend: adaptToFraction:andCompare: adaptToFraction:andSend: adaptToInteger:andCompare: adaptToInteger:andSend: adaptToScaledDecimal:andCompare: adaptToScaledDecimal:andSend: as: asOrderedCollection asSetElement asString asStringOrText changeClassTo: complexContents mustBeBoolean mustBeBooleanIn: printDirectlyToDisplay withoutListWrapper)('copying' copy copyAddedStateFrom: copyFrom: copySameFrom: copyTwoLevel deepCopy initialDeepCopierSize postCopy shallowCopy veryDeepCopy veryDeepCopyUsing: veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:)('debugging' evaluate:wheneverChangeIn: haltIf: haltOnceIf: meetsHaltCondition: needsWork)('debugging-haltOnce' checkHaltCountExpired clearHaltOnce decrementAndCheckHaltCount decrementHaltCount doExpiredHaltCount doExpiredHaltCount: doExpiredInspectCount halt:onCount: haltIfNil haltOnCount: haltOnce haltOnce: haltOnceEnabled hasHaltCount inspectOnCount: inspectOnce inspectUntilCount: removeHaltCount setHaltCountTo: setHaltOnce toggleHaltOnce)('dependents access' addDependent: breakDependents canDiscardEdits dependents hasUnacceptedEdits myDependents myDependents: release removeDependent:)('drag and drop' acceptDroppingMorph:event:inMorph: dragPassengerFor:inMorph: dragStartedFor:transferMorph: dragTransferTypeForMorph: wantsDroppedMorph:event:inMorph:)('error handling' assert: assert:description: assert:descriptionBlock: backwardCompatibilityOnly: caseError deprecated deprecated: deprecated:block: doesNotUnderstand: dpsTrace: dpsTrace:levels: dpsTrace:levels:withContext: error error: halt halt: handles: notify: notify:at: primitiveFailed primitiveFailed: shouldBeImplemented shouldNotImplement subclassResponsibility traitConflict)('evaluating' value valueWithArguments:)('filter streaming' byteEncode: drawOnCanvas: elementSeparator encodePostscriptOn: flattenOnStream: fullDrawPostscriptOn: putOn: writeOnFilterStream:)('flagging' isThisEverCalled isThisEverCalled: logEntry logExecution logExit)('graph model' addModelYellowButtonMenuItemsTo:forMorph:hand: hasModelYellowButtonMenuItems)('macpal' codeStrippedOut: contentsChanged flash instanceVariableValues objectRepresented refusesToAcceptCode)('message handling' executeMethod: perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:with:with:with:with: perform:with:with:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: perform:withEnoughArguments: with:executeMethod: with:with:executeMethod: with:with:with:executeMethod: with:with:with:with:executeMethod: withArgs:executeMethod:)('objects from disk' comeFullyUpOnReload: convertToCurrentVersion:refStream: fixUponLoad:seg: objectForDataStream: readDataFrom:size: saveOnFile saveOnFileNamed: storeDataOn:)('printing' fullPrintString isLiteral longPrintOn: longPrintOn:limitedTo:indent: longPrintString longPrintStringLimitedTo: nominallyUnsent: printOn: printString printStringLimitedTo: printWithClosureAnalysisOn: reportableSize storeOn: storeString stringForReadout stringRepresentation)('system primitives' asOop become: becomeForward: becomeForward:copyHash: className creationStamp instVarAt: instVarAt:put: instVarNamed: instVarNamed:put: oopString primitiveChangeClassTo: rootStubInImageSegment: someObject)('testing' isArray isBehavior isBlock isBoolean isCharacter isClassReference isClosure isCodeReference isCollection isColor isColorForm isCompiledCode isCompiledCodeClass isCompiledMethod isComplex isContext isDictionary isFloat isForm isFraction isHeap isInteger isInterval isMessageSend isMethodContext isMethodProperties isMethodReference isMorph isMorphicEvent isMorphicModel isNumber isPoint isPromise isRectangle isScaledDecimal isSketchMorph isStream isString isSymbol isSystemWindow isText isTextView isTrait isTransparent isVariableBinding isWebBrowser isWindowForModel: knownName name nameForViewer renameTo: shouldBePrintedAsLiteral shouldBePrintedAsLiteralVisiting: showDiffs stepAt:in: stepIn: stepTime stepTimeIn: vocabularyDemanded wantsDiffFeedback wantsSteps wantsStepsIn:)('updating' changed changed: changed:with: handledListVerification noteSelectionIndex:for: okToChange okToClose update: update:with: updateListsAndCodeIn: windowIsClosing)('user interface' addModelItemsToWindowMenu: addModelMenuItemsTo:forMorph:hand: asExplorerString defaultLabelForInspector launchPartVia: launchPartVia:label: launchTileToRefer modelSleep modelWakeUp modelWakeUpIn: mouseUpBalk: notYetImplemented windowActiveOnFirstClick windowReqNewLabel:)('*monticello' isConflict)('*system-support' isPrimitiveError systemNavigation)('*Tools-Explorer' explore exploreWithLabel:)('*tools-browser' browseHierarchy)('private' errorImproperStore errorNonIntegerIndex errorNotIndexable errorSubscriptBounds: setPinned: species storeAt:inTempFrame:)('thumbnail' iconOrThumbnailOfSize:)('*Morphic-Explorer' explorerContents hasContentsInExplorer)('futures' future future: futureDo:at:args: futureSend:at:args:)('*Tools-MessageSets' browseAllCallsOn: browseAllCallsOn:requestor: browseAllImplementorsOf: browseAllImplementorsOf:requestor:)('*Tools-multi-window support' canHaveUnacceptedEdits)('*morphic' asMorph asStringMorph asTextMorph isPluggableListMorph openAsMorph)('tracing' inboundPointers inboundPointersExcluding: outboundPointers outboundPointersDo:)('*Tools-Debugger' canonicalArgumentName chasePointers explorePointers shouldFollowOutboundPointers)('*System-Object Events-accessing' actionForEvent: actionForEvent:ifAbsent: actionMap actionSequenceForEvent: actionsDo: createActionMap hasActionForEvent: setActionSequence:forEvent: updateableActionMap)('*System-Change Notification-events' actionsWithReceiver:forEvent: renameActionsWithReceiver:forEvent:toEvent:)('*System-Change Notification-converting' asActionSequence asActionSequenceTrappingErrors)('*System-Tools-breakpoint' break)('*ToolBuilder-Kernel-error handling' confirm: confirm:orCancel:)('*ToolBuilder-Kernel-user interface' inform:)('*System-Support-user interface' initialExtent)('*System-Localization-locales' localeChanged localeChangedGently translatedNoop)('*System-Object Events-accessing-removing' releaseActionMap removeAction:forEvent: removeActionsForEvent: removeActionsSatisfying: removeActionsSatisfying:forEvent: removeActionsWithReceiver: removeActionsWithReceiver:forEvent:)('*System-Object Events-accessing-triggering' triggerEvent: triggerEvent:ifNotHandled: triggerEvent:with: triggerEvent:with:ifNotHandled: triggerEvent:withArguments: triggerEvent:withArguments:ifNotHandled:)('*System-Object Events-accessing-registering' when:evaluate: when:send:to: when:send:to:with: when:send:to:withArguments:)('*Traits' explicitRequirement requirement)('*Graphics-KernelExtensions' fullScreenSize)('*System-Finalization' actAsExecutor executor finalizationRegistry finalize hasMultipleExecutors retryWithGC:until: toFinalizeSend:to:with:)('*collections' asLink compareSafely:)('*Tools-Browsing' browse)('*System-Recovery-error handling' primitiveError:)('*SUnit-testing' isTestClass)('*Morphic-Events-Filtering' filterEvent:for:)('*System-Preferences' applyUserInterfaceTheme canApplyUserInterfaceTheme userInterfaceTheme)('*Tools' environment)('pinning' isPinned pin unpin)('literals' allLiteralsDo: hasLiteral: hasLiteralSuchThat:)('write barrier' attemptToAssign:withIndex: beReadOnlyObject beWritableObject isReadOnlyObject setIsReadOnlyObject:)('*Tools-Inspector' basicInspect inspect inspectWithLabel: inspectorClass)('*Morphic-Kernel-accessing' currentEvent currentHand currentWorld)('*Monticello-Patching-testing' isMCPatchOperation)('*JSON' asJsonString)('*60Deprecated-accessing' ifNil:ifNotNilDo: ifNotNilDo: ifNotNilDo:ifNil:)('*MorphicExtras-Undo' capturedState commandHistory purgeAllCommands redoFromCapturedState: refineRedoTarget:selector:arguments:in: refineUndoTarget:selector:arguments:in: rememberCommand: rememberUndoableAction:named: undoFromCapturedState:)('*Protocols' currentVocabulary haveFullProtocolBrowsed haveFullProtocolBrowsedShowingSelector:)('*services-base' requestor)('*60Deprecated-copying' clone)('*60Deprecated-Tools' exploreAndYourself notifyWithLabel:)('*MorphicExtras-PartsBin' descriptionForPartsBin)!| currentChanges |currentChanges := ChangeSet current.Smalltalk globals removeKey: #References.Smalltalk globals removeKey: #CustomEventsRegistry.Smalltalk globals removeKey: #ScriptingSystem.ChangeSet newChanges: (ChangeSet new name: 'unload-etoys-more').(Smalltalk classNamed: #StandardScriptingSystem) removeFromSystem.(Smalltalk classNamed: #Presenter) removeFromSystem.(Smalltalk classNamed: #MethodHolder) removeFromSystem.(Smalltalk classNamed: #PaintInvokingMorph) removeFromSystem.(Smalltalk classNamed: #ViewerFlapTab) removeFromSystem.(Smalltalk classNamed: #AcceptableCleanTextMorph) removeFromSystem.(Smalltalk classNamed: #BrowserCommentTextMorph) removeFromSystem.(Smalltalk classNamed: #BorderedSubpaneDividerMorph) removeFromSystem.(Smalltalk classNamed: #TextFieldMorph) removeFromSystem.(Smalltalk classNamed: #KeyboardBuffer) removeFromSystem.(Smalltalk classNamed: #PluggableTabButtonMorph) removeFromSystem.(Smalltalk classNamed: #MorphWithSubmorphsWrapper) removeFromSystem.(Smalltalk classNamed: #TwoWayScrollPane) removeFromSystem.Preferences removePreference: #noviceMode.Preferences removePreference: #eToyFriendly.Preferences removePreference: #universalTiles.Preferences removePreference: #uniTilesClassic.Preferences removePreference: #tileTranslucentDrag.Preferences removePreference: #typeCheckingInTileScripting.Preferences removePreference: #compactViewerFlaps.Preferences removePreference: #viewersInFlaps.Preferences removePreference: #batchPenTrails.Preferences removePreference: #keepTickingWhilePainting.Preferences removePreference: #unlimitedPaintArea.Preferences removePreference: #mvcProjectsAllowed.Preferences removePreference: #eToyLoginEnabled.Preferences removePreference: #oliveHandleForScriptedObjects.Preferences removePreference: #dropProducesWatcher.Preferences removePreference: #automaticViewerPlacement.Preferences removePreference: #capitalizedReferences.Preferences removePreference: #fenceEnabled.Preferences removePreference: #fenceSoundEnabled.Preferences removePreference: #haloTransitions.Preferences removePreference: #selectiveHalos.Preferences removePreference: #useVectorVocabulary.Preferences removePreference: #simpleMenus.Preferences removePreference: #propertySheetFromHalo.Preferences removePreference: #menuColorFromWorld.Preferences removePreference: #enableVirtualOLPCDisplay.Preferences removePreference: #enablePortraitMode.Preferences removePreference: #magicHalos.Preferences removePreference: #tabAmongFields.Preferences removePreference: #sugarAutoSave.Preferences removePreference: #showAdvancedNavigatorButtons.FileServices removeObsolete.ChangeSet newChanges: currentChanges.ChangeSet newChanges: (ChangeSet new name: 'clean-up-categories').SystemChangeNotifier uniqueInstance doSilently: [Smalltalk allClassesDo: [:cls | cls organization renameCategory: 'stepping and presenter' toBe: 'stepping']].Smalltalk removeEmptyMessageCategories.ChangeSet newChanges: currentChanges.Preferences resetHaloSpecifications.TheWorldMainDockingBar updateInstances.Flaps initializeFlapsQuads; initializeStandardFlaps.Vocabulary initializeStandardVocabularies.UserInterfaceTheme cleanUpAndReset."Next: Remove Etoys package from update map."!
Hi Dave! 😊
Thank you for the effort!
Best, Marcel
________________________________ From: lewis@mail.msen.com lewis@mail.msen.com Sent: Sunday, November 5, 2023 5:29:46 PM To: The general-purpose Squeak developers list squeak-dev@lists.squeakfoundation.org Subject: [squeak-dev] Re: Let's discuss the future of Etoys in Squeak 6.1 (and beyond)
I have pushed a number of updates to trunk with class and method recategorization for Etoys. I am attaching for reference an updated RecategorizeForEtoys.st that includes scripts that I have been using to make the changes.
So for, the changes do two things: 1) Clean up category names, based the cleanups in Marcel's Etoys removal script. 2) Move classes an methods from Etoys to base packages if they are used outside of Etoys.
I have also made, but not committed, a bunch of updates that move methods into Etoys if they are used only by Etoys. These changes should be safe for trunk, but I want to spend some more time reviewing them before committing them for real.
Meanwhile any feedback is appreciated :-)
Dave
On 2023-10-03 15:24, David T. Lewis wrote:
On Tue, Aug 29, 2023 at 03:47:19PM +0200, Marcel Taeumel via Squeak-dev wrote:
Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
I have been working with Marcel's excellent Etoys removal script and trying to figure out if it might be possible to maintain images with and without Etoys over time. I have been using Monticello with a local disk based repository to look at the differences between trunk images with and without the Etoys removal.
Just for the record, and in case anyone else is playing around with similar ideas, I am attaching RecategorizeExtensionsForEtoys.st which I have been using to move methods that are different into a separate 'Extensions' package. This separates out the methods that are necessarily different between images with and without Etoys. I don't (yet?) see how this helps with maintainability but it does give a view of the methods that could potentially be refactored in better ways. Basically I think the idea would be to make the 'Extensions' package be as small a possible (right now it is rather large).
I was hoping to find that moving these conflicting methods into a separate package would leave the rest of the packages reasonable similar between the full trunk image and the no-Etoys trunk image. But of course it is not quite that simple.
One encouraging thing is that, after moving the conflicting methods (Etoys image versus no-Etoys) I find a large number of methods in other packages that are referenced only by Etoys, even though that would not be obvious just from looking at those methods in the full image. I think that there is a lot of stuff that could be safely moved to the 'EToys' package without impacting the base image.
Just a few observations that may be of interest, hopefully more to follow.
Dave
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras:
- Games
- Sketches and PaintBox
- Flaps
- CalendarMorph
- SpectrumAnalyzerMorph
Here is what would still "work" through the package System:
- Object storage (ImageSegment etc.)
- ProjectLoading
Here is what would still work through the package Protocols:
- Lexicon tool
- Vocabulary framework
Here is what would be gone:
- Tiles, viewers, and scripts
- Players and costumes
- Pen trails, Turtles, ...
- References, CustomEventsRegistry, ScriptingSystem
- Siblings for (Player-only) uni-classes
- DeepCopier support for (Player-only) uni-classes
- Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
So...should we remove Etoys from Trunk at this point?
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel ???'From Squeak6.1alpha of 26 July 2023 [latest update: #22682] on 29 August 2023 at 3:33:41 pm'!| currentChanges |currentChanges := ChangeSet current.MenuIcons addClassVarName: #ScriptingIcons.MenuIcons classPool at: #ScriptingIcons put: ((Smalltalk globals at: #ScriptingSystem) formDictionary associationsSelect: [:assoc | true "keep all for now" "(assoc key beginsWith: 'Halo-') or: [assoc key beginsWith: 'Debugger']"]).ChangeSet newChanges: (ChangeSet new name: 'move-etoys-games-to-morphicextras').#( "Keep the games as standalone example applications"'Etoys-Squeakland-Morphic-Games' 'MorphicExtras-Games''Etoys-Squeakland-Morphic-Games-Chess' 'MorphicExtras-Games-Chess''Etoys-Squeakland-Morphic-Games-Chess960' 'MorphicExtras-Games-Chess960''Etoys-Squeakland-Morphic-Demo' 'MorphicExtras-Demo') pairsDo: [:oldCat :newCat | (SystemOrganization listAtCategoryNamed: oldCat) do: [:className | (self environment classNamed: className) category: newCat]]."Rescue more examples from Etoys over to MorphicExtras"(Smalltalk classNamed: #CalendarMorph) category: 'MorphicExtras-Demo'.(Smalltalk classNamed: #SpectrumAnalyzerMorph) category: 'MorphicExtras-SoundInterface'.ChangeSet newChanges: currentChanges.(MCPackage named: #EToys) unload.!Object subclass: #DeepCopier instanceVariableNames: 'references uniClasses newUniClasses ' classVariableNames: '' poolDictionaries: '' category: 'System-Object Storage'!!DeepCopier commentStamp: 'mt 8/28/2023 15:05' prior: 0!DeepCopier does a veryDeepCopy.It is a complete tree copy using a dictionary. Any object that is 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. See Object|veryDeepCopy which calls (self veryDeepCopyWith: aDeepCopier).When a tree of morphs points at a morph outside of itself, that morph should not be copied. Use our own kind of weak pointers for the 'potentially outside' morphs. Default is that any new class will have all of its fields deeply copied. If a field needs to be weakly copied, define veryDeepInner: and veryDeepFixupWith:. veryDeepInner: has the loop that actually copies the fields. If a class defines its own copy of veryDeepInner: (to leave some fields out), then veryDeepFixupWith: will be called on that object at the end. veryDeepInner: can compute an alternate object to put in a field. (Object veryDeepCopyWith: discovers which superclasses did not define veryDeepInner:, and very deeply copies the variables defined in those classes). To decide if a class needs veryDeepInner: and veryDeepFixupWith:, ask this about an instance: If I duplicate this object, does that mean that I also want to make duplicates of the things it holds onto? If yes, (i.e. a Paragraph does want a new copy of its Text) then do nothing. If no, (i.e. an undo command does not want to copy the objects it acts upon), then define veryDeepInner: and veryDeepFixupWith:. Here is an analysis for the specific case of a morph being held by another morph. Does field X contain a morph? If not, no action needed.Is the morph in field X already a submorph of the object? Is it down lower in the submorph tree? If so, no action needed.Could the morph in field X every appear on the screen (be a submorph of some other morph)? If not, no action needed. If it could, you must write the methods veryDeepFixupWith: and veryDeepInner:, and in them, refrain from sending veryDeepCopyWith: to the contents of field X.----- Things Ted is still considering -----Rule: If object A has object C in a field, and A says (^ C) for the copy, but object B has A in a normal field and it gets deepCopied, and A in encountered first, then there will be two copies of C. (just be aware of it)Dependents are now fixed up. Suppose a model has a dependent view. In the DependentFields dictionary, model -> (view ...). If only the model is copied, no dependents are created (no one knows about the new model). If only the view is copied, it is inserted into DependentFields on the right side. model -> (view copiedView ...). If both are copied, the new model has the new view as its dependent. If additional things depend on a model that is copied, the caller must add them to its dependents.August 2023: There is no support for uni-classes at this time!!!Model subclass: #FancyMailComposition instanceVariableNames: 'messageText theLinkToInclude to subject' classVariableNames: '' poolDictionaries: '' category: 'Nebraska-Network-Mail'!Object subclass: #MenuIcons instanceVariableNames: '' classVariableNames: 'Icons TranslatedIcons TranslationLocale ScriptingIcons ' poolDictionaries: '' category: 'Morphic-Menus'!Object subclass: #MorphExtension instanceVariableNames: 'locked visible sticky balloonText balloonTextSelector externalName isPartsDonor actorState player eventHandler otherProperties ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Kernel'!BorderedMorph subclass: #PasteUpMorph instanceVariableNames: 'presenter model cursor padding turtleTrailsForm turtlePen lastTurtlePositions isPartsBin indicateCursor wantsMouseOverHalos worldState ' classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler ' poolDictionaries: '' category: 'Morphic-Worlds'!AbstractLauncher subclass: #ProjectLauncher instanceVariableNames: 'showSplash splashURL whichFlaps eToyAuthentificationServer ' classVariableNames: 'SplashMorph ' poolDictionaries: '' category: 'System-Download'!Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl eToyUserListUrl eToyUserList keepAlive encodingName ' classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers ' poolDictionaries: '' category: 'Network-RemoteDirectory'!!SmartRefStream commentStamp: 'mt 8/28/2023 15:44' prior: 0!Ordinary ReferenceStreams assume that the names and order of instance variables is exactly the same when an object file is written and read. SmartRefStream allows object files to be read even after instance variables have changed or the entire class has been renamed.When an object file is written, no one knows how the classes will change in the future. Therefore, all conversion must be done when the file is read. The key is to store enough information in the file about the names of the instance variables of all outgoing classes. SmartRefStream works best with only one tree of objects per file. You can nextPut: more than once, but each object tree gets its own class structure description, which is big. Conversion of old objects is done by a method in each class called (convertToCurrentVersion: varDict refStream: smartRefStrm). At fileOut time, ChangeSet>>checkForConversionMethods creates a prototype of this method (if Preference #conversionMethodsAtFileOut is true). The programmer must edit this method to (1) test if the incoming object needs conversion, (2) put non-nil values into any new inst vars that need them, and (3) save the data of any inst vars that are being deleted. Determining which old version is represented by the incoming object can be done in several ways: - noticing that a current inst var is nil when it should have data, - noticing that there is an older inst var name in the variable dictionary (varDict), - checking kinds of objects in one or more inst vars, or - retrieving the classVersion of the incoming object from the ref stream. If a class is renamed, a method goes into SmartRefStream telling the new name. The conversion method of the new class must be prepared to accept instances of the old class also. If no inst var names have changed, the conversion method does nothing.An example: Suppose we change the representation of class Rectangle from ('origin' 'corner') to ('origin' 'extent'). Suppose lots of Rectangle instances are already out on files (in .pr project files, especially). The programmer changes the class definition, modifies all the methods, and filesOut. A series of dialogs appear, asking if instances Rectangle might be in an object file, if 'extent' needs to be non-nil (yes), and if the info in 'corner' needs to be preserved (yes). This method appears:Rectangle >> convertToCurrentVersion: varDict refStream: smartRefStrm "These variables are automatically stored into the new instance: #('origin'). Test for this particular conversion. Get values using expressions like (varDict at: 'foo')." "New variables: #('extent'). If a non-nil value is needed, please assign it." "These are going away #('corner'). Possibly store their info in some other variable?" "Move your code above the ^ super... Delete extra comments." ^ super convertToCurrentVersion: varDict refStream: smartRefStrmThe programmer modifies it to be:Rectangle >> convertToCurrentVersion: varDict refStream: smartRefStrm(varDict includesKey: 'extent') ifFalse: ["old version!!" "Create the new extent, and preserve the info from the old corner" extent := (varDict at: 'corner') - origin. ].^ super convertToCurrentVersion: varDict refStream: smartRefStrm This conversion method stays in the system and is ready to convert the old format of Rectangle whenever one is encountered in an object file. Note that the subclasses of Rectangle, (B3DViewport, CharacterBlock, and Quadrangle) do not need conversion methods. Their instances will be converted by the code in Rectangle. Files written by SmartRefStream are in standard fileout format. You can mix raw objects with code to be filed in. The file starts out in the normal fileOut format. Definitions of new classes on the front.structures Dictionary of (#Rectangle -> #(<classVersionInteger> 'origin' 'corner')). Inst var names are strings.steady Set of Classes who have the same structure now as on the incoming file. Includes classes with same inst vars except for new ones added on the end.reshaped Dictionary of Classes who have a different structure now from the incoming file. Includes those with same inst vars but new version number. (old class name -> method selector to fill in data for version to version)renamed Dictionary of Classes who have a different name. Make an instance of the new class, and send it the conversion call. (old class name symbol -> new class name). renamedConv Dictionary of conversion selector for Classes who have a different name. (old class name symbol -> conversion selector). topCall Tells if next or nextPut: are working on the top object in the tree. nil if outside, the top object if deep inside.See DataStream.typeIDFor: for where the tangle of objects is clipped, so the whole system will not be written on the file.No object that is written on the file is ever a class. All class definitions are filed in. A class may be stored inside an ImageSegment that itself is stored in a SmartRefStream.UniClasses are classes for the instance specific behavior of just one instance. See #newSubclass. When a UniClass is read in, and a class of the same name already exists, the incoming one is renamed. ObjectScanner converts the filed-in code.Values in instance variables of UniClasses are stored in the array that tells the class structure. It is the fourth of the four top level objects. #(version (class-structure) the-object ((#Player25 scripts slotInfo costumeDictionary) (#Player26 scripts slotInfo costumeDictionary))).There is a separate subclass for doing veryDeepCopy (in memory). Currently, any object for which objectToStoreOnDataStream return an object other than self, does this: The new object (a DiskProxy) is traced. When it comes time to go through the fields of the old object, they are not found as keys in references (DiskProxies are there instead). So the old field value is left in the new object. That is OK for StrikeFont, Class, MetaClass, DisplayScreen. But the DiskProxies are evaluated, which takes a lot of time.Some metaclasses are put into the structures table. This is for when a block has a receiver that is a class. See checkFatalReshape:.ImageSegments: A ReferenceStream is used to enumerate objects to put inside an ImageSegment. If an instance of a UniClass is seen, the class is put in also. A SmartRefStream is used to store the ImageSegment. Roots are nil, and the segment is a wordArray. We are encoding the outPointers. Structures contains all classes from both places. Must filter out UniClasses for some things, and do include them for putting source code at end of file. Do not write any class inst vars in file.--Ted Kaehler and Bob Arning.How are the selectors in the '*Morphic-conversion' protocol ending with something like ttfclpomsswfpp0constructed and what does it mean?Answer:It is the initials of all instance variables followed by the class version integer. The initials allow to detect most changes to the instance variables, but if this is not sufficient (perhaps because the new var had the same initial, or the vars did not change in name at all) we still have the class version.Most classes are still at version 0, but if you check implementers of classVersion you can find a few that were incremented to force a conversion on load.!!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:05'!veryDeepCopy "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." | copier new | copier := DeepCopier new: self initialDeepCopierSize. new := self veryDeepCopyWith: copier. copier references associationsDo: [:assoc | assoc value veryDeepFixupWith: copier]. copier fixDependents. ^ new! !!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:05'!veryDeepCopyUsing: copier "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. Same as veryDeepCopy except copier (with dictionary) is supplied. ** do not delete this method, even if it has no callers **" | new refs | new := self veryDeepCopyWith: copier. copier references associationsDo: [:assoc | assoc value veryDeepFixupWith: copier]. "Fix dependents" refs := copier references. DependentsFields associationsDo: [:pair | pair value do: [:dep | | newDep newModel | (newDep := refs at: dep ifAbsent: [nil]) ifNotNil: [ newModel := refs at: pair key ifAbsent: [pair key]. newModel addDependent: newDep]]]. ^ new! !!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:07'!veryDeepCopyWith: deepCopier "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." | class index sub subAss new sup has mine | deepCopier references at: self ifPresent: [:newer | ^ newer]. "already did him" class := self class. class isMeta ifTrue: [^ self]. "a class" new := self shallowCopy. deepCopier references at: self put: new. "remember" (class isVariable and: [class isPointers]) ifTrue: [index := self basicSize. [index > 0] whileTrue: [sub := self basicAt: index. (subAss := deepCopier references associationAt: sub ifAbsent: [nil]) ifNil: [new basicAt: index put: (sub veryDeepCopyWith: deepCopier)] ifNotNil: [new basicAt: index put: subAss value]. index := index - 1]]. "Ask each superclass if it wants to share (weak copy) any inst vars" new veryDeepInner: deepCopier. "does super a lot" "other superclasses want all inst vars deep copied" sup := class. index := class instSize. [has := sup compiledMethodAt: #veryDeepInner: ifAbsent: [nil]. has := has ifNil: [class isSystemDefined not "is a uniClass"] ifNotNil: [true]. mine := sup instVarNames. has ifTrue: [index := index - mine size] "skip inst vars" ifFalse: [1 to: mine size do: [:xx | sub := self instVarAt: index. (subAss := deepCopier references associationAt: sub ifAbsent: [nil]) "use association, not value, so nil is an exceptional value" ifNil: [new instVarAt: index put: (sub veryDeepCopyWith: deepCopier)] ifNotNil: [new instVarAt: index put: subAss value]. index := index - 1]]. (sup := sup superclass) == nil] whileFalse. new rehash. "force Sets and Dictionaries to rehash" ^ new! !!Object methodsFor: 'testing' stamp: 'mt 3/8/2023 10:43'!knownName ^ nil! !!Class methodsFor: 'testing' stamp: 'mt 8/28/2023 14:56'!officialClass "I am not a UniClass. (See MorphicModel officialClass). Return the class you use to make new subclasses." ^ self! !!Class methodsFor: 'fileIn/Out' stamp: 'mt 8/28/2023 14:56'!objectForDataStream: refStrm "I am about to be written on an object file. Write a reference to a class in Smalltalk instead." refStrm insideASegment ifFalse: ["Normal use" ^ DiskProxy global: self theNonMetaClass name selector: #withClassVersion: args: {self classVersion}] ifTrue: ["recording objects to go into an ImageSegment" self isSystemDefined ifFalse: [^ self]. "do trace uni-classes" (refStrm rootObject includes: self) ifTrue: [^ self]. "is in roots, intensionally write out, ^ self" "A normal class. remove it from references. Do not trace." refStrm references removeKey: self ifAbsent: []. "already there" ^ nil]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!toggleDiffing "Toggle whether diffs should be shown in the code pane. If any kind of diffs were being shown, stop showing diffs. If no kind of diffs were being shown, start showing whatever kind of diffs are called for by default." | wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingAnyKindOfDiffs. self showDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!togglePlainSource "Toggle whether plain source shown in the code pane" | wasShowingPlainSource | self okToChange ifTrue: [wasShowingPlainSource := self showingPlainSource. wasShowingPlainSource ifTrue: [self showDocumentation: true] ifFalse: [contentsSymbol := #source]. self setContentsToForceRefetch. self changed: #contents]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!togglePrettyDiffing "Toggle whether pretty-diffing should be shown in the code pane" | wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingPrettyDiffs. self showPrettyDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!togglePrettyPrint "Toggle whether pretty-print is in effectin the code pane" self okToChange ifTrue: [self showingPrettyPrint ifTrue: [contentsSymbol := #source] ifFalse: [contentsSymbol := #prettyPrint]. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!toggleRegularDiffing "Toggle whether regular-diffing should be shown in the code pane" | wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingRegularDiffs. self showRegularDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'misc' stamp: 'mt 3/23/2023 11:24'!refusesToAcceptCode "Answer whether receiver, given its current contentsSymbol, could accept code happily if asked to" ^ (#(byteCodes documentation) includes: self contentsSymbol)! !!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'!toggleDecompile "Toggle the setting of the showingDecompile flag, unless there are unsubmitted edits that the user declines to discard" | wasShowing | self okToChange ifTrue: [wasShowing := self showingDecompile. self showDecompile: wasShowing not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'!toggleShowDocumentation "Toggle the setting of the showingDocumentation flag, unless there are unsubmitted edits that the user declines to discard" | wasShowing | self okToChange ifTrue: [wasShowing := self showingDocumentation. self showDocumentation: wasShowing not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'!toggleShowingByteCodes "Toggle whether the receiver is showing bytecodes" self showByteCodes: self showingByteCodes not. self setContentsToForceRefetch. self contentsChanged! !!Command class methodsFor: 'dog simple ui' stamp: 'mt 7/31/2023 11:10'!undoRedoButtons "Answer a morph that offers undo and redo buttons" | wrapper | "self currentHand attachMorph: Command undoRedoButtons" wrapper := AlignmentMorph newColumn. wrapper color: Color veryVeryLightGray lighter; borderWidth: 0; layoutInset: 0; vResizing: #shrinkWrap; hResizing: #shrinkWrap. #((CrudeUndo undoLastCommand 'undo last command done' undoEnabled CrudeUndoDisabled CrudeUndoDisabled) (CrudeRedo redoNextCommand 'redo last undone command' redoEnabled CrudeRedoDisabled CrudeRedoDisabled)) do: [:tuple | | aButton | wrapper addTransparentSpacerOfSize: (8@0). aButton := UpdatingThreePhaseButtonMorph new. aButton onImage: (MenuIcons formAtKey: tuple first); offImage: (MenuIcons formAtKey: tuple fifth); pressedImage: (MenuIcons formAtKey: tuple sixth); getSelector: tuple fourth; color: Color transparent; target: self; actionSelector: tuple second; setNameTo: tuple second; setBalloonText: tuple third; extent: aButton onImage extent. wrapper addMorphBack: aButton. wrapper addTransparentSpacerOfSize: (8@0)]. ^ wrapper! !!Debugger methodsFor: 'toolbuilder' stamp: 'mt 3/10/2023 11:26'!buildNotifierWith: builder label: label message: messageString | windowSpec listSpec textSpec panelSpec quads | windowSpec := builder pluggableWindowSpec new model: self; extent: self initialExtentForNotifier; label: label asString; children: OrderedCollection new. panelSpec := builder pluggablePanelSpec new. panelSpec children: OrderedCollection new. quads := self preDebugButtonQuads. (self interruptedContext selector == #doesNotUnderstand:) ifTrue: [ quads := quads copyWith: { 'Create'. #createMethod. #magenta. 'create the missing method' } ]. (#(#notYetImplemented #shouldBeImplemented #requirement) includes: self interruptedContext selector) ifTrue: [ quads := quads copyWith: { 'Create'. #createImplementingMethod. #magenta. 'implement the marked method' } ]. (self interruptedContext selector == #subclassResponsibility) ifTrue: [ quads := quads copyWith: { 'Create'. #createOverridingMethod. #magenta. 'create the missing overriding method' } ]. quads do:[:spec| | buttonSpec | buttonSpec := builder pluggableButtonSpec new. buttonSpec model: self. buttonSpec label: spec first. buttonSpec action: spec second. buttonSpec help: spec fourth. spec size >= 5 ifTrue: [buttonSpec enabled: spec fifth]. panelSpec children add: buttonSpec. ]. panelSpec layout: #horizontal. "buttons" panelSpec frame: self preDebugButtonQuadFrame. windowSpec children add: panelSpec. messageString notNil ifFalse:[ listSpec := builder pluggableListSpec new. listSpec model: self; list: #contextStackList; getIndex: #contextStackIndex; setIndex: #debugAt:; icon: #messageIconAt:; helpItem: #messageHelpAt:; frame: self contextStackFrame. windowSpec children add: listSpec. ] ifTrue:[ message := messageString. textSpec := builder pluggableTextSpec new. textSpec model: self; getText: #preDebugMessageString; setText: nil; selection: nil; menu: #debugProceedMenu:; frame: self contextStackFrame. windowSpec children add: textSpec. ]. ^windowSpec! !!Debugger methodsFor: 'initialize' stamp: 'mt 3/10/2023 11:26'!preDebugButtonQuads ^{ {'Proceed' translated. #proceed. #blue. 'continue execution' translated. #interruptedProcessShouldResume}. self class showTerminateButton ifTrue: [ {'Terminate' translated. #terminateProcess. #black. 'terminate this execution and close this window' translated}]. self class showAbandonButton ifTrue: [ {'Abandon' translated. #abandon. #black. 'terminate this execution aggressively and close this window' translated}]. {'Debug' translated. #debug. #red. 'bring up a debugger' translated}} reject: [:quad | quad isNil]! !!DeepCopier methodsFor: 'like fullCopy' stamp: 'mt 3/10/2023 15:37'!checkBasicClasses "Check that no indexes of instance vars have changed in certain classes. If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated. The idea is to catch a change while it is still in the system of the programmer who made it. DeepCopier new checkVariables " | str objCls morphCls | str := '|veryDeepCopyWith: or veryDeepInner: is out of date.'. (objCls := self objInMemory: #Object) ifNotNil: [ objCls instSize = 0 ifFalse: [self error: 'Many implementers of veryDeepCopyWith: are out of date']]. (morphCls := self objInMemory: #Morph) ifNotNil: [ morphCls superclass == Object ifFalse: [self error: 'Morph', str]. (morphCls instVarNames copyFrom: 1 to: 6) = #('bounds' 'owner' 'submorphs' 'fullBounds' 'color' 'extension') ifFalse: [self error: 'Morph', str]]. "added ones are OK"! !!DeepCopier methodsFor: 'like fullCopy' stamp: 'mt 8/28/2023 15:08'!initialize: size references := IdentityDictionary new: size.! !!ExtendedClipboardUnixInterface methodsFor: 'general-api-read' stamp: 'mt 8/11/2023 15:20'!readHTMLClipboardData | bytes source | "Answer a HTMLDocument object" bytes := self readClipboardData: 'text/html'. (bytes beginsWith: '<!!DOCTYPE' asByteArray) ifTrue: ["BAD HACK for Abiword" source := bytes asString convertFromWithConverter: UTF8TextConverter new] ifFalse: ["BAD HACK for mozilla" source := bytes asString convertFromWithConverter: (UTF16TextConverter new useLittleEndian: SmalltalkImage current isLittleEndian)]. ^ source asTextFromHtml! !!FileList2 methodsFor: 'volume list and pattern' stamp: 'mt 8/16/2023 15:54'!listForPattern: pat "Make the list be those file names which match the pattern." | sizePad newList entries | directory ifNil: [^#()]. entries := directory entries. (fileSelectionBlock isKindOf: MessageSend) ifTrue: [ fileSelectionBlock arguments: {entries}. newList := fileSelectionBlock value. fileSelectionBlock arguments: #(). ] ifFalse: [ newList := entries select: [:entry | fileSelectionBlock value: entry value: pat]. ]. newList := newList asArray sort: self sortBlock. sizePad := (newList inject: 0 into: [:mx :entry | mx max: entry fileSize]) asStringWithCommas size - 1. ^newList collect: [ :e | self fileNameFormattedFrom: e sizePad: sizePad ]! !!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'!morphicViewGeneralLoaderInWorld: aWorld"FileList2 morphicViewGeneralLoaderInWorld: self currentWorld" | window aFileList buttons treePane textColor1 fileListPane pane2a pane2b fileTypeInfo fileTypeButtons fileTypeRow actionRow | fileTypeInfo := self endingSpecs. window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new directory: FileDirectory default. aFileList fileSelectionBlock: self projectOnlySelectionBlock; modalView: window. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1 px; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners. fileTypeButtons := fileTypeInfo collect: [ :each | (self blueButtonText: each first textColor: Color gray inWindow: window) setProperty: #enabled toValue: true; hResizing: #shrinkWrap; useSquareCorners ]. buttons := {{'OK'. Color lightGreen}. {'Cancel'. Color lightRed}} collect: [ :each | self blueButtonText: each first textColor: textColor1 color: each second inWindow: window ]. treePane := aFileList morphicDirectoryTreePane extent: 250 px @ 300 px; retractable: false; borderWidth: 0. fileListPane := aFileList morphicFileListPane extent: 350 px @ 300 px; retractable: false; borderWidth: 0. window addARow: {window fancyText: 'Find...' translated font: Preferences standardWindowTitleFont color: textColor1}. fileTypeRow := window addARowCentered: fileTypeButtons cellInset: 2 px. actionRow := window addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second } cellInset: 2 px. window addARow: { (window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2a fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). pane2b fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35)." buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]." fileTypeButtons do: [ :each | each on: #mouseUp send: #value:value: to: [ :evt :morph | self update: actionRow in: window fileTypeRow: fileTypeRow morphUp: morph. ] ]. buttons first on: #mouseUp send: #okHit to: aFileList. buttons second on: #mouseUp send: #cancelHit to: aFileList. aFileList postOpen. window position: aWorld topLeft + (aWorld extent - window extent // 2). aFileList directoryChangeBlock: [ :newDir | self update: actionRow in: window fileTypeRow: fileTypeRow morphUp: nil. self enableTypeButtons: fileTypeButtons info: fileTypeInfo forDir: newDir. ]. aFileList directory: aFileList directory. window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window openInWorld: aWorld.! !!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'!morphicViewProjectLoader2InWorld: aWorld reallyLoad: aBoolean dirFilterType: aSymbol | window aFileList buttons treePane textColor1 fileListPane pane2a pane2b treeExtent filesExtent | window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new. aFileList optionalButtonSpecs: aFileList servicesForProjectLoader; fileSelectionBlock: ( aSymbol == #limitedSuperSwikiDirectoryList ifTrue: [ MessageSend receiver: Project current selector: #latestProjectVersionsFromFileEntries: ] ifFalse: [ self projectOnlySelectionBlock ] ); "dirSelectionBlock: self hideSqueakletDirectoryBlock;" modalView: window. aFileList directory: FileDirectory default. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1 px; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners. buttons := {{'OK'. Color lightGreen}. {'Cancel'. Color lightRed}} collect: [ :each | self blueButtonText: each first textColor: textColor1 color: each second inWindow: window ]. aWorld width < 800 px ifTrue: [ treeExtent := 150 px @ 300 px. filesExtent := 350 px @ 300 px. ] ifFalse: [ treeExtent := 350 px @ 500 px. filesExtent := 550 px @500 px. ]. (treePane := aFileList morphicDirectoryTreePaneFiltered: aSymbol) extent: treeExtent; retractable: false; borderWidth: 0. fileListPane := aFileList morphicFileListPane extent: filesExtent; retractable: false; borderWidth: 0. window addARow: { window fancyText: 'Load A Project' translated font: Preferences standardWindowTitleFont color: textColor1 }; addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second }; addARow: { window fancyText: 'Please select a project' translated font: Preferences standardButtonFont color: textColor1 }; addARow: { (window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2a fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). pane2b fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35)." buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]." buttons first on: #mouseUp send: (aBoolean ifTrue: [#okHitForProjectLoader] ifFalse: [#okHit]) to: aFileList. buttons second on: #mouseUp send: #cancelHit to: aFileList. aFileList postOpen. window position: aWorld topLeft + (aWorld extent - window extent // 2). window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window openInWorld: aWorld.! !!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'!morphicViewProjectSaverFor: aProject"(FileList2 morphicViewProjectSaverFor: Project current) openInWorld" | window aFileList buttons treePane pane2 textColor1 option treeExtent buttonData buttonRow | textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new directory: ServerDirectory projectDefaultDirectory. aFileList dirSelectionBlock: self hideSqueakletDirectoryBlock. window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. aFileList modalView: window. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners. buttonData := Preferences enableLocalSave ifTrue: [{ {'Save'. #okHit. 'Save in the place specified below, and in the Squeaklets folder on your local disk'. Color lightGreen}. {'Save on local disk only'. #saveLocalOnlyHit. 'saves in the Squeaklets folder'. Color lightGreen}. {'Cancel'. #cancelHit. 'return without saving'. Color lightRed} }] ifFalse: [{ {'Save'. #okHit. 'Save in the place specified below, and in the Squeaklets folder on your local disk'. Color lightGreen}. {'Cancel'. #cancelHit. 'return without saving'. Color lightRed} }]. buttons := buttonData collect: [ :each | (self blueButtonText: each first textColor: textColor1 color: each fourth inWindow: window) setBalloonText: each third translated; hResizing: #shrinkWrap; on: #mouseUp send: each second to: aFileList ]. option := aProject world valueOfProperty: #SuperSwikiPublishOptions ifAbsent: [#initialDirectoryList]. aProject world removeProperty: #SuperSwikiPublishOptions. treeExtent := Project current world height < 500 px ifTrue: [ 350 px @ 150 px ] ifFalse: [ 350 px @ 300 px ]. (treePane := aFileList morphicDirectoryTreePaneFiltered: option) extent: treeExtent; retractable: false; borderWidth: 0. window addARowCentered: { window fancyText: 'Publish This Project' translated font: Preferences standardWindowTitleFont color: textColor1 }. buttonRow := OrderedCollection new. buttons do: [:button | buttonRow add: button] separatedBy: [buttonRow add: ((Morph new extent: 30 px @ 5 px) color: Color transparent)]." addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second. (Morph new extent: 30 px@ 5 px) color: Color transparent. buttons third };" window addARowCentered: buttonRow; addARowCentered: { (window inAColumn: {(ProjectViewMorph on: aProject) lock}) layoutInset: 4 px}; addARowCentered: { window fancyText: 'Please select a folder' translated font: Preferences standardButtonFont color: textColor1 }; addARow: { ( window inAColumn: { (pane2 := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) } ) layoutInset: 10 px }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2 fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35)." buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]." window morphicLayerNumber: window class dialogLayer. aFileList postOpen. window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window ! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:52'!defaultsQuadsDefiningStackToolsFlap "Answer a structure defining the items on the default system Stack Tools flap. previously in quadsDefiningStackToolsFlap" ^ { {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}. {#StackMorph. #stackHelpWindow. 'Stack Help' translatedNoop. 'Some hints about how to use Stacks' translatedNoop}. {#TextMorph . #authoringPrototype. 'Simple Text' translatedNoop. 'Text that you can edit into anything you wish' translatedNoop}. {#TextMorph . #fancyPrototype. 'Fancy Text' translatedNoop. 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop}. {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}. {#StackMorph. #previousCardButton. 'Previous Card' translatedNoop. 'A button that takes the user to the previous card in the stack' translatedNoop}. {#StackMorph. #nextCardButton. 'Next Card' translatedNoop. 'A button that takes the user to the next card in the stack' translatedNoop} } asOrderedCollection! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:52'!defaultsQuadsDefiningSuppliesFlap "Answer a list of quads which define the objects to appear in the default Supplies flap. previously in quadsDefiningSuppliesFlap" ^ { {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}. {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}. {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}. {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}. {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}. {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}. {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}. {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}. {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}. {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}. {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}. {#TabbedPalette. #authoringPrototype. 'TabbedPalette' translatedNoop. 'A structure with tabs' translatedNoop}. {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}. {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}. {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}. {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}} asOrderedCollection! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 14:38'!defaultsQuadsDefiningToolsFlap "Answer a structure defining the default Tools flap. previously in quadsDefiningToolsFlap" ^ OrderedCollection new addAll: #( (Browser prototypicalToolWindow 'Browser' 'A Browser is a tool that allows you to view all the code of all the classes in the system') (TranscriptStream openMorphicTranscript 'Transcript' 'A Transcript is a window usable for logging and debugging; browse references to #Transcript for examples of how to write to it.') (Workspace prototypicalToolWindow 'Workspace' 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.')); add: { FileList2 . #prototypicalToolWindow. 'File List'. 'A File List is a tool for browsing folders and files on disks and FTP servers.' }; addAll: #( (DualChangeSorter prototypicalToolWindow 'Change Sorter' 'Shows two change sets side by side') (SelectorBrowser prototypicalToolWindow 'Method Finder' 'A tool for discovering methods by providing sample values for arguments and results') (MessageNames prototypicalToolWindow 'Message Names' 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.') (PreferencesBrowser prototypicalToolWindow 'Preferences' 'Allows you to control numerous options') (Utilities recentSubmissionsWindow 'Recent' 'A message browser that tracks the most recently-submitted methods') (ProcessBrowser prototypicalToolWindow 'Processes' 'A Process Browser shows you all the running processes') (PackagePaneBrowser prototypicalToolWindow 'Packages' 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"') (ChangeSorter prototypicalToolWindow 'Change Set' 'A tool that allows you to view and manipulate all the code changes in a single change set')); yourself! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:53'!defaultsQuadsDefiningWidgetsFlap "Answer a structure defining the default Widgets flap. previously in quadsDefiningWidgetsFlap" ^ #( (TrashCanMorph new 'Trash' 'A tool for discarding objects') (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there') (GeeMailMorph new 'Gee-Mail' 'A place to present annotated content') (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.') (FrameRateMorph authoringPrototype 'FrameRate' 'An indicator of how fast your system is running') (MagnifierMorph newRound 'Magnifier' 'A magnifying glass') (ObjectsTool newStandAlone 'ObjectCatalog' 'A tool that lets you browse the catalog of objects') ) asOrderedCollection! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:50'!initializeFlapsQuads "initialize the list of dynamic flaps quads. self initializeFlapsQuads" FlapsQuads := nil. self registeredFlapsQuads at: 'Stack Tools' put: self defaultsQuadsDefiningStackToolsFlap; at: 'Supplies' put: self defaultsQuadsDefiningSuppliesFlap; at: 'Tools' put: self defaultsQuadsDefiningToolsFlap; at: 'Widgets' put: self defaultsQuadsDefiningWidgetsFlap. ^ self registeredFlapsQuads! !!Flaps class methodsFor: 'new flap' stamp: 'mt 8/4/2023 14:02'!addLocalFlap: anEvent titled: title onEdge: edge | flapTab menu world | flapTab := self newFlapTitled: title onEdge: edge. (world := anEvent hand world) addMorphFront: flapTab. menu := flapTab buildHandleMenu: anEvent hand. flapTab addTitleForHaloMenu: menu. flapTab computeEdgeFraction. menu popUpEvent: anEvent in: world.! !!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 8/10/2023 11:29'!addStandardFlaps "Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed. " SharedFlapTabs ifNil: [SharedFlapTabs := OrderedCollection new]. SharedFlapTabs add: self newSqueakFlap. SharedFlapTabs add: self newSuppliesFlap. SharedFlapTabs add: self newToolsFlap. SharedFlapTabs add: self newWidgetsFlap. SharedFlapTabs add: self newStackToolsFlap. Preferences showProjectNavigator ifTrue:[SharedFlapTabs add: self newNavigatorFlap]. SharedFlapTabs add: self newObjectsFlap. self disableGlobalFlapWithID: 'Stack Tools' translated. Preferences showProjectNavigator ifTrue:[self disableGlobalFlapWithID: 'Navigator' translated]. ^ SharedFlapTabs! !!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 7/31/2023 11:11'!newSqueakFlap "Answer a new default 'Squeak' flap for the left edge of the screen" | aFlap aFlapTab aButton aClock buttonColor anOffset bb aFont | aFlap := PasteUpMorph newSticky borderWidth: 0. aFlapTab := FlapTab new referent: aFlap. aFlapTab setName: 'Squeak' translated edge: #left color: Color brown lighter lighter. aFlapTab position: (0 @ ((Display height - aFlapTab height) // 2)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. aFlap cellInset: 14@14. aFlap beFlap: true. aFlap color: (Color brown muchLighter lighter "alpha: 0.3"). aFlap extent: 150 @ self currentWorld height. aFlap layoutPolicy: TableLayout new. aFlap wrapCentering: #topLeft. aFlap layoutInset: 2. aFlap listDirection: #topToBottom. aFlap wrapDirection: #leftToRight. "self addProjectNavigationButtonsTo: aFlap." anOffset := 16. aClock := ClockMorph newSticky. aClock color: Color red. aClock showSeconds: false. aClock font: (TextStyle default fontAt: 3). aClock step. aClock setBalloonText: 'The time of day. If you prefer to see seconds, check out my menu.' translated. aFlap addCenteredAtBottom: aClock offset: anOffset. buttonColor := Color cyan muchLighter. bb := SimpleButtonMorph new target: Smalltalk. bb color: buttonColor. aButton := bb copy. aButton actionSelector: #saveSession. aButton setBalloonText: 'Make a complete snapshot of the current state of the image onto disk.' translated. aButton label: 'save' translated font: (aFont := Preferences standardButtonFont). aFlap addCenteredAtBottom: aButton offset: anOffset. aButton := bb copy target: MCMcmUpdater. aButton actionSelector: #updateFromServer. aButton label: 'load code updates' translated font: aFont. aButton color: buttonColor. aButton setBalloonText: 'Check the Squeak server for any new code updates, and load any that are found.' translated. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton := SimpleButtonMorph new target: Smalltalk; actionSelector: #aboutThisSystem; label: 'about this system' translated font: aFont. aButton color: buttonColor. aButton setBalloonText: 'click here to find out version information' translated. aFlap addCenteredAtBottom: aButton offset: anOffset. aFlap addCenteredAtBottom: (Preferences themeChoiceButtonOfColor: buttonColor font: aFont) offset: anOffset. aButton := TrashCanMorph newSticky. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton startStepping. ^ aFlapTab"Flaps replaceGlobalFlapwithID: 'Squeak' translated "! !!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 8/28/2023 14:29'!newSuppliesFlapFromQuads: quads positioning: positionSymbol "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen. Use #center as the positionSymbol to have it centered at the bottom of the screen, or #right to have it placed off near the right edge." | aFlapTab aStrip hPosition | aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: quads. "self twiddleSuppliesButtonsIn: aStrip." aFlapTab := FlapTab new referent: aStrip beSticky. aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter. hPosition := positionSymbol == #center ifTrue: [(Display width // 2) - (aFlapTab width // 2)] ifFalse: [Display width - (aFlapTab width + 22)]. aFlapTab position: (hPosition @ (self currentWorld height - aFlapTab height)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. aStrip extent: self currentWorld width @ 136. aStrip beFlap: true. aStrip autoLineLayout: true. ^ aFlapTab"Flaps replaceGlobalFlapwithID: 'Supplies' translated"! !!Flaps class methodsFor: 'replacement' stamp: 'mt 8/4/2023 15:19'!replaceGlobalFlapwithID: flapID "If there is a global flap with flapID, replace it with an updated one." | replacement tabs | (tabs := self globalFlapTabsWithID: flapID) size = 0 ifTrue: [^ self]. tabs do: [:tab | self removeFlapTab: tab keepInList: false]. flapID = 'Stack Tools' translated ifTrue: [replacement := self newStackToolsFlap]. flapID = 'Supplies' translated ifTrue: [replacement := self newSuppliesFlap]. flapID = 'Tools' translated ifTrue: [replacement := self newToolsFlap]. flapID = 'Widgets' translated ifTrue: [replacement := self newWidgetsFlap]. flapID = 'Navigator' translated ifTrue: [replacement := self newNavigatorFlap]. flapID = 'Squeak' translated ifTrue: [replacement := self newSqueakFlap]. replacement ifNil: [^ self]. self addGlobalFlap: replacement. self currentWorld ifNotNil: [self currentWorld addGlobalFlaps]"Flaps replaceFlapwithID: 'Widgets' translated "! !!FontSubstitutionDuringLoading methodsFor: 'accessing' stamp: 'mt 8/11/2023 13:59'!defaultAction familyName ifNil: [ familyName := 'NoName' ]. pixelSize ifNil: [ pixelSize := 12 ]. ^((familyName beginsWith: 'Comic') ifTrue: [ TextStyle named: (Preferences standardDefaultTextFont familyName) ] ifFalse: [ TextStyle default ]) fontOfSize: pixelSize.! !!Form methodsFor: 'converting' stamp: 'mt 8/16/2023 16:54'!blendColor: aTranslucentColor | form canvas | form := self deepCopy asFormOfDepth: 32. canvas := form getCanvas. canvas stencil: form at: 0 @ 0 sourceRect: (0 @ 0 extent: form extent) color: aTranslucentColor. ^ canvas form! !!Form methodsFor: 'scaling, rotation' stamp: 'sw 4/16/2008 00:13'!scaledToHeight: newHeight "Answer the receiver, scaled such that it has the desired height." newHeight = self height ifTrue: [^ self]. ^self magnify: self boundingBox by: (newHeight / self height) smoothing: 2.! !!Form methodsFor: 'scaling, rotation' stamp: 'ct 9/17/2019 18:50'!scaledToWidth: newWidth "Answer the receiver, scaled such that it has the desired width." newWidth = self width ifTrue: [^ self]. ^self magnify: self boundingBox by: (newWidth / self width) smoothing: 2.! !!Form class methodsFor: '*MorphicExtras-examples' stamp: 'mt 8/14/2023 16:21'!gridFormExample "Original was in Morph
#setStandardTexture and #textureParameters and #makeGraphPaperGrid:... Morph new color: Form gridFormExample; extent: 500@500; openInHand " ^ self gridFormOrigin: 0@0 grid: 16 px background: Color black line: Color lightGreen lighter lighter ! !!Form class methodsFor: '*MorphicExtras-sprites' stamp: 'mt 8/14/2023 16:20'!gridFormOrigin: origin grid: smallGrid background: backColor line: lineColor | bigGrid gridForm gridOrigin | gridOrigin := origin \ smallGrid. bigGrid := (smallGrid asPoint x) @ (smallGrid asPoint y). gridForm := Form extent: bigGrid depth: Display depth. backColor ifNotNil: [gridForm fillWithColor: backColor]. gridOrigin x to: gridForm width by: smallGrid asPoint x do: [:x | gridForm fill: (x@0 extent: 1@gridForm height) fillColor: lineColor]. gridOrigin y to: gridForm height by: smallGrid asPoint y do: [:y | gridForm fill: (0@y extent: gridForm width@1) fillColor: lineC
olor]. ^ InfiniteForm with: gridForm! !!GetTextExporter class methodsFor: 'utilities' stamp: 'mt 8/4/2023 13:49'!listAllHelp "self listAllHelp" | spec specs oCatalog flap flapSelectors allKeys oCatalogHelp flapHelp | oCatalog := Dictionary new. Morph withAllSubclasses do: [:aClass | (aClass class includesSelector: #descriptionForPartsBin) ifTrue: [spec := aClass descriptionForPartsBin. oCatalog at: spec formalName put: spec documentation]]. Morph withAllSubclasses do: [:aClass | (aClass class includesSelector: #supplementaryPartsDescriptions) ifTrue: [specs := aClass supplementaryPartsDescriptions. specs do: [:each | oCatalog at: each formalName put: each documentation]]]. flap := Dictionary new. flapSelectors := #( #defaultsQuadsDefiningStackToolsFlap #defaultsQuadsDefiningSuppliesFlap #defaultsQuadsDefiningToolsFlap #defaultsQuadsDefiningWidgetsFlap ). flapSelectors do: [:selector | specs := Flaps perform: selector. specs do: [:each | flap at: each third put: each fourth]]. allKeys := oCatalog keys intersection: flap keys. allKeys asArray sort do: [:each | oCatalogHelp := oCatalog at: each ifAbsent: ['']. flapHelp := flap at: each ifAbsent: ['']. oCatalogHelp = flapHelp ifFalse: [Transcript cr; show: 'Name: ' , each. Transcript cr; show: 'O: ' , oCatalogHelp. Transcript cr; show: 'F: ' , flapHelp. Transcript cr.]]! !!ImageSegment methodsFor: 'fileIn' stamp: 'mt 8/16/2023 16:51'!declareAndPossiblyRename: classThatIsARoot | existing catInstaller | "The class just arrived in this segment. How fit it into the Smalltalk dictionary? If it had an association, that was ins talled with associationDeclareAt:." catInstaller := [ classThatIsARoot category: Object categoryForUniclasses. ]. classThatIsARoot superclass addSubclass: classThatIsARoot. (Smalltalk includesKey: classThatIsARoot name) ifFalse: [ "Class entry in Smalltalk not referred to in Segment, install anyway." catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. existing := Smalltalk at: classThatIsARoot name. existing xxxClass == ImageSegmentRootStub ifTrue: [ "We are that segment!! Must ask it carefully!!" catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. existing == false | (existing == nil) ifTrue: [ "association is in outPointers, just installed" catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. "Conflict with existing global or copy of the class" (existing isKindOf: Class) ifTrue: [ classThat IsARoot isSystemDefined not ifTrue: [ "UniClass. give it a new name" classThatIsARoot setName: MorphicModel chooseUniqueClassName. catInstaller value. "must be after new name" ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. "Take the incoming one" self inform: 'Using newly arrived version of ', classThatIsARoot name. classThatIsARoot superclass removeSubclass: classThatIsARoot. "just in case" (Smalltalk at: classThatIsARoot name) becomeForward: classThatIsARoot. catInstaller value. ^ classThatIsARoot superclass addSubclass: classThatIsARoot]. self error: 'Name already in use by a non-class: ', classThatIsARoot name.! !!ImageSegment class methodsFor: 'fileIn/Out' stamp: 'mt 8/28/2023 15:10'!copyFromRootsLocalFileFor: rootArray sizeHint: segSize ^ NativeImageSegment new copyFromRootsLocalFileFor: rootArray sizeHint: segSize! !!Inspector methodsFor: 'menu' stamp: 'mt 8/28/202 3 14:33'!inspectorKey: aChar from: view "Respond to a Command key issued while the cursor is over my field list" ^ aChar caseOf: { [$x] -> [self removeSelection]. [$i] -> [self inspectSelection]. [$I] -> [self exploreSelection]. [$b] -> [self browseClass]. [$h] -> [self browseClassHierarchy]. [$p] -> [self browseFullProtocol]. [$r] -> [self browseVariableReferences]. [$a] -> [self browseVariableAssignments]. [$N] -> [self browseClassRefs]. [$c] -> [self copyName] } otherwise: [self arrowKey: aChar from: view]! !!Inspector methodsFor: 'menu' stamp: 'mt 3/10/2023 15:12'!mainFieldListMenu: aMenu "Arm the supplied menu with items for the field-list of the receiver" <fieldListMenu> aMenu addStayUpItemSpecial. self addObjectItemsTo: aMenu. (#(self ellipsis element nil) includes: self typeOfSelection) ifTrue: [self addCollectionItemsTo: aMenu]. self typeOfSelection = #instVar ifTrue: [self addInstVarItemsTo: aMenu]. self addFieldItemsTo: aMenu. self addClassItemsTo: aMenu. ^ aMenu! !!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 7/31/2023 10:45'!formAtKey: aString "Answer the form saved under the given key" ^(Symbol lookup: aString) ifNotNil: [ :aKey | ScriptingIcons at: aKey ifAbsent: [ self blankIcon ] ] ifNil: [ self blankIcon ]! !!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:08'!formPressedAtKey: aSymbol "Answer the form for pressed button. It is automatically generated if unavailable." "(ScriptingSystem formPressedAtKey: #TryIt) asMorph openInHand" | pressedName pressedImage | pressedName := (aSymbol , 'Pressed') asSymbol. ((ScriptingIcons includesKey: aSymbol) and: [(ScriptingIcons includesKey: pressedName) not])
ifTrue: [pressedImage := ((self formAtKey: aSymbol) blendColor: (Color black alpha: 0.3)) colorReduced. ScriptingIcons at: pressedName put: pressedImage]. ^ self formAtKey: pressedName! !!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:11'!saveForm: aForm atKey: aKey ScriptingIcons at: aKey asSymbol put: aForm! !!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:05'!scriptingIcons ^ ScriptingIcons ifNil: [ScriptingIcons := IdentityDictionary new]! !!MessageSet methodsFor: 'filtering' stamp: 'mt 8/28/2023 15:11'!filterMessageList "Allow the user to refine the list of messages." | builder menuSpec | builder := ToolBuilder default. menuSpec := builder pluggableMenuSpec new model: self; yourself. menuSpec addList: #( ('unsent messages' filterToUnsentMessages 'filter to show only messages that have no senders') - ('messages that send...' filterToSendersOf 'filter to show only messages that send a selector I specify') ('messages that do not send...' filterToNotSendersOf 'filter to show only messages that do not send a selector I specify') - ('messages whose selector is...' filterToImplementorsOf 'filter to show only messages with a given selector I specify') ('messages whose selector is NOT...' filterToNotImplementorsOf 'filter to show only messages whose selector is NOT a seletor I specify') - ('messages in current change set' filterToCurrentChangeSet 'filter to show only messages that are in the current change set') ('messages not in current change set' filterToNotCurrentChangeSet 'filter to show only messages that are not in the current change set') - ('messages in any change set' filterToAnyChangeSet 'filter to show only messages that occur in at least one change set') ('messages not in any change set' filterToNotAnyChangeSet 'filter to show only messages that do not occur in any change set in the system') - ('messages authored by me' filterToCurrentAuthor 'filter to show only messages whose authoring stamp has my initials') ('messages not authored by me' filterToNotCurrentAuthor 'filter to show only messages whose authoring stamp does not have my initials') - ('messages logged in .changes file' filterToMessagesInChangesFile 'filter to show only messages whose latest source code is logged in the .changes file') ('messages only in .sources file' filterToMessagesInSourcesFile 'filter to show only messages whose latest source code is logged in the .sources file') - ('messages with prior versions' filterToMessagesWithPriorVersions 'filter to show only messages that have at least one prior version') ('messages without prior versions' filterToMessagesWithoutPriorVersions 'filter to show only messages that have no prior versions') - ('uncom mented messages' filterToUncommentedMethods 'filter to show only messages that do not have comments at the beginning') ('commented messages' filterToCommentedMethods 'filter to show only messages that have comments at the beginning') - ('messages in hardened classes' filterToMessagesWithHardenedClasses 'filter to show only messages of established classes (as opposed to Uniclasses such as MorphicModel23)') - ('methods in classes with matching names' filterToMatchingClassesNames 'filter to show only methods of classes with names that match the given criteria (wildcards are allowed)') ('methods in package...' filterToPackage 'filter to show only methods of a given package') ('methods not in package...' filterToNotPackage 'filter to show only methods not of a given package') - ('messages that...' filterToMessagesThat 'let me type in a block taking a class and a selector, which will specify yea or nay concerning which element s should remain in the list')). builder runModal: (builder open: menuSpec).! !!Lexicon methodsFor: 'toolbuilder' stamp: 'mt 7/31/2023 11:13'!addSpecialButtonsTo: buttonPanelSpec with: builder | homeCatBtnSpec menuBtnSpec mostGenericBtnSpec | homeCatBtnSpec := builder pluggableButtonSpec new model: self; action: #showHomeCategory; label: MenuIcons smallHomeIcon scaleIconToDisplay; help: 'show this method''s home category'; yourself. menuBtnSpec := builder pluggableButtonSpec new model: self; action: #offerMenu; label: (MenuIcons formAtKey: #TinyMenu) asMorph; help: 'click here to get a menu with further options'; yourself. mostGenericBtnSpec :=builder pluggableButtonSpec new model: self; action: #chooseLimitClass; label: #limitClassString; help: 'Governs which classes'' methods should be shown. If this is the same as the viewed class, then only methods implemented in that c lass will be shown. If it is ProtoObject, then methods of all classes in the vocabulary will be shown.'. buttonPanelSpec children add: homeCatBtnSpec; addFirst: mostGenericBtnSpec; addFirst: menuBtnSpec.! !!InstanceBrowser methodsFor: 'menu commands' stamp: 'mt 8/16/2023 16:52'!offerMenu "Offer a menu to the user, in response to the hitting of the menu button on the tool pane" | aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu title: ('Messages of {1}' translated format: {objectViewed nameForViewer}). aMenu addStayUpItem. aMenu addTranslatedList: #( ('vocabulary...' chooseVocabulary) ('what to show...' offerWhatToShowMenu) - ('inst var refs (here)' setLocalInstVarRefs) ('inst var defs (here)' setLocalInstVarDefs) ('class var refs (here)' setLocalClassVarRefs) - ('navigate to a sender...' navigateToASender) ('recent...'
navigateToRecentMethod) ('show methods in current change set' showMethodsInCurrentChangeSet) ('show methods with initials...' showMethodsWithInitials) - "('toggle search pane' toggleSearch)" - - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' browseClassHierarchy) ('browse protocol (p)' browseFullProtocol) - ('fileOut' fileOutMessage) ('printOut' printOutMessage) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('versions (v)' browseVersions) ('inheritance (i)' methodHierarchy) - ('references... (r)' browseVariableReferences) ('assignments... (a)' browseVariableAssignments) - ('inspector on me' inspectViewee) - ('more...' shiftedYellowButtonActivity)). ^ aMenu popUpInWorld: self currentWorld! !!MethodCall methodsFor: 'initialization' stamp: 'mt 8/28/2023 14:54'!receiver: aReceiver methodInterface: aMethodInterface "Initialize me to have the given receiver and methodInterface" receiver := aReceiver. selector := aMethodInterface selector. methodInterface := aMethodInterface. arguments := aMethodInterface defaultArguments. lastValue := nil.! !!MethodFinder methodsFor: 'initialize' stamp: 'mt 3/10/2023 15:58'!initialize "The methods we are allowed to use. (MethodFinder new initialize) " Approved := Set new. AddAndRemove := Set new. Blocks := Set new. "These modify an argument and are not used by the MethodFinder: longPrintOn: printOn: storeOn: sentTo: storeOn:base: printOn:base: absPrintExactlyOn:base: absPrintOn:base: absPrintOn:base:digitCount: writeOn: writeScanOn: possibleVariablesFor:continuedFrom: printOn:format:""Object" #("in class, instance creation" categoryForUniclasses chooseUniqueClassName initialInstance isSystemDefined newFrom: officialClass readCarefullyFrom:"accessing" at: basicAt: basicSize bindWithTemp: in: size yourself "testing" basicType ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: isColor isFloat isFraction isInMemory isInteger isMorph isNil isNumber isPoint isText isTransparent isWebBrowser knownName notNil pointsTo: wantsSteps "comparing" = == closeTo: hash identityHash identityHashPrintString ~= ~~ "copying" copy shallowCopy "dependents access" canDiscardEdits dependents hasUnacceptedEdits "updating" changed changed: okToChange update: windowIsClosing "printing" fullPrintString isLiteral longPrintString printString storeString stringForReadout stringRepresentation "class membership" class isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass "error han dling" "user interface" addModelMenuItemsTo:forMorph:hand: defaultLabelForInspector fullScreenSize initialExtent modelWakeUp mouseUpBalk: newTileMorphRepresentative windowActiveOnFirstClick windowReqNewLabel: "system primitives" asOop instVarAt: instVarNamed: "private" "associating" -> "converting" as: asOrderedCollection asString "casing" caseOf: caseOf:otherwise: "binding" bindingOf: "macpal" contentsChanged currentEvent currentHand currentWorld flash instanceVariableValues "flagging" flag: "translation support" "objects from disk" "finalization" ) do: [:sel | Approved add: sel]. #(at:add: at:modify: at:put: basicAt:put: "NOT instVar:at:""message handling" perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: ) do: [:sel | AddAndRemove add: sel]."Boolean, True, False, UndefinedObject" #("logical operations" & eqv: not xor: |"controlling" and: ifFalse: ifFalse:ifTrue: ifTrue: ifTrue:ifF alse: or:"copying" "testing" isEmptyOrNil) do: [:sel | Approved add: sel]."Behavior" #("initialize-release""accessing" compilerClass decompilerClass evaluatorClass format methodDict parserClass sourceCodeTemplate subclassDefinerClass"testing" instSize instSpec isBits isBytes isFixed isPointers isVariable isWeak isWords"copying""printing" printHierarchy"creating class hierarchy""creating method dictionary""instance creation" basicNew basicNew: new new:"accessing class hierarchy" allSubclasses allSubclassesWithLevelDo:startingLevel: allSuperclasses subclasses superclass withAllSubclasses withAllSuperclasses"accessing method dictionary" allSelectors changeRecordsAt: compiledMethodAt: compiledMethodAt:ifAbsent: firstCommentAt: lookupSelector: selectors selectorsDo: selectorsWithArgs: "slow but useful ->" sourceCodeAt: sourceCodeAt:ifAbsent: sourceMethodAt: sourceMethodAt:ifAbsent:"accessing instances and variables" allClassVarNames allInstVarNames allSharedPools classVarNames instV arNames instanceCount sharedPools someInstance subclassInstVarNames"testing class hierarchy" inheritsFrom: kindOfSubclass"testing method dictionary" canUnderstand: classThatUnderstands: hasMethods includesSelector: whichClassIncludesSelector: whichSelectorsAccess: whichSelectorsReferTo: whichSelectorsReferTo:special:byte: whichMethodsStoreInto:"enumerating""user interface") do: [:sel | Approved add: sel]."ClassDescription" #("initialize-release" "accessing" classVersion isMeta name theNonMetaClass"copying" "printing" classVariablesString instanceVariablesString sharedPoolsString"instance variables" checkForInstVarsOK: "method dictionary" "organization" category organization whichCategoryIncludesSelector:"compiling" acceptsLoggingOfCompilation wantsChangeSetLogging"fileIn/Out" definition"private" ) do: [:sel | Approved add: sel]."Class" #("initialize-release" "accessing" classPool"testing""copying" "class name" "instance variables" "class variables" classVarAt: classVariableAssociationAt:"pool variables" "compiling" "subclass creation" "fileIn/Out" ) do: [:sel | Approved add: sel]. "Metaclass" #("initialize-release" "accessing" isSystemDefined soleInstance"copying" "instance creation" "instance variables" "pool variables" "class hierarchy" "compiling""fileIn/Out" nonTrivial ) do: [:sel | Approved add: sel]."Context, BlockContext" #(receiver client method receiver tempAt: "debugger access" pc selector sender shortStack sourceCode tempNames tempsAndValues"controlling" "printing" "system simulation" "initialize-release" "accessing" hasMethodReturn home numArgs"evaluating" value value:ifError: value:value: value:value:value: value:value:value:value: valueWithArguments:"controlling" "scheduling" "instruction decoding" "printing" "private" "system simulation" ) do: [:sel | Approved add: sel]. #(value: "<- Association has it as a store" ) do: [:sel | AddAndRemove add: sel]."Message" #("inclass, instance creation" select or: selector:argument: selector:arguments:"accessing" argument argument: arguments sends:"printing" "sending" ) do: [:sel | Approved add: sel]. #("private" setSelector:arguments:) do: [:sel | AddAndRemove add: sel]."Magnitude" #("comparing" < <= > >= between:and:"testing" max: min: min:max: ) do: [:sel | Approved add: sel]."Date, Time" #("in class, instance creation" fromDays: fromSeconds: fromString: newDay:month:year: newDay:year: today "in class, general inquiries" dateAndTimeNow dayOfWeek: daysInMonth:forYear: daysInYear: firstWeekdayOfMonth:year: indexOfMonth: leapYear: nameOfDay: nameOfMonth:"accessing" day leap monthIndex monthName weekday year"arithmetic" addDays: subtractDate: subtractDays:"comparing""inquiries" dayOfMonth daysInMonth daysInYear daysLeftInYear firstDayOfMonth previous:"converting" asSeconds"printing" mmddyyyy printFormat: "private" weekdayIndex "in class, instance creation" fromSeconds: now "in class, general inquiries" dateAndTimeFromSeconds: dateAndTimeNow millisecondClockValue millisecondsToRun: totalSeconds"accessing" hours minutes seconds"arithmetic" addTime: subtractTime:"comparing""printing" intervalString print24 "converting") do: [:sel | Approved add: sel]. #("private" ) do: [:sel | AddAndRemove add: sel]."Number" #("in class" readFrom:base: "arithmetic" * + - / // \ abs negated quo: reciprocal rem:"mathematical functions" arcCos arcSin arcTan arcTan: cos exp floorLog: ln log log: raisedTo: raisedToInteger: sin sqrt squared tan"truncation and round off" ceiling detentBy:atMultiplesOf:snap: floor roundTo: roundUpTo: rounded truncateTo: truncated"comparing""testing" even isDivisibleBy: isInfinite isNaN isZero negative odd positive sign strictlyPositive"converting" @ asInteger asNumber asPoint asSmallAngleDegrees degreesToRadians radiansToDegrees"intervals" to: to:by: "printing" printStringBase: storeStringBase: ) do: [:sel | Approved add: sel]."Integer" #("in class" primesUpTo:"testing" isPowerOfTwo"arithmetic" alignedTo:"comparing""truncation and round off" atRandom normalize"enumerating" timesRepeat:"mathematical functions" degreeCos degreeSin factorial gcd: lcm: take:"bit manipulation" << >> allMask: anyMask: bitAnd: bitClear: bitInvert bitInvert32 bitOr: bitShift: bitXor: lowBit noMask:"converting" asCharacter asColorOfDepth: asFloat asFraction asHexDigit"printing" asStringWithCommas hex hex8 radix:"system primitives" lastDigit replaceFrom:to:with:startingAt:"private" "benchmarks" ) do: [:sel | Approved add: sel]."SmallInteger, LargeNegativeInteger, LargePositiveInteger" #("arithmetic" "bit manipulation" highBit "testing" "comparing" "copying" "converting" "printing" "system primitives" digitAt: digitLength "private" fromString:radix: ) do: [:sel | Approved add: sel]. #(digitAt:put: ) do: [:sel | AddAndRemove add: sel]."Float" #("arithmetic""mathematical functions" reciprocalLogBase2 timesTwoPower:"comparing" "testing""trunc ation and round off" exponent fractionPart integerPart significand significandAsInteger"converting" asApproximateFraction asIEEE32BitWord asTrueFraction"copying") do: [:sel | Approved add: sel]."Fraction, Random" #(denominator numerator reduced next nextValue) do: [:sel | Approved add: sel]. #(setNumerator:denominator:) do: [:sel | AddAndRemove add: sel]."Collection" #("accessing" anyOne"testing" includes: includesAllOf: includesAnyOf: includesSubstringAnywhere: isEmpty isSequenceable occurrencesOf:"enumerating" collect: collect:thenSelect: count: detect: detect:ifNone: detectMax: detectMin: detectSum: inject:into: reject: select: select:thenCollect: intersection:"converting" asBag asCharacterSet asSet asSortedArray asSortedCollection asSortedCollection:"printing""private" maxSize"arithmetic""math functions" average max median min range sum) do: [:sel | Approved add: sel]. #("adding" add: addAll: addIfNotPresent:"removing" remove: remove:ifAbsent: removeAll: removeAllFo undIn: removeAllSuchThat: remove:ifAbsent:) do: [:sel | AddAndRemove add: sel]."SequenceableCollection" #("comparing" hasEqualElements:"accessing" allButFirst allButLast at:ifAbsent: atAll: atPin: atRandom: atWrap: fifth first fourth identityIndexOf: identityIndexOf:ifAbsent: indexOf: indexOf:ifAbsent: indexOf:startingAt:ifAbsent: indexOfSubCollection:startingAt: indexOfSubCollection:startingAt:ifAbsent: last second sixth third"removing""copying" , copyAfterLast: copyAt:put: copyFrom:to: copyReplaceAll:with: copyReplaceFrom:to:with: copyUpTo: copyUpToLast: copyWith: copyWithout: copyWithoutAll: forceTo:paddingWith: shuffled sorted:"enumerating" withIndexCollect: findFirst: findLast: pairsCollect: with:collect: withIndexCollect: polynomialEval:"converting" asArray asDictionary asFloat32Array asFloat64Array asIntegerArray asStringWithCr asWordArray reversed"private" copyReplaceAll:with:asTokens: ) do: [:sel | Approved add: sel]. #( swap:with:) do: [:sel | AddAndRemove add: sel]."ArrayedCollection, Bag" #("private" defaultElement "sorting" isSorted"accessing" cumulativeCounts sortedCounts sortedElements "testing" "adding" add:withOccurrences: "removing" "enumerating" ) do: [:sel | Approved add: sel]. #( mergeSortFrom:to:by: sort sort: add: add:withOccurrences:"private" setDictionary ) do: [:sel | AddAndRemove add: sel]."Other messages that modify the receiver" #(atAll:put: atAll:putAll: atAllPut: atWrap:put: replaceAll:with: replaceFrom:to:with: removeFirst removeLast) do: [:sel | AddAndRemove add: sel]. self initialize2."MethodFinder new initialize.MethodFinder new organizationFiltered: Set"! !!MissingFont methodsFor: 'handling' stamp: 'mt 3/7/2023 15:07'!defaultAction familyName ifNil: [ familyName := 'NoName' ]. pixelSize ifNil: [ pixelSize := 12 ]. ^((familyName beginsWith: 'Comic') ifTrue: [ TextStyle named: (Preferences standardButtonFont familyName) ] ifFalse: [ TextStyle default ]) fontOfSize: pixe lSize.! !!Morph methodsFor: 'accessing' stamp: 'mt 8/11/2023 16:29'!balloonText "Answer balloon help text or nil, if no help is available." "NB: subclasses may override such that they programatically construct the text, for economy's sake, such as model phrases in a Viewer." | balloonSelector | extension ifNil: [^ nil]. extension balloonText ifNotNil: [:balloonText | ^ balloonText]. balloonSelector := extension balloonTextSelector ifNil: [^ nil]. balloonSelector isUnary ifTrue: [ (self respondsTo: balloonSelector) ifTrue: [^ self perform: balloonSelector]. (self model respondsTo: balloonSelector) ifTrue: [^ self model perform: balloonSelector]]. ^ nil! !!Morph methodsFor: 'copying' stamp: 'mt 3/10/2023 14:51'!duplicate "Make and return a duplicate of the receiver" | newMorph aName w topRend | ((topRend := self topRendererOrSelf) ~~ self) ifTrue: [^ topRend duplicate]. self okayToDuplicate ifFalse: [^ self]. aName := (w := self world) ifNotNil: [w nameForCopyIfAlreadyNamed: self]. newMorph := self veryDeepCopy. aName ifNotNil: [newMorph setNameTo: aName]. newMorph arrangeToStartStepping. newMorph privateOwner: nil. "no longer in world" newMorph isPartsDonor: false. "no longer parts donor" ^ newMorph! !!Morph methodsFor: 'debug and other' stamp: 'mt 3/10/2023 15:09'!buildDebugMenu: aHand "Answer a debugging menu for the receiver. The hand argument is seemingly historical and plays no role presently" | aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu addStayUpItem. (self hasProperty: #errorOnDraw) ifTrue: [aMenu add: 'start drawing again' translated action: #resumeAfterDrawError. aMenu addLine]. (self hasProperty: #errorOnStep) ifTrue: [aMenu add: 'start stepping again' translated action: #resumeAfterStepError. aMenu addLine]. (self hasProperty: #errorOnLayout) ifTrue: [aMenu add: 'start layouting again' translated action: #resumeAfterLayoutError. aMenu addLine]. aMenu add: 'inspect morph' translated action: #inspectInMorphic:. aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain. Smalltalk isMorphic ifFalse: [aMenu add: 'inspect morph (in MVC)' translated action: #inspect]. self isMorphicModel ifTrue: [aMenu add: 'inspect model' translated target: self model action: #inspect; add: 'explore model' translated target: self model action: #explore]. aMenu add: 'explore morph' translated target: self selector: #exploreInMorphic:. aMenu addLine. aMenu add: 'browse morph class' translated target: self selector: #browseHierarchy. (self isMorphicModel) ifTrue: [aMenu add: 'browse model class' target: self model selector: #browseHierarchy]. aMenu addLine. self addViewingItemsTo: aMenu. aMenu add: 'make own subclass' translated action: #subclassMorph; add: 'save morph in file' translated action: #saveOnFile; addLine; add: 'call #tempCommand' translated action: #tempCommand; add: 'define #tempCommand' translated action: #defineTempCommand; addLine; add: 'control-menu...' translated target: self selector: #invokeMetaMenu:; add: 'edit balloon help' translated action: #editBalloonHelpText. ^ aMenu! !!Morph methodsFor: 'debug and other' stamp: 'mt 8/16/2023 17:11'!deleteAnyMouseActionIndicators self changed. (self valueOfProperty: #mouseActionIndicatorMorphs ifAbsent: [#()]) do: [ :each | each delete "one is probably enough, but be safe" ]. self removeProperty: #mouseActionIndicatorMorphs. self hasRolloverBorder: false. self removeProperty: #rolloverWidth. self removeProperty: #rolloverColor. self layoutChanged. self changed.! !!Morph methodsFor: 'dropping/grabbing' stamp: 'mt 8/4/2023 14:49'!justDroppedInto: aMorph event: anEvent "This message is sent to a dropped morph after it has been dropped on -- and been accepted by -- a drop-sensitive morph" | partsBinCase cmd | (self formerOwner notNil and: [self formerOwner ~~ aMorph]) ifTrue: [self removeHalo]. self formerOwner: nil. self formerPosition: nil. cmd := self valueOfProperty: #undoGrabCommand. cmd ifNotNil:[aMorph rememberCommand: cmd. self removeProperty: #undoGrabCommand]. (partsBinCase := aMorph isPartsBin) ifFalse: [self isPartsDonor: false]. (self isInWorld and: [partsBinCase not]) ifTrue: [self world startSteppingSubmorphsOf: self]. "Note an unhappy inefficiency here: the startStepping... call will often have already been called in the sequence leading up to entry to this method, but unfortunately the isPartsDonor: call often will not have already happened, with the result that the startStepping... call will not have resulted in the startage of the steppage."! !!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:54'!handleMouseDown: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseDown: and #mouseDown: in your custom morphs. See #handlerForMouseDown: and #mouseDownPriority." anEvent wasHandled ifTrue:[^self]. "not interested" anEvent hand removePendingBalloonFor: self. anEvent wasHandled: true. "Make me modal during mouse transitions" anEvent hand newMouseFocus: self event: anEvent. "this mouse down could be the start of a gesture, or the end of a gesture focus" (self isGestureStart: anEvent) ifTrue: [^ self gestureStart: anEvent]. self mouseDown: anEvent. (self handlesMouseStillDown: anEvent) ifTrue:[ self startStepping: #handleMouseStillDown: at: Time millisecondClockValue + self mouseStillDownThreshold arguments: {anEvent copy resetHandlerFields} stepTime: self mouseStillDownStepRate ].! !!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:54'!handleMouseEnter: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseOver: and #mouseEnter: in your custom morphs. Also see/use #handlesMouseOverDragging: and #mouseEnterDragging:." (anEvent isDraggingEvent) ifTrue:[ (self handlesMouseOverDragging: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseEnterDragging: anEvent]. ^self]. self wantsBalloon ifTrue:[anEvent hand triggerBalloonFor: self after: self balloonHelpDelayTime]. (self handlesMouseOver: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseEnter: anEvent. ].! !!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:55'!handleMouseLeave: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseOver: and #mouseLeave: in your custom morphs. Also see/ use #handlesMouseOverDragging: and #mouseLeaveDragging:." anEvent hand removePendingBalloonFor: self. anEvent isDraggingEvent ifTrue:[ (self handlesMouseOverDragging: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseLeaveDragging: anEvent]. ^self]. (self handlesMouseOver: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseLeave: anEvent. ].! !!Morph methodsFor: 'halos and balloon help' stamp: 'mt 8/14/2023 15:59'!addHandlesTo: aHaloMorph box: box "Add halo handles to the halo. Apply the halo filter if appropriate." aHaloMorph haloBox: box. Preferences haloSpecifications do: [:aSpec | (self wantsHaloHandleWithSelector: aSpec addHandleSelector inHalo: aHaloMorph) ifTrue: [aHaloMorph perform: aSpec addHandleSelector with: aSpec]]. aHaloMorph innerTarget addOptionalHandlesTo: aHaloMorph box: box! !!Morph methodsFor: 'halos and balloon help' stamp: 'mt 8/11/2023 16:50'!balloonHelpTextForHandle: aHandle "Answer a string providing balloon help for the given halo handle" | itsSelector | itsSelector := aHandle eventHandler firstMouseSelector. itsSelector == #doRecolor:with: ifTrue: [^ 'Change color']. itsSelector == #mouseDownInDimissHandle:with: ifTrue: [^ TrashCanMorph preserveTrash ifTrue: ['Move to trash'] ifFalse: ['Remove from screen']]. #(#(#addFullHandles 'More halo handles') #(#addSimpleHandles 'Fewer halo handles') #(#chooseEmphasisOrAlignment 'Emphasis & alignment') #(#chooseFont 'Change font') #(#chooseStyle 'Change style') #(#dismiss 'Remove') #(#doDebug:with: 'Debug') #(#doDirection:with: 'Choose forward direction') #(#doDup:with: 'Duplicate') #(#doMenu:with: 'Menu') #(#doGrab:with: 'Pick up') #(#editButtonsScript 'See the script for this button') #(#editDrawing 'Repaint') #(#mouseDownInCollapseHandle:with: 'Collapse') #(#mouseDownOnHelpHandle: 'Help') #(#paintBackground 'Paint background') #(#prepareToTrackCenterOfRotation:with: 'Move object or set center of rotation') #(#presentViewMenu 'Present the Viewing menu') #(#startDrag:with: 'Move') #(#startGrow:with: 'Change size (Ctrl + drag blue button)') #(#startRot:with: 'Rotate') #(#startScale:with: 'Change scale') #(#tearOffTile 'Make a tile representing this object') #(#trackCenterOfRotation:with: 'Set center of rotation') ) do: [:pair | itsSelector == pair first ifTrue: [^ pair last]]. ^ 'unknown halo handle'translated! !!Morph methodsFor: 'menu' stamp: 'mt 8/11/2023 14:44'!addYellowButtonMenuItemsTo: aMenu event: evt "Populate aMenu with appropriate menu items for a yellow-button (context menu) click." aMenu defaultTarget: self. "" aMenu addStayUpItem. "" self addModelYellowButtonItemsTo: aMenu event: evt. "" Preferences generalizedYellowButtonMenu ifFalse: [^ self]. "" aMenu addLine. aMenu add: 'insp ect' translated action: #inspect. "" aMenu addLine. self world selectedObject == self ifTrue: [aMenu add: 'deselect' translated action: #removeHalo] ifFalse: [aMenu add: 'select' translated action: #addHalo]. "" self isWorldMorph ifFalse: ["" aMenu addLine. aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: evt hand]. "" self isWorldMorph ifFalse: ["" Smalltalk at: #NCAAConnectorMorph ifPresent: [:connectorClass | aMenu addLine. aMenu add: 'connect to' translated action: #startWiring. aMenu addLine]. "" self isFullOnScreen ifFalse: [aMenu add: 'move onscreen' translated action: #goHome]]. "" self addLayoutMenuItems: aMenu hand: evt hand. (owner notNil and: [owner isTextMorph]) i fTrue: [self addTextAnchorMenuItems: aMenu hand: evt hand]. "" self isWorldMorph ifFalse: ["" aMenu addLine. self addToggleItemsToHaloMenu: aMenu]. "" aMenu addLine. self isWorldMorph ifFalse: [aMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:]. self hasStrings ifTrue: [ aMenu add: 'copy text' translated action: #clipText]. "" self addExportMenuItems: aMenu hand: evt hand. "" self isWorldMorph not ifTrue: ["" aMenu addLine. aMenu add: 'adhere to edge...' translated action: #adhereToEdge]. "" self addCustomMenuItems: aMenu hand: evt hand! !!Morph methodsFor: 'menu' stamp: 'mt 3/10/2023 16:07'!wantsYellowButtonMenu "Answer true if the receiver wants a yellow button menu" self valueOfProperty: #wantsYellowButtonMenu ifPresentDo: [:value | ^ value]. "" self isInSystemWindow ifTrue: [^ false]."" ^ Preferences generalizedYellowButtonMenu! !!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:59'!absorbStateFromRenderer: aRenderer "Transfer knownName, actorState, visible over from aRenderer, which was formerly imposed above me as a transformation shell but is now going away." | current | (current := aRenderer actorStateOrNil) ifNotNil: [self actorState: current. aRenderer actorState: nil]. (current := aRenderer knownName) ifNotNil: [self setNameTo: current. aRenderer setNameTo: nil]. self visible: aRenderer visible! !!Morph methodsFor: 'menus' stamp: 'mt 3/10/2023 14:25'!addHaloActionsTo: aMenu "Add items to aMenu representing actions requestable via halo" | subMenu | subMenu := MenuMorph new defaultTarget: self. subMenu addTitle: self externalName. subMenu addStayUpItemSpecial. subMenu addLine. subMenu add: 'delete' translated action: #dismissViaHalo. subMenu balloonTextForLastItem: 'Delete this object -- warning -- can be destructive!!' translated. self maybeAddCollapseItemTo: subMenu. subMenu add: 'grab' translated action: #openInHand. subMenu balloonTextForLastItem: 'Pick this object up -- warning, since this removes it from its container, it can have adverse effects.' translated. subMenu addLine. subMenu add: 'resize' translated action: #resizeFromMenu. subMenu balloonTextForLastItem: 'Change the size of this object' translated. subMenu add: 'duplicate' translated action: #maybeDuplicateMorph. subMenu balloonTextForLastItem: 'Hand me a copy of this object' translated. "Note that this allows access to the non-instancing duplicate even when this is a uniclass instance" subMenu addLine. subMenu add: 'set color' translated target: self renderedMorph action: #changeColor. subMenu balloonTextForLastItem: 'Change the color of this object' translated. subMenu addLine. subMenu add: 'inspect' translated target: self action: #inspect. subMenu balloonTextForLastItem: 'Open an Inspector on this object' translated. aMenu add: 'halo actions...' translated subMenu: subMenu! !!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:47'!addMiscExtrasTo: aMenu "Add a submenu of miscellaneous extra items to the menu." | realOwner realMorph subMenu | subMenu := MenuMorph new defaultTarget: self. self isWorldMorph ifFalse: [subMenu add: 'adhere to edge...' translated action: #adhereToEdge. subMenu addLine]. realOwner := (realMorph := self topRendererOrSelf) owner. (realOwner isKindOf: TextPlusPasteUpMorph) ifTrue: [subMenu add: 'GeeMail stuff...' translated subMenu: (realOwner textPlusMenuFor: realMorph)]. subMenu add: 'add mouse up action' translated action: #addMouseUpAction; add: 'remove mouse up action' translated action: #removeMouseUpAction; add: 'hand me tiles to fire this button' translated action: #handMeTilesToFire. subMenu addLine. subMe nu add: 'arrowheads on pen trails...' translated action: #setArrowheads. subMenu addLine. subMenu defaultTarget: self topRendererOrSelf. subMenu add: 'draw new path' translated action: #definePath. subMenu add: 'follow existing path' translated action: #followPath. subMenu add: 'delete existing path' translated action: #deletePath. subMenu addLine. self addGestureMenuItems: subMenu hand: self currentHand. aMenu add: 'extras...' translated subMenu: subMenu! !!Morph methodsFor: 'menus' stamp: 'mt 8/16/2023 15:58'!addStandardHaloMenuItemsTo: aMenu hand: aHandMorph "Add standard halo items to the menu" | unlockables | self isWorldMorph ifTrue: [^ self addWorldHaloMenuItemsTo: aMenu hand: aHandMorph]. aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: aHandMorph. aMenu addLine. self addFillStyleMenuItems: aMenu hand: aHandMorph. self addBorderStyleMenuItems: aMenu hand: aHandMorph. self addDropShadowMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph. self addHaloActionsTo: aMenu. owner isTextMorph ifTrue:[self addTextAnchorMenuItems: aMenu hand: aHandMorph]. aMenu addLine. self addToggleItemsToHaloMenu: aMenu. aMenu addLine. self addCopyItemsTo: aMenu. self addExportMenuItems: aMenu hand: aHandMorph. self addMiscExtrasTo: aMenu. self addDebuggingItemsTo: aMenu hand: aHandMorph. aMenu addLine. aMenu defaultTarget: self. aMenu addLine. unlockables := self submorphs select: [:m | m isLocked]. unlockables size = 1 ifTrue: [aMenu add: ('unlock "{1}"' translated format: unlockables first externalName) action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' translated action: #unlockContents]. aMenu defaultTarget: aHandMorph.! !!Morp h methodsFor: 'menus' stamp: 'mt 3/10/2023 16:06'!addToggleItemsToHaloMenu: aMenu "Add standard true/false-checkbox items to the memu" #( (resistsRemovalString toggleResistsRemoval 'whether I should be reistant to easy deletion via the pink X handle') (stickinessString toggleStickiness 'whether I should be resistant to a drag done by mousing down on me') (lockedString lockUnlockMorph 'when "locked", I am inert to all user interactions') (hasClipSubmorphsString changeClipSubmorphs 'whether the parts of objects within me that are outside my bounds should be masked.') (hasDirectionHandlesString changeDirectionHandles 'whether direction handles are shown with the halo') (hasDragEnabledString changeDrag 'whether I am open to having objects dragged out of me') (hasDropEnabledString changeDrop 'whether I am open to having objects dropped into me') ) do: [:each | aMenu addUpdating: each first action: eac h second. aMenu balloonTextForLastItem: each third translated]. self couldHaveRoundedCorners ifTrue: [aMenu addUpdating: #roundedCornersString action: #toggleCornerRounding. aMenu balloonTextForLastItem: 'whether my corners should be rounded' translated]! !!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:59'!transferStateToRenderer: aRenderer "Transfer knownName, actorState, visible over to aRenderer, which is being imposed above me as a transformation shell" | current | (current := self actorStateOrNil) ifNotNil: [aRenderer actorState: current. self actorState: nil]. (current := self knownName) ifNotNil: [aRenderer setNameTo: current. self setNameTo: nil]. aRenderer simplySetVisible: self visible ! !!Morph methodsFor: 'meta-actions' stamp: 'mt 3/10/2023 16:06'!buildHandleMenu: aHand "Build the morph menu for the given morph's halo's menu handle. This menu has two sections. The first section con tains commands that are interpreted by the hand; the second contains commands provided by the target morph. This method allows the morph to decide which items should be included in the hand's section of the menu." | menu | menu := MenuMorph new defaultTarget: self. menu addStayUpItem. menu addLine. self addStandardHaloMenuItemsTo: menu hand: aHand. menu defaultTarget: aHand. self addAddHandMenuItemsForHalo: menu hand: aHand. menu defaultTarget: self. self addCustomHaloMenuItems: menu hand: aHand. menu defaultTarget: aHand. ^ menu! !!Morph methodsFor: 'naming' stamp: 'mt 3/8/2023 10:49'!renameTo: aName self knownName = aName ifTrue: [^ aName]. self topRendererOrSelf setNameTo: aName. ^ aName! !!Morph methodsFor: 'stepping' stamp: 'mt 8/28/2023 15:14'!step "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message."! !!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:53'!stepAt: millisecondClockValue "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message. The millisecondClockValue parameter gives the value of the millisecond clock at the moment of dispatch. Default is to dispatch to the parameterless step method for the morph, but this protocol makes it possible for some morphs to do differing things depending on the clock value" self step! !!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:53'!stepTime "Answer the desired time between steps in milliseconds. This default implementation requests that the 'step' method be called once every second." ^ 1000! !!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:57'!wantsSteps "Return true if the receiver overrides the default Morph step method." "Details: Find first cla ss in superclass chain that implements #step and return true if it isn't class Morph." | c | self isPartsDonor ifTrue: [^ false]. c := self class. [c includesSelector: #step] whileFalse: [c := c superclass]. ^ c ~= Morph! !!Morph methodsFor: 'thumbnail' stamp: 'mt 8/14/2023 17:40'!representativeNoTallerThan: maxHeight norWiderThan: maxWidth thumbnailHeight: thumbnailHeight "Return a morph representing the receiver but which is no taller than aHeight. If the receiver is already small enough, just return it, else return a MorphThumbnail companioned to the receiver, enforcing the maxWidth. If the receiver personally *demands* thumbnailing, do it even if there is no size-related reason to do it." self permitsThumbnailing ifFalse: [^ self]. (self fullBounds height <= maxHeight and: [self fullBounds width <= maxWidth]) ifTrue: [^ self]. ^ MorphThumbnail new extent: maxWidth @ (thumbnailHeight min: self fullBounds height); morphRepresented: self! !!Morph metho dsFor: 'WiW support' stamp: 'mt 3/7/2023 15:07'!eToyRejectDropMorph: morphToDrop event: evt | tm am | tm := TextMorph new beAllFont: ((TextStyle named: Preferences standardButtonFont familyName) fontOfSize: 24); contents: 'GOT IT!!'. (am := AlignmentMorph new) color: Color yellow; layoutInset: 10; useRoundedCorners; vResizing: #shrinkWrap; hResizing: #shrinkWrap; addMorph: tm; fullBounds; position: (self bounds center - (am extent // 2)); openInWorld: self world. SoundService default playSoundNamed: 'yum' ifAbsentReadFrom: 'yum.aif'. morphToDrop rejectDropMorphEvent: evt. "send it back where it came from" am delete! !!Morph methodsFor: 'private' stamp: 'mt 3/10/2023 14:53'!privateMoveBy: delta "Private!! Use 'position:' instead." | fill | bounds := bounds translateBy: delta. fullBounds ifNotNil: [fullBounds := fullBounds translateBy: delta]. fill := self fillStyle. fill isOrientedFill ifTrue: [fill origin: fill origin + delta]! !!Morph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/10/2023 14:50'!delete "Remove the receiver as a submorph of its owner and make its new owner be nil." | oldWorld | self removeHalo. (oldWorld := self world) ifNotNil: [ self disableSubmorphFocusForHand: self activeHand. self activeHand releaseKeyboardFocus: self; releaseMouseFocus: self]. owner ifNotNil: [ self privateDelete. "remove from world"].! !!Morph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/10/2023 14:27'!goBehind "Move the receiver to bottom z-order." | topRend | topRend := self topRendererOrSelf. topRend owner ifNotNil: [:own | own addMorphBack: topRend]! !!Morph methodsFor: 'submorphs - layers' stamp: 'dgd 8/31/2004 16:21'!wantsToBeTopmost "Answer if the receiver want to be one of the topmost objects in its owner" ^ self isFlapOrTab! !!BorderedMorph method sFor: 'menu' stamp: 'mt 4/11/2018 08:30'!changeBorderWidth: evt | handle origin aHand newWidth oldWidth | aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand]. origin := aHand position. oldWidth := self borderWidth. (handle := HandleMorph new) forEachPointDo: [:newPoint | handle removeAllMorphs. handle addMorph: (LineMorph from: origin to: newPoint color: Color black width: 1). newWidth := (newPoint - origin) r asInteger // 5. self borderWidth: newWidth] lastPointDo: [:newPoint | handle deleteBalloon. self halo ifNotNil: [:halo | halo addHandles]. self rememberCommand: (Command new cmdWording: 'border change' translated; undoTarget: self selector: #borderWidth: argument: oldWidth; redoTarget: self selector: #borderWidth: argument: newWidth)]. aHand attachMorph: handle. handle setProperty: #helpAtCe nter toValue: true. handle showBalloon:'Move cursor farther fromthis point to increase border width.Click when done.' translated hand: evt hand. handle startStepping! !!AlignmentMorph methodsFor: 'geometry' stamp: 'mt 3/7/2023 14:37'!addTransparentSpacerOfSize: aPoint "Required for several MorphicExtras and other non-Etoys stuff." self addMorphBack: ((Morph new extent: aPoint asPoint) color: Color transparent)! !!BookPageSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'!addControls "Add the control bar at the top of the tool." | bb r str aCheckbox aWrapper | r := AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0. r wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. bb := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated font: Preferences standardButtonFont ; actionSelector: #acceptSort)). bb setBalloonText: 'Accept the changes made here as the new page-order for this book' translated. r addTransparentSpacerOfSize: 12. bb := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #delete)). bb setBalloonText: 'Forgot any changes made here, and dismiss this sorter' translated. "eliminate the parts-bin button on the book-page sorters... r addTransparentSpacerOfSize: 24 @ 0. aCheckbox := UpdatingThreePhaseButtonMorph checkBox. aCheckbox target: self; actionSelector: #togglePartsBinStatus; arguments: #(); getSelector: #getPartsBinStatus. str := StringMorph contents: 'Parts bin' translated font: Preferences standardButtonFont. aWrapper := AlignmentMorph newRow beTransparent. aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0. aWrapper
addMorphBack: (self wrapperFor: aCheckbox); addMorphBack: (self wrapperFor: str lock). r addMorphBack: aWrapper." self addMorphFront: r! !!BookPageSorterMorph methodsFor: 'initialization' stamp: 'mt 8/16/2023 13:52'!initialize "initialize the state of the receiver" super initialize. "" self extent: Display extent - 100; listDirection: #topToBottom; wrapCentering: #topLeft; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 3. pageHolder := PasteUpMorph new. pageHolder vResizeToFit: true; autoLineLayout: true. pageHolder extent: self extent - self borderWidth. pageHolder hResizing: #shrinkWrap. "pageHolder cursor: 0." "causes a walkback as of 5/25/2000" self addControls. self addMorphBack: pageHolder! !!BooklikeMorph methodsFor: 'misc' stamp: 'mt 8/4/2023 13:41'!playPageFlipSound: soundName PageFlipSoundOn "mechanism to suppress sounds at init time" ifTrue: [self playSoundNamed: soundName].! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:39'!addBookMenuItemsTo: aMenu hand: aHandMorph | controlsShowing subMenu | subMenu := MenuMorph new defaultTarget: self. subMenu add: 'previous page' translated action: #previousPage. subMenu add: 'next page' translated action: #nextPage. subMenu add: 'goto page' translated action: #goToPage. subMenu add: 'insert a page' translated action: #insertPage. subMenu add: 'delete this page' translated action: #deletePage. controlsShowing := self hasSubmorphWithProperty: #pageControl. controlsShowing ifTrue: [subMenu add: 'hide page controls' translated action: #hidePageControls. subMenu add: 'fewer page controls' translated action: #fewerPageControls] ifFalse: [subMenu add: 'show page controls' translated action: #showPageControls]. self isInFullScreenMode ifTrue: [ subMenu add: 'exit full screen' translated action: #exitFullScreen. ] ifFalse: [ subMenu add: 'show full screen' translated action: #goFullScreen. ]. subMenu addLine. subMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:. subMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:. subMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:. subMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:. subMenu addLine. subMenu add: 'sort pages' translated action: #sortPages:. subMenu add: 'uncache page sorter' translated action: #uncachePageSorter. (self hasProperty: #dontWrapAtEnd) ifTrue: [subMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true] ifFalse: [subMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false]. subMenu addLine. subMenu add: 'search for text' translated action: #textSearch. (aHandMorph pasteBuffer class isKindOf: PasteUpMorph class) ifTrue: [subMenu add: 'paste book page' translated action: #pasteBookPage]. subMenu add: 'send all pages to server' translated action: #savePagesOnURL. subMenu add: 'send this page to server' translated action: #saveOneOnURL. subMenu add: 'reload all from server' translated action: #reload. subMenu add: 'copy page url to clipboard' translated action: #copyUrl. subMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype. newPagePrototype ifNotNil: [subMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype]. aMenu add: 'book...' translated subMenu: subMenu! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/11/2023 14:44'!invokeBookMenu "Invoke the book's control panel menu." | aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'Book' translated. aMenu addStayUpItem. aMenu add: 'find...' translated action: #textSearch. aMenu add: 'go to page...' translated action: #goToPage. aMenu addLine. aMenu addList: { {'sort pages' translated. #sortPages}. {'uncache page sorter' translated. #uncachePageSorter}}. (self hasProperty: #dontWrapAtEnd) ifTrue: [aMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true] ifFalse: [aMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false]. aMenu addList: { {'make bookmark' translated. #bookmarkForThisPage}. {'make thumbnail' translated. #thumbnailForThisPage}}. aMenu addUpdating: #showingPageControlsString action: #toggleShowingOfPageControls. aMenu addUpdating: #showingFullScreenString action: #toggleFullScreen. aMenu addLine. aMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:. aMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:. aMen u add: 'visual effect for all pages' translated action: #menuPageVisualForAll:. aMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:. aMenu addLine. (self primaryHand pasteBuffer class isKindOf: PasteUpMorph class) ifTrue: [aMenu add: 'paste book page' translated action: #pasteBookPage]. aMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype. newPagePrototype ifNotNil: [ aMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype]. aMenu add: (self dragNDropEnabled ifTrue: ['close dragNdrop'] ifFalse: ['open dragNdrop']) translated action: #changeDragAndDrop. aMenu add: 'make all pages this size' translated action: #makeUniformPageSize. aMenu addUpdating: #keepingUniformPageSizeString target: self action: #toggleMaintainUniformPageSize. aMenu addLine. aMenu add: 'send all pages to server' translated action: #savePagesOnURL . aMenu add: 'send this page to server' translated action: #saveOneOnURL. aMenu add: 'reload all from server' translated action: #reload. aMenu add: 'copy page url to clipboard' translated action: #copyUrl. aMenu addLine. aMenu add: 'load PPT images from slide #1' translated action: #loadImagesIntoBook. aMenu add: 'background color for all pages...' translated action: #setPageColor. aMenu add: 'make a thread of projects in this book' translated action: #buildThreadOfProjects. aMenu popUpEvent: self world activeHand lastEvent in: self world! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:38'!saveAsNumberedURLs "Write out all pages in this book that are not showing, onto a server. The local disk could be the server. For any page that does not have a SqueakPage and a url already, name that page file by its page number. Any pages that are already totally out will stay that way." | stem list firstTime | firstTime := (self valueOfProperty: #url ) isNil. stem := self getStemUrl. "user must approve" stem isEmpty ifTrue: [^self]. firstTime ifTrue: [self setProperty: #futureUrl toValue: stem , '.bo']. self reserveUrlsIfNeeded. pages withIndexDo: [:aPage :ind | "does write the current page too" aPage isInMemory ifTrue: ["not out now" aPage saveOnURL: stem , ind printString , '.sp']]. list := pages collect: [:aPage | aPage sqkPage prePurge]. "knows not to purge the current page" list := (list select: [:each | each notNil]) asArray. "do bulk become:" (list collect: [:each | each contentsMorph]) elementsExchangeIdentityWith: (list collect: [:spg | MorphObjectOut new xxxSetUrl: spg url page: spg]). self saveIndexOnURL. firstTime ifTrue: ["Put a thumbnail into the hand" URLMorph grabForBook: self. self setProperty: #futureUrl toValue: nil " clean up"]! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:39'!saveOnUrlPage: pageMorph "Write out this single page in this book onto a server. See savePagesOnURL. (Don't compute the texts, only this page's is written.)" | stem ind response rand newPlace dir | "Don't give the chance to put in a different place. Assume named by number" ((self valueOfProperty: #url) isNil and: [pages first url notNil]) ifTrue: [response := Project uiManager chooseOptionFrom: {'Old book' translated. 'New book sharing old pages' translated} title: 'Modify the old book, or make a new book sharing its pages?' translated. response = 2 ifTrue: ["Make up new url for .bo file and confirm with user." "Mark as shared" [rand := String new: 4. 1 to: rand size do: [:ii | rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)]. (newPlace := self get StemUrl) ifEmpty: [^ self]. newPlace := (newPlace copyUpToLast: $/), '/BK', rand, '.bo'. dir := ServerFile new fullPath: newPlace. (dir includesKey: dir fileName)] whileTrue. "keep doing until a new file" self setProperty: #url toValue: newPlace]. response = 0 ifTrue: [^ self]]. stem := self getStemUrl. "user must approve" stem ifEmpty: [^ self]. ind := pages identityIndexOf: pageMorph ifAbsent: [self error: 'where is the page?' translated]. pageMorph isInMemory ifTrue: "not out now" [pageMorph saveOnURL: stem,(ind printString),'.sp']. self saveIndexOfOnly: pageMorph.! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:40'!savePagesOnURL "Write out all pages in this book onto a server. For any page that does not have a SqueakPage and a url already, ask the user for one. Give the option of naming all page files by page number. Any pages that are not in memory will stay that way. The local disk coul d be the server." | response list firstTime newPlace rand dir bookUrl | self getAllText. "stored with index later" response := Project uiManager chooseOptionFrom: {'Use page numbers' translated. 'Type in file names' translated. 'Save in a new place (using page numbers)' translated. 'Save in a new place (typing names)' translated. 'Save new book sharing old pages' translated. } title: 'Each page will be a file on the server. Do you want to page numbers be the names of the files? or name each one yourself?' translated. response = 1 ifTrue: [self saveAsNumberedURLs. ^ self]. response = 3 ifTrue: [self forgetURLs; saveAsNumberedURLs. ^ self]. response = 4 ifTrue: [self forgetURLs]. response = 5 ifTrue: ["Make up new url for .bo file and confirm with user." "Mark as shared" [rand := String new: 4. 1 to: rand size do: [:ii | rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)]. (newPlace := self getStemUrl) isEmpty ifTrue: [^ self]. newPlace := (newPlace copyUpToLast: $/), '/BK', rand, '.bo'. dir := ServerFile new fullPath: newPlace. (dir includesKey: dir fileName)] whileTrue. "keep doing until a new file" self setProperty: #url toValue: newPlace. self saveAsNumberedURLs. bookUrl := self valueOfProperty: #url. (SqueakPage stemUrl: bookUrl) = (SqueakPage stemUrl: currentPage url) ifTrue: [bookUrl := true]. "not a shared book" (URLMorph grabURL: currentPage url) book: bookUrl. ^ self]. response = 0 ifTrue: [^ self]. "self reserveUrlsIfNeeded. Need two passes here -- name on one, write on second" pages do: [:aPage | "does write the current page too" aPage isInMemory ifTrue: "not out now" [aPage saveOnURLbasic]]. "ask user if no url" list := pages collect: [:aPage | aPage sqkPage prePurge]. "knows not to purge the current page" list := (list select: [:each | each notNil]) asArray. "do bulk become:" (list collect: [:each | each contentsMorph]) elementsExchangeIdentityWith: (list collect: [:spg | MorphObjectOut new xxxSetUrl: spg url page: spg]). firstTime := (self valueOfProperty: #url) isNil. self saveIndexOnURL. firstTime ifTrue: "Put a thumbnail into the hand" [URLMorph grabForBook: self. self setProperty: #futureUrl toValue: nil]. "clean up"! !!BookMorph methodsFor: 'navigation' stamp: 'mt 8/4/2023 13:34'!goToPageMorph: aMorph "Set the given morph as the current page; run closing and opening scripts as appropriate" self goToPage: (pages identityIndexOf: aMorph ifAbsent: [^ self "abort"]) transitionSpec: nil! !!BookMorph methodsFor: 'navigation' stamp: 'mt 8/4/2023 13:30'!goToPageMorph: newPage transitionSpec: transitionSpec "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly. Apply the transitionSpec provided." | pageIndex aWorld oldPageIndex ascending tSpec readIn | pages isEmpty ifTrue: [^self]. self setProperty: #searchContainer toValue: nil. "forget previous search" self setProperty: #searchOffset toValue: nil. self setProperty: #searchKey toValue: nil. pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"]. readIn := newPage isInMemory not. oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil]. ascending := (oldPageIndex isNil or: [newPage == currentPage]) ifTrue: [nil] ifFalse: [oldPageIndex < pageIndex]. tSpec := transitionSpec ifNil: ["If transition not specified by requestor..." newPage valueOfProperty: #transitionSpec
ifAbsent: [" ... then consult new page" self transitionSpecFor: self " ... otherwise this is the default"]]. self flag: #arNote. "Probably unnecessary" (aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus]. currentPage ifNotNil: [currentPage updateCachedThumbnail]. self currentPage notNil ifTrue: [(((pages at: pageIndex) owner isKindOf: TransitionMorph) and: [(pages at: pageIndex) isInWorld]) ifTrue: [^self "In the process of a prior pageTurn"]. ascending ifNotNil: ["Show appropriate page transition and start new page when done" currentPage stopStepping. (pages at: pageIndex) position: currentPage position. ^(TransitionMorph effect: tSpec second direction: tSpec third inve rse: (ascending or: [transitionSpec notNil]) not) showTransitionFrom: currentPage to: (pages at: pageIndex) in: self whenStart: [self playPageFlipSound: tSpec first] whenDone: [currentPage delete; fullReleaseCachedState. self insertPageMorphInCorrectSpot: (pages at: pageIndex). self adjustCurrentPageForFullScreen. self snapToEdgeIfAppropriate. aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. aWorld := self world. readIn ifTrue: [currentPage updateThumbnailUrlInBook: self url. currentPage sqkPage computeThumbnail "just store it"]]]. "No transition, but at least decommission current page" currentPage delete; fullReleaseCachedState]. self insertPageMorphInCorrectSpot: (pages at: pageIndex). "sets currentPage" self adjustCurrentPageForFullScreen. self snapToEdgeIfAppropriate. aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. aWorld := self world. readIn ifTrue: [currentPage updateThumbnailUrl. currentPage sqkPage computeThumbnail "just store it"].! !!DockingBarMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 16:05'!wantsYellowButtonMenu "Answer true if the receiver wants a yellow button menu" ^ true! !!EventRecorderMorph methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:52'!makeStatusLightIn: aPoint ^statusLight := EllipseMorph new extent: aPoint; color: Color green ; borderWidth: 0! !!GraphMorph methodsFor: 'accessing'!valueAtCursor: aPointOrNumber data isEmpty ifTrue: [^ 0]. data at: ((cursor truncated max: 1) min: data size) put: (self asNumber: aPointOrNumber). self flushCachedForm.! !!GraphMorph methodsFor: 'commands'!appendValue: aPointOrNumber | newVal | (data isKindOf: OrderedCollection) ifFalse: [data := data asOrderedCollection]. newVal := self asNumber: aPointOrNumber. data addLast: newVal. newVal < minVal ifTrue: [minVal := newVal]. newVal > maxVal ifTrue: [maxVal := newVal]. self cursor: data size. self flushCachedForm.! !!GraphMorph methodsFor: 'private' stamp: 'mt 8/14/2023 16:25'!asNumber: aPointOrNumber ^ aPointOrNumber isPoint ifTrue: [aPointOrNumber r] ifFalse: [aPointOrNumber]! !!GraphicalDictionaryMenu methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'!initializeFor: aTarget fromDictionary: aDictionary "Initialize me for a target and a dictionary ." | anIndex aButton | self baseDictionary: aDictionary. target := aTarget. coexistWithOriginal := true. self extent: 210 @ 210. self clipSubmorphs: true. self layoutPolicy: ProportionalLayout new. aButton := (IconicButton new) borderWidth: 0; labelGraphic: (MenuIcons formAtKey: 'TinyMenu'); color: Color transparent; actWhen: #buttonDown; actionSelector: #showMenu; target: self; setBalloonText: 'menu'. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (-50 @ 6 extent: aButton extent)). aButton := (SimpleButtonMorph new) target: self; borderColor: Color black; label: 'Prev'; actionSelector: #downArrowHit; actWhen: #whilePressed; setBalloonText: 'show previous picture'; yourself. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (-24 @ 4 extent: aButton extent)). aButton := (SimpleButtonMorph new) target: self; borderColor: Color black; label: 'Next'; actionSelector: #upArrowHit; actWhen: #whilePressed; setBalloonText: 'show next pictutre'. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (24 @ 4 extent: aButton extent)). self addMorph: ((UpdatingStringMorph new) contents: ' '; target: self; putSelector: #renameGraphicTo:; getSelector: #truncatedNameOfGraphic; useStringFormat; setBalloonText: 'The name of the current graphic'; yourself) fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ 0) offsets: (10 @ 40 corner: -10 @ 60)). self addMorph: ((Morph new) extent: 100 @ 4; color: Color black) fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ 0) offsets: (0 @ 60 corner: 0 @ 64)). formDisplayMorph := (Thumbnail new) extent: 100 @ 100; useInterpolation: true; maxWidth: 300 minHeight: 100; yourself. formDisplayMorph layoutFrame: (LayoutFrame fractions: (0 @ 0 extent: 0@0) offsets: (8 @ 72 corner: 108 @ 172)). self addMorph: formDisplayMorph. self minimumExtent: 116@180. target ifNotNil: [(anIndex := formChoices indexOf: target form ifAbsent: []) ifNotNil: [currentIndex := anIndex]]. self updateThumbnail! !!GraphicalDictionaryMenu methodsFor: 'menu commands' stamp: 'mt 8/16/2023 13:50'!repaintEntry "Let the user enter into painting mode to repaint the item and save it back." | aWorld bn ds sketchEditor aPaintBox formToEdit | (aWorld := self world) assureNotPaintingElse: [^ self]. formToEdit := formChoices at: currentIndex. bnds := (submorphs second boundsInWorld origin extent: formToEdit extent) intersect: aWorld bounds. bnds := bnds expandBy: 60@60. sketchEditor := SketchEditorMorph new. aWorld addMorphFront: sketchEditor. sketchEditor initializeFor: ((aWorld drawingClass withForm: formToEdit) position: submorphs second positionInWorld) inBounds: bnds pasteUpMorph: aWorld paintBoxPosition: bnds topRight. sketchEditor afterNewPicDo: [:aForm :aRect | formChoices at: currentIndex put: aForm. baseDictionary at: (entryNames at: currentIndex) put: aForm. self updateThumbnail. (aPaintBox := aWorld paintBoxOrNil) ifNotNil: [aPaintBox delete]] ifNoBits: [(aPaintBox := aWorld paintBoxOrNil) ifNotNil: [aPaintBox delete]]. ! !!HandMorph methodsFor: 'paste buffer' stamp: ' mt 3/10/2023 14:49'!pasteMorph | aPastee | PasteBuffer ifNil: [^ self inform: 'Nothing to paste.' translated]. self attachMorph: (aPastee := self objectToPaste). aPastee align: aPastee center with: self position.! !!HandMorphForReplay methodsFor: 'event handling' stamp: 'mt 8/28/2023 14:05'!processEvents "Play back the next event" | evt hadMouse hadAny tracker | suspended == true ifTrue: [^ self]. hadMouse := hadAny := false. tracker := recorder objectTrackingEvents. [(evt := recorder nextEventToPlay) isNil] whileFalse: [ ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self]. tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp]. evt type == #EOF ifTrue: [recorder pauseIn: self currentWorld. ^ self]. evt type == #startSound ifTrue: [evt argument play. re corder synchronize. ^ self]. evt isMouse ifTrue: [hadMouse := true]. (evt isMouse or: [evt isKeyboard]) ifTrue: [self handleEvent: (evt setHand: self) resetHandlerFields. hadAny := true]]. (mouseClickState notNil and: [hadMouse not]) ifTrue: ["No mouse events during this cycle. Make sure click states time out accordingly" mouseClickState handleEvent: lastMouseEvent asMouseMove from: self]. hadAny ifFalse: ["No pending events. Make sure z-order is up to date" self mouseOverHandler processMouseOver: lastMouseEvent]! !!ImageMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:15'!setNewImageFrom: formOrNil "Change the receiver's image to be one derived from the supplied form. If nil is supplied, clobber any existing image in the receiver, and in its place put a default graphic, either the one known to the receiver as it s default value" formOrNil ifNotNil: [^ self image: formOrNil]. self image: (Form extent: 16@16 depth: 32)! !!GrabPatchMorph methodsFor: 'dropping' stamp: 'mt 8/14/2023 17:31'!wantsToBeDroppedInto: aMorph "Only into PasteUps that are not part bins" ^ aMorph isWorldMorph! !!GrabPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:11'!initialize "Initialize the receiver. Emblazon the GrabPatch icon on its face" super initialize. self image: (MenuIcons formAtKey: 'GrabPatch'). self setProperty: #ignorePartsBinDrop toValue: true! !!GrabPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:11'!initializeToStandAlone "Initialize the receiver. Emblazon the GrabPatch icon on its face" super initializeToStandAlone. self image: (MenuIcons formAtKey: 'GrabPatch')! !!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'mt 8/23/2023 13:48'!insertNewProject [MorphicProject openViewOn: nil] on: ProjectViewOpenNotifica tion do: [ :ex | ex resume: false].! !!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'mt 8/11/2023 14:44'!moreCommands "Put up a menu of options" | allThreads aMenu others target | allThreads := self class knownThreads. aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'navigation' translated. self flag: #deferred. "Probably don't want that stay-up item, not least because the navigation-keystroke stuff is not dynamically handled" aMenu addStayUpItem. others := (allThreads keys reject: [ :each | each = threadName]) asArray sort. others do: [ :each | aMenu add: ('switch to <{1}>' translated format:{each}) selector: #switchToThread: argument: each ]. aMenu addList: { {'switch to recent projects' translated. #getRecentThread}. #-. {'create a new thread' translated. #threadOfNoProjects}. {'edit this thread' translated. #editThisThread}. {'create thread of all projects' transl ated. #threadOfAllProjects}. #-. {'First project in thread' translated. #firstPage}. {'Last project in thread' translated. #lastPage} }. (target := self currentIndex + 2) > listOfPages size ifFalse: [ aMenu add: ('skip over next project ({1})' translated format:{(listOfPages at: target - 1) first}) action: #skipOverNext ]. aMenu addList: { {'jump within this thread' translated. #jumpWithinThread}. {'insert new project' translated. #insertNewProject}. #-. {'simply close this navigator' translated. #delete}. {'destroy this thread' translated. #destroyThread}. #- }. (self currentWorld keyboardNavigationHandler == self) ifFalse:[ aMenu add: 'start keyboard navigation with this thread' translated action: #startKeyboardNavigation ] ifTrue: [ aMenu add: 'stop keyboard navigation with this thread' translated action: #stopKeyboardNavigation ]. aMenu popUpInWorld.! !!LassoPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'!initialize "Initialize the receiver. Sets its image to the lasso picture" super initialize. self image: (MenuIcons formAtKey: 'Lasso')! !!LassoPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'!initializeToStandAlone "Initialize the receiver such that it can live on its own. Sets its image to the lasso picture" super initializeToStandAlone. self image: (MenuIcons formAtKey: 'Lasso')! !!Morph class methodsFor: 'fileIn/Out' stamp: 'mt 3/8/2023 09:07'!fromFileName: fullName "Reconstitute a Morph from the file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world" | aFileStream morphOrList | aFileStream := (MultiByteBinaryOrTextStream with: ((FileStream readOnlyFileNamed: fullName) binary contentsOfEntireFile)) binary reset. morphOrList := aFileStream fileInObjectAndCode. P roject current world addMorphsAndModel: morphOrList.! !!Morph class methodsFor: '*MorphicExtras-parts bin' stamp: 'mt 8/4/2023 14:43'!supplementaryPartsDescriptions "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol" ^ {DescriptionForPartsBin formalName: 'NextPage' translatedNoop categoryList: {'Multimedia' translatedNoop} documentation: 'A button which, when clicked, takes the reader to the next page of a book' translatedNoop globalReceiverSymbol: #BookMorph nativitySelector: #nextPageButton. DescriptionForPartsBin formalName: 'PreviousPage' translatedNoop categoryList: {'Multimedia'} documentation: 'A button which, when clicked, takes the reader to the previous page of a book' translatedNoop globalReceiverSymbol: #BookMorph
nativitySelector: #previousPageButton.}! !!GraphicalDictionaryMenu class methodsFor: 'example' stamp: 'mt 7/31/2023 11:13'!example "GraphicalDictionaryMenu example" | aDict | aDict := Dictionary new. #('ColorTilesOff' 'ColorTilesOn' 'Controls') do: [:aString | aDict at: aString put: (MenuIcons formAtKey: aString)]. self openOn: aDict withLabel: 'Testing One Two Three'! !!ImageMorph class methodsFor: 'scripting' stamp: 'mt 3/15/2023 14:10'!authoringPrototype | aMorph aForm | aMorph := super authoringPrototype. aForm := MenuIcons formAtKey: 'Image'. aForm ifNil: [aForm := aMorph image rotateBy: 90]. aMorph image: aForm. ^ aMorph! !!GrabPatchMorph class methodsFor: 'instance creation' stamp: 'mt 7/31/2023 11:11'!authoringPrototype "Answer a prototype for use in a parts bin" ^ self new image: (MenuIcons formAtKey: 'GrabPatch'); markAsPartsDonor; setBalloonText: 'Use this to grab a rectangular patch from the screen'; yourself! !!LassoPatchMorph class methodsFor: 'instance creation' stamp: 'mt 7/31/2023 11:13'!authoringPrototype "Answer a prototype for use in a parts bin" ^ self new image: (MenuIcons formAtKey: 'Lasso'); markAsPartsDonor; setBalloonText: 'Drop this on the desktop and you can then grab a patch from the screen with a lasso.'; yourself! !!MorphExtension methodsFor: 'accessing - other properties' stamp: 'mt 3/10/2023 14:57'!sortedPropertyNames "answer the receiver's property names in a sorted way" | props | props := WriteStream on: (Array new: 10). locked == true ifTrue: [props nextPut: #locked]. visible == false ifTrue: [props nextPut: #visible]. sticky == true ifTrue: [props nextPut: #sticky]. balloonText isNil ifFalse: [props nextPut: #balloonText]. balloonTextSelector isNil ifFalse: [props nextPut: #balloonTextSelector]. externalName isNil ifFalse: [props nextPut: #externalName]. isPartsDonor == true ifTrue: [props nextPut: #isPartsDonor]. act orState isNil ifFalse: [props nextPut: #actorState]. eventHandler isNil ifFalse: [props nextPut: #eventHandler]. otherProperties ifNotNil: [otherProperties associationsDo: [:a | props nextPut: a key]]. ^props contents sort: [:s1 :s2 | s1 <= s2]! !!MorphExtension methodsFor: 'connectors-copying' stamp: 'mt 3/10/2023 16:11'!veryDeepInner: deepCopier "Copy all of my instance variables. Some otherProperties need to be not copied at all, but shared. Their names are given by copyWeakly. Some otherProperties should not be copied or shared. Their names are given by propertyNamesNotCopied. This is special code for the dictionary. See DeepCopier, and veryDeepFixupWith:." | namesOfWeaklyCopiedProperties weaklyCopiedValues | super veryDeepInner: deepCopier. locked := locked veryDeepCopyWith: deepCopier. visible := visible veryDeepCopyWith: deepCopier. sticky := sticky veryDeepCopyWith: deepCopier. balloonText := balloonText veryDeepCopyWith: deepCopier.
balloonTextSelector := balloonTextSelector veryDeepCopyWith: deepCopier. externalName := externalName veryDeepCopyWith: deepCopier. isPartsDonor := isPartsDonor veryDeepCopyWith: deepCopier. actorState := actorState veryDeepCopyWith: deepCopier. eventHandler := eventHandler veryDeepCopyWith: deepCopier. "has its own restrictions" otherProperties ifNil: [ ^self ]. otherProperties := otherProperties copy. self propertyNamesNotCopied do: [ :propName | otherProperties removeKey: propName ifAbsent: [] ]. namesOfWeaklyCopiedProperties := self copyWeakly. weaklyCopiedValues := namesOfWeaklyCopiedProperties collect: [ :propName | otherProperties removeKey: propName ifAbsent: [] ]. "Now copy all the others." otherProperties := otherProperties veryDeepCopyWith: deepCopier. "And replace the weak ones." namesOfWeaklyCopiedProperties with: weaklyCopiedValues do: [ :name :value | value ifNotNil: [ otherProperties at: name put: value ]].! !!MorphE xtension methodsFor: 'other' stamp: 'mt 3/10/2023 16:11'!isDefault "Return true if the receiver is a default and can be omitted" locked == true ifTrue: [^ false]. visible == false ifTrue: [^ false]. sticky == true ifTrue: [^ false]. balloonText isNil ifFalse: [^ false]. balloonTextSelector isNil ifFalse: [^ false]. externalName isNil ifFalse: [^ false]. isPartsDonor == true ifTrue: [^ false]. actorState isNil ifFalse: [^ false]. eventHandler isNil ifFalse: [^ false]. otherProperties ifNotNil: [otherProperties isEmpty ifFalse: [^ false]]. ^ true! !!MorphExtension methodsFor: 'printing' stamp: 'mt 3/10/2023 16:11'!printOn: aStream "Append to the argument, aStream, a sequence of characters that identifies the receiver." super printOn: aStream. aStream nextPutAll: ' ' , self identityHashPrintString. locked == true ifTrue: [aStream nextPutAll: ' [locked] ']. visibl e == false ifTrue: [aStream nextPutAll: '[not visible] ']. sticky == true ifTrue: [aStream nextPutAll: ' [sticky] ']. balloonText ifNotNil: [aStream nextPutAll: ' [balloonText] ']. balloonTextSelector ifNotNil: [aStream nextPutAll: ' [balloonTextSelector: ' , balloonTextSelector printString , '] ']. externalName ifNotNil: [aStream nextPutAll: ' [externalName = ' , externalName , ' ] ']. isPartsDonor == true ifTrue: [aStream nextPutAll: ' [isPartsDonor] ']. eventHandler ifNotNil: [aStream nextPutAll: ' [eventHandler = ' , eventHandler printString , '] ']. (otherProperties isNil or: [otherProperties isEmpty ]) ifTrue: [^ self]. aStream nextPutAll: ' [other: '. self otherProperties keysDo: [:aKey | aStream nextPutAll: ' (' , aKey , ' -> ' , (self otherProperties at: aKey) printString , ')']. aStream nextPut: $]! !!MorphHierarchy class methodsFor: 'opening' stamp: 'mt 8/4/2023 14:46'!openOrDelete | oldMorph | oldMorph := Project current world submorphs detect: [:each | each hasProperty: #morphHierarchy] ifNone: [| newMorph | newMorph := self new asMorph. newMorph bottomLeft: self currentHand position. newMorph openInWorld. ^ self]. "" oldMorph delete! !!MorphListItemWrapper methodsFor: 'accessing' stamp: 'mt 3/10/2023 16:07'!contents "Answer the receiver's contents" | tentative submorphs | tentative := item submorphs collect: [:each | each renderedMorph]. submorphs := tentative reject: [:each | each isKindOf: HaloMorph]. ^ submorphs collect: [:each | self class with: each]! !!MorphicModel methodsFor: 'submorphs - accessing' stamp: 'mt 3/10/2023 14:52'!allKnownNames "Return a list of all known names based on the scope of the receiver. If the receiver is a member of a uniclass, incorporate the original 1997 logic that queries the known names of the values of all the instance variables." | superNames | superNames := super allKnownNames. "gather them from submorph tree" ^self class isUniClass ifTrue: [superNames , (self instanceVariableValues select: [:e | e notNil and: [e knownName notNil]] thenCollect: [:e | e knownName])] ifFalse: [superNames]! !!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 3/8/2023 11:01'!copyFromRootsForExport: rootArray "When possible, use copySmartRootsExport:. This way may not copy a complete tree of objects. Add to roots: all of the methods pointed to from the outside by blocks." | newRoots segSize symbolHolder | arrayOfRoots := rootArray. "self halt." symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers, so they will be in outPointers" "Creation of the segment happens here" self copyFromRoots: arrayOfRoots sizeHint: 0. segSize := segment size. [(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize]. "with methods pointed at from outside" [(newRoots := self rootsIncludingBlocks) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize]. "with methods, blocks from outPointers" "Zap sender of a homeContext. Can't send live stacks out." "Why not? eem 7/3/2017 15:31" 1 to: outPointers size do: [:ii | | outPointer | outPointer := outPointers at: ii. (outPointer isBlock or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil]]. symbolHolder size "Keep reference to symbolHolder until the last"! !!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/28/2023 15:10'!copyFromRootsLocalFileFor: rootArray sizeHint: segSize arrayOfRoots := rootArr ay. self copyFromRoots: arrayOfRoots sizeHint: segSize.! !!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/28/2023 15:40'!copySmartRootsExport: rootArray "Use SmartRefStream to find the object. Make them all roots. Create the segment in memory. Project should be in first five objects in rootArray." | newRoots segSize symbolHolder replacements naughtyBlocks allClasses sizeHint proj dummy world | world := Project current world. symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers, so they will be in outPointers" dummy := ReferenceStream on: (DummyStream on: nil). "Write to a fake Stream, not a file" "Collect all objects" dummy insideASegment: true. "So Uniclasses will be traced" dummy rootObject: rootArray. "inform him about the root" dummy nextPut: rootArray. (proj :=dummy project) ifNotNil: [self dependentsSave: dummy]. allClasses := SmartRefStream new uniClassInstVarsRefs: dummy. " catalog the extra objects in UniClass inst vars. Put into dummy" allClasses do: [:cls | dummy references at: cls class put: false. "put MorphicModel5 class in roots" dummy blockers removeKey: cls class ifAbsent: []]. "refs := dummy references." arrayOfRoots := self smartFillRoots: dummy. "guaranteed none repeat" replacements := dummy blockers. dummy project "recompute it" ifNil: [self error: 'lost the project!!']. dummy project class == DiskProxy ifTrue: [self error: 'saving the wrong project']. dummy := nil. "Allow dummy to be GC'ed below (bytesLeft)." naughtyBlocks := arrayOfRoots select: [ :each | each isContext and: [each hasInstVarRef]]. "since the caller switched ActiveWorld, put the real one back temporarily" naughtyBlocks isEmpty ifFalse: [world becomeActiveDuring: [world firstHand becomeActiveDuring: [ | goodToGo | goodToGo := (Project uiM anager chooseOptionFrom: #('keep going' 'stop and take a look') title: 'Some block(s) which reference instance variables are included in this segment. These may fail when the segment is loaded if the class has been reshaped. What would you like to do?') = 1. goodToGo ifFalse: [naughtyBlocks inspect. self error: 'Here are the bad blocks']]]]. "Creation of the segment happens here" "try using one-quarter of memory min: four megs to publish (will get bumped up later if needed)" sizeHint := (Smalltalk bytesLeft // 4 // 4) min: 1024*1024. self copyFromRoots: arrayOfRoots sizeHint: sizeHint areUnique: true. segSize := segment size. [(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true]. "with methods pointed at from outsi de" [(newRoots := self rootsIncludingBlocks) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true]. "with methods, blocks from outPointers" 1 to: outPointers size do: [:ii | | outPointer | outPointer := outPointers at: ii. (outPointer isBlock or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil]. "substitute new object in outPointers" (replacements includesKey: outPointer) ifTrue: [outPointers at: ii put: (replacements at: outPointer)]]. proj ifNotNil: [self dependentsCancel: proj]. symbolHolder. "hold onto symbolHolder until the last."! !!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/16/2023 16:58'!smartFillRoots: dummy | refs known ours ww blockers | "Put all traced objects into my arrayOfRoots. Remove somethat want to be in outPointers. Return blockers, anIdentityDictionary of objects to r eplace in outPointers." blockers := dummy blockers. known := (refs := dummy references) size. refs keys do: [:obj | "copy keys to be OK with removing items" (obj isSymbol) ifTrue: [refs removeKey: obj. known := known-1]. (obj class == PasteUpMorph) ifTrue: [ obj isWorldMorph & (obj owner == nil) ifTrue: [ (dummy project ~~ nil and: [obj == dummy project world]) ifFalse: [ refs removeKey: obj. known := known-1. blockers at: obj put: (StringMorph contents: 'The worldMorph of a different world')]]]. "Make a ProjectViewMorph here" "obj class == Project ifTrue: [Transcript show: obj; cr]." (blockers includesKey: obj) ifTrue: [ refs removeKey: obj ifAbsent: [known := known+1]. known := known-1]. ]. ours := (dummy project ifNil: [Project current]) world. refs keysDo: [:obj | obj isMorph ifTrue: [ ww := obj world. (ww == ours) | (ww == nil) ifFalse: [ refs removeKey: obj. known := known-1. blockers at: obj put: (StringMorph contents: obj printString, ' from another world')]]]. "keep original roots on the front of the list" dummy rootObject do: [:rr | refs removeKey: rr ifAbsent: []]. ^dummy rootObject, refs keys asArray! !!NativeImageSegment methodsFor: 'testing' stamp: 'mt 3/8/2023 11:01'!findRogueRootsImSeg: rootArray "This is a tool to track down unwanted pointers into the segment. If we don't deal with these pointers, the segment turns out much smaller than it should. These pointers keep a subtree of objects out of the segment.1) Break all owner pointers in submorphs and all scripts.2) Create the segment and look at outPointers.3) Remove those we expect.4) Remember to quit without saving -- the owner pointers are smashed."| suspects bag1 bag2 |arrayOfRoots := rootArray.self findRogueRootsPrep. "and free that context!!"Smalltalk garbageCollect.self copyFromRoots: arrayOfRoots sizeHint: 0.suspects := outPointers select: [:oo | oo isMorph].suspects size > 0 ifTrue: [suspects inspect].bag1 := Bag new. bag2 := Bag new.outPointers do: [:key | (key isKindOf: Class) ifTrue: [bag2 add: key class name] ifFalse: [(#(Symbol Point Rectangle True False String Float Color Form ColorForm StrikeFont Metaclass UndefinedObject TranslucentColor) includes: key class name) ifTrue: [bag2 add: key class name] ifFalse: [bag1 add: key class name]]]."(bag sortedCounts) is the SortedCollection"(StringHolder new contents: bag1 sortedCounts printString, '', bag2 sortedCounts printString) openLabel: 'Objects pointed at by the outside'.self halt: 'Examine local variables pointIn and inSeg'."Use this in inspectors: outPointers select: [:oo | oo class == <a Class>]. "! !!NativeImageSegment methodsFor: 'testing' stamp: 'm t 3/10/2023 15:12'!findRogueRootsPrep "Part of the tool to track down unwanted pointers into the segment. Break all owner pointers in submorphs, scripts, and viewers in flaps."| wld morphs |wld := arrayOfRoots detect: [:obj | obj isMorph ifTrue: [obj isWorldMorph] ifFalse: [false]] ifNone: [nil].wld ifNil: [wld := arrayOfRoots detect: [:obj | obj isMorph] ifNone: [^ self error: 'can''t find a root morph']].morphs := IdentitySet new: 400.wld allMorphsDo: [:m | morphs add: m].morphs do: [:mm | "break the back pointers" mm isInMemory ifTrue: [ (mm respondsTo: #target) ifTrue: [ mm nearestOwnerThat: [:ow | ow == mm target ifTrue: [mm target: nil. true] ifFalse: [false]]]. (mm respondsTo: #arguments) ifTrue: [ mm arguments do: [:arg | arg ifNotNil: [ mm nearestOwnerThat: [:ow | ow == arg ifTrue: [mm arguments at: (mm arguments indexOf: arg) put: nil. true] ifFalse: [fal se]]]]]. mm eventHandler ifNotNil: ["recipients point back up" (morphs includesAllOf: (mm eventHandler allRecipients)) ifTrue: [ mm eventHandler: nil]]. "temporary, until using Model for PartsBin" (mm isMorphicModel) ifTrue: [ (mm model isMorphicModel) ifTrue: [ mm model breakDependents]]. (mm isTextMorph) ifTrue: [mm setContainer: nil]]].(Smalltalk includesKey: #Owners) ifTrue: [Smalltalk at: #Owners put: nil]. "in case findOwnerMap: is commented out""self findOwnerMap: morphs."morphs do: [:mm | "break the back pointers" mm isInMemory ifTrue: [mm privateOwner: nil]]."more in extensions?"! !!NebraskaCommunicatorMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/11/2023 13:59'!textEntryFieldNamed: aSymbol with: aString help: helpString | f col | f := (StringMorph new contents: aString; font: Preferences standardDefaultTextFont; yourself) setBalloonText: helpString; on: #mouseUp send: #editEvent:for: to: sel f. self field: aSymbol is: f. col := (self inAColumn: {f}) color: Color white; hResizing: #shrinkWrap. ^col! !!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:52'!acceptTo: someText forMorph: aMorph | betterText | betterText := self improveText: someText forMorph: aMorph. self transmitStreamedObject: (SmartRefStream streamedRepresentationOf: betterText) to: self ipAddress. aMorph setText: '' asText. self appendMessage: self startOfMessageFromMe, ' - ', betterText, String cr. ^true! !!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:56'!appendMessage: aText receivingPane setText: (receivingPane text append: aText).! !!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:54'!improveText: someText forMorph: aMorph | betterText conversions fontForAll | fontForAll := TextStyle default. betterText := someText veryDeepCopy. conversions := OrderedCollection new. betterText runs withStartStopAndValueDo: [:start :stop :attributes | attributes do: [:att | (att isMemberOf: TextFontChange) ifTrue: [ conversions add: {att. start. stop} ] ] ]. conversions do: [ :old | | newAttr | betterText removeAttribute: old first from: old second to: old third. newAttr := TextFontReference toFont: (fontForAll fontAt: old first fontNumber). newAttr fontNumber: old first fontNumber. betterText addAttribute: newAttr from: old second to: old third. ]. ^betterText! !!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:57'!reportError: aString receivingPane setText: (receivingPane text append: (aString asText addAttribute: TextColor red), String cr).! !!NebraskaFridgeMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:52'!acceptDroppingMorph: morphToDrop event: evt | outData | (morphToDrop i sKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt ]. self eToyRejectDropMorph: morphToDrop event: evt. "we will keep a copy" (morphToDrop isKindOf: NebraskaSenderMorph) ifTrue: [ self class addRecipient: morphToDrop. ^self rebuild ]. self stopFlashing. "7 mar 2001 - remove #veryDeepCopy" outData := SmartRefStream streamedRepresentationOf: morphToDrop. self resetIndicator: #working. self class fridgeRecipients do: [ :each | self transmitStreamedObject: outData to: each ipAddress ].! !!NebraskaMorphsWelcomeMorph methodsFor: 'initialization' stamp: 'mt 8/11/2023 13:59'!initialize "initialize the state of the receiver" | earMorph | super initialize. "" self layoutInset: 8 @ 8. "earMorph := (EToyListenerMorph makeListeningToggle: true) asMorph." earMorph := TextMorph new contents: 'Morphswelcomehere'; fontName: Preferences standardDefaultTextFont familyName size: 18; centered; lock. self addARow: {earMorph}. self setBalloonText: 'My presence in this world means received morphs may appear automatically' translated! !!NebraskaMultiChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:52'!acceptTo: someText forMorph: aMorph | streamedMessage betterText | betterText := self improveText: someText forMorph: aMorph. streamedMessage := SmartRefStream streamedRepresentationOf: {targetIPAddresses. betterText}. targetIPAddresses do: [ :each | self transmitStreamedObject: streamedMessage to: each. ]. aMorph setText: '' asText. self appendMessage: self startOfMessageFromMe, ' - ', betterText, String cr. ^true! !!NebraskaSenderMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:53'!acceptDroppingMorph: morphToDrop event: evt | myCopy outData | (morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it" "7 mar 2001 - remove #veryDeepCopy" myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position. self stopFlashing. outData := SmartRefStream streamedRepresentationOf: myCopy. self resetIndicator: #working. self transmitStreamedObject: outData to: self ipAddress.! !!NebraskaSenderMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:53'!sendStatusReply | null | null := String with: 0 asCharacter. NebraskaPeerToPeer new sendSomeData: { NebraskaIncomingMessage typeStatusReply,null. Preferences defaultAuthorName,null. (SmartRefStream streamedRepresentationOf: (NebraskaGateKeeperMorph acceptableTypesFor: self ipAddress)). } to: self ipAddress for: self.! !!NebraskaServerMorph methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:54'!rebuild | myServer toggle closeBox font | font := StrikeFont familyName: #Palatino size: 14. self removeAllMorphs. self setColorsAndBorder. self updateCurrentStatusString. toggle := SimpleHierarchicalListMorph new perform: ( fullDisplay ifTrue: [#expandedForm] ifFalse: [#notExpandedForm] ). closeBox := SimpleButtonMorph new borderWidth: 0; label: 'X' font: Preferences standardButtonFont; color: Color transparent; actionSelector: #delete; target: self; extent: 14@14; setBalloonText: 'End Nebraska session' translated. self addARow: { self inAColumn: {closeBox}. self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentStatusString; contents: sel f currentStatusString; stepTime: 2000; lock. }. self inAColumn: { toggle asMorph on: #mouseUp send: #toggleFull to: self; setBalloonText: 'Show more or less of Nebraska Status' translated }. }. myServer := self server. (myServer isNil or: [fullDisplay not]) ifTrue: [ ^self world startSteppingSubmorphsOf: self ]. "--- the expanded display ---" self addARow: { self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentBacklogString; contents: self currentBacklogString; stepTime: 2000; lock. }. }. self addARow: { self inAColumn: { (StringMorph contents: '--clients--' translated) lock; font: font. }. }. myServer clients do: [ :each | self addARow: {
UpdatingStringMorph new useStringFormat; target: each; font: font; getSelector: #currentStatusString; contents: each currentStatusString; stepTime: 2000; lock. } ]. self world startSteppingSubmorphsOf: self.! !!NebraskaServerMorph methodsFor: 'initialization' stamp: 'mt 8/23/2023 13:26'!setColorsAndBorder self color: (Color r: 0.9 g: 0.9 b: 0.9). self borderStyle: (BorderStyle raised width: 1). self useRoundedCorners! !!NetworkTerminalMorph methodsFor: 'events-processing' stamp: 'mt 8/14/2023 11:29'!handleMouseDown: anEvent anEvent wasHandled ifTrue:[^self]. anEvent hand removePendingBalloonFor: self. anEvent wasHandled: true. anEvent hand newMouseFocus: self event: anEvent. anEvent hand removeHaloFromClick: anEvent on: self. self sendEventAsIs: anEvent.! !!NetworkTerminalMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:53'!acceptDroppingMorph: morphToDrop event: evt | myCopy outData null | (morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it" "7 mar 2001 - remove #veryDeepCopy" myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position. outData := SmartRefStream streamedRepresentationOf: myCopy. null := String with: 0 asCharacter. NebraskaPeerToPeer new sendSomeData: { NebraskaIncomingMessage typeMorph,null. Preferences defaultAuthorName,null. outData } to: connection remoteSocketAddress hostNumber for: self.! !!NewHandleMorph methodsFor: 'initialization' stamp: 'mt 3/10/2023 16:07'!initialize"initialize the state of the receiver" super initialize.""
waitingForClickInside := true.! !!ObjectExplorer methodsFor: 'menus' stamp: 'mt 8/28/2023 14:40'!explorerKey: aChar from: view event: event event anyModifierKeyPressed ifFalse: [^ false]. self object ifNotNil: [ aChar == $i ifTrue: [self inspectSelection. ^ true]. aChar == $I ifTrue: [self exploreSelection. ^ true]. aChar == $b ifTrue: [self browseFull. ^ true]. aChar == $h ifTrue: [self browseClassHierarchy. ^ true]. aChar == $c ifTrue: [self copyName. ^ true]. aChar == $p ifTrue: [self browseFullProtocol. ^ true]. aChar == $N ifTrue: [self browseClassRefs. ^ true]]. ^ false! !!ObjectlandMorph methodsFor: 'projects' stamp: 'mt 8/11/2023 15:16'!fillObjectlandProject ^ self fillObjectlandProjectWith: { self createGamesProject. self createGraphicsProject. self createToolsProject. self createSoundsProject }! !!ObjectsTool methodsFor: 'search' stamp: 'mt 8/11/2023 13:59'!newSearchPan e "Answer a type-in pane for searches" | aTextMorph | aTextMorph := TextMorph new setProperty: #defaultContents toValue: ('' asText allBold addAttribute: (TextFontChange font3)); setTextStyle: (TextStyle fontArray: { Preferences standardDefaultTextFont }); setDefaultContentsIfNil; on: #keyStroke send: #searchPaneCharacter: to: self; setNameTo: 'SearchPane'; setBalloonText: 'Type here and all entries that match will be shown.' translated; vResizing: #shrinkWrap; hResizing: #spaceFill; margins: 4 px @ 6 px; backgroundColor: Color white. ^ aTextMorph! !!PackageDependencyTest methodsFor: 'tests' stamp: 'mt 3/15/2023 14:59'!testMorphic self testPackage: #Morphic dependsExactlyOn: #( Balloon #'Chronology-Core' Collections Compiler Compression Files Graphics 'Installer-Core' "Because of TheWorldMainDockingBar's install feature ..." Kernel
MonticelloConfigurations MorphicExtras Multilingual Network Sound System SystemReporter #'ToolBuilder-Kernel' #'ToolBuilder-Morphic' Tools TrueType ).! !!PackageDependencyTest methodsFor: 'failures' stamp: 'mt 3/15/2023 14:58'!expectedFailures ^ #(testSystem testTools)! !!PaintBoxMorph methodsFor: 'actions' stamp: 'mt 8/10/2023 15:31'!currentColor: aColor currentColor := aColor.! !!PaintBoxMorph methodsFor: 'initialization' stamp: 'mt 8/28/2023 14:39'!addLabels self addGraphicLabels ifFalse: [self addTextualLabels].! !!PaintBoxMorph methodsFor: 'initialization' stamp: 'mt 8/10/2023 15:30'!beSupersized "Not supported."! !!PaintBoxMorph methodsFor: 'other' stamp: 'mt 8/28/2023 14:39'!offsetFromMaxBounds "location of normal PaintBox within maxBounds." | left | left := self left. self flag: #useBiggerPaintingBox. left := left - (( self width * 1.5)- self width). ^ left - colorM emory left @ 0! !!PaintBoxMorph class methodsFor: 'instance creation' stamp: 'mt 8/28/2023 15:42'!new | pb | pb := self prototype veryDeepCopy. pb stampHolder normalize. "Get the stamps to show" "Get my own copies of the brushes so I can modify them" #(brush1: brush2: brush3: brush4: brush5: brush6:) do: [:sel | | dualUse button | button := pb submorphNamed: sel. button offImage: button offImage deepCopy. dualUse := button onImage == button pressedImage. "sometimes shared" button onImage: button onImage deepCopy. dualUse ifTrue: [button pressedImage: button onImage] ifFalse: [button pressedImage: button pressedImage deepCopy]. ]. pb showColor. pb fixUpRecentColors. pb addLabels. ^ pb! !!ParagraphEditor methodsFor: 'editing keys' stamp: 'mt 8/11/2023 14:44'!changeEmphasis: characterStream "Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change. Keeps typeahead." | keyCode attribute oldAttributes index thisSel colors extras | "control 0..9 -> 0..9" keyCode := ('0123456789' indexOf: sensor keyboard ifAbsent: [1]) - 1. oldAttributes := paragraph text attributesAt: self pointIndex forStyle: paragraph textStyle. thisSel := self selection. "Decipher keyCodes for Command 0-9..." "(keyCode between: 1 and: 5) ifTrue: [ attribute := TextFontChange fontNumber: keyCode ]." keyCode = 5 ifTrue: [ | labels lines | colors := #(#black #magenta #red #yellow #green #blue #cyan #white ). extras := #('Link to comment of class' 'Link to definition of class' 'Link to hierarchy of class' 'Link to method' ). labels := colors , #('choose color...' 'Do it' 'Print it' ) , extras , #('be a web URL link' 'Edit hidden info' 'Copy hidden info' ). lines := Array with: colors size + 1. "index := (PopUpMenu labelArra y: labels lines: lines) startUp. " index := UIManager default chooseFrom: labels lines: lines. index = 0 ifTrue: [ ^ true]. index <= colors size ifTrue: [ attribute := TextColor color: (Color perform: (colors at: index)) ] ifFalse: [ index := index - colors size - 1. "Re-number!!!!!!" index = 0 ifTrue: [ attribute := self chooseColor ]. index = 1 ifTrue: [ attribute := TextDoIt new. thisSel := attribute analyze: self selection asString ]. index = 2 ifTrue: [ attribute := TextPrintIt new. thisSel := attribute analyze: self selection asString ]. extras size = 0 & (index > 2) ifTrue: [ index := index + 4 "skip those" ]. index = 3 ifTrue: [ attribute := TextLink new. thisSel := attribute a nalyze: self selection asString with: 'Comment' ]. index = 4 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Definition' ]. index = 5 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Hierarchy' ]. index = 6 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString ]. index = 7 ifTrue: [ attribute := TextURL new. thisSel := attribute analyze: self selection asString ]. index = 8 ifTrue: [ "Edit hidden info" thisSel := self hiddenInfo. "includes selection" attribute := TextEmphasis normal ]. index = 9 ifTrue: [ "Copy hidden info"
self copyHiddenInfo. ^ true ]. "no other action" thisSel ifNil: [ ^ true ] ] ]. (keyCode between: 6 and: 9) ifTrue: [ sensor leftShiftDown ifTrue: [ keyCode = 6 ifTrue: [ attribute := TextKern kern: -1 ]. keyCode = 7 ifTrue: [ attribute := TextKern kern: 1 ] ] ifFalse: [ "And remember this: nine is fine for underline, obliter-eight it as you see fit, seven has been bold for ever'n, which leaves six as the obivous fix to emphasize your poetics." attribute := TextEmphasis perform: (#(italic bold struckOut underlined) at: keyCode - 5). oldAttributes do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]] ] ]. keyCode = 0 ifTrue: [attribute := TextEmphasis normal]. attribute ifNil: [^ true]. beginTypeInBlock ~ ~ nil ifTrue: [ "only change emphasisHere while typing" self insertTypeAhead: characterStream. emphasisHere := Text addAttribute: attribute toArray: oldAttributes. ^ true ]. self replaceSelectionWith: (thisSel asText addAttribute: attribute). ^ true! !!ParagraphEditor class methodsFor: 'class initialization' stamp: 'mt 8/11/2023 14:47'!yellowButtonMenu ^ SelectionMenu fromArray: StringHolder yellowButtonMenuItems! !!ParagraphEditor class methodsFor: 'keyboard shortcut tables' stamp: 'mt 8/11/2023 14:45'!initializeCmdKeyShortcuts "Initialize the (unshifted) command-key (or alt-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "ParagraphEditor initialize" | cmdMap | cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash" cmdMap at: 1 + 1 put: #cursorHome:. "home key" cmdMap at: 4 + 1 put: #cursorEnd:. "end key" cmdM ap at: 8 + 1 put: #backspace:. "ctrl-H or delete key" cmdMap at: 11 + 1 put: #cursorPageUp:. "page up key" cmdMap at: 12 + 1 put: #cursorPageDown:. "page down key" cmdMap at: 13 + 1 put: #crWithIndent:. "cmd-Return" cmdMap at: 27 + 1 put: #offerMenuFromEsc:. "escape key" cmdMap at: 28 + 1 put: #cursorLeft:. "left arrow key" cmdMap at: 29 + 1 put: #cursorRight:. "right arrow key" cmdMap at: 30 + 1 put: #cursorUp:. "up arrow key" cmdMap at: 31 + 1 put: #cursorDown:. "down arrow key" cmdMap at: 32 + 1 put: #selectWord:. "space bar key" cmdMap at: 127 + 1 put: #forwardDelete:. "del key" '0123456789' do: [:char | cmdMap at: char asciiValue + 1 put: #changeEmphasis:]. "triplet = {character. comment selector. novice appropiated}" #( ($a #selectAll: ) ($b #browseIt: ) ($c #copySel ection: ) ($d #doIt: ) ($e #exchange: ) ($f #find: ) ($g #findAgain: ) ($h #setSearchString: ) ($i #inspectIt: ) ($j #doAgainOnce: ) ($k #offerFontMenu: ) ($l #cancel: ) ($m #implementorsOfIt: ) ($n #sendersOfIt: ) ($o #spawnIt: ) ($p #printIt: ) ($q #querySymbol: ) ($s #save: ) ($t #tempCommand: ) ($u #align: ) ($v #paste: ) ($w #backWord: ) ($x #cut: ) ($y #swapChars: ) ($z #undo: ) ) do:[:triplet | cmdMap at: triplet first asciiV alue + 1 put: triplet second]. CmdActions := cmdMap.! !!ParagraphEditor class methodsFor: 'keyboard shortcut tables' stamp: 'mt 8/11/2023 14:46'!initializeShiftCmdKeyShortcuts "Initialize the shift-command-key (or control-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the capitalized versions of the letters. TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values." | cmdMap | "shift-command and control shortcuts" cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash" cmdMap at: ( 1 + 1) put: #cursorHome:. "home key" cmdMap at: ( 4 + 1) put: #cursorEnd:. "end key" cmdMap at: ( 8 + 1) put: #forwardDelete:. "ctrl-H or delete key" cmdMap at: (11 + 1) put: #cursorPageUp:. "page up key" cmdMap at: (12 + 1) put: #cursorPageDown:. "page down key" cmdMap at: (13 + 1) put: #crWithIndent:. "ctrl-Return" cmdMap at: (27 + 1) put: #offerMenuFromEsc:. "escape key" cmdMap at: (28 + 1) put: #cursorLeft:. "left arrow key" cmdMap at: (29 + 1) put: #cursorRight:. "right arrow key" cmdMap at: (30 + 1) put: #cursorUp:. "up arrow key" cmdMap at: (31 + 1) put: #cursorDown:. "down arrow key" cmdMap at: (32 + 1) put: #selectWord:. "space bar key" cmdMap at: (45 + 1) put: #changeEmphasis:. "cmd-sh-minus" cmdMap at: (61 + 1) put: #changeEmphasis:. "cmd-sh-plus" cmdMap at: (127 + 1) put: #forwardDelete:. "del key" "triplet = {character. comment selector. novice appropiated}" #( ($a argAdvance: ) ($b browseItHere: ) ($c compareToClipboard: ) ($d debugIt:
) ($e methodStringsContainingIt:) ($f displayIfFalse: ) ($g fileItIn: ) ($h cursorTopHome: ) ($i exploreIt: ) ($j doAgainMany: ) ($k changeStyle: ) ($m selectCurrentTypeIn: ) ($n referencesToIt: ) ($p makeProjectLink: ) ($s search: ) ($t displayIfTrue: ) ($u changeLfToCr: ) ($v pasteInitials: ) ($w methodNamesContainingIt:) ($x makeLowercase: ) ($y makeUppercase: ) ($z makeCapitalized: ) ) do:[:triplet | cmdMap at: (triplet first asciiValue + 1) put: tr iplet second. "plain keys" cmdMap at: (triplet first asciiValue - 32 + 1) put: triplet second. "shifted keys" cmdMap at: (triplet first asciiValue - 96 + 1) put: triplet second. "ctrl keys" ]. ShiftCmdActions := cmdMap! !!PasteUpMorph methodsFor: 'accessing' stamp: 'mt 8/11/2023 16:19'!flapTab "Answer the tab affilitated with the receiver. Normally every flap tab is expected to have a PasteUpMorph which serves as its 'referent.'" self isFlap ifFalse: [^ nil]. ^ self flapTabs detect: [:any| any referent == self] ifNone: [nil]! !!PasteUpMorph methodsFor: 'caching' stamp: 'mt 3/10/2023 15:07'!releaseCachedState super releaseCachedState. self isWorldMorph ifTrue:[self cleanseStepList].! !!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'mt 8/14/2023 17:42'!acceptDroppingMorph: dropped event: evt "The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitatin g event is supplied" | aMorph | (self isWorldMorph and: [dropped isTransferMorph] and: [self hasTransferMorphConverter not]) ifTrue: [ dropped dragTransferType = #filesAndDirectories ifTrue: [^ self dropFiles: dropped passenger event: evt]. dropped dragTransferType = #sourceCode ifTrue: [^ self dropSourceCode: dropped passenger event: evt]. dropped dragTransferType = #inspectorField "See Tools-Inspector" ifTrue: [^ self dropInspectorField: dropped passenger event: evt]. dropped dragTransferType = #explorerField "See Tools-Explorer" ifTrue: [^ self dropExplorerField: dropped passenger from: dropped source model event: evt]]. aMorph := self morphToDropFrom: dropped. self isWorldMorph ifFalse: [super acceptDroppingMorph: aMorph event: evt] ifTrue: ["Add the given morph to this world and start s tepping it if it wants to be." aMorph isInWorld ifFalse: [aMorph position: evt position]. self addMorphFront: aMorph. (aMorph fullBounds intersects: self viewBox) ifFalse: [Beeper beep. aMorph position: self bounds center]]. aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]]. self isPartsBin ifTrue: [aMorph isPartsDonor: true. aMorph stopSteppingSelfAndSubmorphs. aMorph suspendEventHandler] ifFalse: [self world startSteppingSubmorphsOf: aMorph]. self bringTopmostsToFront.! !!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'mt 8/14/2023 17:41'!morphToDropFrom: aMorph "Given a morph being carried by the hand which the hand is about to drop, answer the actual morph to be deposited. Normally this would be just the morph itself, but several unusual cases arise, which this method is designed to service." | aNail rep resentee handy posBlock | handy := self isWorldMorph ifTrue: [self primaryHand] ifFalse: [self currentHand]. posBlock := [:z | | tempPos | tempPos := handy position - ((handy targetOffset - aMorph formerPosition) * (z extent / aMorph extent)) rounded. self pointFromWorld: tempPos]. self alwaysShowThumbnail ifTrue: [aNail := aMorph representativeNoTallerThan: self maxHeightToAvoidThumbnailing norWiderThan: self maximumThumbnailWidth thumbnailHeight: self heightForThumbnails. aNail == aMorph ifFalse: [aMorph formerPosition: aMorph position. aNail position: (posBlock value: aNail)]. ^aNail]. ((aMorph isKindOf: MorphThumbnail) and: [(representee := aMorph morphRepresented) owner isNil]) ifT rue: [representee position: (posBlock value: representee). ^representee]. ^aMorph morphToDropInPasteUp: self! !!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/15/2023 13:45'!handlesKeyboard: evt ^self isWorldMorph! !!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/15/2023 13:45'!keyStroke: anEvent "A keystroke has been made. Service event handlers and, if it's a keystroke presented to the world, dispatch it to #unfocusedKeystroke:" | selected | super keyStroke: anEvent. "Give event handlers a chance" selected := self selectedObject. selected isNil ifFalse:[ selected moveOrResizeFromKeystroke: anEvent ]. self isWorldMorph ifTrue: [self keystrokeInWorld: anEvent]! !!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 16:08'!mouseDown: evt "Handle a mouse down event." | grabbedMorph handHadHalos | (Preferences generalizedYellowButtonMenu and: [evt yellowButtonPressed])
ifTrue: [^ self yellowButtonActivity: evt shiftPressed]. grabbedMorph := self morphToGrab: evt. grabbedMorph ifNotNil:[ grabbedMorph isSticky ifTrue:[^self]. self isPartsBin ifFalse:[^evt hand grabMorph: grabbedMorph]. grabbedMorph := grabbedMorph partRepresented duplicate. grabbedMorph restoreSuspendedEventHandler. (grabbedMorph fullBounds containsPoint: evt position) ifFalse:[grabbedMorph position: evt position]. "Note: grabbedMorph is ownerless after duplicate so use #grabMorph:from: instead" ^ evt hand grabMorph: grabbedMorph from: self]. (super handlesMouseDown: evt) ifTrue:[^super mouseDown: evt]. handHadHalos := evt hand halo notNil. evt hand removeHalo. "shake off halos" evt hand releaseKeyboardFocus. "shake of keyboard foci" self submorphs select:[:each | each hasProperty: #morphHierarchy] thenDo:[:each | each delete]. (evt shiftPressed not and:[ self isWorldMorph not and:[ self wantsEasySelection not ]]) ifTrue:[ "explicitly ignore the event if we're not the world and we'll not select, so that we could be picked up if need be" evt wasHandled: false. ^ self. ]. ( evt shiftPressed or: [ self wantsEasySelection ] ) ifTrue:[ "We'll select on drag, let's decide what to do on click" | clickSelector | clickSelector := nil. evt shiftPressed ifTrue:[ clickSelector := #findWindow:. ] ifFalse:[ self isWorldMorph ifTrue:[ clickSelector := handHadHalos ifTrue: [ #delayedInvokeWorldMenu: ] ifFalse: [ #invokeWorldMenu: ] ] ]. evt hand waitForClicksOrDrag: self event: evt selectors: { clickSelector. nil. nil. #dragThroughOnDesktop: } threshold: Hand Morph dragThreshold. ] ifFalse:[ "We wont select, just bring world menu if I'm the world" self isWorldMorph ifTrue:[ handHadHalos ifTrue: [ self delayedInvokeWorldMenu: evt ] ifFalse: [ self invokeWorldMenu: evt ] ] ].! !!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/7/2023 18:18'!windowEvent: anEvent self windowEventHandler ifNotNil: [^self windowEventHandler windowEvent: anEvent]. anEvent type caseOf: { [#windowClose] -> [TheWorldMenu basicNew quitSession]. [#windowDeactivated] -> [ "The host window has been deactivated. Until it regains the focus, honor the fact that we will not receive keyboard events again by changing the current keyboard focus morph. windowHostFocusMorph represents the host system which now holds the keyboard focus instead of the previousFocus." (self valueOfProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | "There is currently no exact-once guarantee for this event type from the VM. Mark any older host focus morph as inactive, it will be held as the previousFocus of the next host focus morph." hostFocus active: false]. self setProperty: #windowHostFocusMorph toValue: (WindowHostFocusMorph new in: [:hostFocus | hostFocus previousFocus: anEvent hand keyboardFocus. anEvent hand newKeyboardFocus: hostFocus.]; yourself)]. [#windowActivated] -> [ "Alright, the spook is over!! We have back control over the keyboard focus, delete the windowHostFocusMorph and restore the previous focus holder." (self removeProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | hostFocus active: false. (anEvent hand keyboardFocus == hostFocus and: [hostFocus previousF ocus notNil]) ifTrue: [anEvent hand newKeyboardFocus: hostFocus previousFocus]]]. } otherwise: []! !!PasteUpMorph methodsFor: 'events-processing' stamp: 'mt 3/10/2023 16:09'!tryInvokeHalo: aUserInputEvent Morph haloForAll ifFalse: [ ^ self ]. (self transferHalo: aUserInputEvent) ifTrue: "The event was handled, don't let it cause any further side-effects." [ aUserInputEvent ignore ].! !!PasteUpMorph methodsFor: 'events-processing' stamp: 'mt 3/10/2023 11:27'!tryInvokeMetaMenu: anEvent | innerMost target | Morph metaMenuForAll ifFalse: [^ self]. innerMost := (self morphsAt: anEvent position unlocked: true) first. "Traverse the owner chain if some morph does not want to show its meta menu." target := innerMost. [target isNil or: [target wantsMetaMenu]] whileFalse: [target := target owner]. target ifNil: [^ self]. target invokeMetaMenu: anEvent. anEvent ignore.! !!PasteUpMorph methodsFor: 'ha los and balloon help' stamp: 'mt 3/7/2023 17:39'!wantsHaloFromClick (owner isSystemWindow) ifTrue: [^ false]. ^ true.! !!PasteUpMorph methodsFor: 'initialization' stamp: 'mt 3/10/2023 15:29'!initialize"initialize the state of the receiver" super initialize."" padding := 3. self enableDragNDrop. self clipSubmorphs: true. self initializeKeyboardShortcuts. self initializeMouseShortcuts.! !!PasteUpMorph methodsFor: 'menu & halo' stamp: 'mt 8/11/2023 16:18'!addCustomMenuItems: menu hand: aHandMorph "Add morph-specific menu itemns to the menu for the hand" super addCustomMenuItems: menu hand: aHandMorph. self isWorldMorph ifTrue: [ | twm | menu addLine. menu addUpdating: #showWorldMainDockingBarString action: #toggleShowWorldMainDockingBar. menu addLine. Flaps sharedFlapsAllowed ifTrue: [ menu addUpdating: #suppressFlapsString
target: Project current action: #toggleFlapsSuppressed. ]. twm := TheWorldMenu new. twm world: self project: Project current hand: aHandMorph. menu add: 'old desktop menu... (W)' translated subMenu: twm buildWorldMenu. ].! !!PasteUpMorph methodsFor: 'menu & halo' stamp: 'mt 8/16/2023 16:02'!addWorldHaloMenuItemsTo: aMenu hand: aHandMorph "Add standard halo items to the menu, given that the receiver is a World" | unlockables | self addFillStyleMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph. aMenu addLine. self addWorldToggleItemsToHaloMenu: aMenu. aMenu addLine. self addCopyItemsTo: aMenu. self addExportMenuItems: aMenu hand: aHandMorph. self addMiscExtrasTo: aMenu. self addDebuggingItemsTo: aMenu hand: aHandMorph. aMenu addLine. aMenu defaultTarget: self. aMenu addLine. unlockables := self submorphs select: [:m | m isLo cked]. unlockables size = 1 ifTrue: [aMenu add: ('unlock "{1}"' translated format:{unlockables first externalName})action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' translated action: #unlockContents]. aMenu defaultTarget: aHandMorph.! !!PasteUpMorph methodsFor: 'options' stamp: 'mt 8/4/2023 14:08'!autoLineLayout: aBoolean "Make the receiver be viewed with auto-line-layout, which means that its submorphs will be laid out left-to-right and then top-to-bottom in the manner of a word processor, or (if aBoolean is false,) cease applying auto-line-layout" aBoolean ifTrue:[ self layoutPolicy: TableLayout new. self layoutInset: 8; cellGap: 4. self listDirection: #leftToRight; wrapDirection: #topToBottom. ] ifFalse:[ self layoutPolicy: nil. self layoutInset: 0; cellGap: 0. ].! !!PasteUpMorph methodsFor: 'undo' stamp: 'fbs 12/31/2013 12:08'!onceAgainDismiss: aMorph "Occasioned by a r edo of a dismiss-via-halo" aMorph dismissMorph. TrashCanMorph preserveTrash ifTrue: [TrashCanMorph slideDismissalsToTrash ifTrue:[aMorph slideToTrash: nil] ifFalse:[TrashCanMorph moveToTrash: aMorph]]! !!PasteUpMorph methodsFor: 'undo' stamp: 'mt 8/4/2023 14:45'!reintroduceIntoWorld: aMorph "The given morph is being raised from the dead. Bring it back to life." (aMorph valueOfProperty: #lastPosition) ifNotNil: [:pos | aMorph position: pos]. aMorph openInWorld ! !!PasteUpMorph methodsFor: 'WiW support' stamp: 'raa 11/14/2017 07:47'!installAsActiveSubprojectIn: enclosingWorld at: newBounds titled: aString | window howToOpen tm boundsForWorld | howToOpen := self embeddedProjectDisplayMode. "#scaled may be the only one that works at the moment" submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." boundsForWorld := howToOpen == #naked ifTrue : [newBounds] ifFalse: [bounds]. worldState canvas: nil. worldState viewBox: boundsForWorld. self bounds: boundsForWorld. "self viewBox: Display boundingBox." "worldState handsDo: [:h | h initForEvents]." self installFlaps. "SystemWindow noteTopWindowIn: self." "self displayWorldSafely." howToOpen == #naked ifTrue: [enclosingWorld addMorphFront: self]. howToOpen == #window ifTrue: [window := (SystemWindow labelled: aString) model: self. window addMorph: self frame: (0 @ 0 extent: 1.0 @ 1.0). window openInWorld: enclosingWorld]. howToOpen == #frame ifTrue: [window := (AlignmentMorphBob1 new) minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color green; bounds: newBounds. window addMorph: self. window openInWorld: enclosingWorld]. howToOp en == #scaled ifTrue: [self position: 0 @ 0. window := (EmbeddedWorldBorderMorph new) minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color green; bounds: newBounds. tm := BOBTransformationMorph new. window addMorph: tm. tm addMorph: self. window openInWorld: enclosingWorld. tm changeWorldBoundsToShow: bounds. self arrangeToStartSteppingIn: enclosingWorld "tm scale: (tm width / self width min: tm height / self height) asFloat."]! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 8/14/2023 17:32'!findWindow: evt "Present a menu names of windows and naked morphs, and activate the one that gets chosen. Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo." | menu expanded collapsed nakedMorphs | menu := MenuMorph new. expanded := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed not]. collapsed := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed]. nakedMorphs := self submorphsSatisfying: [:m | m isSystemWindow not and: [(m isFlapTab) not]]. (expanded isEmpty & (collapsed isEmpty & nakedMorphs isEmpty)) ifTrue: [^ Beeper beep]. (expanded sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: (w label contractTo: 80) target: w action: #beKeyWindow. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. (expanded isEmpty | (collapsed isEmpty & nakedMorphs isEmpty)) ifFalse: [menu addLine]. (collapsed sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: (w labe l contractTo: 80) target: w action: #collapseOrExpand. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. nakedMorphs isEmpty ifFalse: [menu addLine]. (nakedMorphs sort: [:w1 :w2 | w1 nameForFindWindowFeature caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) do: [:w | menu add: (w nameForFindWindowFeature contractTo: 80) target: w action: #comeToFrontAndAddHalo]. menu addTitle: 'find window' translated. menu popUpEvent: evt in: self.! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 11:27'!invokeWorldMenu: evt "Put up the world menu, triggered by the passed-in event." self putUpWorldMenu: evt.! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 11:27'!keystrokeInWorld: evt "A keystroke was hit when no keyboard focus was set, so it is sent here to the world instead." | aChar isCmd ascii | aChar := evt keyCharacter. (ascii := aChar asciiValue) = Character escape asciiValue ifTrue: [evt commandKeyPressed ifFalse: [^ self putUpWorldMenuFromEscapeKey]]. (evt controlKeyPressed not and: [(#(1 4 8 28 29 30 31 32) includes: ascii) "home, end, backspace, arrow keys, space" and: [self keyboardNavigationHandler notNil]]) ifTrue: [self keyboardNavigationHandler navigateFromKeystroke: aChar]. isCmd := evt commandKeyPressed and: [Preferences cmdKeysInText]. (isCmd and: [Preferences honorDesktopCmdKeys]) ifTrue: [^ self dispatchCommandKeyInWorld: aChar event: evt]. "It was unhandled. Remember the keystroke." self lastKeystroke: evt keyString. self triggerEvent: #keyStroke! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/8/2023 10:36'!putUpNewMorphMenu "Put up the New Morph menu in the world" TheWorldMenu new world: self project: Project current hand: self currentHand; newMorph! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 16:08'!putUpWorldMenuFromEscapeKey
self putUpWorldMenu: self currentEvent.! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/10/2023 13:57'!allNonWindows "Answer all non-window submorphs" ^submorphs select: [:m | (m isSystemWindow) not and: [m wantsToBeTopmost not]]! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/10/2023 15:29'!beWorldForProject: aProject self privateOwner: nil. worldState := WorldState new. self addHand: HandMorph new. self setProperty: #optimumExtentFromAuthor toValue: Display extent. self startSteppingSubmorphsOf: self! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/15/2023 13:18'!initForProject: aWorldState worldState := aWorldState. self viewBox: Display boundingBox. self color: Preferences defaultWorldColor. self addHand: HandMorph new. self setProperty: #optimumExtentFromAuthor toValue: Display extent. self borderWidth: 0. model := nil.! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 8/11/2023 16:20'!install owner := nil. "since we may have been inside another world previously" submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." self viewBox: Display boundingBox. EventSensor default flushEvents. worldState handsDo: [:h | h initForEvents]. self installFlaps. self borderWidth: 0. "default" (Preferences showSecurityStatus and: [SecurityManager default isInRestrictedMode]) ifTrue: [self borderWidth: 2; borderColor: Color red]. SystemWindow noteTopWindowIn: self.! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 8/10/2023 15:27'!paintBox "Return the painting controls widget (PaintBoxMorph) to be used for painting in this world. If there is not already a PaintBox morph, or if it has been deleted from this world, create a new one." | newPaintBox refPoint | self allMorphsDo: [:m | (m isKindOf: PaintB oxMorph) ifTrue: [^ m]]. refPoint := self topRight. newPaintBox := PaintBoxMorph new. newPaintBox position: (refPoint - (newPaintBox width @ 0)). self addMorph: newPaintBox. ^ newPaintBox! !!PasteUpMorph methodsFor: 'world state' stamp: 'sw 9/2/1999 12:01'!paintBoxOrNil "Return the painting controls widget (PaintBoxMorph) to be used for painting in this world. If there is not already a PaintBox morph return nil" self allMorphsDo: [:m | (m isKindOf: PaintBoxMorph) ifTrue: [^ m]]. ^ nil! !!PasteUpMorph methodsFor: '*Tools' stamp: 'mt 3/10/2023 16:08'!defaultDesktopCommandKeyTriplets "Answer a list of triplets of the form <key> <receiver> <selector> [+ optional fourth element, a <description> for use in desktop-command-key-help] that will provide the default desktop command key handlers. If the selector takes an argument, that argument will be the command-key event" "World initializeDesktopCommandKeySelectors" | noviceKeys expertKeys | no viceKeys := { {$r. self. #restoreMorphicDisplay. 'Redraw the screen' translated}. {$M. self. #toggleShowWorldMainDockingBar. 'Show/Hide the Main Docking Bar' translated}. {$]. Smalltalk. #saveSession. 'Save the image.' translated}. }. expertKeys := { {$b. SystemBrowser. #defaultOpenBrowser. 'Open a new System Browser' translated}. {$k. Workspace. #open. 'Open a new Workspace' translated}. {$m. self. #putUpNewMorphMenu. 'Put up the "New Morph" menu' translated}. {$O. self. #findAMonticelloBrowser. 'Bring a Monticello window into focus.' translated}. {$t. self. #findATranscript:. 'Make a System Transcript visible' translated}. {$w. SystemWindow. #closeTopWindow. 'Close the topmost window' translated}. {Character escape. SystemWindow. #closeTopWindow. 'Close the topmost window' translated}. {$C. self. #findAChangeSorter:. 'Make a Change Sorter visible' translated}. {$L. self. #findAFileList:. 'Make a File List visible' translated}. {$P. self. #findAPreferencesPanel:. 'Activate the Preferences tool' translated}. {$R. Utilities. #browseRecentSubmissions. 'Make a Recent Submissions browser visible' translated}. {$W. self. #findAMessageNamesWindow:. 'Make a MessageNames tool visible' translated}. {$Z. ChangeList. #browseRecentLog. 'Browse recently-logged changes' translated}. {$. SystemWindow. #sendTopWindowToBack. 'Send the top window to the back' translated}. {$_. Smalltalk. #quitPrimitive. 'Quit the image immediately.' translated}. {$-. Preferences. #decreaseFontSize. 'Decrease all font sizes' translated}. {$+. Preferences. #increaseFontSize. 'Increase all font sizes' translated}. }. ^ noviceKeys, expertKeys! !!PasteUpMorph methodsFor: 'flaps' stamp: 'mt 8/4/2023 14:02'!addGlobalFlaps "Must make global flaps adapt to world. Do this even if not shown, so the old world will not be pointed at by the flaps." | use thisWorld | use := Flaps sharedFlapsAllowed. Project current flapsSuppressed ifTrue: [use := false]. "Smalltalk isMorphic ifFalse: [use := false]." thisWorld := use ifTrue: [self] ifFalse: [PasteUpMorph new initForProject: "fake to be flap owner" WorldState new; bounds: (0@0 extent: 4000@4000); viewBox: (0@0 extent: 4000@4000)]. Flaps globalFlapTabsIfAny do: [:aFlapTab | (Project current isFlapEnabled: aFlapTab) ifTrue: [(aFlapTab world == thisWorld) ifFalse: [thisWorld addMorphFront: aFlapTab]. "always do" use ifTrue: [aFlapTab spanWorld. aFlapTab adjustPositionAfterHidingFlap. aFlapTab flapShowing ifTrue: [aFlapTab showFlap]]]]! !!PasteUpMorph methodsFor: 'flaps' stamp: 'nice 12/27/2009 20:14'!localFlapTabs "Answer a list of local fla p tabs in the current project" | globalList aList | globalList := Flaps globalFlapTabsIfAny. aList := OrderedCollection new. submorphs do: [:m | | aFlapTab | ((m isFlapTab) and: [(globalList includes: m) not]) ifTrue: [aList add: m] ifFalse: [((m isFlap) and: [(aFlapTab := m submorphs detect: [:n | n isFlapTab] ifNone: [nil]) notNil]) ifTrue: [aList add: aFlapTab]]]. ^ aList! !!PasteUpMorph methodsFor: '*services-base' stamp: 'mt 8/4/2023 14:03'!openWorldMenu | menu | menu := (TheWorldMenu new world: self project: nil hand: self primaryHand) buildWorldMenu. menu addTitle: Preferences desktopMenuTitle translated. menu openInHand! !!PasteUpMorph methodsFor: '*services-base' stamp: 'mt 8/28/2023 14:42'!worldMenu ^ TheWorldMenu new world: self project: nil hand: self primaryHand! !!PasteUpMorph class methodsFor: 'scripting' stamp: 'mt 3/15/2023 13:30'!authoringPrototype "Answer an instance of the receiver suitable for placing in a parts bin for authors" | proto | proto := self new markAsPartsDonor. proto color: Color green muchLighter; extent: 100 @ 80; borderColor: (Color r: 0.645 g: 0.935 b: 0.161). proto extent: 300 @ 240. proto beSticky. ^ proto! !!PasteUpMorph class methodsFor: '*MorphicExtras-class initialization' stamp: 'mt 7/31/2023 11:14'!initialize "Initialize the class" self registerInFlapsRegistry.! !!PolygonMorph methodsFor: 'stepping' stamp: 'mt 3/10/2023 15:01'!stepTime "Answer the desired time between steps in milliseconds." ^ 100! !!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:59'!printStandardSystemFonts "self printStandardSystemFonts" | string | string := String streamContents: [ :s | #(standardDefaultTextFont standardListFont standardFlapFont standardMenuFont windowTitleFont standardBalloonHelpFont standardCodeFont standardButtonFont) do: [:selector | | font | font := Preferences perform: selector. s nextPutAll: selector; space; nextPutAll: font familyName; space; nextPutAll: (AbstractFont emphasisStringFor: font emphasis); nextPutAll: ' points: '; print: font pointSize; nextPutAll: ' height: '; print: font height; cr ]]. (StringHolder new) contents: string; openLabel: 'Current system font settings' translated.! !!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:58'!refreshFontSettings "Try to update all the current font settings to make things consistent." UserInterfaceTheme current applyAfter: [ self setFlapsFontTo: (self standardFlapFont); setWindowTitleFontTo: (self windowTitleFont); setListFontTo: (self standardListFont); setMenuFontTo: (self standardMenuFont);
setSystemFontTo: (TextStyle defaultFont); setCodeFontTo: (self standardCodeFont); setBalloonHelpFontTo: (BalloonMorph balloonFont)]. SystemWindow allSubInstancesDo: [ :s | | rawLabel | rawLabel := s getRawLabel. rawLabel owner vResizing: #spaceFill. rawLabel font: rawLabel font. s setLabel: s label. s replaceBoxes ].! !!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:59'!restoreFontsAfter: aBlock "Restore the currently chosen set of standard fonts after evaluating aBlock. Used for tests that modify the default fonts." | standardDefaultTextFont standardListFont standardMenuFont windowTitleFont standardBalloonHelpFont standardCodeFont standardButtonFont | standardDefaultTextFont := Preferences standardDefaultTextFont. standardListFont := Preferences standardListFont. standardMenuFont := Preferences standardMenuFont. windowTitleFont := Preferences windowTitleFont. standardBalloonHelpFont := Preferences standardBalloonHelpFont. standardCodeFont := Preferences standardCodeFont. standardButtonFont := Preferences standardButtonFont. ^ UserInterfaceTheme current applyAfter: [ aBlock ensure: [ Preferences setSystemFontTo: standardDefaultTextFont. Preferences setListFontTo: standardListFont. Preferences setMenuFontTo: standardMenuFont. Preferences setWindowTitleFontTo: windowTitleFont. Preferences setBalloonHelpFontTo: standardBalloonHelpFont. Preferences setCodeFontTo: standardCodeFont. Preferences setButtonFontTo: standardButtonFont]].! !!Preferences class methodsFor: 'support - misc' stamp: 'mt 3/7/2023 15:42'!personalizeUserMenu: aMenu "The user has clicked on the morphic desktop with the yellow mouse button (option+click on the Mac); a menu is being constructed to present to the user in response; its default target is the current world. In th is method, you are invited to add items to the menu as per personal preferences. The default implementation, for illustrative purposes, sets the menu title to 'personal', and adds items for go-to-previous-project, show/hide flaps, and load code updates" aMenu addTitle: 'personal' translated. "Remove or modify this as per personal choice" aMenu addStayUpItem. aMenu add: 'previous project' translated action: #goBack. aMenu add: 'load latest code updates' translated target: MCMcmUpdater action: #updateFromServer. aMenu add: 'about this system...' translated target: Smalltalk action: #aboutThisSystem.! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'!classicHaloSpecs "Non-iconic halos with traditional placements" "Preferences installClassicHaloSpecs" "Preferences resetHaloSpecifications" " <- will result in the standard default halos being reinstalled" "NB: listed below in clockwise order" ^ #( " selecto r horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addMenuHandle: left top (red) none) (addDismissHandle: leftCenter top (red muchLighter) 'Halo-Dismiss') (addGrabHandle: center top (black) none) (addDragHandle: rightCenter top (brown) none) (addDupHandle: right top (green) none) (addDebugHandle: right topCenter (blue veryMuchLighter) none) (addGrowHandle: right bottom (yellow) none) (addScaleHandle: right bottom (lightOrang e) none) (addFontEmphHandle: rightCenter bottom (lightBrown darker) none) (addFontStyleHandle: center bottom (lightRed) none) (addFontSizeHandle: leftCenter bottom (lightGreen) none) (addRecolorHandle: right bottomCenter (magenta darker) none) (addRotateHandle: left bottom (blue) none))! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/8/2023 11:41'!customHaloSpecs "Intended for you to modify to suit your personal preference. What is implemented in the default here is just a skeleton; in comment at the bottom of this method are some useful lines you may wish to paste in to the main body here, possibly modifying positions, colors, etc.. Note that in this example, we include: Dismiss handle, at top-left M enu handle, at top-right Resize handle, at bottom-right Rotate handle, at bottom-left Drag handle, at top-center Recolor handle, at left-center. (this one is NOT part of the standard formulary -- it is included here to illustrate how to add non-standard halos) Note that the optional handles for specialized morphs, such as Sketch, Text, PasteUp, are also included" ^ #( (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addMenuHandle: right top (red) 'Halo-Menu') (addDragHandle: center top (brown) 'Halo-Drag') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bot tom (lightOrange) 'Halo-Scale') (addRecolorHandle: left center (green muchLighter lighter) 'Halo-Recolor') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') ) " Other useful handles... selector horiz vert color info icon key --------- ------ ----------- ------------------------------- --------------- (addTileHandle: left bottomCenter (lightBrown) 'Halo-Tile') (addViewHandle: left center (cyan) 'Halo-View') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addFewerHandlesHandle: left topCenter (paleBuff) 'Halo-FewerHandles') (addPaintBgdHandle: right center (lightGray) 'Halo-Paint') (addRepaintHandle: right center (lightGray) 'Halo-Paint ') "! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/8/2023 11:30'!haloSpecificationsForWorld | desired | "Answer a list of HaloSpecs that describe which halos are to be used on a world halo, what they should look like, and where they should be situated" "Preferences resetHaloSpecifications" desired := #(addDebugHandle: addMenuHandle: addHelpHandle: addRecolorHandle:). ^ self haloSpecifications select: [:spec | desired includes: spec addHandleSelector]! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'!iconicHaloSpecifications "Answer an array that characterizes the locations, colors, icons, and selectors of the halo handles that may be used in the iconic halo scheme" "Preferences resetHaloSpecifications" ^ #( " selector horiz vert color info icon key --------- ------ ----------- -------------------------------
---------------" (addCollapseHandle: left topCenter (tan) 'Halo-Collapse') (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addMenuHandle: leftCenter top (red) 'Halo-Menu') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue)
'Halo-Help') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor') ) ! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'!simpleFullHaloSpecifications "This method gives the specs for the 'full' handles variant when simple halos are in effect" "Preferences resetHaloSpecifications" ^ #( " selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addMenuHandle: leftCenter top (red) 'Halo-Menu') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale') (addFewerHandlesHandle: left topCenter (paleBuff) 'Halo-FewerHandles') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor') ) ! !!Preferences class methodsFor: 'defaults' stamp: 'mt 8/29/2023 15:25'!defaultValueTableForCurrentRelease "Answer a table defining default values for all the prefere nces in the release. Returns a list of (pref-symbol, boolean-symbol) pairs" ^ #( (alternativeBrowseIt false) (annotationPanes false) (areaFillsAreTolerant false) (areaFillsAreVeryTolerant false) (automaticKeyGeneration false) (balloonHelpEnabled true) (balloonHelpInMessageLists false) (caseSensitiveFinds false) (changeSetVersionNumbers true) (checkForSlips true) (checkForUnsavedProjects true) (cmdDotEnabled true) (collapseWindowsInPlace false) (confirmFirstUseOfStyle true) (conversionMethodsAtFileOut false) (debugHaloHandle true) (debugPrintSpaceLog false) (debugShowDamage false) (decorateBrowserButtons true) (diffsInChangeList true) (diffsWithPrettyPrint false) (dismissAllOnOptionClose false) (fastDragWindowForMorphic true) (fullScreenLeavesDeskMargins true) (higherPerformance false) (honorDesktopCm dKeys true) (logDebuggerStackToFile true) (menuKeyboardControl false) (modalColorPickers true) (mouseOverForKeyboardFocus false) (navigatorOnLeftEdge true) (optionalButtons true) (passwordsOnPublish false) (personalizedWorldMenu true) (postscriptStoredAsEPS false) (projectViewsInWindows true) (projectZoom true) (projectsSentToDisk false) (readDocumentAtStartup true) (restartAlsoProceeds false) (reverseWindowStagger true) (roundedMenuCorners true) (scrollBarsNarrow false) (scrollBarsOnRight true) (securityChecksEnabled false) (showBoundsInHalo false) (showDirectionForSketches false) (showDirectionHandles false) (showProjectNavigator false) (showSecurityStatus true) (signProjectFiles true) (smartUpdating true) (startInUntrustedDirectory false) (systemWindowEmbedOK false) (timeStampsInMenuTitles true) (turnOffPowerManager false) (twentyFourHourFileStamps true) (uniqueNamesInHalos false) (useButtonPropertiesToFire false) (warnAboutInsecureContent true) (warnIfNoChangesFile true) (warnIfNoSourcesFile true))"Preferences defaultValueTableForCurrentRelease do: [:pair | (Preferences preferenceAt: pair first ifAbsent: [nil]) ifNotNilDo: [:pref | pref defaultValue: (pair last == true)]].Preferences chooseInitialSettings."! !!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/10/2023 16:09'!disableProgrammerFacilities "Warning: do not call this lightly!! It disables all access to menus, debuggers, halos. There is no guaranteed return from this, which is to say, you cannot necessarily reenable these things once they are disabled -- you can only use whatever the UI of the current project affords, and you cannot even snapshot -- you can only quit. You can completely r everse the work of this method by calling the dual Preferences method enableProgrammerFacilities, provided you have left yourself leeway to bring about a call to that method. To set up a system that will come up in such a state, you have to request the snapshot in the same breath as you disable the programmer facilities. To do this, put the following line into the 'do' menu and then evaluate it from that 'do' menu: Preferences disableProgrammerFacilities.You will be prompted for a new image name under which to save the resulting image." Beeper beep. (self confirm: 'CAUTION!!!!This is a drastic step!!Do you really want to do this?') ifFalse: [Beeper beep. ^self inform: 'whew!!']. self disable: #cmdDotEnabled. "No user-interrupt-into-debugger" self compileAccessorForPreferenceNamed: #cmdGesturesEnabled value: false. "No halos, etc." self compileAccessorForPreferenceNamed: #cmdKeysInText value: false. "No user commands invokable via cmd-key combos in text editor" self disable: #warnIfNoSourcesFile. self disable: #warnIfNoChangesFile. Smalltalk saveAs! !!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/10/2023 16:09'!enableProgrammerFacilities "Meant as a one-touch recovery from a #disableProgrammerFacilities call." "Preferences enableProgrammerFacilities" self enable: #cmdDotEnabled. self compileAccessorForPreferenceNamed: #cmdGesturesEnabled value: true. self compileAccessorForPreferenceNamed: #cmdKeysInText value: true. self enable: #warnIfNoSourcesFile. self enable: #warnIfNoChangesFile.! !!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/15/2023 13:50'!setNotificationParametersForStandardPreferences "Set up the notification parameters for the standard preferences that require need them. When adding new Preferences that require use of the notification mechanism, users declare the notifcation info as part of the call that adds the preference, or afterwards -- the two relevant methods for doing that are: Preferences.addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: and Preference changeInformee:changeSelector:" "Preferences setNotificationParametersForStandardPreferences" #( (annotationPanes annotationPanesChanged) (optionalButtons optionalButtonsChanged) (smartUpdating smartUpdatingChanged) ) do: [:pair | | aPreference | aPreference := self preferenceAt: pair first. aPreference changeInformee: self changeSelector: pair second]! !!Preferences class methodsFor: 'initialization - save/load' stamp: 'mt 3/7/2023 13:27'!loadPreferencesFrom: aFile | stream params dict desktopColor patternsToIgnore | patternsToIgnore := #('*updateMapName' '*defaultUpdateURL'). stream := ReferenceStream fileNamed: aFile. params := stream n ext. self assert: (params isKindOf: IdentityDictionary). params removeKey: #PersonalDictionaryOfPreferences. dict := stream next. self assert: (dict isKindOf: IdentityDictionary). desktopColor := stream next. stream close. dict rehash. "See http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217817.html" dict keys reject: [:key | patternsToIgnore anySatisfy: [:pattern | pattern match: key]] thenDo: [:key | | value | value := dict at: key. (self preferenceAt: key ifAbsent: [nil]) ifNotNil: [:pref | [pref preferenceValue: value preferenceValue] on: Deprecation do: [ : err | "Ignore preferences which may not be supported anymore."]]]. params keysAndValuesDo: [ :key :value | self setParameter: key to: value ]. Project current world fillStyle: desktopColor.! !!ProgressMorph methodsFor: 'private' stamp: 'mt 8/11/2023 14:00'!fontOfPointSize: size ^ (TextConstants at: Prefe rences standardDefaultTextFont familyName ifAbsent: [TextStyle default]) fontOfPointSize: size! !!Project methodsFor: 'displaying' stamp: 'mt 8/28/2023 14:08'!displayZoom: entering "Show the project transition when entering a new project" | newDisplay vanishingPoint | "Show animated zoom to new display" newDisplay := self imageForm. entering ifTrue: [vanishingPoint := Sensor cursorPoint] ifFalse: [vanishingPoint := self viewLocFor: CurrentProject]. Display zoomIn: entering orOutTo: newDisplay at: 0@0 vanishingPoint: vanishingPoint.! !!Project methodsFor: 'file in/out' stamp: 'mt 8/16/2023 15:46'!exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: noInteraction | exportChangeSet | "An experimental version to fileout a changeSet first so that a project can contain its own classes" "Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target i mage. Name it <project name>.extSeg. Player classes are included automatically." exportChangeSet := nil. (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [ (noInteraction or: [self confirm: 'Would you like to include all the changes in the change set as part of this publishing operation?' translated]) ifTrue: [ exportChangeSet := changeSet ]. ]. ^ self exportSegmentWithChangeSet: exportChangeSet fileName: aFileName directory: aDirectory withoutInteraction: noInteraction! !!Project methodsFor: 'menu messages' stamp: 'mt 8/23/2023 13:50'!validateProjectNameIfOK: aBlock | details | details := world valueOfProperty: #ProjectDetails. details ifNotNil: ["ensure project info matches real project name" details at: 'projectname' put: self name. ]. self doWeWantToRename ifTrue: [self notify: 'Please choose another name!!'] ifFalse: [aBlock value: details]! !!MorphicProj ect methodsFor: 'initialize' stamp: 'mt 3/8/2023 09:42'!initialize "Initialize a new Morphic Project" super initialize. world := PasteUpMorph newWorldForProject: self. self setWorldBackground: true. Locale switchToID: CurrentProject localeID. Project current isMorphic ifTrue: [ "Only trigger tool builders etc. if we are already in the same kind of project because there is global state that cannot yet be configured in a dynamic scope such as 'ToolBuilder default'." self assureMainDockingBarPresenceMatchesPreference].! !!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/16/2023 17:02'!exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileNamedirectory: aDirectory withoutInteraction: noInteraction "Store my project out on the disk as an *exported*ImageSegment. All outPointers will be in a form that can be resolvedin the target image. Name it <project name>.extSeg. Whatdo we doabout subProjects, especially if they are out as local imagesegments? Force them to come in? Player classes are included automatically." | is str ans revertSeg roots holder collector fd mgr stacks | "Files out a changeSet first, so that a project can containits own classes" world ifNil: [^ false]. ScrapBook default emptyScrapBook. world currentHand pasteBuffer: nil. "don't write the paste buffer." world currentHand mouseOverHandler initialize. "forget about any references here" "Display checkCurrentHandForObjectToPaste." Command initialize. world clearCommandHistory. world fullReleaseCachedState. world cleanseStepList. world localFlapTabs size = world flapTabs size ifFalse: [noInteraction ifTrue: [^ false]. self error: 'Still holding onto Global flaps']. world releaseSqueakPages. holder := Project allProjects. "force them in to outPointers, where DiskProxys are made" "Just export me, not my previous version" revertSeg := self parameterAt: #revert ToMe. self removeParameter: #revertToMe. roots := OrderedCollection new. roots add: self; add: world; add: transcript; add: aChangeSetOrNil; add: thumbnail; add: world activeHand. roots := roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail" fd := aDirectory directoryNamed: self resourceDirectoryName. fd assureExistence. "Clean up resource references before writing out" mgr := self resourceManager. self resourceManager: nil. ResourceCollector current: ResourceCollector new. ResourceCollector current localDirectory: fd. ResourceCollector current baseUrl: self resourceUrl. ResourceCollector current initializeFrom: mgr. ProgressNotification signal: '2:findingResources' extra:'(collecting resources...)' translated. "Must activate old world because this is run at #armsLength. Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent will not be captured correc tly if referenced from blocks or user code." world becomeActiveDuring: [is := ImageSegment copySmartRootsExport: roots asArray. "old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)"]. self resourceManager: mgr. collector := ResourceCollector current. ResourceCollector current: nil. ProgressNotification signal: '2:foundResources' extra: ''. is state = #tooBig ifTrue: [collector replaceAll. ^ false]. str := ''. "considered legal to save a project that has never been entered" (is outPointers includes: world) ifTrue: [str := str, '\Project''s own world is not in the segment.' translated withCRs]. str isEmpty ifFalse: [ans := Project uiManager chooseOptionFrom: {'Do not write file' translated. 'Write file anyway' translated. 'Debug' translated} title: str. ans = 1 ifTrue:
[revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. ^ false]. ans = 3 ifTrue: [collector replaceAll. self halt: 'Segment not written' translated]]. stacks := is findStacks. is writeForExportWithSources: aFileName inDirectory: fd changeSet: aChangeSetOrNil. SecurityManager default signFile: aFileName directory: fd. "Compress all files and update check sums" collector forgetObsolete. self storeResourceList: collector in: fd. self storeHtmlPageIn: fd. self storeManifestFileIn: fd. self writeStackText: stacks in: fd registerIn: collector. "local proj.005.myStack.t" self compressFilesIn: fd to: aFileName in: aDirectory resources: collector. "also deletes the resource directory" "Now update everything tha t we know about" mgr updateResourcesFrom: collector. revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. world flapTabs do: [:ft | (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. ^ true! !!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/11/2023 16:06'!storeSegment "Store my project out on the disk as an ImageSegment. Keep the outPointers in memory. Name it <project name>.seg. *** Caller must be holding (Project alInstances) to keep subprojects from going out. ***" | currentWorld is sizeHint | currentWorld := Project current world. (currentWorld == world) ifTrue: [^ false]. "self inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ false]. "already done" world ifNil: [^ false]. ScrapBook default emptyScrapBook. currentWorld checkCurrentHandForObjectToPaste. world releaseSqueakPages. sizeHint := self projectParame ters at: #segmentSize ifAbsent: [0]. is := ImageSegment copyFromRootsLocalFileFor: {world} sizeHint: sizeHint. is state = #tooBig ifTrue: [^ false]. is segment size < 2000 ifTrue: ["debugging" Transcript show: self name, ' only ', is segment size printString, 'bytes in Segment.'; cr]. self projectParameters at: #segmentSize put: is segment size. is extract; writeToFile: self name. ^ true! !!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/11/2023 16:08'!storeSegmentNoFile "For testing. Make an ImageSegment. Keep the outPointers in memory. Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)" | is currentWorld | currentWorld := Project current world. (currentWorld == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ self]. "already done" world ifNil: [^ self]. "Do this on project enter" ScrapBook de fault emptyScrapBook. currentWorld checkCurrentHandForObjectToPaste2. is := ImageSegment copyFromRootsLocalFileFor: {world} sizeHint: 0. is segment size < 800 ifTrue: ["debugging" Transcript show: self name, ' did not get enough objects'; cr. ^ Beeper beep]. is extract. "is instVarAt: 2 put: is segment clone." "different memory"! !!MorphicProject methodsFor: 'enter' stamp: 'mt 3/10/2023 15:01'!enterAsActiveSubprojectWithin: enclosingWorld "Install my ChangeSet, Transcript, and scheduled views as current globals. If returningFlag is true, we will return to the project from whence the current project was entered; don't change its previousProject link in this case. If saveForRevert is true, save the ImageSegment of the project being left. If revertFlag is true, make stubs for the world of the project being left. If revertWithoutAsking is true in the project being left, then always revert." "Experimental mods for i nitial multi-project work: 1. assume in morphic (this eliminated need for <showZoom>) 2. assume <saveForRevert> is false (usual case) - removed <old> 3. assume <revertFlag> is false 4. assume <revertWithoutAsking> is false - <forceRevert> now auto false <seg> n.u. 5. no zooming 6. assume <projectsSentToDisk> false - could be dangerous here 7. assume no isolation problems (isolationHead ==) 8. no closing scripts " self isCurrentProject ifTrue: [^ self]. "guards ifNotNil: [ guards := guards reject: [:obj | obj isNil]. guards do: [:obj | obj okayToEnterProject ifFalse: [^ self]] ]." "CurrentProject makeThumbnail." "--> Display bestGuessOfCurrentWorld triggerClosingScripts." CurrentProject displayDepth: Display depth. displayDepth == nil ifTrue: [displayDepth := Display depth]. "Display newDepthNoRestore: displayDepth." "(world hasProperty: #letTheMusicPlay) ifT rue: [world removeProperty: #letTheMusicPlay] ifFalse: [Smalltalk at: #ScorePlayer ifPresent: [:playerClass | playerClass allSubInstancesDo: [:player | player pause]]]." "returningFlag ifTrue: [nextProject := CurrentProject] ifFalse: [previousProject := CurrentProject]." "CurrentProject saveState." "CurrentProject := self." "Smalltalk newChanges: changeSet." "TranscriptStream newTranscript: transcript." "Sensor flushKeyboard." "recorderOrNil := Display pauseMorphicEventRecorder." "Display changeMorphicWorldTo: world." "Signifies Morphic" world installAsActiveSubprojectIn: enclosingWorld titled: self name. "recorderOrNil ifNotNil: [recorderOrNil resumeIn: world]." self removeParameter: #exportState. "self spawnNewProcessAndTerminateOld: true"! !!MorphicProject methodsFor: 'enter' stamp: 'mt 8/28/2023 14:28'!finalEnterActions: leavingP roject "Perform the final actions necessary as the receiver project is entered" | navigator armsLengthCmd navType thingsToUnhibernate | "If this image has a global World variable, update it now" Smalltalk globals at: #World ifPresent: [ :w | Smalltalk globals at: #World put: world ]. world install. world transferRemoteServerFrom: leavingProject world. "(revertFlag | saveForRevert | forceRevert) ifFalse: [ (Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [ self storeSomeSegment]]." "Transfer event recorder to me." leavingProject isMorphic ifTrue: [ leavingProject world pauseEventRecorder ifNotNil: [:rec | rec resumeIn: world]]. self initializeMenus. self projectParameters at: #projectsToBeDeleted ifPresent: [ :projectsToBeDeleted | self removeParameter: #projectsToBeDeleted. projectsToBeDeleted do: [:each | each delete]]. Locale switchToID: self localeID. thingsToUnhibernate := world valueOfProperty: #thingsToUnhibernate ifAbsent: [#()]. thingsToUnhibernate do: [:each | each unhibernate]. world removeProperty: #thingsToUnhibernate. navType := ProjectNavigationMorph preferredNavigator. armsLengthCmd := self parameterAt: #armsLengthCmd ifAbsent: [nil]. navigator := world findA: navType. (Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator and: [navigator isNil]]) ifTrue: [(navigator := navType new) bottomLeft: world bottomLeft; openInWorld: world]. navigator notNil & armsLengthCmd notNil ifTrue: [navigator color: Color lightBlue]. armsLengthCmd notNil ifTrue: [self flapsSuppressed: true. navigator ifNotNil: [navigator visible: false]. armsLengthCmd openInWorld: world]. world reformulateUpdatingMenus. self assureMainDockingBarPresenceMatchesPreference. world repairEmbeddedWorlds.! !!MorphicProject methodsFor: 'enter ' stamp: 'mt 8/11/2023 16:05'!finalExitActions: enteringProject "Pause sound players, subject to preference settings" (world hasProperty: #letTheMusicPlay) ifTrue: [world removeProperty: #letTheMusicPlay] ifFalse: [SoundService stop]. world sleep. (world findA: ProjectNavigationMorph) ifNotNil: [:navigator | navigator retractIfAppropriate]. self clearGlobalState. EventSensor default flushEvents. self world submorphsDo: [:ea | ea removeProperty: #dropShadow].! !!MorphicProject methodsFor: 'release' stamp: 'mt 3/10/2023 15:10'!prepareForDelete "The window in which the project is housed is about to deleted. Perform any necessary actions to prepare for deletion." Smalltalk at: #WonderlandCameraMorph ifPresent:[:aClass | world submorphs do: "special release for wonderlands" [:m | (m isKindOf: aClass) and: [m getWonderland release]]].! !!MorphicProject methodsFor: 'language' sta mp: 'mt 3/10/2023 16:07'!chooseNaturalLanguage "Put up a menu allowing the user to choose the natural language for the project" | aMenu availableLanguages | aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'choose language' translated. aMenu lastItem setBalloonText: 'This controls the human language in which tiles should be viewed. It is potentially extensible to be a true localization mechanism, but initially it only works in the classic tile scripting system. Each project has its own private language choice' translated. aMenu addStayUpItem. availableLanguages := NaturalLanguageTranslator availableLanguageLocaleIDs sorted:[:x :y | x displayName < y displayName]. availableLanguages do: [:localeID | aMenu addUpdating: #stringForLanguageNameIs: target: Locale selector: #switchToID: argumentList: {localeID}]. aMenu popUpInWorld"Project current chooseNaturalLanguage"! !!MorphicProject method sFor: 'language' stamp: 'mt 8/4/2023 15:20'!updateLocaleDependents "Set the project's natural language as indicated" Flaps disableGlobalFlaps: false. Flaps enableGlobalFlaps. (self isFlapIDEnabled: 'Navigator' translated) ifFalse: [Flaps enableDisableGlobalFlapWithID: 'Navigator' translated]. ScrapBook default emptyScrapBook. MenuIcons initializeTranslations. super updateLocaleDependents. "self setFlaps. self setPaletteFor: aLanguageSymbol."! !!MorphicProject methodsFor: 'scheduling & debugging' stamp: 'mt 3/10/2023 11:26'!interruptCleanUpFor: interruptedProcess "Clean up things in case of a process interrupt." super interruptCleanUpFor: interruptedProcess. self uiProcess == interruptedProcess ifTrue: [ self currentHand ifNotNil: [:hand | hand interrupted]. world removeProperty: #shouldDisplayWorld].! !!Project class methodsFor: 'utilities' stamp: 'mt 3/15/2023 14:01'!removeAll: projects "Project removeAll: (Pr oject allSubInstances copyWithout: Project current)" AllProjects := nil. Smalltalk garbageCollect. ProjectHistory currentHistory initialize. projects do: [:project | Project deletingProject: project]. Smalltalk garbageCollect. Smalltalk garbageCollect.! !!ProjectLauncher methodsFor: 'initialization' stamp: 'mt 8/4/2023 13:21'!setupFlaps "Only called when the image has been launched in a browser. If I am requested to show all flaps, then if flaps already exist, use them as is, else set up to show the default set of standard flaps." whichFlaps = 'all' ifTrue: [Flaps sharedFlapsAllowed ifFalse: [Flaps enableGlobalFlaps]]! !!ProjectLauncher methodsFor: 'running' stamp: 'mt 8/4/2023 13:23'!startUp | scriptName loader isUrl | self setupFlaps. Smalltalk firstArgMightBeDocument ifTrue: [scriptName := Smalltalk documentPath. scriptName := scriptName convertFromSystemString. scriptName isEmpty ifFalse: ["figure out if script name is a URL by itself" isUrl := (scriptName asLowercase beginsWith: 'http://') or: [(scriptName asLowercase beginsWith: 'file://') or: [scriptName asLowercase beginsWith: 'ftp://']]. isUrl ifFalse: [| encodedPath pathTokens | "Allow for ../dir/scriptName arguments" pathTokens := scriptName splitBy: FileDirectory slash. pathTokens := pathTokens collect: [:s | s encodeForHTTP]. encodedPath := pathTokens reduce: [:acc :each | acc , FileDirectory slash , each]. scriptName := (FileDirectory default uri resolveRelativeURI: encodedPath) asString]]] ifFalse: [scriptName := '']. scriptName isEmptyOrNil ifT rue: [^ self]. loader := CodeLoader new. loader loadSourceFiles: (Array with: scriptName). (scriptName asLowercase endsWith: '.pr') ifTrue: [self installProjectFrom: loader] ifFalse: [loader installSourceFiles]! !!ProjectLoading class methodsFor: 'accessing' stamp: 'mt 8/28/2023 13:46'!projectStreamFromArchive: archive | ext prFiles entry unzipped | ext := FileDirectory dot, Project projectExtension. prFiles := archive members select:[:any| any fileName endsWith: ext]. prFiles isEmpty ifTrue: ['']. entry := prFiles first. unzipped := MultiByteBinaryOrTextStream on: (ByteArray new: entry uncompressedSize). entry extractTo: unzipped. ^unzipped reset! !!ProjectLoading class methodsFor: 'loading' stamp: 'mt 8/28/2023 13:51'!openName: aFileName stream: preStream fromDirectory: aDirectoryOrNilwithProjectView: existingView clearOriginFlag: clearOriginFlag "Reconstitute a Morph from the selected file, presumed torepresent a Morph saved via the SmartRefStream mechanism, and open itin an appropriate Morphic world." | morphOrList archive mgr substituteFont numberOfFontSubstitutes resultArray anObject project manifests dict | ProgressNotification signal: '0.2'. archive := preStream isZipArchive ifTrue:[ZipArchive new readFrom: preStream] ifFalse:[nil]. archive ifNotNil:[ manifests := (archive membersMatching: '*manifest'). (manifests size = 1 and: [((dict := self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression']) ifTrue: [^ self notify: 'S-Expression format projects not supported. Use Squeak 6.0 or older.']]. morphOrList := self morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive. morphOrList ifNil: [^ self]. ProgressNotification signal: '0.4'. resultArray := self fileInName: aFileName archive: archive morphOrList: morphOrList. anObject := resultArray first. numberOfFontSubstitut es := resultArray second. substituteFont := resultArray third. mgr := resultArray fourth. preStream close. ProgressNotification signal: '0.7'. "the hard part is over" (anObject isKindOf: ImageSegment) ifTrue: [ project := self loadImageSegment: anObject fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr. project noteManifestDetailsIn: dict. clearOriginFlag ifTrue: [project forgetExistingURL]. ProgressNotification signal: '0.8'. ^ project ifNil: [self inform: 'No project found in this file' translated] ifNotNil: [ProjectEntryNotification signal: project]]. Project current openViewAndEnter: anObject! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'tak 9/3/2006 11:00'!checkSecurity: aFileName preStream: preStream projStream: projStream "Answer true if passed" | trusted enterRestricted | trusted := SecurityManager default positionToSecureContentsOf:projStream. trusted ifFalse: [enterRestricted := (preStream isTypeHTTP or:[aFileName isNil]) ifTrue: [Preferences securityChecksEnabled] ifFalse: [Preferences standaloneSecurityChecksEnabled]. enterRestricted ifTrue: [SecurityManager default enterRestrictedMode ifFalse: [preStream close. ^ false]]]. ^ true! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'mt 8/28/2023 13:49'!fileInName: aFileName archive: archive morphOrList: morphOrList | baseChangeSet substituteFont numberOfFontSubstitutes exceptions anObject mgr | ResourceCollector current: ResourceCollector new. baseChangeSet := ChangeSet current. self useTempChangeSet. "named zzTemp" "The actual reading happens here" substituteFont := Preference s standardDefaultTextFont copy. numberOfFontSubstitutes := 0. exceptions := Set new. [[anObject := morphOrList fileInObjectAndCodeForProject] on: MissingFont do: [ :ex | exceptions add: ex. numberOfFontSubstitutes := numberOfFontSubstitutes + 1. ex resume: substituteFont ]] ensure: [ ChangeSet newChanges: baseChangeSet]. mgr := ResourceManager new initializeFrom: ResourceCollector current. mgr fixJISX0208Resource. mgr registerUnloadedResources. archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName]. ResourceCollector current: nil. ^ {anObject. numberOfFontSubstitutes. substituteFont. mgr}! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'mt 8/28/2023 14:00'!loadImageSegment: morphOrList fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr | proj projectsToBeD eleted f | (f := (Flaps globalFlapTabWithID: 'Navigator' translated)) ifNotNil: [f hideFlap]. proj := morphOrList arrayOfRoots detect: [:mm | mm isKindOf: Project] ifNone: [^ nil]. proj projectParameterAt: #substitutedFont put: substituteFont. proj projectParameters at: #MultiSymbolInWrongPlace put: false. "Yoshiki did not put MultiSymbols into outPointers in older images!!" morphOrList arrayOfRoots do: [:obj | obj fixUponLoad: proj seg: morphOrList "imageSegment"]. (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [ morphOrList arrayOfRoots do: [:obj | (obj isKindOf: HashedCollection ) ifTrue: [obj rehash]]]. proj resourceManager: mgr. "proj versionFrom: preStream." proj lastDirectory: aDirectoryOrNil. proj setParent: Project current. projectsToBeDeleted := OrderedCollection new. existingView == #none ifFalse: [ self makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted]. ChangeSet allChangeSets add: proj changeSet. Project current projectParameters at: #deleteWhenEnteringNewProject ifPresent: [ :ignored | projectsToBeDeleted add: Project current. Project current removeParameter: #deleteWhenEnteringNewProject. ]. projectsToBeDeleted isEmpty ifFalse: [ proj projectParameters at: #projectsToBeDeleted put: projectsToBeDeleted. ]. ^ proj! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'pre 8/22/2019 15:03'!makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted existingView ifNil: [ Smalltalk isMorphic ifTrue: [ proj createViewIfAppropriate. ] ifFalse: [ ChangeSet allChangeSets add: proj changeSet. Project current openProject: proj. "Note: in MVC we get no further than the above" ]. ] ifNot Nil: [ (existingView project isKindOf: DiskProxy) ifFalse: [ existingView project changeSet name: ChangeSet defaultName. projectsToBeDeleted add: existingView project. ]. (existingView owner isSystemWindow) ifTrue: [ existingView owner model: proj ]. existingView project: proj. ].! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'cmm 10/23/2013 16:24'!morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive "Answer morphOrList or nil if problem happened" | projStream localDir morphOrList | projStream := archive ifNil: [preStream] ifNotNil: [self projectStreamFromArchive: archive]. (self checkSecurity: aFileName preStream: preStream projStream: projStream) ifFalse: [^nil]. localDir := Project squeakletDirectory. aFileName ifNotNil: [ (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName~= l ocalDir pathName]) ifTrue: [ localDir deleteFileNamed: aFileName. (localDir fileNamed: aFileName) binary nextPutAll: preStream remainingContents; close. ]. ]. morphOrList := projStream asUnZippedStream. preStream sleep. "if ftp, let the connection close" ^ morphOrList! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'yo 2/5/2008 17:15'!parseManifest: aString | dict line index key value aStream | aStream := aString readStream. dict := Dictionary new. [(line := aStream nextLine) notNil] whileTrue: [ index := line indexOf: $:. index > 0 ifTrue: [ key := line copyFrom: 1 to: index - 1. value := (line copyFrom: index + 1 to: line size) withBlanksTrimmed. dict at: key put: value. ]. ]. ^ dict.! !!ProjectNavigationMorph methodsFor: 'buttons' stamp: 'mt 8/10/2023 11:32'!makeTheAdvancedButtons ^{ self buttonNewProject.
self buttonShare. self buttonPrev. self buttonNext. self buttonPublish. self buttonNewer. self buttonTell. self buttonFind. self buttonFullScreen. "self buttonFlaps." }, ( Preferences includeSoundControlInNavigator ifTrue: [{self buttonSound}] ifFalse: [#()] ), { self buttonLanguage. self buttonUndo. self buttonQuit. }! !!ProjectNavigationMorph methodsFor: 'buttons' stamp: 'mt 8/28/2023 14:27'!makeTheButtons ^ self makeTheAdvancedButtons! !!ProjectNavigationMorph methodsFor: 'the actions' stamp: 'mt 8/23/2023 13:51'!doPublishButtonMenuEvent: evt | selection | selection := UIManager default chooseFrom: { 'Publish' translated. 'Publish As...' translated. 'Publish to Different Server' translated. } values: { [self publishProject]. [self publishProjectAs]. [self publishDifferent]. } title: 'Publish options' translated. sel ection ifNil: [^self]. selection value.! !!ProjectSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'!addControls "Add the control bar at the top of the tool." | b r partsBinButton newButton aWrapper | newButton := ImageMorph new image: (Project current makeThumbnail scaledToSize: 48@36). newButton on: #mouseDown send: #insertNewProject: to: self. newButton setBalloonText: 'Make a new Project' translated. (partsBinButton := UpdatingThreePhaseButtonMorph checkBox) target: self; actionSelector: #togglePartsBinStatus; arguments: #(); getSelector: #getPartsBinStatus. (r := AlignmentMorph newRow) color: Color transparent; borderWidth: 0; layoutInset: 0; cellInset: 10@0; wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black. r addMorphBack: (self wrapperFor: (b label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort)). b := SimpleButtonMorph new target: self; color: self defaultColor darker; borderColor: Color black. r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #delete)); addTransparentSpacerOfSize: 8 @ 0; addMorphBack: (self wrapperFor: (newButton)); addTransparentSpacerOfSize: 8 @ 0. aWrapper := AlignmentMorph newRow beTransparent. aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0. aWrapper addMorphBack: (self wrapperFor: partsBinButton); addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated font: Preferences standardButtonFont) lock). r addMorphBack: aWrapper. self addMorphFront: r.! !!ProjectSorterMorph methodsFor: 'initialization' stamp: 'mt 8/14/2023 16:22'!in itialize "initialize the state of the receiver" super initialize. self useRoundedCorners. pageHolder useRoundedCorners; borderWidth: 0; color: (Form gridFormOrigin: 0 @ 0 grid: 32 @ 32 background: Color white line: Color blue muchLighter)! !!ProjectSorterMorph methodsFor: 'controls' stamp: 'mt 8/23/2023 13:50'!insertNewProject: evt [MorphicProject openViewOn: nil] on: ProjectViewOpenNotification do: [ :ex | ex resume: false].! !!RecordingControlsMorph methodsFor: 'button commands' stamp: 'mt 8/22/2023 15:53'!makeTile "Make a tile representing my sound. Get a sound-name from the user by which the sound is to be known." | tile | recorder verifyExistenceOfRecordedSound ifFalse: [^ self]. recorder pause. tile := InterimSoundMorph new sound: (SampledSound samples: recorder condensedSamples samplingRate: recorder samplingRate). tile bounds: tile fullBounds. tile openInHand! !!ReferenceMorph methodsFor: 'menu' stamp: 'mt 8/14/2023 17:24'!changeTabGraphic | aGraphicalMenu | aGraphicalMenu := GraphicalMenu new initializeFor: submorphs first withForms: submorphs first reasonableForms coexist: true. self primaryHand attachMorph: aGraphicalMenu.! !!ReferenceMorph methodsFor: 'menu' stamp: 'mt 7/31/2023 11:15'!graphicalMorphForTab | formToUse | formToUse := self valueOfProperty: #priorGraphic ifAbsent: [MenuIcons formAtKey: 'squeakyMouse']. ^ SketchMorph withForm: formToUse! !!FlapTab methodsFor: 'show & hide' stamp: 'mt 8/4/2023 14:02'!showFlap "Open the flap up" | thicknessToUse flapOwner | "19 sept 2000 - going for all paste ups <- raa note" flapOwner := self pasteUpMorph. self referentThickness <= 0 ifTrue: [thicknessToUse := lastReferentThickness ifNil: [100]. self orientation == #horizontal ifTrue: [referent height: thicknessToUse] ifFalse: [referent width: thicknessToUse]]. inboard ifTrue: [self stickOntoReferent]. "makes referent my owner, and positions me accordingly" referent pasteUpMorph == flapOwner ifFalse: [flapOwner accommodateFlap: self. "Make room if needed" flapOwner addMorphFront: referent. flapOwner startSteppingSubmorphsOf: referent. self positionReferent]. inboard ifFalse: [self adjustPositionVisAVisFlap]. flapShowing := true. self pasteUpMorph hideFlapsOtherThan: self ifClingingTo: edgeToAdhereTo. flapOwner bringTopmostsToFront! !!ReferenceStream class methodsFor: 'accessing' stamp: 'mt 8/28/2023 15:43'!versionCode "Answer a number representing the 'version' of the ReferenceStream facility; this is stashed at the beginning of ReferenceStreams, as a secondary versioning mechanism (the primary one is the fileTyp eCode). At present, it serves for information only, and is not checked for compatibility at reload time, but could in future be used to branch to variant code. " " 1 = original version 1992" " 2 = HyperSqueak. PathFromHome used for Objs outside the tree. SqueakSupport SysLibrary for shared globals like Display and StrikeFonts. File has version number, class structure, then an IncomingObjects manager. 8/16/96 tk. Extended to SmartRefStream. class structure also keeps superclasse chain. Does analysis on structure to see when translation methods are needed. Embedable in file-ins. (factored out HyperSqueak support) Feb-May 97 tk" " 3 = Reference objects are byte offsets relative to the start of the object portion of the file. Rectangles with values -2048 to 2047 are encoded compactly." " 4 = If UniClasses have class instance variables, append their values in the form (#Class43 (val1 val2 vla3)). An array of those. Can still read version 3." ^ 4! !!Release Builder class methodsFor: 'scripts' stamp: 'mt 8/16/2023 15:43'!configureTools "Initialize well-known tools and other resources." FileList initialize. FileServices initialize. "register file reader services" RealEstateAgent standardSize: 650@425. SMLoaderPlus setDefaultFilters: #(filterSafelyAvailable). "Default applications and tools." SystemBrowser default: TreeBrowser. MailSender default: nil. SoundService default: BaseSoundSystem. ToolSet default: StandardToolSet. WebBrowser default: nil.! !!ReleaseBuilder class methodsFor: 'scripts - support' stamp: 'mt 3/7/2023 14:05'!discardUserObjects "Remove the classes." MorphicModel removeUninstantiatedSubclassesSilently. "Clean-up environment hick-ups." Environment default allClassesDo: [:cls | (cls isUniClass and: [cls environment ~~ Environment default]) ifTrue: [Environment default forgetClass: cls logged: false]]. Environment default declarations select: [:bindi ng | (binding value isBehavior and: [binding value isUniClass]) and: [binding value isObsolete]] thenDo: [:binding | SystemOrganization removeElement: binding key. Environment default removeKey: binding key]. "Remove auto-generated accessors. See Preferences." (MCPackage named: 'Autogenerated') unload. "Remove empty categories for user objects. See Object class >> #categoryForUniclasses." SystemOrganizer cleanUp: true.! !!RemoteHandMorph methodsFor: 'event handling' stamp: 'mt 8/28/2023 14:35'!transmitEvent: aMorphicEvent "Transmit the given event to all remote connections." | firstEvt | self readyToTransmit ifFalse: [^ self]. self lastEventTransmitted = aMorphicEvent ifTrue: [^ self]. sendBuffer ifNil: [sendBuffer := WriteStream on: (String new: 10000)]. sendBuffer nextPutAll: aMorphicEvent storeString; cr. self lastEventTransmitted: aMorphicEvent. sendSocket isConnected ifTrue:[ sendState = #opening ifTrue: [ "connection established; disable TCP delays on sends" sendSocket setOption: 'TCP_NODELAY' value: true. "send worldExtent as first event" firstEvt := MorphicUnknownEvent new setType: #worldBounds argument: self worldBounds extent. sendSocket sendData: firstEvt storeString, (String with: Character cr). Transcript show: 'Connection established with remote WorldMorph at '; show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. sendState := #connected]. sendSocket sendData: sendBuffer contents. ] ifFalse: [ owner primaryHand removeEventListener: self. sendState = #connected ifTrue: [ "other end has closed; close our end" Transcript show: 'Closing connection with remote WorldMorph at '; show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. sendSocket cl ose. sendState := #closing]]. sendBuffer reset.! !!ResourceCollector methodsFor: 'initialize' stamp: 'mt 3/15/2023 14:07'!initialize originalMap := IdentityDictionary new. stubMap := IdentityDictionary new. locatorMap := IdentityDictionary new. internalStubs := IdentityDictionary new.! !!ScreenController methodsFor: 'nested menus' stamp: 'mt 7/31/2023 11:19'!helpMenu "Answer the help menu to be put up as a screen submenu" ^ SelectionMenu labelList: #( 'about this system...' 'update code from server' 'preferences...' 'command-key help' 'font size summary' 'useful expressions' 'view graphical imports' 'standard graphics library'), (Array with: (SoundService soundEnablingString)) , #( 'set author initials...' 'vm statistics' 'space left') lines: #(1 4 6 11) selections: #( aboutThisSystem absorbUpdatesFromServereditPreferences openCommandKeyHelp fontSizeSummary openStandardWorkspace viewImageImportssoundOnOrOff setAuthorInitials vmStatistics garbageCollect)"ScreenController new helpMenu startUp"! !!ScrollableField methodsFor: 'menu' stamp: 'mt 8/11/2023 14:47'!getMenu: shiftKeyState ^ shiftKeyState not ifTrue: [TextEditor yellowButtonMenu] ifFalse: [TextEditor shiftedYellowButtonMenu]! !!SelectionMorph methodsFor: 'halo commands' stamp: 'mt 3/10/2023 15:26'!duplicate "Make a duplicate of the receiver and havbe the hand grab it" selectedItems := self duplicateMorphCollection: selectedItems. selectedItems reverseDo: [:m | (owner ifNil: [self currentWorld]) addMorph: m]. dupLoc := self position. self currentHand grabMorph: self.! !!ServerDirectory class methodsFor: 'school support' stamp: 'mt 3/10/2023 11:45'!projectDefaultDirectory ^ FileDirectory default! !!ServerDirectory class methodsFor: 'server prefs' stamp: 'mt 8/16 /2023 15:50'!parseServerEntryFrom: stream | server type directory entries serverName | entries := ExternalSettings parseServerEntryArgsFrom: stream. serverName := entries at: 'name' ifAbsent: [^nil]. directory := entries at: 'directory' ifAbsent: [^nil]. type := entries at: 'type' ifAbsent: [^nil]. type = 'file' ifTrue: [ server := self determineLocalServerDirectory: directory. entries at: 'userListUrl' ifPresent:[:value | "Ignore" ]. entries at: 'baseFolderSpec' ifPresent:[:value | "Ignore" ]. ^self addLocalProjectDirectory: server]. type = 'bss' ifTrue: [server := SuperSwikiServer new type: #http]. type = 'http' ifTrue: [server := HTTPServerDirectory new type: #ftp]. type = 'ftp' ifTrue: [server := ServerDirectory new type: #ftp]. server directory: directory. entries at: 'server' ifPresent: [:value | server server: value]. entries at: 'user' ifPresent: [:value | server user: value]. entries at: 'group' ifPresent: [:value | server groupName: value]. entries at: 'passwdseq' ifPresent: [:value | server passwordSequence: value asNumber]. entries at: 'url' ifPresent: [:value | server altUrl: value]. entries at: 'loaderUrl' ifPresent: [:value | server loaderUrl: value]. entries at: 'acceptsUploads' ifPresent: [:value | server acceptsUploads: value asLowercase = 'true']. entries at: 'userListUrl' ifPresent:[:value | "Ignore" ]. entries at: 'encodingName' ifPresent:[:value | server encodingName: value]. ServerDirectory addServer: server named: serverName.! !!IconicButton methodsFor: 'initialization' stamp: 'mt 3/7/2023 15:06'!initializeWithThumbnail: aThumbnail withLabel: aLabel andColor: aColor andSend: aSelector to: aReceiver "Initialize the receiver to show aThumbnail on its face, giving it the label supplied and arranging for it, when the button goes down on it, to obtain a new morph by sending the supplied selector to the supplied receiver" | labeledItem nonTranslucent | nonTranslucent := aColor asNontranslucentColor. labeledItem := AlignmentMorph newColumn. labeledItem color: nonTranslucent. labeledItem borderWidth: 0. labeledItem layoutInset: 4@0; cellPositioning: #center. labeledItem addMorph: aThumbnail. labeledItem addMorphBack: (Morph new extent: (4@4)) beTransparent. labeledItem addMorphBack: (TextMorph new backgroundColor: nonTranslucent; contentsAsIs: aLabel; beAllFont: Preferences standardButtonFont; centered). self beTransparent; labelGraphic: ((labeledItem imageForm: 32 backgroundColor: nonTranslucent forRectangle: labeledItem fullBounds) replaceColor: nonTranslucent withColor: Color transparent); borderWidth: 0; target: aReceiver; actionSelector: #launchPartVia:label:; arguments: {aSelector. aLabel}; actWhen: #buttonDown. self stationarySetup.! !!IconicButton methodsFor: 'initialization' stamp: 'mt 3/15/2023 14:10'!setDefaultLabel self labelGraphic: (MenuIcons formAtKey: 'squeakyMouse')! !!HaloMorph methodsFor: 'handles' stamp: 'mt 3/15/2023 13:34'!addDismissHandle: handleSpec "Add the dismiss handle according to the spec, unless my target resists dismissal" | dismissHandle | target okayToAddDismissHandle ifTrue: [dismissHandle := self addHandle: handleSpec on: #mouseDown send: #mouseDownInDimissHandle:with: to: self. dismissHandle on: #mouseUp send: #maybeDismiss:with: to: self. dismissHandle on: #mouseDown send: #setDismissColor:with: to: self. dismissHandle on: #mouseMove send: #setDismissColor:with: to: self]! !!HaloMorph methodsFor: 'handles' stamp: 'mt 8/11/2023 14:24'!addDupHandle: haloSpec "Add the halo that offers duplication" self addHandle: haloSpec on: #mouseDown send: #doDup:with: to: self! !!HaloMorph methodsFor: 'handles' stamp: 'sw 1/26/2000 16:16'!addHelpHan dle: haloSpec target balloonText ifNotNil: [(self addHandle: haloSpec on: #mouseDown send: #mouseDownOnHelpHandle: to: innerTarget) on: #mouseUp send: #deleteBalloon to: innerTarget]! !!HaloMorph methodsFor: 'handles' stamp: 'RAA 3/15/2001 11:24'!addRecolorHandle: haloSpec "Add a recolor handle to the receiver, if appropriate" | recolorHandle | "since this halo now opens a more general properties panel, allow it in all cases" "innerTarget canSetColor ifTrue:" recolorHandle := self addHandle: haloSpec on: #mouseUp send: #doRecolor:with: to: self. recolorHandle on: #mouseUp send: #doRecolor:with: to: self! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/15/2023 14:10'!addGraphicalHandleFrom: formKey at: aPoint "Add the supplied form as a graphical handle centered at the given point. Return the handle." | handle aForm | aForm := (MenuIcons formAtKey: formKey) ifNil: [MenuIcons formAtKey: #SolidMenu]. handle := ImageMorph new image: a Form; bounds: (Rectangle center: aPoint extent: aForm extent). handle borderColor: Color black; borderWidth: 2. handle wantsYellowButtonMenu: false. self addMorph: handle. handle on: #mouseUp send: #endInteraction: to: self. ^ handle! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/15/2023 14:10'!createHandleAt: aPoint color: aColor iconName: iconName | bou handle | bou := Rectangle center: aPoint extent: self handleSize asPoint. Preferences alternateHandlesLook ifTrue: [handle := RectangleMorph newBounds: bou color: aColor. handle useRoundedCorners. self setColor: aColor toHandle: handle] ifFalse: [handle := EllipseMorph newBounds: bou color: aColor]. handle borderWidth: 0; wantsYellowButtonMenu: false. "" iconName isNil ifFalse: [| form | form := MenuIcons formAtKey: iconName. form isNil ifFalse: [| image | image := ImageMorph new.
image image: form scaleIconToDisplay. image color: aColor makeForegroundColor. image lock. handle addMorphCentered: image]]. "" ^ handle! !!HaloMorph methodsFor: 'private' stamp: 'mt 2/19/2021 14:52'!doGrow: evt with: growHandle "Called while the mouse is down in the grow handle" | newExtent extentToUse scale | evt hand obtainHalo: self. newExtent := (target pointFromWorld: evt cursorPoint - positionOffset) - target topLeft. evt shiftPressed ifTrue: [ scale := (newExtent x / (originalExtent x max: 1)) min: (newExtent y / (originalExtent y max: 1)). newExtent := (originalExtent x * scale) asInteger @ (originalExtent y * scale) asInteger ]. (newExtent x < 1 or: [newExtent y < 1 ]) ifTrue: [^ self]. target renderedMorph setExtentFromHalo: (extentToUse := newExtent). growHandle position: evt cursorPoint - (growHandle extent // 2 ). self layoutChanged. (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | "Update the final extent" cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: extentToUse]! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/8/2023 11:29'!doRecolor: evt with: aHandle "The mouse went down in the 'recolor' halo handle. Allow the user to change the color of the innerTarget" evt hand obtainHalo: self. (aHandle containsPoint: evt cursorPoint) ifFalse: "only do it if mouse still in handle on mouse up" [self delete. target addHalo: evt] ifTrue: [innerTarget changeColor. self showingDirectionHandles ifTrue: [self addHandles]]! !!HaloMorph methodsFor: 'private' stamp: 'ul 12/12/2009 14:11'!doRot: evt with: rotHandle "Update the rotation of my target if it is rotatable. Keep the relevant command object up to date." | degrees | evt hand obtainHalo: self. degre es := (evt cursorPoint - (target pointInWorld: target referencePosition)) degrees. degrees := degrees - angleOffset degrees. degrees := degrees detentBy: 10.0 atMultiplesOf: 90.0 snap: false. degrees = 0.0 ifTrue: [self setColor: Color lightBlue toHandle: rotHandle] ifFalse: [self setColor: Color blue toHandle: rotHandle]. rotHandle submorphsDo: [:m | m color: rotHandle color makeForegroundColor]. self removeAllHandlesBut: rotHandle. self showingDirectionHandles ifFalse: [self showDirectionHandles: true addHandles: false]. self addDirectionHandles. target rotationDegrees: degrees. rotHandle position: evt cursorPoint - (rotHandle extent // 2). (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | "Update the final rotation" cmd redoTarget: target renderedMorph selector: #heading: argument: degrees]. self layoutChanged! !!HaloMorph methodsFor: 'private' stamp: 'ul 12/12/2009 14:11'!doScale: evt with: scaleHandle "Update the scale of my target if it is scalable." | newHandlePos colorToUse | evt hand obtainHalo: self. newHandlePos := evt cursorPoint - (scaleHandle extent // 2). target scaleToMatch: newHandlePos. colorToUse := target scale = 1.0 ifTrue: [Color yellow] ifFalse: [Color orange]. self setColor: colorToUse toHandle: scaleHandle. scaleHandle submorphsDo: [:m | m color: colorToUse makeForegroundColor]. scaleHandle position: newHandlePos. self layoutChanged. (self valueOfProperty: #commandInProgress) ifNotNil:[:cmd | "Update the final extent" cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent ].! !!HaloMorph methodsFor: 'private' stamp: 'mt 8/11/2023 17:00'!endInteraction: event "Clean up after a user interaction with the a halo control" | m | (target isInWorld not or: [owner isNil]) ifTrue: [^self]. [target isFlexMorph and: [target hasNoScaleOrRotation]] whileTrue: [m := target firstSubmorph. target removeFlexShell. target := m]. self restoreTargetDropShadows. target changedViaHalo: self. self isInWorld ifTrue: ["make sure handles show in front, even if flex shell added" self flag: #tofix. "mt: Try to avoid deleting and re-creating an event handler (here: the handle) while handling the event." self comeToFront. self addHandles. event hand newMouseFocus: self]. (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | self rememberCommand: cmd. self removeProperty: #commandInProgress].! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/10/2023 15:08'!maybeDismiss: evt with: dismissHandle "Ask hand to dismiss my target if mouse comes up in it." evt hand obtainHalo: self. (dismissHandle containsPoint: evt cursorPoint) ifFal se: [self delete. target addHalo: evt] ifTrue: [target resistsRemoval ifTrue: [(Project uiManager chooseOptionFrom: {'Yes' translated. 'Um, no, let me reconsider' translated.} title: 'Really throw this away?' translated) = 1 ifFalse: [^ self]]. evt hand removeHalo. self delete. target dismissViaHalo].! !!HaloMorph methodsFor: 'private' stamp: 'HenrikSperreJohansen 1/21/2011 18:34'!mouseDownInDimissHandle: evt with: dismissHandle evt hand obtainHalo: self. SoundService soundEnabled ifTrue: [TrashCanMorph playMouseEnterSound]. self removeAllHandlesBut: dismissHandle. self setColor: Color darkGray toHandle: dismissHandle.! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/10/2023 13:51'!startDrag: evt with: dragHandle "Drag my target without removing it from its owner." self obtainHaloForEvent: evt andRemoveAllHandlesBut: dragHandle. target aboutToBeDraggedViaHalo. positionOffset := dragHandle center - (target point: target position in: owner).! !!HaloMorph methodsFor: 'private' stamp: 'ct 2/28/2022 16:24'!startGrow: evt with: growHandle "Initialize resizing of my target. Launch a command representing it, to support Undo" | botRt | self obtainHaloForEvent: evt andRemoveAllHandlesBut: growHandle. self backupAndHideTargetDropShadows. target aboutToBeGrownViaHalo. botRt := target point: target bottomRight in: owner. positionOffset := (self world viewBox containsPoint: botRt) ifTrue: [evt cursorPoint - botRt] ifFalse: [0@0]. self setProperty: #commandInProgress toValue: (Command new cmdWording: ('resize ' translated, target nameForUndoWording); undoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent). originalExtent := target extent! !!HaloMorph methodsFor: 'p rivate' stamp: 'mt 8/11/2023 16:59'!startRot: evt with: rotHandle "Initialize rotation of my target if it is rotatable. Launch a command object to represent the action" self obtainHaloForEvent: evt andRemoveAllHandlesBut: rotHandle. self backupAndHideTargetDropShadows. target aboutToBeRotatedViaHalo. target isFlexMorph ifFalse: [target addFlexShellIfNecessary]. growingOrRotating := true. self removeAllHandlesBut: rotHandle. "remove all other handles" angleOffset := evt cursorPoint - (target pointInWorld: target referencePosition). angleOffset := Point r: angleOffset r degrees: angleOffset degrees - target rotationDegrees. self setProperty: #commandInProgress toValue: (Command new cmdWording: ('rotate ' translated, target nameForUndoWording); undoTarget: target renderedMorph selector: #heading: argument: target rotationDegrees)! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/7/2023 16:46'!startS cale: evt with: scaleHandle "Initialize scaling of my target." self obtainHaloForEvent: evt andRemoveAllHandlesBut: scaleHandle. self backupAndHideTargetDropShadows. target aboutToBeScaledViaHalo. target isFlexMorph ifFalse: [target addFlexShellIfNecessary]. growingOrRotating := true. positionOffset := 0@0. originalExtent := target extent! !!HaloMorph methodsFor: 'pop up' stamp: 'mt 3/15/2023 13:40'!popUpFor: morph at: position hand: hand super popUpFor: morph at: position hand: hand. self startStepping.! !!HaloMorph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/15/2023 13:40'!delete "Delete the halo. Tell the target that it no longer has the halo; accept any pending edits to the name; and then actually delete myself" self acceptNameEdit. super delete.! !!SketchEditorMorph methodsFor: 'initialization' stamp: 'mt 8/10/2023 15:28'!initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph." | paintBoxBounds worldBounds | self setProperty: #recipientPasteUp toValue: aPasteUpMorph. paintBoxBounds := self world paintBox bounds. worldBounds := self world bounds. self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: ((boundsToUse topRight extent: paintBoxBounds extent) translatedToBeWithin: worldBounds) topLeft.! !!SketchEditorMorph methodsFor: 'start & finish' stamp: 'mt 8/10/2023 15:34'!cancelOutOfPainting "The user requested to back out of a painting session without saving" self deleteSelfAndSubordinates. emptyPicBlock ifNotNil: [emptyPicBlock value]. "note no args to block!!" hostView ifNotNil: [hostView changed]. ^ nil! !!SketchEditorMorph methodsFor: 'start & finish' stamp: 'mt 8/10/2023 15:34'!deliverPainting: result evt: evt "Done painting. May come from resume, or from original call. Execute user's post painting instructions in the block. Always use this standard one. 4/21/97 tk" | newBox newForm ans | palette ifNotNil: "nil happens" [palette setAction: #paint: evt: evt]. "Get out of odd modes" "rot := palette getRotations." "rotate with heading, or turn to and fro" "palette setRotation: #normal." result == #cancel ifTrue: [ ans := Project uiManager chooseOptionFrom: { 'throw it away' translated. 'keep painting it' translated} title: 'Do you really want to throw away what you just painted?' translated. ^ ans = 1 ifTrue: [self cancelOutOfPainting] ifFalse: [nil]]. "cancelled out of cancelling." "hostView rotationStyle: rot." "rotate with heading, or turn to and fro" newBox := paintingForm rectangleEnclosingPixelsNotOfColor: Color transparent. registrationPoint ifNotNil:
[registrationPoint := registrationPoint - newBox origin]. "relative to newForm origin" newForm := Form extent: newBox extent depth: paintingForm depth. newForm copyBits: newBox from: paintingForm at: 0@0 clippingBox: newForm boundingBox rule: Form over fillColor: nil. newForm isAllWhite ifTrue: [(self valueOfProperty: #background) == true ifFalse: [^ self cancelOutOfPainting]]. newForm fixAlpha. "so alpha channel stays intact for 32bpp" self delete. "so won't find me again" dimForm ifNotNil: [dimForm delete]. newPicBlock value: newForm value: (newBox copy translateBy: bounds origin).! !!SketchMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:15'!setNewFormFrom: formOrNil "Set the receiver's form as indicated. If nil is provided, then a default form will be used" formOrNil ifNotNil: [^ self form: formOrNil]. self form: (Form extent: 16@16 depth: 32)! !!SketchMorph methodsFor: 'initialization' stamp: 'm t 3/15/2023 14:10'!initialize"initialize the state of the receiver" ^ self initializeWith: (MenuIcons formAtKey: 'Painting') deepCopy! !!SketchMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 14:30'!addPaintingItemsTo: aMenu hand: aHandMorph | subMenu movies | subMenu := MenuMorph new defaultTarget: self. subMenu add: 'repaint' translated action: #editDrawing; add: 'set rotation center' translated action: #setRotationCenter; add: 'reset forward-direction' translated action: #resetForwardDirection; add: 'set rotation style' translated action: #setRotationStyle; add: 'erase pixels of color' translated action: #erasePixelsUsing:; add: 'recolor pixels of color' translated action: #recolorPixelsUsing:; add: 'reduce color palette' translated action: #reduceColorPalette:; add: 'detect edges' translated action: #edgeDetect; add: 'sharpen' translated action: #sharpen; add: 'blur' translated action: #blur;
add: 'emboss' translated action: #emboss; add: 'add a border around this shape...' translated action: #addBorderToShape:. movies := (self world rootMorphsAt: aHandMorph targetPoint) select: [:m | (m isKindOf: MovieMorph) or: [m isSketchMorph]]. movies size > 1 ifTrue: [subMenu add: 'insert into movie' translated action: #insertIntoMovie:]. aMenu add: 'painting...' translated subMenu: subMenu! !!SketchMorph methodsFor: 'menu' stamp: 'mt 8/10/2023 15:33'!editDrawingIn: aPasteUpMorph forBackground: forBackground "Edit an existing sketch." | w bnds sketchEditor rotCenter aWorld aPaintBox | self world assureNotPaintingElse: [^self]. w := aPasteUpMorph world. w displayWorld. self visible: false. bnds := forBackground ifTrue: [aPasteUpMorph boundsInWorld] ifFalse: [self boundsInWorld expandBy: 60 @ 60]. sketchEditor := SketchEditorMorph new. forBackground ifTrue: [sketchEditor setProperty: #background toValue: true]. w addMorphFront: sketchEditor. sketchEditor initializeFor: self inBounds: bnds pasteUpMorph: aPasteUpMorph. rotCenter := self rotationCenter. sketchEditor afterNewPicDo: [:aForm :aRect | | tfx | self visible: true. self form: aForm. tfx := aPasteUpMorph transformFrom: aPasteUpMorph world. self topRendererOrSelf position: (tfx globalPointToLocal: aRect origin). self rotationStyle: sketchEditor rotationStyle. self forwardDirection: sketchEditor forwardDirection. (rotCenter notNil and: [(rotCenter = (0.5 @ 0.5)) not]) ifTrue: [self rotationCenter: rotCenter]. aWorld := self world. (aPaintBox := aWorld paintBox) ifNotNil: [aPaintBox delete]. forBackground ifTrue: [self goBehind "shouldn't be necessary"]] ifNoBits: []! !!SketchMorph met hodsFor: 'menus' stamp: 'mt 3/10/2023 16:09'!addToggleItemsToHaloMenu: aCustomMenu "Add toggle-items to the halo menu" super addToggleItemsToHaloMenu: aCustomMenu. aCustomMenu addUpdating: #useInterpolationString target: self action: #toggleInterpolation.! !!SketchMorph methodsFor: 'menus' stamp: 'mt 8/11/2023 13:42'!chooseNewGraphic "Allow the user to choose a different form for her form-based morph" | aGraphicalMenu | aGraphicalMenu := GraphicalMenu new initializeFor: self withForms: self reasonableForms coexist: true. self primaryHand attachMorph: aGraphicalMenu.! !!SketchMorph methodsFor: 'parts bin' stamp: 'mt 3/15/2023 14:10'!initializeToStandAlone super initializeToStandAlone. self initializeWith: (MenuIcons formAtKey: 'Painting') deepCopy! !!ColorPickerMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 14:01'!mouseUp: evt self stopStepping. sourceHand := nil. deleteOnMou seUp ifTrue: [self delete]. self updateTargetColor.! !!ColorPickerMorph methodsFor: 'menu' stamp: 'mt 3/15/2023 14:09'!pickUpColorFor: aMorph "Show the eyedropper cursor, and modally track the mouse through a mouse-down and mouse-up cycle" | aHand localPt | aHand := aMorph ifNil: [self activeHand] ifNotNil: [aMorph activeHand]. aHand ifNil: [aHand := self currentHand]. self addToWorld: aHand world near: (aMorph ifNil: [aHand world]) fullBounds. self owner ifNil: [^ self]. aHand showTemporaryCursor: (MenuIcons formAtKey: #Eyedropper) hotSpotOffset: 2@14. "<<<< the form was changed a bit??" self updateContinuously: false. [Sensor anyButtonPressed] whileFalse: [self trackColorUnderMouse]. self deleteAllBalloons. localPt := Sensor cursorPoint - self topLeft. self inhibitDragging ifFalse: [ (DragBox containsPoint: localPt) ifTrue: ["Click or drag the drag-dot means to anchor as a modeless pick er" ^ self anchorAndRunModeless: aHand]. ]. (clickedTranslucency := TransparentBox containsPoint: localPt) ifTrue: [selectedColor := originalColor]. self updateContinuously: true. [Sensor anyButtonPressed] whileTrue: [self updateTargetColorWith: self indicateColorUnderMouse]. aHand newMouseFocus: nil; showTemporaryCursor: nil; flushEvents. self delete. ! !!ColorPickerMorph methodsFor: 'private' stamp: 'mt 3/10/2023 14:01'!pickColorAt: aGlobalPoint | alpha selfRelativePoint pickedColor | clickedTranslucency ifNil: [clickedTranslucency := false]. selfRelativePoint := (self globalPointToLocal: aGlobalPoint) - self topLeft. (FeedbackBox containsPoint: selfRelativePoint) ifTrue: [^ self]. (RevertBox containsPoint: selfRelativePoint) ifTrue: [^ self updateColor: originalColor feedbackColor: originalColor]. "check for transparent color and update using appropriate feedback color " (TransparentBox containsPoint: selfRelativePoint) ifTrue: [clickedTranslucency ifFalse: [^ self]. "Can't wander into translucency control" alpha := (selfRelativePoint x - TransparentBox left - 10) asFloat / (TransparentBox width - 20) min: 1.0 max: 0.0. "(alpha roundTo: 0.01) printString , ' ' displayAt: 0@0." " -- debug" self updateColor: (selectedColor alpha: alpha) feedbackColor: (selectedColor alpha: alpha). ^ self]. "pick up color, either inside or outside this world" clickedTranslucency ifTrue: [^ self]. "Can't wander out of translucency control" self locationIndicator visible: false. self refreshWorld. pickedColor := Display colorAt: aGlobalPoint. self locationIndicator visible: true. self refreshWorld. self updateColor: ( (selectedColor isColor and: [selectedColor isTranslucentColor])
ifTrue: [pickedColor alpha: selectedColor alpha] ifFalse: [pickedColor] ) feedbackColor: pickedColor! !!SmartRefStream methodsFor: 'read write' stamp: 'mt 3/10/2023 15:43'!initKnownRenames renamed at: #FlasherMorph put: #Flasher; at: #AlansTextPlusMorph put: #TextPlusMorph; at: #Project put: #MorphicProject; at: #InputSensor put: #EventSensor; yourself! !!SmartRefStream methodsFor: 'read write' stamp: 'mt 3/10/2023 15:43'!restoreClassInstVars "Install the values of the class instance variables of UniClasses." self flag: #todo. "mt: See EToys in Squeak 6.0 and before."! !!SqueakToolsDebuggerHelp class methodsFor: 'pages' stamp: 'mt 3/15/2023 14:10'!showForm: aSymbol | form contents | form := MenuIcons formAtKey: aSymbol. contents := (String with: Character cr) asText, (Text string: ' ' attribute: (TextFontReference toFont: (FormSetFont new fromFormArray: (Array with: form) asciiStart: Character space asInteger ascent: form height))), (String with: Character cr) asText. ^contents! !!SystemWindow methodsFor: 'initialization' stamp: 'mt 3/10/2023 16:09'!initializeLabelArea "Initialize the label area (titlebar) for the window." labelString ifNil: [labelString := 'Untitled Window']. label := StringMorph new contents: labelString; font: (self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont]); yourself. "Add collapse box so #labelHeight will work" collapseBox := self createCollapseBox. stripes := Array with: (RectangleMorph newBounds: bounds) with: (RectangleMorph newBounds: bounds). "see extent:" self addLabelArea. se lf setLabelWidgetAllowance. self addCloseBox. self class moveMenuButtonRight ifTrue: [self addLabel. self addMenuControl] ifFalse: [self addMenuControl. self addLabel]. self addExpandBox. labelArea addMorphBack: collapseBox. self setFramesForLabelArea.! !!SystemWindow methodsFor: 'menu' stamp: 'dao 10/1/2004 12:57'!fullScreenMaximumExtent "Zoom Window to Full World size with possible DeskMargins obey the maximum extent rules" | left right possibleBounds | left := right := 0. self paneMorphs do: [:pane | ((pane isKindOf: ScrollPane) and: [pane retractableScrollBar]) ifTrue: [pane scrollBarOnLeft ifTrue: [left := left max: pane scrollBarThickness] ifFalse: [right := right max: pane scrollBarThickness]]]. possibleBounds := self worldBounds insetBy: (left @ 0 corner: right @ 0 ). self maximumExtent ifNotNil: [possibleBounds := possibleBounds origin extent: ( self maximumExtent min: ( possibleBounds extent ))]. ((Flaps sharedFlapsAllowed and: [Project current flapsSuppressed not]) or: [Preferences fullScreenLeavesDeskMargins]) ifTrue: [possibleBounds := possibleBounds insetBy: 22]. self bounds: possibleBounds! !!SystemWindow methodsFor: 'menu' stamp: 'mt 3/10/2023 14:27'!sendToBack | aWorld nextWindow | aWorld := self world. nextWindow := aWorld submorphs detect: [:m | (m isSystemWindow) and: [m ~~ self]] ifNone: [^self]. nextWindow beKeyWindow. aWorld addMorphBack: self! !!SystemWindow methodsFor: 'open/close' stamp: 'mt 3/7/2023 17:40'!delete | thisWorld | self mustNotClose ifTrue: [^self]. model okToClose ifFalse: [^self]. thisWorld := self world. self activeHand removeKeyboardListener: self. self isFlexed ifTrue: [owner delet e] ifFalse: [super delete]. model windowIsClosing; release. model := nil. SystemWindow noteTopWindowIn: thisWorld! !!SystemWindow methodsFor: 'stepping' stamp: 'mt 8/28/2023 15:51'!stepAt: millisecondClockValue "If the receiver is not collapsed, step it, after first stepping the model." (isCollapsed not or: [self wantsStepsWhenCollapsed]) ifTrue: [model ifNotNil: [model stepAt: millisecondClockValue in: self]. super stepAt: millisecondClockValue]"Since this method ends up calling step, the model-stepping logic should not be duplicated there."! !!SystemWindow methodsFor: 'stepping' stamp: 'mt 3/10/2023 15:01'!wantsSteps "Return true if the model wants its view to be stepped. For an open system window, we give the model to offer an opinion" self isPartsDonor ifTrue: [^ false]. ^ isCollapsed not and: [model wantsStepsIn: self]! !!SystemWindow methodsFor: 'top window' stamp: 'mt 3/7/2023 17:40'!comeToFront "Modal windows: Walk along the modal owner chain, the bring all to top." self modalOwner ifNotNil: [:mo | mo isSystemWindow ifTrue: [ ^ mo modalOwner ifNil: [mo comeToFrontModally] ifNotNil: [:omo | omo comeToFront]]]. self modalChild ifNotNil: [^ self comeToFrontModally]. "Now show me." super comeToFront. "Label should be visible to interact with." self assureLabelAreaVisible.! !!TabMorph methodsFor: 'tabs' stamp: 'mt 8/4/2023 13:36'!tabSelected "Called when the receiver is hit. First, bulletproof against someone having taken the structure apart. My own action basically requires that my grand-owner be a TabbedPalette" (owner isKindOf: IndexTabs) ifFalse: [^ Beeper beep]. (owner owner isKindOf: TabbedPalette) ifFalse: [^ Beeper beep]. owner owner selectTab: self! !!TabSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'!addControls "Add the control bar at the top of the tool." | b r | b := SimpleButtonMorph ne w target: self; borderColor: Color black. r := AlignmentMorph newRow. r color: b color; borderWidth: 0; layoutInset: 0. r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. r wrapCentering: #topLeft. r addMorphBack: (b label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort). b := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (b label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #cancelSort). self addMorphFront: r.! !!TabSorterMorph methodsFor: 'initialization' stamp: 'mt 8/16/2023 13:52'!initialize "Initialize the receiver." super initialize. self removeAllMorphs. self extent: 300@100. pageHolder := PasteUpMorph new. pageHolder vResizeToFit: true; autoLineLayout: true. pageHolder extent: self extent - self borderWidth. pageHolder padding: 8. pageHolder cursor: 0. self addControls. self addMorphBack: pageHolder ! !!TabbedPalette methodsFor: 'palette menu' stamp: 'mt 8/4/2023 13:42'!addBookMenuItemsTo: aCustomMenu hand: aHandMorph aCustomMenu add: 'add palette menu' translated action: #addMenuTab.! !!TabbedPalette methodsFor: 'palette menu' stamp: 'mt 7/31/2023 11:20'!addMenuTab "Add the menu tab. This is ancient code, not much in the spirit of anything current" | aMenu aTab aGraphic sk | aMenu := MenuMorph new defaultTarget: self. aMenu stayUp: true. "aMenu add: 'clear' translated action: #showNoPalette." aMenu add: 'sort tabs' translated action: #sortTabs:. aMenu add: 'choose new colors for tabs' translated action: #recolorTabs. aMenu setProperty: #paletteMenu toValue: true. "aMenu add: 'make me the Standard palette' translated action: #becomeStandardPalette." aTab := self addTabForBook: aMenu withBalloonText: 'a menu of palette-related controls' translated. aTab highlightColor: tabsMorph highlightColor; regularColor: tabsMorph regularColor.
tabsMorph laySubpartsOutInOneRow; layoutChanged. aGraphic := MenuIcons formAtKey: 'TinyMenu'. aGraphic ifNotNil: [aTab removeAllMorphs. aTab addMorph: (sk := Project current world drawingClass withForm: aGraphic). sk position: aTab position. sk lock. aTab fitContents]. self layoutChanged! !!TabbedPalette methodsFor: 'user-interface' stamp: 'mt 8/4/2023 13:36'!selectTab: aTab | currentPalette morphToInstall oldTab aSketchEditor | oldTab := tabsMorph highlightedTab. (oldTab notNil and: [(morphToInstall := oldTab morphToInstall) isKindOf: PaintBoxMorph]) ifTrue: [(aSketchEditor := self world submorphOfClass: SketchEditorMorph) ifNotNil: [aSketchEditor cancelOutOfPainting]. morphToInstall delete]. tabsMorph selectTab: aTab. morphToInstall := aTab morphToInstall. (morphToInstall isKindOf: PaintBoxMorph) "special case, maybe generalize this need?" ifFalse: [se lf goToPageMorph: morphToInstall] ifTrue: [self showNoPaletteAndHighlightTab: aTab. self world addMorphFront: morphToInstall. morphToInstall position: ((self left max: 90) "room for the pop-out-to-left panel" @ (tabsMorph bottom))]. (currentPalette := self currentPalette) ifNotNil: [currentPalette layoutChanged]. self snapToEdgeIfAppropriate! !!TabbedPalette class methodsFor: 'scripting' stamp: 'mt 7/31/2023 11:20'!authoringPrototype | aTabbedPalette aBook aTab | aTabbedPalette := self new markAsPartsDonor. aTabbedPalette pageSize: 200 @ 300. aTabbedPalette tabsMorph highlightColor: Color red regularColor: Color blue. aTabbedPalette addMenuTab. aBook := BookMorph new setNameTo: 'one'; pageSize: aTabbedPalette pageSize. aBook color: Color blue muchLighter. aBook removeEverything; insertPage; showPageControls. aBook currentPage addMorphBack: (Project current world drawingClass withFo rm: (MenuIcons formAtKey: 'squeakyMouse')). aTab := aTabbedPalette addTabForBook: aBook. aBook := BookMorph new setNameTo: 'two'; pageSize: aTabbedPalette pageSize. aBook color: Color red muchLighter. aBook removeEverything; insertPage; showPageControls. aBook currentPage addMorphBack: CurveMorph authoringPrototype. aTabbedPalette addTabForBook: aBook. aTabbedPalette selectTab: aTab. aTabbedPalette beSticky. aTabbedPalette tabsMorph hResizing: #spaceFill. ^ aTabbedPalette! !!TextMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 16:10'!getMenu: shiftKeyState ^ shiftKeyState not ifTrue: [TextEditor yellowButtonMenu] ifFalse: [TextEditor shiftedYellowButtonMenu]! !!TextMorph methodsFor: 'events-processing' stamp: 'mt 3/15/2023 13:46'!handleKeystroke: anEvent "Overwritten to support tab-among-fields preference." anEvent wasHandled ifTrue:[^self]. (self handlesKeyboard: anEvent) ifFalse: [^ self]. (anEvent hand keyboard Focus ~~ self and: [self handlesKeyboardOnlyOnFocus]) ifTrue: [^ self]. ^ super handleKeystroke: anEvent! !!TextMorph methodsFor: 'menu' stamp: 'mt 8/16/2023 13:54'!addCustomMenuItems: aCustomMenu hand: aHandMorph | outer | super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu add: 'text properties...' translated action: #changeTextColor. aCustomMenu addUpdating: #autoFitString target: self action: #autoFitOnOff. aCustomMenu addUpdating: #wrapString target: self action: #wrapOnOff. aCustomMenu add: 'text margins...' translated action: #changeMargins:. aCustomMenu add: 'add predecessor' translated action: #addPredecessor:. aCustomMenu add: 'add successor' translated action: #addSuccessor:. outer := self owner. outer ifNotNil: [ outer isLineMorph ifTrue: [container isNil ifTrue: [Smalltalk at: #TextOnCurveContainer ifPresent: [:ignored | aCustomMenu add: 'follow owner''s curve' translated actio n: #followCurve]] ifFalse: [aCustomMenu add: 'reverse direction' translated action: #reverseCurveDirection. aCustomMenu add: 'set baseline' translated action: #setCurveBaseline:]] ifFalse: [self fillsOwner ifFalse: [aCustomMenu add: 'fill owner''s shape' translated action: #fillingOnOff] ifTrue: [aCustomMenu add: 'rectangular bounds' translated action: #fillingOnOff]. self avoidsOcclusions ifFalse: [aCustomMenu add: 'avoid occlusions' translated action: #occlusionsOnOff] ifTrue: [aCustomMenu add: 'ignore occlusions' translated action: #occlusionsOnOff]]].! !!TextMorph class methodsFor: 'parts bin' stamp: 'mt 3/7/2023 15:07'!fancyPrototype | t | t := self authoringPrototype. t autoFit: false; extent: 150@75. t borderWidth: 2; margins: 4@0; useRoundedCorners. "Why not rounded?" "fancy font, shadow, rounded" t fontName: Preferences standardButtonFont familyName size: 18; textColor: Color blue; fillStyle: Color lightBrown. t addDropShadow."Strangeness here in order to avoid two offset copies of the default contents when operating in an mvc project before cursor enters the morphic window" t paragraph. ^ t! !!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 8/11/2023 15:18'!extrasMenuOn: aDockingBar aDockingBar addItem: [ :it| it contents: 'Extras' translated; addSubMenu: [:menu| menu addItem:[:item| item contents: 'Recover Changes' translated; help: 'Recover changes after a crash' translated; icon: MenuIcons smallDocumentClockIcon; target: ChangeList; selector: #browseRecentLog]. menu addItem:[:item| item contents: 'Recover Method Versions' translated; help: 'Recover ve rsions of deleted methods' translated; target: ChangeList; selector: #browseMethodVersions]. menu addLine. menu addItem:[:item| item contents: 'Themes & Colors' translated; subMenuUpdater: self selector: #themesAndWindowColorsOn: ]. menu addItem:[:item| item contents: 'Scale Factor' translated; subMenuUpdater: self selector: #scaleFactorsOn:]. menu addItem:[:item| item contents: 'Language' translated; subMenuUpdater: self selector: #languageTranslatorsOn: ]. menu addItem:[:item| item contents: 'Set Author Initials' translated; help: 'Sets the author initials' translated; icon: MenuIcons smallUserQuestionIcon; target: Utilities; selector: #setAuthorInitials]. menu addItem:[:item| item contents: 'Restore Display (r)' translated; help: 'Redraws the entire display' translated; target: Project current; selector: #restoreDisplay]. menu addItem:[:item| item contents: 'Rebuild Menus' translated; help: 'Rebuilds the menu bar' translated; target: TheWorldMainDockingBar; selector: #updateInstances]. menu addLine. menu addItem:[:item| item contents: 'Start Profiler' translated; help: 'Starts the profiler' translated; icon: MenuIcons smallTimerIcon; target: self; selector: #startMessageTally]. menu addItem:[:item| item contents: 'Collect Garbage' translated; help: 'Run the garbage collector and report space usage' translated; target: Utilities; selector: #garbageCollectAndReport]. menu addItem:[:item| item contents: 'Purge Undo Records' translated; help: 'Save space by removing all the undo information remembered in all projects' translated; target: CommandHistory; selector: #resetAllHistory]. menu addItem:[:item| item contents: 'VM statistics' translated; help: 'Virtual Machine infor mation' translated; target: self; selector: #vmStatistics]. menu addLine. menu addItem:[:item| item contents: 'Graphical Imports' translated; help: 'View the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList' translated; target: (Imports default); selector: #viewImages]. menu addItem:[:item| item contents: 'Browse My Changes' translated; help: 'Browse all of my changes since the last time #condenseSources was run.' translated; target: SystemNavigation new; selector: #browseMyChanges]. ] ]! !!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 3/7/2023 13:59'!themesAndWindowColorsOn: menu | themes | menu addItem:[:item| item contents: 'Fonts' translated; subMenuUpdater: Preferences selector: #fontConfigurationMenu:; icon: MenuIcons smallFontsIcon]. menu addLine. menu addItem:[:item| item contents: (Model useColorfulWindows ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Colorful Windows' translated; target: self; selector: #toggleColorfulWindows]. menu addItem:[:item| item contents: (SystemWindow gradientWindow not ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Flat Widget Look' translated; target: self; selector: #toggleGradients]. menu addLine. menu addItem:[:item | item contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Soft Shadows' translated; target: self; selector: #toggleSoftShadows]. menu addItem:[:item | item contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow not]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Hard Shadows' translated; target: self; selector: #toggleHardShadows]. menu addLine. menu addItem:[:item | item contents: (SystemWindow roundedWindowCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Window/Dialog Look' translated; target: self; selector: #toggleRoundedWindowLook]. menu addItem:[:item | item contents: (PluggableButtonMorph roundedButtonCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Button/Scrollbar/Menu Look' translated; target: self; selector: #toggleRoundedButtonLook]. menu addLine. themes := UserInterfaceTheme allThemes asArray sort: #name ascending. themes := themes select: [ :each | each isGenuine]. themes ifEmpty: [ menu addIt em: [ :item | item contents: '(No UI themes found.)' translated; isEnabled: false ] ]. themes do: [ :each | menu addItem: [ :item | item contents: (UserInterfaceTheme current name = each name ifTrue: ['<yes>'] ifFalse: ['<no>']), each name; target: each; selector: #applyScaled ] ]. menu addLine; add: 'Restore UI theme background' translated target: self selector: #restoreThemeBackground; add: 'Reset all UI themes' translated target: self selector: #resetAllThemes; add: 'Edit current UI theme...' translated target: self selector: #editCurrentTheme.! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/4/2023 13:59'!addObjectsAndTools: menu self fillIn: menu from: { nil. { 'objects (o)'. { #myWorld. #activateObjectsTool }. 'A tool for finding and obtaining many kinds of objects' }. { 'new morph. ..'. { self. #newMorph }. 'Offers a variety of ways to create new objects' }. nil. { 'flaps...'. { self. #flapsDo }. 'A menu relating to use of flaps. For best results, use "keep this menu up"' }. { 'projects...'. { self. #projectDo }. 'A menu of commands relating to use of projects' }. { 'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}. nil }! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:54'!addPrintAndDebug: menu self fillIn: menu from: { { 'make screenshot'. {self. #saveScreenshot}. 'makes a screenshot and saves it to disk'}. "{ 'print PS to file...'. { self. #printWorldOnFile }. 'write the world into a postscript file' }." { 'debug...'. { self. #debugDo }. 'a menu of debugging items' } }! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:58'!addUtilities: menu self
fillIn: menu from: { { 'open...'. { self. #openWindow } }. { 'windows...'. { self. #windowsDo } }. { 'changes...'. { self. #changesDo } } }. self fillIn: menu from: { { 'help...'. { self. #helpDo }. 'puts up a menu of useful items for updating the system, determining what version you are running, and much else' }. { 'appearance...'. { self. #appearanceDo }. 'put up a menu offering many controls over appearance.' } }. self fillIn: menu from: { { 'do...'. { Utilities. #offerCommonRequests }. 'put up an editible list of convenient expressions, and evaluate the one selected.' } }! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:57'!appearanceMenu "Build the appearance menu for the world." ^self fillIn: (self menu: 'appearance...') from: { {'preferences...' . { self . #openPreferencesBrowser} . 'Opens a "Preferences Browser" which allows you to alter many settings' } . {'preferences wizard...' . { self . #openPreferencesWizard} . 'Opens a "Preferences Wizard" which allows you to alter many settings in a guided fashion' } . {'choose set of preferences...' . { Preferences . #offerThemesMenu} . 'Presents you with a menu of sets or preferences; each item''s balloon-help will tell you about the particular set. If you choose one, many different preferences that come along are set at the same time; you can subsequently change any settings by using a Preferences Panel'} . nil . {'system fonts...' . { self . #standardFontDo} . 'Choose the standard fonts to use for code, lists, menus, window titles, etc.'}. nil. {'full screen on' . { DisplayScreen . #fullScreenOn} . 'puts you in full-screen mode, if not already there.'}. {'full screen off' . { DisplayScreen . #fullScreenOff} . 'if in full-screen mode, takes you out of it.'}. nil. {'set display depth ...' . {self. #setDisplayDepth} . 'choose how many bits per pixel.'}. {'set desktop color...' . {self. #changeBackgroundColor} . 'choose a uniform color to use as desktop background.'}. {'set gradient color...' . {self. #setGradientColor} . 'choose second color to use as gradient for desktop background.'}. }! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 7/31/2023 11:19'!helpMenu "Build the help menu for the world." | menu | menu := self menu: 'help...'. self fillIn: menu from: { {'about this system...'. {Smalltalk. #aboutThisSystem}. 'current version information.'}. {'update code from server'. {MCMcmUpdater. #updateFromServer}. 'load latest code updates via the internet'}. {'preferences...'. {self. #openPreferencesBrowser}. 'view and change various options.'}. {'set language...' . {Project. #chooseNaturalLanguage}. 'choose the language in which tiles should be displaye d.'} . nil. {'command-key help'. { TheWorldMainDockingBar instance . #commandKeyHelp}. 'summary of keyboard shortcuts.'} }. self addGestureHelpItemsTo: menu. self fillIn: menu from: { {'world menu help'. { self . #worldMenuHelp}. 'helps find menu items buried in submenus.'}. "{'info about flaps' . { Utilities . #explainFlaps}. 'describes how to enable and use flaps.'}." {'font size summary' . { TextStyle . #fontSizeSummary}. 'summary of names and sizes of available fonts.'}. {'useful expressions' . { Utilities . #openStandardWorkspace}. 'a window full of useful expressions.'}. {'annotation setup...' . { Preferences . #editAnnotations}. 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools'}. nil. {'graphical imports' . { Imports default . #viewImages}. 'view the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList'}. nil. {'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}. {#soundEnablingString . { SoundService . #toggleSoundEnabled}. 'turning sound off will completely disable Squeak''s use of sound.'}. nil. {'set author initials...' . { Utilities . #setAuthorInitials }. 'supply initials to be used to identify the author of code and other content.'}. {'vm statistics' . { self . #vmStatistics}. 'obtain some intriguing data about the vm.'}. nil. {'purge undo records' . { CommandHistory . #resetAllHistory }. 'save space by removing all the undo information remembered in all projects.'}. {'space left' . { self . #garbageCollect}. 'perform a full garbage-co llection and report how many bytes of space remain in the image.'}. }. ^menu! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/16/2023 11:24'!newMorph "The user requested 'new morph' from the world menu. Put up a menu that allows many ways of obtaining new morphs." | menu | menu := self menu: 'Add a new morph'. menu add: 'from paste buffer' translated target: myHand action: #pasteMorph; add: 'from alphabetical list' translated subMenu: self alphabeticalMorphMenu; add: 'from a file...' translated target: self action: #readMorphFromAFile. menu addLine. menu add: 'grab rectangle from screen' translated target: myWorld action: #grabDrawingFromScreen:; add: 'grab with lasso from screen' translated target: myWorld action: #grabLassoFromScreen:; add: 'grab rubber band from screen' translated target: myWorld action: #grabRubberBandFromScreen:; add: 'grab flood area from screen' translated target: myWorld action: #grabFloodFromScreen:. menu addLine. menu add: 'make link to project...' translated target: self action: #projectThumbnail. self doPopUp: menu.! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/11/2023 16:37'!openMenu "Build the open window menu for the world." | menu | menu := self menu: 'open...'. menu defaultTarget: ToolSet default. menu addList: ToolSet menuItems. menu defaultTarget: self. self fillIn: menu from: { nil. {'file...' . { self . #openFileDirectly} . 'Lets you open a window on a single file'}. {'transcript (t)' . {self . #openTranscript}. 'A window used to report messages sent to Transcript' }. "{'inner world' . { WorldWindow . #test1} }." nil. }. self fillIn: menu from: self class registeredOpenCommands. menu addLine. self fillIn: menu from: { {'morphic project' . {self. #openMorphicProject} . 'Creates a new morphic project'}. {'mvc project' . {self. #openMVCProj ect} . 'Creates a new project of the classic "mvc" style'} }. ^menu! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/11/2023 16:37'!projectMenu "Build the project menu for the world." | menu | self flag: #bob0302. menu := self menu: 'projects...'. self fillIn: menu from: { { 'save on server (also makes a local copy)' . { #myProject . #storeOnServer } }. { 'save to a different server' . { #myProject . #saveAs } }. { 'save project on local file only' . { #myWorld . #saveOnFile } }. { 'see if server version is more recent...' . { #myProject . #loadFromServer } }. { 'load project from file...' . { self . #loadProject } }. nil. }. self fillIn: menu from: { { 'create new morphic project' . { self . #openMorphicProject } }. { 'create new mvc project'. { self . #openMVCProject } }. }. self fillIn: menu from: { nil. { 'go to previous project' . { Project . #returnToPreviousProject } }. { 'go to next project' . { Project . #advanceToNextProject } }. { 'jump to project...' . { #myWorld . #jumpToProject } }. }. self fillIn: menu from: { nil. { 'save for future revert' . { #myProject . #saveForRevert } }. { 'revert to saved copy' . { #myProject . #revert } }. }. ^ menu! !!TheWorldMenu methodsFor: '*MorphicExtras-windows & flaps menu' stamp: 'mt 8/4/2023 15:18'!formulateFlapsMenu: aMenu "Fill aMenu with appropriate content" aMenu addTitle: 'flaps' translated. aMenu addStayUpItem. Preferences classicNavigatorEnabled ifTrue: [aMenu addUpdating: #navigatorShowingString enablementSelector: #enableProjectNavigator target: Preferences selector: #toggle: argumentList: #(showProjectNavigator). aMenu balloonTextForLastItem: (Preferences preferenceAt: #showProjectNavigator) helpString translated]. Flaps sharedFlapsAllowed ifTrue:
[self fillIn: aMenu from: {{#suppressFlapsString. {Project current. #toggleFlapsSuppressed}. 'Whether prevailing flaps should be shown in the project right now or not.'}}. aMenu addUpdating: #automaticFlapLayoutString target: Preferences selector: #toggle: argumentList: #(automaticFlapLayout). aMenu balloonTextForLastItem: (Preferences preferenceAt: #automaticFlapLayout) helpString translated. aMenu addLine. Flaps addIndividualGlobalFlapItemsTo: aMenu]. self fillIn: aMenu from: { nil. {'make a new flap'. {Flaps. #addLocalFlap}. 'Create a new flap. You can later make it into a shared flap is you wish.'}. nil.}. Flaps sharedFlapsAllowed ifTrue: [aMenu addWithLabel: 'put shared flaps on bottom' translated enablementSelector: #showSharedFlaps target: Flaps selector: #sharedFlapsAlongBottom argumentList: #(). aMenu balloonTextForLastItem: 'Group all the standard shared flaps along the bottom edge of the screen' translated. self fillIn: aMenu from: { {'destroy all shared flaps'. {Flaps. #disableGlobalFlaps}. 'Destroy all the shared flaps and disable their use in all projects.'}}] ifFalse: [aMenu add: 'install default shared flaps' translated target: Flaps action: #enableGlobalFlaps. aMenu balloonTextForLastItem: 'Create the default set of shared flaps' translated. aMenu addLine]. self fillIn: aMenu from: { nil. {'about flaps...'. {Flaps . #explainFlaps}. 'Gives a window full of details about how to use flaps.'}}! !!ThreePhaseButtonMorph class methodsFor: 'class initialization' stamp: 'mt 3/15/2023 14:11'!initialize "ThreePhaseButtonMorph initialize" | extent inset | extent := 12@12. inset := 3. #('CheckBoxOff' 'CheckBoxOn' 'CheckBoxPressed') do: [:button | | f r | f := ColorForm extent: extent depth: 1. f colors: {Color transparent. Color black}. f borderWidth: 1. r := f boundingBox insetBy: inset. button = 'CheckBoxPressed' ifTrue: [f border: r width: 1]. button = 'CheckBoxOn' ifTrue: [f fillBlack: r]. MenuIcons saveForm: f atKey: button]. #('RadioButtonOff' 'RadioButtonOn' 'RadioButtonPressed') do: [:button | | f r c | f := ColorForm extent: extent depth: 1. f colors: {Color transparent. Color black}. r := f boundingBox. c := f getCanvas. c frameOval: r color: Color black. r := r insetBy: inset. button = 'RadioButtonPressed' ifTrue: [c frameOval: r color: Color black]. button = 'RadioButtonOn' ifTrue: [c fillOval: r color: Color black]. MenuIcons saveForm: f atKey: button]! !!ThreePhaseButtonMorph class methodsFor: 'instance creation' stamp: 'mt 3/15/2023 14:09'!labelSymbol: aSymbol "(self labelSymbol: #TryIt) openInHand" | aButton form | aButton := ThreePhaseButtonMorph new. form := MenuIcons formAtKey: aSymbol. aButton offImage: form. aButton image: form. aButton pressedImage: (MenuIcons formPressedAtKey: aSymbol). ^ aButton! !!ThumbnailMorph methodsFor: 'stepping' stamp: 'mt 8/28/2023 14:37'!stepTime "Adjust my step time to the time it takes drawing my referent" drawTime ifNil:[^ 250]. ^(20 * drawTime) max: 250.! !!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'!actualViewee "Return the actual morph to be viewed, or nil if there isn't an appropriate morph to view." | aMorph actualViewee | aMorph := self morphToView ifNil: [^ nil]. aMorph isInWorld ifFalse: [^ nil]. actualViewee := viewSelector ifNil: [aMorph] ifNotNil: [objectToView perform: viewSelector]. actualViewee == 0 ifTrue: [^ nil]. "valueAtCu rsor result for an empty HolderMorph" actualViewee ifNil: [actualViewee := objectToView]. (actualViewee isMorph and: [actualViewee isFlexMorph and: [actualViewee submorphs size = 1]]) ifTrue: [actualViewee := actualViewee firstSubmorph]. ^ actualViewee! !!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'!formOrMorphToView "Answer the form to be viewed, or the morph to be viewed, or nil" | actualViewee | (objectToView isForm) ifTrue: [^objectToView]. actualViewee := viewSelector ifNil: [objectToView] ifNotNil: [objectToView perform: viewSelector]. ^actualViewee == 0 ifTrue: [nil "valueAtCursor result for an empty HolderMorph"] ifFalse: [actualViewee]! !!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'!morphToView "If the receiver is viewing some object, answer a morph can be thought of as being viewed; A gesture is made toward generalizing this beyond the morph/p layer regime, in that a plain blue rectangle is returned rather than simply failing if the referent is not itself displayable." objectToView ifNil: [^ nil]. ^ objectToView isMorph ifTrue: [objectToView] ifFalse: [RectangleMorph new color: Color blue]! !!TransformationMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 15:02'!removeFlexShell "Remove the shell used to make a morph rotatable and scalable." | oldHalo unflexed myWorld refPos aPosition | self isInWorld ifFalse: [^self]. refPos := self referencePosition. myWorld := self world. oldHalo := self halo. submorphs isEmpty ifTrue: [^ self delete]. aPosition := (owner submorphIndexOf: self) ifNil: [1]. unflexed := self firstSubmorph. self submorphs do: [:m | m position: self center - (m extent // 2). owner addMorph: m asElementNumber: aPosition]. unflexed absorbStateFromRenderer: self. oldHalo ifNotNil: [oldHalo setTarget: unflexed]. myWorld ifNotNil: [myWorld startSteppingSubmorphsOf: unflexed]. self delete. unflexed referencePosition: refPos. ^ unflexed! !!TransformationMorph methodsFor: 'private' stamp: 'mt 3/10/2023 11:18'!adjustAfter: changeBlock "Cause this morph to remain centered where it was before, and choose appropriate smoothing, after a change of scale or rotation." | oldRefPos | oldRefPos := self referencePosition. changeBlock value. self chooseSmoothing. self layoutChanged. owner ifNotNil: [owner invalidRect: bounds]! !!TranslucentProgessMorph methodsFor: 'drawing' stamp: 'mt 3/7/2023 15:07'!drawOn: aCanvas | revealPercentage revealingStyle revealingColor revealingBounds revealToggle x baseColor revealTimes secondsRemaining stringToDraw where fontToUse innerBounds | innerBounds := bounds. opaqueBackgroundColor ifNotNil: [ aCanvas frameAndFillRectangle: bounds fillColor: opaqueBackgroundColor borderWidth: 8
borderColor: Color blue. innerBounds := innerBounds insetBy: 8. ]. revealTimes := (self valueOfProperty: #revealTimes) ifNil: [^self]. revealPercentage := (revealTimes first / revealTimes second) asFloat. revealingStyle := self revealingStyle. x := self valueOfProperty: #progressStageNumber ifAbsent: [1]. baseColor := Color perform: (#(red blue green magenta cyan yellow) atPin: x). revealingColor := baseColor alpha: 0.2. revealingStyle = 3 ifTrue: [ "wrap and change color" revealPercentage > 1.0 ifTrue: [ revealingColor := baseColor alpha: (0.2 + (revealingStyle / 10) min: 0.5). ]. revealPercentage := revealPercentage fractionPart. ]. revealingStyle = 2 ifTrue: [ "peg at 75 and blink" revealPercentage > 0.75 ifTrue: [ revealToggle := self valueOfProperty: #revealToggle ifAbsent: [true]. self setProperty: #revealToggle toValue: revealToggle not. revealToggle ifTru e: [revealingColor := baseColor alpha: 0.8.]. ]. revealPercentage := revealPercentage min: 0.75. ]. revealingBounds := innerBounds withLeft: innerBounds left + (innerBounds width * revealPercentage) truncated. aCanvas fillRectangle: revealingBounds color: revealingColor. secondsRemaining := (revealTimes second - revealTimes first / 1000) rounded. secondsRemaining > 0 ifTrue: [ fontToUse := StrikeFont familyName: Preferences standardButtonFont familyName size: 24. stringToDraw := secondsRemaining printString. where := innerBounds corner - ((fontToUse widthOfString: stringToDraw) @ fontToUse height). aCanvas drawString: stringToDraw in: (where corner: innerBounds corner) font: fontToUse color: Color black. aCanvas drawString: stringToDraw in: (where - (1@1) corner: innerBounds corner) font: fontToUse color: Color white. ]. ! !!TrashCanMorph methodsFor: 'event handling' stamp: 'mt 8/11/2023 13:45'!doubleClick: evt evt hand world addMorphCentered: ScrapBook default scrapBook! !!UpdatingRectangleMorph methodsFor: 'setting' stamp: 'mt 3/10/2023 15:02'!valueProvider "Answer the object to which my get/set messages should be sent. This is inefficient and contorted in order to support grandfathered content for an earlier design" ^ target! !!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:28'!decimalPlaces: aNumber "Set the receiver's number of decimal places to be shown." | constrained | self setProperty: #decimalPlaces toValue: (constrained := aNumber min: 11). self pvtFloatPrecision: (Utilities floatPrecisionForDecimalPlaces: constrained).! !!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 15:45'!target: anObject target := anObject. floatPrecision := 1.! !!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:02'!valueFromContents "Return a new value from the current contents string." format = #symbol ifTrue: [^ lastValue]. format = #string ifTrue: [^ contents]. ^ Compiler evaluate: contents! !!UpdatingStringMorph methodsFor: 'target access' stamp: 'mt 3/10/2023 14:13'!readFromTarget "Update my readout from my target" | v ret | (target isNil or: [getSelector isNil]) ifTrue: [^contents]. ret := self checkTarget. ret ifFalse: [^ '0']. v := target perform: getSelector. "scriptPerformer" (v isKindOf: Text) ifTrue: [v := v asString]. ^self acceptValueFromTarget: v! !!UserInterfaceTheme methodsFor: 'private - fonts' stamp: 'mt 7/31/2023 11:21'!installSystemFont: aFont "Establish the default text font and style. Update the #defaultFontIndex in all known text styles to reflect the system's new default point size." | aStyle | self flag: #todo. "mt: Support derivatives such as bold and italic." aStyle := aFont textStyleOrNil. "mt: Must b e installed and thus never be nil!!" aStyle defaultFontIndex: (aStyle fontIndexOfPointSize: aFont pointSize "drop emphasis"). TextStyle setDefault: aStyle. TextStyle actualTextStyles "no defaults" do: [:ea | ea isTTCStyle ifTrue: [ea defaultFont asPointSize: aFont pointSize "May generate new pointSize"]. ea defaultFontIndex: (ea fontIndexOfPointSize: aFont pointSize)]. RealEstateAgent resetScaleFactor. Flaps replaceToolsFlap.! !!CommunityTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addDarkWindowColors: aUserInterfaceTheme "self createDark apply." aUserInterfaceTheme set: #uniformWindowColor for: #Model to: Color darkGray; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color darker] ]; set: #unfocusedLabelColor for: #SystemWindow to: Color veryLightGray; set: #focusedLabelColor for: #SystemWindow to: Color white; set: #customWindowColor for: #Br owser to: self dbBlue; set: #customWindowColor for: #ChangeList to: self dbBlue; set: #customWindowColor for: #ChangeSorter to: self dbBlue; set: #customWindowColor for: #ChatNotes to: self dbPurple twiceDarker; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self dbPurple twiceDarker; set: #customWindowColor for: #Debugger to: self dbRed; set: #customWindowColor for: #DualChangeSorter to: self dbOrange twiceDarker; set: #customWindowColor for: #FileContentsBrowser to: self dbGray; set: #customWindowColor for: #FileList to: self dbGray; set: #customWindowColor for: #Inspector to: self dbYellow duller; set: #customWindowColor for: #InstanceBrowser to: self dbYellow duller; set: #customWindowColor for: #Lexicon to: self dbGreen; set: #customWindowColor for: #MCTool to: self dbOrange twiceDarker; set: #customWindowColor for: #MessageNames to: self dbGreen; set: #customWindow Color for: #MessageSet to: self dbGreen; set: #customWindowColor for: #ObjectExplorer to: self dbYellow duller; set: #customWindowColor for: #PackagePaneBrowser to: self dbBlue; set: #customWindowColor for: #PluggableFileList to: self dbGray; set: #customWindowColor for: #PreferenceBrowser to: self dbBlue; set: #customWindowColor for: #ProcesBrowser to: self dbAqua; set: #customWindowColor for: #SMLoader to: self dbOrange twiceDarker; set: #customWindowColor for: #SMLoaderPlus to: self dbOrange twiceDarker; set: #customWindowColor for: #SMReleaseBrowser to: self dbOrange twiceDarker; set: #customWindowColor for: #SelectorBrowser to: self dbBlue; set: #customWindowColor for: #StringHolder to: self dbGray; set: #customWindowColor for: #TestRunner to: self dbPink darker; set: #customWindowColor for: #TranscriptStream to: self dbGray; set: #customWindowColor for: #VersionsBrowser to: self dbPurpl e twiceDarker; set: #customWindowColor for: #Workspace to: self dbPink darker.! !!MonokaiTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addDarkWindowColors: theme "self createDark apply." theme set: #uniformWindowColor for: #Model to:( self invisibleColor adjustBrightness: 0.16) "lighter twice"; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: -0.16 "darker twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: [ Model useColorfulWindows ifTrue: [(Color r: 0.285 g: 0.282 b: 0.242) "invisible color"] ifFalse: [(Color r: 0.972 g: 0.972 b: 0.948) "foreground color"] ]; set: #focusedLabelColor for: #SystemWindow to: [ Model useColorfulWindows ifTrue: [(Color r: 0.152 g: 0.156 b: 0.133) "background color"] ifFalse: [(Color r: 0.901 g: 0.858 b: 0.455) "yellow"] ]; set: #customWindowColor for: #Browser to: self green duller; set: #customWindowColor for: #ChangeList to: self blue duller; set: #customWindowColor for: #ChangeSorter to: self blue duller; set: #customWindowColor for: #ChatNotes to: self magenta duller; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet duller; set: #customWindowColor for: #Debugger to: self red duller; set: #customWindowColor for: #DualChangeSorter to: self blue duller; set: #customWindowColor for: #FileContentsBrowser to: self yellow duller; set: #customWindowColor for: #FileList to: self yellow duller; set: #customWindowColor for: #InstanceBrowser to: self cyan duller; set: #customWindowColor for: #Lexicon to: self cyan duller; set: #customWindowColor for: #MCTool to: self violet duller; set: #customWindowColor for: #MessageNames to: self green duller; set: #customWindowColor for: #MessageSet to: se lf cyan duller; set: #customWindowColor for: #PackagePaneBrowser to: self green duller; set: #customWindowColor for: #PluggableFileList to: self yellow duller; set: #customWindowColor for: #PreferenceBrowser to: self cyan duller; set: #customWindowColor for: #SMLoader to: self orange duller; set: #customWindowColor for: #SMLoaderPlus to: self orange duller; set: #customWindowColor for: #SMReleaseBrowser to: self orange duller; set: #customWindowColor for: #SelectorBrowser to: self cyan duller; set: #customWindowColor for: #StringHolder to: self yellow duller; set: #customWindowColor for: #TestRunner to: self orange duller; set: #customWindowColor for: #TranscriptStream to: self orange duller; set: #customWindowColor for: #VersionsBrowser to: self violet duller.! !!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addDarkWindowColors: theme "doIt: [self createDark apply.]" theme set: #uniformWindowColor for: #Model to: (self darkBackgroundHighlights adjustBrightness: 0.16 "lighter twice"); set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: -0.16 "darker twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: self darkContentEmphasized; set: #focusedLabelColor for: #SystemWindow to: self darkContentEmphasizedMore; set: #customWindowColor for: #Browser to: self green; set: #customWindowColor for: #ChangeList to: self blue; set: #customWindowColor for: #ChangeSorter to: self blue; set: #customWindowColor for: #ChatNotes to: self magenta; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet; set: #customWindowColor for: #Debugger to: self red; set: #customWindowColor for: #DualChangeSorter to: self blue; set: #customWindowColor for: #FileContentsBrowser to: self yellow; set: #customWindowColor for: # FileList to: self yellow; set: #customWindowColor for: #InstanceBrowser to: self cyan; set: #customWindowColor for: #Lexicon to: self cyan; set: #customWindowColor for: #MCTool to: self violet; set: #customWindowColor for: #MessageNames to: self green; set: #customWindowColor for: #MessageSet to: self cyan; set: #customWindowColor for: #PackagePaneBrowser to: self green; set: #customWindowColor for: #PluggableFileList to: self yellow; set: #customWindowColor for: #PreferenceBrowser to: self cyan; set: #customWindowColor for: #SMLoader to: self orange; set: #customWindowColor for: #SMLoaderPlus to: self orange; set: #customWindowColor for: #SMReleaseBrowser to: self orange; set: #customWindowColor for: #SelectorBrowser to: self cyan; set: #customWindowColor for: #StringHolder to: self yellow; set: #customWindowColor for: #TestRunner to: self orange; set: #customWindowColor for: #TranscriptStream to: self orange; set: #customWindowColor for: #VersionsBrowser to: self violet.! !!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addLightWindowColors: theme "You have to create dark first. doIt: [self createDark. self createLight apply.]" theme set: #uniformWindowColor for: #Model to: (self lightBackgroundHighlights adjustBrightness: -0.16 "darker twice"); set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: 0.16 "lighter twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: self lightContentEmphasized; set: #focusedLabelColor for: #SystemWindow to: self lightContentEmphasizedMore; set: #customWindowColor for: #Browser to: self green; set: #customWindowColor for: #ChangeList to: self blue; set: #customWindowColor for: #ChangeSorter to: self blue; set: #customWindowColor for: #ChatNotes to: self magenta; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet; set: #customWindowColor for: #Debugger to: (self red adjustSaturation: -0.27 brightness: 0.27); set: #customWindowColor for: #DualChangeSorter to: self blue; set: #customWindowColor for: #FileContentsBrowser to: self yellow; set: #customWindowColor for: #FileList to: self yellow; set: #customWindowColor for: #InstanceBrowser to: self cyan; set: #customWindowColor for: #Lexicon to: self cyan; set: #customWindowColor for: #MCTool to: self violet; set: #customWindowColor for: #MessageNames to: self green; set: #customWindowColor for: #MessageSet to: self cyan; set: #customWindowColor for: #PackagePaneBrowser to: self green; set: #customWindowColor for: #PluggableFileList to: self yellow; set: #customWindowColor for: #PreferenceBrowser to: self cyan; set: #customWindowColor for: #SMLoader to: (self orange adjustSaturation : -0.18 brightness: 0.18); set: #customWindowColor for: #SMLoaderPlus to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SMReleaseBrowser to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SelectorBrowser to: self cyan; set: #customWindowColor for: #StringHolder to: self yellow; set: #customWindowColor for: #TestRunner to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #TranscriptStream to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #VersionsBrowser to: self violet.! !!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addDullerWindowColors: theme theme set: #uniformWindowColor for: #Model to: Color veryVeryLightGray duller; set: #customWindowColor for: #Browser to: (Color r: 0.764 g: 0.9 b: 0.63) duller; set: #customWindowColor f or: #ChangeList to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #ChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #ChatNotes to: (Color r: 1.0 g: 0.7 b: 0.8) duller; set: #customWindowColor for: #ClassCommentVersionsBrowser to: (Color r: 0.753 g: 0.677 b: 0.9) duller; set: #customWindowColor for: #Debugger to: (Color r: 0.9 g: 0.719 b: 0.719) duller; set: #customWindowColor for: #DualChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #FileContentsBrowser to: (Color r: 0.7 g: 0.7 b: 0.508) duller; set: #customWindowColor for: #FileList to: (Color r: 0.65 g: 0.65 b: 0.65) duller; set: #customWindowColor for: #InstanceBrowser to: (Color r: 0.726 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #Lexicon to: (Color r: 0.79 g: 0.9 b: 0.79) duller; set: #customWindowColor for: #MCTool to: (Color r: 0.65 g: 0.691 b: 0.876) duller; set: #customWindowColor for: #MessageNames to: (Color r: 0.639 g: 0.9 b: 0.497) duller; set: #customWindowColor for: #MessageSet to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #PackagePaneBrowser to: (Color r: 0.9 g: 0.9 b: 0.63) duller; set: #customWindowColor for: #PluggableFileList to: Color lightYellow duller; set: #customWindowColor for: #PreferenceBrowser to: (Color r: 0.671 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #SMLoader to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SMLoaderPlus to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SMReleaseBrowser to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SelectorBrowser to: (Color r: 0.45 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #StringHolder to: (Color r: 0.9 g: 0.9 b: 0.719) duller; set: #customWindowColor for: #TestRunn er to: (Color r: 0.9 g: 0.576 b: 0.09) duller; set: #customWindowColor for: #TranscriptStream to: (Color r: 0.9 g: 0.75 b: 0.45) duller; set: #customWindowColor for: #VersionsBrowser to: (Color r: 0.782 g: 0.677 b: 0.9) duller.! !!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addWindowColors: theme theme set: #titleFont for: #SystemWindow to: [Preferences windowTitleFont]; set: #borderColorModifier for: #SystemWindow to: [ [:c | c adjustBrightness: -0.3] ]; set: #borderColorModifier for: #ScrollPane to: [ [:c | c adjustBrightness: -0.3] ]; set: #borderWidth for: #SystemWindow to: 1; derive: #resizerColorModifier for: #AbstractResizerMorph from: #SystemWindow at: #borderColorModifier; set: #uniformWindowColor for: #Model to: Color veryVeryLightGray; derive: #uniformWindowColor for: #TranscriptStream from: #Model; derive: #color for: #SystemWindow from: #Model at: #uniformWind owColor; "Fall back for windows without models." set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color darker] ]; set: #unfocusedLabelColor for: #SystemWindow to: Color darkGray; set: #focusedLabelColor for: #SystemWindow to: Color black; set: #customWindowColor for: #Browser to: (Color r: 0.764 g: 0.9 b: 0.63); set: #customWindowColor for: #ChangeList to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #ChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #ChatNotes to: (Color r: 1.0 g: 0.7 b: 0.8); set: #customWindowColor for: #ClassCommentVersionsBrowser to: (Color r: 0.753 g: 0.677 b: 0.9); set: #customWindowColor for: #Debugger to: (Color r: 0.9 g: 0.719 b: 0.719); set: #customWindowColor for: #DualChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #FileContentsBrowser to: (Color r: 0.7 g: 0.7 b: 0.508) ; set: #customWindowColor for: #FileList to: (Color r: 0.65 g: 0.65 b: 0.65); set: #customWindowColor for: #InstanceBrowser to: (Color r: 0.726 g: 0.9 b: 0.9); set: #customWindowColor for: #Lexicon to: (Color r: 0.79 g: 0.9 b: 0.79); set: #customWindowColor for: #MCTool to: (Color r: 0.65 g: 0.691 b: 0.876); set: #customWindowColor for: #MessageNames to: (Color r: 0.639 g: 0.9 b: 0.497); set: #customWindowColor for: #MessageSet to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #PackagePaneBrowser to: (Color r: 0.9 g: 0.9 b: 0.63); set: #customWindowColor for: #PluggableFileList to: Color lightYellow; set: #customWindowColor for: #PreferenceBrowser to: (Color r: 0.671 g: 0.9 b: 0.9); set: #customWindowColor for: #SMLoader to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SMLoaderPlus to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SMReleaseBrowser to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SelectorBrowser to: (Color r: 0.45 g: 0.9 b: 0.9); set: #customWindowColor for: #StringHolder to: (Color r: 0.9 g: 0.9 b: 0.719); set: #customWindowColor for: #TestRunner to: (Color r: 0.9 g: 0.576 b: 0.09); set: #customWindowColor for: #TranscriptStream to: (Color r: 0.9 g: 0.75 b: 0.45); set: #customWindowColor for: #VersionsBrowser to: (Color r: 0.782 g: 0.677 b: 0.9).! !!TrimTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addWindowColors: theme | windowColorBrightnessAdjustment | windowColorBrightnessAdjustment := -0.35. theme set: #titleFont for: #SystemWindow to: [Preferences windowTitleFont]; set: #borderColorModifier for: #SystemWindow to: [ [:c | c adjustBrightness: -0.1] ]; set: #borderColorModifier for: #ScrollPane to: [ [:c | c adjustBrightness: 0.1] ]; set: #borderWidth for: #SystemWindow to: 1;
set: #uniformWindowColor for: #Model to: self gray76; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color alphaMixed: 0.5 with: self gray40] ]; set: #unfocusedLabelColor for: #SystemWindow to: self gray168; set: #focusedLabelColor for: #SystemWindow to: Color white; set: #customWindowColor for: #Browser to: ((Color r: 0.764 g: 0.9 b: 0.63) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChangeList to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChangeSorter to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChatNotes to: ((Color r: 1.0 g: 0.7 b: 0.8) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ClassCommentVersionsBrowser to: ((Color r: 0.753 g: 0.677 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #Debugger to: ((Color r: 0.9 g: 0.719 b: 0.719) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #DualChangeSorter to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #FileContentsBrowser to: ((Color r: 0.7 g: 0.7 b: 0.508) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #FileList to: ((Color r: 0.65 g: 0.65 b: 0.65) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #InstanceBrowser to: ((Color r: 0.726 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #Lexicon to: ((Color r: 0.79 g: 0.9 b: 0.79) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MCTool to: ((Color r: 0.65 g: 0.691 b: 0.876) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MessageNames to: ((Color r: 0.639 g: 0.9 b: 0.497) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MessageSet to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PackagePaneBrowser to: ((Color r: 0.9 g: 0.9 b: 0.63) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PluggableFileList to: (Color lightYellow adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PreferenceBrowser to: ((Color r: 0.671 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMLoader to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMLoaderPlus to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMReleaseBrowser to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SelectorBrowser to: ((Color r: 0.45 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #StringHolder to: ((Color r: 0.9 g: 0.9 b: 0.719) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #TestRunner to: ((Color r: 0.9 g: 0.576 b: 0.09) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #TranscriptStream to: ((Color r: 0.9 g: 0.75 b: 0.45) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #VersionsBrowser to: ((Color r: 0.782 g: 0.677 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment).! !!Utilities class methodsFor: 'common requests' stamp: 'mt 8/11/2023 15:01'!initializeCommonRequestStrings "Initialize the common request strings, a directly-editable list of expressions that can be evaluated from the 'do...' menu." CommonRequestStrings := StringHolder new contents: 'Utilities emergencyCollapse.Utilities closeAllDebuggers.RecentMessages default revertMostRecent.-MCFileBasedRepository flushAllCaches-Sensor keyboard.ParagraphEditor abandonChangeText.Cursor normal show.-CommandHistory resetAllHistory.Project allInstancesDo: [:p | p displayDepth: 16].ScriptingSystem inspectFormDictionary.Form fromUser bitEdit.Display border: (0@0 extent: 640@480) width: 2.-Undeclared inspect.Undeclared removeUnreferencedKeys; inspect.Transcript clear.GIFReadWriter grabScreenAndSaveOnDisk.FrameRateMorph new openInHand.-Utilities reconstructTextWindowsFromFileNamed: ''TW''.Utilities storeTextWindowContentsToFileNamed: ''TW''.ChangeSet removeEmptyUnnamedChangeSets.ChangesOrganizer reorderChangeSets.'"Utilities initializeCommonRequestStrings"! !!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:55'!addControls | slider aWrapper m aButton | aWrapper := AlignmentMorph newRow. aWrapper color: Color transparent; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 @ 5. aWrapper wrapCentering: #topLeft. aButton := self buttonName: 'X' action: #delete. aButton setBalloonText: 'Close WaveEditor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Menu' translated action: #invokeMenu. aButton setBalloonText: 'Open a menu' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play' translated action: #play. aButton setBalloonText: 'Play sound' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play Before' translated action: #playBeforeCur sor. aButton setBalloonText: 'Play before cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play After' translated action: #playAfterCursor. aButton setBalloonText: 'Play after cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play Loop' translated action: #playLoop. aButton setBalloonText: 'Play the loop' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Test' translated action: #playTestNote. aButton setBalloonText: 'Test the note' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Save' translated action: #saveInstrument. aButton setBalloonText: 'Save the sound' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1 . aButton := self buttonName: 'Set Loop End' translated action: #setLoopEnd. aButton setBalloonText: 'Set loop end at cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set One Cycle' translated action: #setOneCycle. aButton setBalloonText: 'Set one cycle' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set Loop Start' translated action: #setLoopStart. aButton setBalloonText: 'Set the loop start at cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. self addMorphBack: aWrapper. aWrapper := AlignmentMorph newRow. aWrapper color: self color; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5 @ 20; wrapCentering: #center; cellPositioning: #leftCenter. m := Strin gMorph new contents: 'Index: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #cursor; putSelector: #cursor:; font: Preferences standardButtonFont; growable: false; width: 71; step. aWrapper addMorphBack: m. m := StringMorph new contents: 'Value: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #valueAtCursor; putSelector: #valueAtCursor:; font: Preferences standardButtonFont; growable: false; width: 50; step. aWrapper addMorphBack: m. slider := SimpleSliderMorph new color: color; extent: 200 @ 10; target: self; actionSelec tor: #scrollTime:. aWrapper addMorphBack: slider. m := Morph new color: aWrapper color; extent: 10 @ 5. "spacer" aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #startIndex; putSelector: #startIndex:; font: Preferences standardButtonFont; width: 40; step. aWrapper addMorphBack: m. self addMorphBack: aWrapper! !!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:56'!addLoopPointControls | m aWrapper | aWrapper := AlignmentMorph newRow. aWrapper color: self color; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter. m := StringMorph new contents: 'Loop end: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopEn d; putSelector: #loopEnd:; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Loop length: ' translated ; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopLength; putSelector: #loopLength:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m.aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Loop cycles: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopCycles; putSelector: #loopCycles:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m.aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Frequency: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #perceivedFrequency; putSelector: #perceivedFrequency:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. self addMorphBack: aWrapper! !!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:53'!buttonName: aString action: aSymbol "Create a button with the given label and action selector, and answer it." ^ SimpleButtonMorph new target: self; label: aString font: Preferences standardButtonFont; actionSelector: aSymbol! !WebCamMorph class removeSelector: #additionsToViewerCategories!SymbolListType removeSelector: #initialValueForASlotFor:!StringType removeSelector: #initialValueForASlotFor:!SoundType removeSele ctor: #initialValueForASlotFor:!PointType removeSelector: #initialValueForASlotFor:!NumberType removeSelector: #initialValueForASlotFor:!GraphicType removeSelector: #initialValueForASlotFor:!!GraphicType reorganize!('initial value')('initialization' initialize)!ColorType removeSelector: #initialValueForASlotFor:!BooleanType removeSelector: #initialValueForASlotFor:!DataType removeSelector: #initialValueForASlotFor:!Vocabulary removeSelector: #isEToyVocabulary!UpdatingStringMorph removeSelector: #isEtoyReadout!!UpdatingStringMorph reorganize!('accessing' autoAcceptOnFocusLoss autoAcceptOnFocusLoss: decimalPlaces decimalPlaces: floatPrecision format getSelector getSelector: growable growable: maximumWidth maximumWidth: minWidth minWidth: putSelector putSelector: pvtFloatPrecision: target target: valueFromContents)('copying' veryDeepFixupWith: veryDeepInner:)('editing' acceptContents acceptValue: addCustomMenuItems:hand: doneWithEdits lostFocusWithoutAccepting setDecimalPlaces: setFon tSize setFontStyle setPrecision setToAllowTextEdit toggleGrowability userEditsAllowed)('event handling' handlesMouseDown: mouseDown: wouldAcceptKeyboardFocus)('events-processing' handlerForMouseDown:)('formats' useDefaultFormat useStringFormat useSymbolFormat)('initialization' defaultMaximumWidth defaultMinimumWidth initialize)('stepping' step stepTime stepTime: updateContentsFrom:)('target access' acceptValueFromTarget: checkTarget informTarget readFromTarget setDecimalPlacesFromTypeIn: stringForNumericValue:)('layout' fitContents)('*MorphicExtras-accessing' floatPrecision:)!UpdatingRectangleMorph removeSelector: #isEtoyReadout!!UpdatingRectangleMorph reorganize!('accessing' contents contents: getSelector getSelector: putSelector putSelector: target target: userEditsAllowed)('copying' veryDeepFixupWith: veryDeepInner:)('event handling' handlesMouseDown: mouseUp:)('initialization' defaultBorderColor)('setting' setTargetColor: valueProvider)('stepping' step stepTime)('target access' readFromTarget)!UpdatingMenuItemMorph removeSelector: #adaptToWorld:!ThumbnailMorph removeSelector: #isEtoyReadout!!ThumbnailMorph reorganize!('accessing' getSelector getSelector: putSelector target)('caching' releaseCachedState)('copying' veryDeepFixupWith: veryDeepInner:)('display' drawForForm:on: drawMeOn: scaleFor:in:)('drawing' drawOn:)('initialization' defaultBorderWidth defaultColor initialize objectToView: objectToView:viewSelector:)('stepping' step stepTime)('texture support' installAsWonderlandTextureOn:)('what to view' actualViewee formOrMorphToView morphToView)!ThreePhaseButtonMorph initialize!!ThreePhaseButtonMorph class reorganize!('class initialization' initialize)('instance creation' checkBox labelSymbol: radioButton)('preferences' themeProperties)!ThreePhaseButtonMorph removeSelector: #adaptToWorld:!TheWorldMenu removeSelector: #adaptToWorld:!TheWorldMenu removeSelector: #menuColorString!TheWorldMenu removeSelector: #mvcProjectsAllowed!TheWorldMenu removeSele ctor: #roundedCornersString!TheWorldMenu removeSelector: #toggleMenuColorPolicy!!TheWorldMenu reorganize!('action' commandKeyTypedIntoMenu: doMenuItem:with: projectThumbnail saveScreenshot setGradientColor soundEnablingString staggerPolicyString toggleRoundedCorners toggleWindowPolicy)('commands' changeBackgroundColor cleanUpWorld garbageCollect loadProject lookForSlips newMorphOfClass:event: openBrowser openFileDirectly openFileList openMorphicProject openMVCProject openPreferencesBrowser openPreferencesWizard openTranscript openWorkspace projectForMyWorld quitSession readMorphFromAFile saveAndQuit saveWorldInFile setDisplayDepth splitNewMorphList:depth: startMessageTally vmStatistics worldMenuHelp)('construction' addObjectsAndTools: addPrintAndDebug: addProjectEntries: addRestoreDisplay: addSaveAndQuit: addUtilities: alphabeticalMorphMenu appearanceMenu buildWorldMenu changesMenu colorForDebugging: debugMenu fillIn:from: helpMenu makeConvenient: newMorph openMenu projectMenu remoteMenu)('mechanics' menu: world:project:hand:)('menu' addGestureHelpItemsTo:)('popups' appearanceDo changesDo debugDo doPopUp: helpDo openWindow projectDo remoteDo standardFontDo)('windows & flaps menu' suppressFlapsString windowsDo windowsMenu)('*MorphicExtras-action' createStandardPartsBin launchCustomPartsBin toggleFlapSuppressionInProject)('*MorphicExtras-construction' myMenuColor)('*MorphicExtras-mechanics')('*MorphicExtras-windows & flaps menu' flapsDo flapsMenu formulateFlapsMenu: globalFlapsEnabled newGlobalFlapString)('*Tools' browseRecentLog openChangeSorter1 openChangeSorter2 openMessageNames openProcessBrowser openSelectorBrowser startThenBrowseMessageTally)('*MorphicExtras-Postscript Canvases' printWorldOnFile)!TextMorphForEditView removeSelector: #wouldAcceptKeyboardFocusUponTab!!TextMorph class reorganize!('class initialization' cleanUp defaultEditorClass defaultEditorClass: initialize registerInFlapsRegistry unload)('connectorstext-parts bin' boldAuthoringPrototype)('new-morph participation' includeInNewMorphMenu)('parts bin' borderedPrototype exampleBackgroundLabel fancyPrototype)('scripting' authoringPrototype defaultNameStemForInstances)('instance creation' string:fontName: string:fontName:size: string:fontName:size:wrap: string:size:)('*MorphicExtras-parts bin' supplementaryPartsDescriptions)!TextMorph removeSelector: #cursor!TextMorph removeSelector: #cursorWrapped:!TextMorph removeSelector: #getAllButFirstCharacter!TextMorph removeSelector: #holderForCharacters!TextMorph removeSelector: #insertCharacters:!TextMorph removeSelector: #insertContentsOf:!TextMorph removeSelector: #setAllButFirstCharacter:!TextMorph removeSelector: #wouldAcceptKeyboardFocusUponTab!!TextMorph reorganize!('accessing' autoFit: backgroundColor backgroundColor: borderWidth: caretColor caretColor: contents contentsAsIs: contentsWrapped: contents: contents:wrappedTo: crAction crAction: editor elementCount font: getFirstCharacter getLastC haracter hasTranslucentColor isAutoFit isWrapped margins margins: newContents: plainTextOnly plainTextOnly: readOnly readOnly: selectAll selectFrom:to: selectInterval: selection selectionColor selectionColor: selectionInterval selectionInterval: setCharacters: setFirstCharacter: setLastCharacter: text textAlignment textAlignmentSymbol textColor textColor: textStyle textStyle: unfocusedSelectionColor unfocusedSelectionColor: userString wrapFlag:)('alignment' centered justified leftFlush rightFlush)('anchors' adjustTextAnchor: anchorMorph:at:type:)('caching' loadCachedState releaseCachedState)('change reporting' ownerChanged)('classification' isTextMorph)('containment' avoidsOcclusions fillingOnOff fillsOwner fillsOwner: occlusionsOnOff recognizerArena setContainer:)('copying' copy veryDeepFixupWith: veryDeepInner:)('drawing' areasRemainingToFill: debugDrawLineRectsOn: drawNullTextOn: drawOn:)('editing' acceptContents acceptOnCR cancelEdits cancelEditsSafely chooseAlignment chooseEmphas is chooseEmphasisOrAlignment chooseFont chooseStyle handleEdit: handleInteraction:fromEvent: hasUnacceptedEdits: passKeyboardFocusTo: setCompositionWindow xeqLinkText:withParameter:)('event handling' click: getMenu: handlesKeyboard: handlesMouseDown: handlesMouseMove: handlesMouseOver: handlesMouseStillDown: hasFocus keyboardFocusChange: keyStroke: mouseDown: mouseEnter: mouseLeave: mouseMove: mouseUp: startDrag: wantsKeyboardFocus yellowButtonActivity:)('events-processing' handleKeystroke:)('geometry' bounds container defaultLineHeight extent: maximumContainerExtent privateMoveBy: textBounds)('geometry testing' containsPoint:)('initialization' beAllFont: defaultBorderWidth defaultColor fontName:pointSize: fontName:size: initialize setTextStyle: string:fontName:size: string:fontName:size:wrap:)('layout' acceptDroppingMorph:event: averageLineLength averageLineLength: doLayoutIn: layoutChanged minCompositionHeight minCompositionWidth minHeight minWidth)('linked frames' addPredeces sor: addSuccessor: firstCharacterIndex firstInChain isLinkedTo: lastCharacterIndex predecessor recomposeChain startingIndex successor withSuccessorsDo:)('menu' addCustomMenuItems:hand: autoFitOnOff autoFitString changeMargins: changeTextColor followCurve reverseCurveDirection setCurveBaseline: wrapOnOff wrapString)('multi level undo' editHistory)('objects from disk' convertToCurrentVersion:refStream: fixUponLoad:seg:)('visual properties' fillStyle fillStyle:)('*MorphicExtras-accessing' getCharacters)('*MorphicExtras-copying' updateReferencesUsing:)('private' adjustLineIndicesBy: clippingRectangle composeToBounds compositionRectangle createParagraph editorClass fit installEditorToReplace: paragraph paragraphClass predecessorChanged predecessor:successor: privateOwner: releaseEditor releaseParagraph releaseParagraphReally removedMorph: selectionChanged selectionChanged: setDefaultContentsIfNil setPredecessor: setSuccessor: text:textStyle: text:textStyle:wrap:color:predecessor:succes sor: updateFromParagraph)('blinking' blinkStart blinkStart: onBlinkCursor resetBlinkCursor startBlinking stopBlinking)('layout-properties' hResizing hResizing: vResizing vResizing: wrapDirection)('printing' fullPrintOn:)('Multilingual-ImmPlugin' preferredKeyboardPosition)('submorphs - add/remove' addMorphFront:fromWorldPosition: delete goBehind)('converting' asText withNoLineLongerThan:)!TabbedPalette removeSelector: #becomeStandardPalette!!TabbedPalette reorganize!('dropping/grabbing' wantsDroppedMorph:event:)('halos and balloon help' defersHaloOnClickTo:)('initialization' addTabFor:font: addTabForBook: addTabForBook:withBalloonText: defaultColor defaultPageSize initialize newTabs: setInitialState)('misc menu items' recolorTabs showNoPalette showNoPaletteAndHighlightTab: sortTabs:)('miscellaneous' currentPalette tabsMorph)('navigation' transitionSpecFor:)('other' setExtentFromHalo:)('palette menu' addBookMenuItemsTo:hand: addMenuTab)('scraps tab' hasScrapsTab scrapsBook showScrapsTab)('user-interface' selectTab: selectTabNamed: selectTabOfBook: tabMorphs tabNamed:)('submorphs - add/remove' replaceSubmorph:by:)!SystemWindow removeSelector: #extantSketchEditor!SystemWindow removeSelector: #wantsExpandBox!SystemWindow removeSelector: #wantsHalo!!SystemWindow reorganize!('drawing' areasRemainingToFill: colorForInsets makeMeVisible wantsRoundedCorners)('events' doFastFrameDrag: filterEvent:for: handleListenEvent: handleMouseDown: handleMouseUp: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: paneTransition: secondaryPaneTransition:divider: startDragFromLabel: wantsToBeDroppedInto:)('geometry' extent: justDroppedInto:event: labelRect paneMorphs panelRect position: removeMenuBox setPaneRectsFromBounds)('initialization' addCloseBox addExpandBox addGrips addKeyboardShortcuts addLabelArea addMenuControl applyModelExtent boxExtent createBox: createCloseBox createCollapseBox createExpandBox createMenuBox defaultBounds defaultColor initialize initializeKeyboardShortcuts initializeLabelArea initializeWithLabel: maximumExtent maximumExtent: model: removeKeyboardShortcuts replaceBoxes setDefaultParameters setFramesForLabelArea)('label' addLabel getRawLabel knownName label labelArea labelHeight labelWidgetAllowance relabel relabelEvent: setLabel: setLabelWidgetAllowance tryToRenameTo: update: widthOfFullLabelText)('layout' assureLabelAreaVisible changeCellGapOfLayoutFrames: convertAlignment displayScaleChangedBy: layoutBounds putLabelItemsInLabelArea)('menu' addCustomMenuItems:hand: buildWindowMenu changeColor deleteCloseBox fullScreen fullScreenMaximumExtent makeClosable makeSecondTopmost makeUnclosable offerWindowMenu sendToBack setWindowColor takeOutOfWindow wantsYellowButtonMenu)('object fileIn' convertToCurrentVersion:refStream:)('open/close' anyOpenWindowLikeMeIn: closeBoxHit delete initialExtent mustNotClose openAsIs openAsIsI n: openInWorld: openInWorld:extent: openInWorldExtent: postAcceptBrowseFor:)('panes' addMorph:frame: addMorph:fullFrame: holdsTranscript paneMorphSatisfying: replacePane:with: setUpdatablePanesFrom: titleAndPaneText updatablePanes updateBox:color: updateBoxesColor:)('resize/collapse' allowReframeHandles allowReframeHandles: collapse collapseOrExpand collapsedFrame contractToOriginalSize dragToEdgeDistance dragToEdgesSelectorFor:in: expand expandBoxHit expandToFullScreen fastFramingOn fullFrame getBoundsWithFlex getCollapsedFrame isCollapsed isPoint:nearBottomLeftOf: isPoint:nearBottomOf: isPoint:nearBottomRightOf: isPoint:nearLeftOf: isPoint:nearRightOf: isPoint:nearTopLeftOf: isPoint:nearTopOf: isPoint:nearTopRightOf: mouseLeaveEvent:fromPane: paneWithLongestSide:near: reframePanesAdjoining:along:to: setBoundsWithFlex: unexpandedFrame unexpandedFrame:)('stepping' amendSteppingStatus stepAt: stepTime wantsSteps wantsStepsWhenCollapsed)('testing' isSystemWindow isWindowForModel: shouldDropOnMouseUp wantsToBeCachedByHand)('top window' beKeyWindow beKeyWindowIfNeeded: comeToFront comeToFrontModally dimWindowButtons isKeyWindow undimWindowButtons updatePanesFromSubmorphs)('thumbnail' icon)('polymorph' modalChild modalLockTo: modalOwner modalUnlockFrom: rememberedKeyboardFocus)('focus' activate defaultFocusMorph defaultFocusMorph: isActive isActive: isLookingFocused isLookingFocused: lockWindowDecorations lockWindowTitle lookFocused lookUnfocused passivate passivateIfNeeded unlockWindowDecorations unlockWindowTitle updateFocusLookAtHand updateFocusLookForKeyboardFocus windowDecorations)('colors' existingPaneColor gradientWithColor: paneColor paneColor: paneColorToUse paneColorToUseWhenNotActive raisedColor refreshWindowColor restoreDefaultPaneColor setStripeColorsFrom: setWindowColor: updatePaneColors)('user interface' applyUserInterfaceTheme)('*ToolBuilder-Morphic-opening' openAsTool)('*services-base' requestor topWindow)('*60Deprecated-open/close' anyOpenWindowLikeMe)!SuperSwikiServer removeSelector: #matchingEntries:!StringButtonMorph removeSelector: #adaptToWorld:!!StringButtonMorph reorganize!('accessing' actionSelector actionSelector: arguments arguments: target target:)('button' doButtonAction)('copying' updateReferencesUsing: veryDeepFixupWith: veryDeepInner:)('event handling' handlesMouseDown: handlesMouseStillDown: mouseDown: mouseMove: mouseStillDown: mouseUp:)('initialization' initialize)('menu' addCustomMenuItems:hand: addTargetingMenuItems:hand: clearTarget setActWhen setActionSelector setArguments setLabel setTarget:)('submorphs - add/remove' actWhen:)('classification' isButton)!SqueakFurtherCorePackagesHelp class removeSelector: #etoys!!SmartRefStream reorganize!('accessing' structures: superclasses:)('class changed shape' catalogValues:size: conversionMethodsFor: storeInstVarsIn:from: writeClassRename:was: writeClassRenameMethod:was:fromInstVars: writeConversionMethod:class:was:fromInstVars:to: writeConversionMethodIn:fromInstVars:to:renamedFrom:)('conversion' inputSensorx0 worldMorphbosfcebbfgccpmcpbttloiairfidcuwhavcdsll0)('import image segment' applyConversionMethodsTo:className:varMap: checkFatalReshape: convert1:to:allVarMaps: convert2:allVarMaps: mapClass:origName: reshapedClassesIn:)('read write' appendClassDefns checkCrLf initKnownRenames initShapeDicts instVarInfo: mapClass: moreObjects next nextAndClose nextPut: nextPutObjOnly: noHeader readInstance readInstanceSize:clsname:refPosn: readShortInst readWordLike recordImageSegment: renamed renamedConv restoreClassInstVars saveClassInstVars scanFrom: scanFrom:environment: setStream: setStream:reading: structures superclasses uniClasesDo: uniClassInstVarsRefs: verifyStructure versionSymbol:)('*Morphic-conversion' bookPageMorphbosfcepcbbfgcc0 clippingMorphbosfcep0 clippingMorphbosfcepc0 dropShadowMorphbosfces0 layoutMorphbosfcepbbochvimol0 layoutMorphbosfcepcbbochvimol0 morphicEventtcbks0 morphicSoundEventtcbkss 0 multiNewParagraphttfclpomsswfpp0 myMorphbosfce0 newMorphicEventts0)('*ST80-conversion' scrollControllermvslrrsmsms0)('*Graphics-conversion' transparentColorrcc0)('strings-conversion' abstractStringx0 multiStringx0 multiSymbolx0)!ColorPickerMorph removeSelector: #delete!ColorPickerMorph removeSelector: #getColorFromKedamaWorldIfPossible:!!ColorPickerMorph reorganize!('accessing' argument argument: deleteOnMouseUp deleteOnMouseUp: locationIndicator originalColor: selectedColor selector selector: sourceHand sourceHand: target target: updateContinuously updateContinuously:)('drawing' drawOn:)('event handling' handlesMouseDown: inhibitDragging mouseDown: mouseUp:)('geometry testing' containsPoint:)('halos and balloon help' isLikelyRecipientForMouseOverHalos)('initialization' buildChartForm choseModalityFromPreference initialize initializeForPropertiesPanel initializeModal: updateSelectorDisplay)('menu' addCustomMenuItems:hand: pickUpColorFor: toggleDeleteOnMouseUp toggleUpdateContinuously)('other' addToWorld:near: bestPositionNear:inWorld: indicateColorUnderMouse putUpFor:near: trackColorUnderMouse)('stepping' step stepTime)('private' anchorAndRunModeless: argumentsWith: deleteAllBalloons modalBalloonHelpAtPoint: pickColorAt: positionOfColor: trackColorAt: updateAlpha: updateColor:feedbackColor: updateTargetColor updateTargetColorWith:)('submorphs - add/remove' delete)!SketchMorph removeSelector: #firstIntersectionWithLineFrom:to:!!SketchMorph reorganize!('accessing' form form: framesToDwell framesToDwell: keepAspectRatio keepAspectRatio: nominalForm: originalForm: rotatedForm scaleFactor scalePoint scalePoint: setNewFormFrom: useInterpolation useInterpolation: wantsSimpleSketchMorphHandles)('caching' releaseCachedState)('drawing' canBeEnlargedWithB3D drawHighResolutionOn:in: drawInterpolatedImage:on: drawOn: generateInterpolatedForm generateRotatedForm)('support' baseGraphic baseGraphic: flipHorizontal flipVertical rotationStyle rotationStyle: wantsRecolorHandle)('geometry' extent:)('geometry testing' containsPoint:)('halos and balloon help' isLikelyRecipientForMouseOverHalos wantsDirectionHandles wantsDirectionHandles:)('initialization' initialize initializeWith:)('layout' layoutChanged)('menu' addBorderToShape: addCustomMenuItems:hand: addPaintingItemsTo:hand: blur callThisBaseGraphic edgeDetect editDrawing editDrawingIn:forBackground: emboss erasePixelsOfColor: erasePixelsUsing: insertIntoMovie: recolorPixelsOfColor:with: recolorPixelsUsing: reduceColorPalette: restoreBaseGraphic restoreBaseGraphicFromMenu setRotationStyle sharpen toggleInterpolation useInterpolationString)('menus' addFillStyleMenuItems:hand: addToggleItemsToHaloMenu: changePixelsOfColor:toColor: chooseNewGraphic collapse)('objects from disk' convertToCurrentVersion:refStream:)('other' newForm: replaceSelfWithMovie)('parts bin' initializeToStandAlone)('pen support' clearExtent:fillColor: penOnMyForm revealPenStrokes)('rotate scale and flex' forwardDirection: heading:)('*MorphicExtras-testing' canDrawAtHigherResolution)!SketchEditorMorph removeSelector: #wantsHaloFromClick!SimpleSliderMorph removeSelector: #isLikelyRecipientForMouseOverHalos!!SimpleSliderMorph reorganize!('accessing' actionSelector actionSelector: arguments arguments: maxVal maxVal: minVal minVal: target target:)('copying' updateReferencesUsing: veryDeepFixupWith: veryDeepInner:)('initialization' initialize)('menu' addCustomMenuItems:hand: addSliderMenuItems:hand: addTargetingMenuItems:hand: clearTarget descendingString setActionSelector setArguments setLabel setMaxVal setMinVal setMinVal: setTarget: toggleDescending toggleTruncate truncateString)('model access' setValue:)('parts bin' initializeToStandAlone)('private' adjustToValue: getScaledValue setMaxVal: setScaledValue: truncate truncate:)!SimpleHierarchicalListMorph class removeSelector: #submorphsExample!!SimpleHierarchicalListMorph class reorganize!('instance creation' expandedForm notExpandedForm on:list:selected:changeSelected: on:list:selected:changeSelected:menu: on:list:selected:changeSelected:menu:keystroke:)('preferences' applyUserInterfaceTheme expandAllLimit expandAllLimit: themeProperties wrappedNavigation wrappedNavigation:)!HaloMorph removeSelector: #addChooseGraphicHandle:!HaloMorph removeSelector: #addMakeSiblingHandle:!HaloMorph removeSelector: #addPaintBgdHandle:!HaloMorph removeSelector: #addPoohHandle:!HaloMorph removeSelector: #addRepaintHandle:!HaloMorph removeSelector: #addScriptHandle:!HaloMorph removeSelector: #addTileHandle:!HaloMorph removeSelector: #addViewHandle:!HaloMorph removeSelector: #addViewingHandle:!HaloMorph removeSelector: #doDupOrMakeSibling:with:!HaloMorph removeSelector: #doMakeSibling:with:!HaloMorph removeSelector: #doMakeSiblingOrDup:with:!HaloMorph removeSelector: #fadeIn!HaloMorph removeSelector: #fadeInInitially!HaloMorph removeSelector: #fadeOut!HaloMorph removeSelector: #fadeOutFinally!HaloMorph removeSele ctor: #handleEntered!HaloMorph removeSelector: #handleLeft!HaloMorph removeSelector: #isMagicHalo!HaloMorph removeSelector: #isMagicHalo:!HaloMorph removeSelector: #mouseDown:!HaloMorph removeSelector: #openViewerForTarget:with:!HaloMorph removeSelector: #popUpMagicallyFor:hand:!HaloMorph removeSelector: #tearOffTileForTarget:with:!SimpleHaloMorph removeSelector: #isMagicHalo!SimpleHaloMorph removeSelector: #popUpMagicallyFor:hand:!!IconicButton reorganize!('events' mouseEnter: mouseLeave:)('initialization' borderNormal borderThick buttonSetup defaultBorderWidth initialize initializeWithThumbnail:withLabel:andColor:andSend:to: initializeWithThumbnail:withLabel:andSend:to: setDefaultLabel stationarySetup)('menu' addLabelItemsTo:hand:)('button' doButtonAction)('compatibility' dim undim)('ui' darken darkenedForm restoreImage shedSelvedge)('label' labelFromString: labelGraphic: labelMorph)('*MorphicExtras-initialization' initializeToShow:withLabel:andSend:to:)!SimpleButtonMorph removeS elector: #adaptToWorld:!!ServerDirectory class reorganize!('available servers' addLocalProjectDirectory: addServer:named: localProjectDirectories nameForServer: projectServers removeServerNamed: removeServerNamed:ifAbsent: resetLocalProjectDirectories resetServers serverForURL: serverNamed: serverNamed:ifAbsent: serverNames servers)('class initialization' cleanUp: initialize)('misc' defaultStemUrl newFrom: on: parseFTPEntry: secondsForDay:month:yearOrTime:thisMonth:thisYear:)('school support' projectDefaultDirectory)('server prefs' determineLocalServerDirectory: fetchExternalSettingsIn: parseServerEntryFrom: releaseExternalSettings serverConfDirectoryName storeCurrentServersIn: transferServerDefinitionsToExternal)('*UpdateStream-server groups' convertGroupNames groupNames serverInGroupNamed: serversInGroupNamed:)!Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl keepAlive encodingName'
classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers' poolDictionaries: '' category: 'Network-RemoteDirectory'!SelectionMorph removeSelector: #couldMakeSibling!SelectionMorph removeSelector: #preferredDuplicationHandleSelector!ScrollableField removeSelector: #cursorWrapped:!ScrollableField removeSelector: #getAllButFirstCharacter!ScrollableField removeSelector: #getNumericValue!ScrollableField removeSelector: #insertCharacters:!ScrollableField removeSelector: #insertContentsOf:!ScrollableField removeSelector: #setNumericValue:!!ScreeningMorph reorganize!('accessing' passElseBlock: passingColor:)('drawing' fullDrawOn:)('halos and balloon help' wantsRecolorHandle)('geometry testing' containsPoint:)('initialization' initialize)('layout' layoutChanged)('menu' addCustomMenuItems:hand: chooseBlockingColor choosePassingColor exchange showScreenOnly showScreenOverSource showScreened showSourceOnly)('private' removedMorph: screenFor m screenMorph sourceMorph)('submorphs - add/remove' addMorph:)!ScreenController removeSelector: #standardGraphicsLibrary!ReleaseBuilder class removeSelector: #beautifyEtoys!FlapTab removeSelector: #makeNewDrawing:!FlapTab removeSelector: #startOrFinishDrawing:!FlapTab removeSelector: #thicknessString!Quadrangle class removeSelector: #exampleInViewer!!ProjectSorterMorph reorganize!('initialization' addControls defaultBorderWidth defaultColor initialize navigator:listOfPages:)('event handling' clickFromSorterEvent:morph:)('controls' insertNewProject:)('private' morphsForMyContentsFrom:sizedTo: sorterMorphForProjectNamed:)!ProjectNavigationMorph removeSelector: #buttonPaint!ProjectNavigationMorph removeSelector: #doNewPainting!ProjectNavigationMorph removeSelector: #editProjectInfo!ProjectNavigationMorph removeSelector: #makeTheSimpleButtons!!ProjectLoading class reorganize!('accessing' projectStreamFromArchive: thumbnailFromUrl:)('loading' installRemoteNamed:from:named:in: openFromDirectory:andFileName: openFromFile:fromDirectory:withProjectView: openName:stream:fromDirectory:withProjectView: openName:stream:fromDirectory:withProjectView:clearOriginFlag: openOn:)('utilities' bestAccessToFileName:andDirectory: useTempChangeSet)('loading - support' checkSecurity:preStream:projStream: fileInName:archive:morphOrList: loadImageSegment:fromDirectory:withProjectView:numberOfFontSubstitutes:substituteFont:mgr: makeExistingView:project:projectsToBeDeleted: morphOrList:stream:fromDirectory:archive: parseManifest:)!ProjectLauncher removeSelector: #cancelLogin!ProjectLauncher removeSelector: #doEtoyLogin!ProjectLauncher removeSelector: #loginAs:!ProjectLauncher removeSelector: #prepareForLogin!ProjectLauncher removeSelector: #proceedWithLogin!ProjectLauncher removeSelector: #startUpAfterLogin!AbstractLauncher subclass: #ProjectLauncher instanceVariableNames: 'showSplash splashURL whichFlaps' classVariableNames: 'SplashMorph' poolDictionaries: ''
category: 'System-Download'!!ProjectLauncher reorganize!('initialization' initialize setupFlaps setupFromParameters)('running' hideSplashMorph installProjectFrom: showSplashMorph startUp)('private' showSplash)!Project class removeSelector: #publishInSexp!!Project class reorganize!('class initialization' cleanUp: cleanUpProjectPreferences initialize localeChanged rebuildAllProjects)('constants' current uiManager uiProcess)('squeaklet on server' enterIfThereOrFind: fromUrl: isBadNameForStoring: loaderUrl mostRecent:onServer: namedUrl: parseProjectFileName: projectExtension serverDirectoryFromURL: serverFileFromURL: squeakletDirectory sweep:)('utilities' addingProject: advanceToNextProject allNames allNamesAndProjects allProjects allProjectsOrdered canWeLoadAProjectNow chooseNaturalLanguage deletingProject: enter: flattenProjectHierarchy forget: hierarchyOfNamesAndProjects jumpToProject jumpToSelection: maybeForkInterrupt named: named:in: namedWithDepth: ofWorld: projectHierarch y releaseProjectReferences: removeAll: removeAllButCurrent returnToParentProject returnToPreviousProject storeAllInSegments topProject versionForFileName:)('*Morphic-Support' allMorphicProjects)('error recovery' tryEmergencyEvaluatorForRecovery: tryOtherProjectForRecovery:)('shrinking' removeProjectsFromSystem)('snapshots' shutDown: startUp:)('*ST80-Support' allMVCProjects)('preferences')('*60Deprecated-error recovery' handlePrimitiveError:)('*61Deprecated-utilities' resumeProcess:)!MorphicProject removeSelector: #exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction:!MorphicProject removeSelector: #initMorphic!MorphicProject removeSelector: #myPlayerClasses!MorphicProject removeSelector: #setFlaps!!MorphicProject reorganize!('display' displayScaleChangedFrom:to: invalidate noDisplayDuring: previewImageForm restore viewLocFor:)('initialize' initialize installPasteUpAsWorld: openProject: setWorldBackground:)('testing' isMorphic)('menu messages' assureNavigatorPresenceMatchesPreference makeThumbnail)('utilities' addItem:toMenu:selection:color:thumbnail: composeDisplayTextIntoForm: createViewIfAppropriate do:withProgressInfoOn:label: findAFolderForProject:label: findProjectView: jumpToProject launchSystemFiles:event: offerMenu:from:shifted: pointerMoved setAsBackground: showImage:named: textWindows)('docking bars support' assureMainDockingBarPresenceMatchesPreference createOrUpdateMainDockingBar dockingBar dockingBar: removeMainDockingBar showWorldMainDockingBar showWorldMainDockingBar: showWorldMainDockingBarString toggleShowWorldMainDockingBar)('file in/out' acceptProjectDetails: armsLengthCommand:withDescription: compressFilesIn:to:in: compressFilesIn:to:in:resources: exportSegmentWithChangeSet:fileName:directory: exportSegmentWithChangeSet:fileName:directory:withoutInteraction: loadFromServer: noteManifestDetailsIn: storeSegment storeSegmentNoFile)('enter' clearGlobalState enterAsActiveSubprojectWithin: finalEnter Actions: finalExitActions: initializeMenus isIncompletelyLoaded resumeEventRecorder: scheduleProcessForEnter startUpActions suspendProcessForDebug terminateProcessForLeave wakeUpTopWindow)('squeaklet on server' enterIfThereOrFind: openBlankProjectNamed:)('release' deletingProject: prepareForDelete)('language' chooseNaturalLanguage updateLocaleDependents)('editors' bitEdit: bitEdit:at:scale: editCharacter:ofFont: formEdit: formViewClass openImage:name:saveResource:)('futures' future:do:at:args: future:send:at:args:)('active process' spawnNewProcess spawnNewProcessAndTerminateOld: spawnNewProcessIfThisIsUI: uiProcess uiProcess:)('transcripter' displayTranscripter: initializeParagraphForTranscripter:)('subprojects' addProject: subProjects)('accessing' color topMorphicProject)('updating' applyUserInterfaceTheme canApplyUserInterfaceTheme)('scheduling & debugging' addDeferredUIMessage: fatalDrawingError: interruptCleanUpFor: lastDeferredUIMessage openDebuggerWindow: recursiveError: restore Display resumeProcessSafely: suspendProcessSafely:)('flaps support' assureFlapIntegrity cleanseDisabledGlobalFlapIDsList enableDisableGlobalFlap: flapsSuppressed: globalFlapEnabledString: globalFlapWithIDEnabledString: isFlapEnabled: isFlapIDEnabled: suppressFlapsString toggleFlapsSuppressed)('protocols' currentVocabulary)!Project removeSelector: #restoreReferences!!Project reorganize!('accessing' changeSet color displayDepth displayDepth: explicitName explicitName: findProjectView: forgetExistingURL labelString lastDirectory: lastSavedAtSeconds name nameAdjustedForDepth nextProject nilParentError previousProject projectChangeSet renameTo: storeNewPrimaryURL: thumbnail thumbnail: topProject transcript uiManager urlList viewSize viewSize: world)('active process' depth spawnNewProcessIfThisIsUI: uiProcess)('displaying' displayDepthChanged displayScaleChangedFrom:to: displaySizeChanged displayZoom: imageForm imageFormOfSize:depth: invalidate noDisplayDuring: previewImageForm restore restoreDisplay showZoom shrinkDisplay viewLocFor:)('file in/out' armsLengthCommand:withDescription: assureIntegerVersion bumpVersion: couldBeSwappedOut currentVersionNumber decideAboutCreatingBlank: doArmsLengthCommand: downloadUrl ensureChangeSetNameUnique exportSegmentFileName:directory: exportSegmentFileName:directory:withoutInteraction: exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction: exportSegmentWithCatagories:classes:fileName:directory: exportSegmentWithChangeSet:fileName:directory: findAFolderToLoadProjectFrom findAFolderToStoreProjectIn fromMyServerLoad: hasBadNameForStoring htmlPagePrototype loadFromServer loadFromServer: objectForDataStream: primaryServer primaryServerIfNil: projectExtension revert saveAs saveForRevert serverList squeakletDirectory storeAttributeKey:value:on: storeAttributesOn: storeDataOn: storeHtmlPageIn: storeManifestFileIn: storeOnServer storeOnServerAssumingNameValid storeOnServerInnards storeOnServerShowProgressOn:forge tURL: storeOnServerWithProgressInfo storeOnServerWithProgressInfoOn: storeSegment storeSegmentNoFile storeSomeSegment storeToMakeRoom tryToFindAServerWithMe url urlForLoading versionForFileName versionFrom: versionedFileName writeFileNamed:fromDirectory:toServer: writeStackText:in:registerIn:)('flaps support' flapsSuppressed flapsSuppressed: showSharedFlaps)('initialization' initialExtent initialProject initialize installNewDisplay:depth: openProject: resetTranscript setChangeSet: setServer windowActiveOnFirstClick windowReqNewLabel:)('language' chooseNaturalLanguage localeChanged localeID naturalLanguage updateLocaleDependents)('menu messages' assureNavigatorPresenceMatchesPreference doWeWantToRename exit fileOut installProjectPreferences makeThumbnail saveProjectPreferences validateProjectNameIfOK:)('printing' addSubProjectNamesTo:indentation: printOn:)('project parameters' initializeProjectParameters initializeProjectPreferences noteThatParameter:justChangedTo: parameterAt: parameterAt:ifAbsent: projectParameterAt: projectParameterAt:ifAbsent: projectParameterAt:ifAbsentPut: projectParameterAt:put: projectParameters projectPreferenceAt: projectPreferenceAt:ifAbsent: projectPreferenceFlagDictionary rawParameters removeParameter:)('release' addDependent: canDiscardEdits close delete deletingProject: forget okToChange prepareForDelete release removeChangeSetIfPossible windowIsClosing)('resources' abortResourceLoading resourceDirectoryName resourceManager resourceManager: resourceUrl startResourceLoading storeResourceList:in:)('SuperSwiki' tellAFriend tellAFriend:)('*sound' beep)('enter' enter enter: enter:revert:saveForRevert: finalEnterActions: finalExitActions: loadState saveState scheduleProcessForEnter shutDownActions startUpActions terminateProcessForLeave wakeUpTopWindow)('utilities' addItem:toMenu:selection:color:thumbnail: buildJumpToMenu: composeDisplayTextIntoForm: do:withProgressInfoOn:label: findAFolderForProject:label: jumpToProject jumpToSelection: offerMenu:from:shifted: pointerMoved setAsBackground: showImage:named: textWindows)('squeaklet on server' enterIfThereOrFind: openBlankProjectNamed:)('futures' future:do:at:args: future:send:at:args:)('editors' bitEdit: bitEdit:at:scale: editCharacter:ofFont: formEdit: formViewClass openImage:name:saveResource:)('transcripter' displayTranscripter: initializeParagraphForTranscripter:)('sub-projects & hierarchy' addProject: beTopProject children isTopProject liftSubProjects parent setParent: subProjects withChildrenDo:)('enter - recovery' enterForEmergencyRecovery suspendProcessForDebug)('testing' isCurrentProject isIncompletelyLoaded isMorphic)('shrinking' removeAllOtherProjects)('*ST80-Testing' isMVC)('*60Deprecated-accessing' setThumbnail: setViewSize:)('scheduling & debugging' addDeferredUIMessage: debugProcess:inDialog: debugProcess:inWindow: guardRecursiveError:during: interruptCleanUpFor: interruptName: interruptName:message: interruptName:message:preemptedProcess: interruptName:preemptedProcess: lastDeferredUIMessage openDebuggerWindow: prepareProcessForDebugger: primitiveError: recursiveError: resumeProcessSafely: suspendProcessSafely:)('*MorphicExtras-accessing' useOwnChangeSetWithCurrentName useParentChangeSetButSetProjectName:)('protocols' currentVocabulary)!Preferences class removeSelector: #annotationEditingWindow!Preferences class removeSelector: #automaticViewerPlacement!Preferences class removeSelector: #batchPenTrails!Preferences class removeSelector: #capitalizedReferences!Preferences class removeSelector: #cautionBeforeClosing!Preferences class removeSelector: #chooseEToysFont!Preferences class removeSelector: #chooseEToysTitleFont!Preferences class removeSelector: #classicTilesSettingToggled!Preferences class removeSelector: #compactViewerFlaps!Preferences class removeSelector: #debugMenuItemsInvokableFromScripts!Preferences class removeSelector: #defaultPaintingExtent!Preferences cl ass removeSelector: #dropProducesWatcher!Preferences class removeSelector: #eToyFriendly!Preferences class removeSelector: #eToyFriendlyChanged!Preferences class removeSelector: #eToyLoginEnabled!Preferences class removeSelector: #editAnnotations!Preferences class removeSelector: #enableLocalSave!Preferences class removeSelector: #expandedPublishing!Preferences class removeSelector: #fenceEnabled!Preferences class removeSelector: #fenceSoundEnabled!Preferences class removeSelector: #fenceSoundEnabled:!Preferences class removeSelector: #haloTransitions!Preferences class removeSelector: #includeSoundControlInNavigator!Preferences class removeSelector: #keepTickingWhilePainting!Preferences class removeSelector: #largeTilesSettingToggled!Preferences class removeSelector: #magicHalos!Preferences class removeSelector: #menuColorFromWorld!Preferences class removeSelector: #menuColorString!Preferences class removeSelector: #messengersInViewers!Preferences class removeSelector: #mouseOverHalos!Preferences class removeSelector: #mouseOverHalosChanged!Preferences class removeSelector: #mvcProjectsAllowed!Preferences class removeSelector: #navigatorOnLeftEdge!Preferences class removeSelector: #noviceMode!Preferences class removeSelector: #noviceModeSettingChanged!Preferences class removeSelector: #okToReinitializeFlaps!Preferences class removeSelector: #oliveHandleForScriptedObjects!Preferences class removeSelector: #propertySheetFromHalo!Preferences class removeSelector: #selectiveHalos!Preferences class removeSelector: #setEToysFontTo:!Preferences class removeSelector: #setEToysTitleFontTo:!Preferences class removeSelector: #showAdvancedNavigatorButtons!Preferences class removeSelector: #showFlapsWhenPublishing!Preferences class removeSelector: #simpleMenus!Preferences class removeSelector: #standardEToysFont!Preferences class removeSelector: #standardEToysTitleFont!Preferences class removeSelector: #tabAmongFields!Preferences class removeSelector: #tileTranslucentDrag!Preferences class removeSelector: #typeCheckingInTileScripting!Preferences class removeSelector: #uniTilesClassic!Preferences class removeSelector: #universalTiles!Preferences class removeSelector: #universalTilesSettingToggled!Preferences class removeSelector: #unlimitedPaintArea!Preferences class removeSelector: #useCategoryListsInViewers!Preferences class removeSelector: #useVectorVocabulary!Preferences class removeSelector: #vectorVocabularySettingChanged!Preferences class removeSelector: #viewersInFlaps!!Preferences class reorganize!('accessing' allPreferences atomicUpdatePreferences: dictionaryOfPreferences pragmaIdFor:getter: pragmaPreferenceFor:getter: preferenceAt: preferenceAt:ifAbsent:)('class initialization' initialize unload)('get/set' doesNotUnderstand: setPreference:toValue: setPreference:toValue:during: valueOfPreference: valueOfPreference:ifAbsent:)('initialization' chooseInitialSettings cleanUp: cleanUpPragmaPreferences initializeDictionaryOfPreferences registerForEvents removeObsolete resetDefaultValues setPreferencesFrom:)('parameters' expungeParameter: initializeParameters inspectParameters parameterAt: parameterAt:ifAbsentPut: parameterAt:ifAbsent: parameters setParameter:to:)('reacting to change' isChangeSelector:)('standard queries' alphabeticalProjectMenu alternateHandlesLook alternativeBrowseIt alternativeWindowBoxesLook alwaysHideHScrollbar alwaysShowHScrollbar alwaysShowVScrollbar annotationPanes areaFillsAreTolerant areaFillsAreVeryTolerant autoIndent automaticFlapLayout automaticKeyGeneration balloonHelpEnabled balloonHelpInMessageLists biggerHandles caseSensitiveFinds changeSetVersionNumbers checkForSlips checkForUnsavedProjects classicNavigatorEnabled cmdDotEnabled cmdGesturesEnabled collapseWindowsInPlace confirmFirstUseOfStyle conversionMethodsAtFileOut debugHaloHandle debugLogTimestamp debugPrintSpaceLog debugShowDamage decorateBrowserButtons diffsInChangeList diffsWithPrett yPrint dismissAllOnOptionClose easySelection extraDebuggerButtons fastDragWindowForMorphic fullScreenLeavesDeskMargins generalizedYellowButtonMenu haloEnclosesFullBounds higherPerformance honorDesktopCmdKeys infiniteUndo logDebuggerStackToFile maintainHalos menuAppearance3d menuKeyboardControl menuWithIcons modalColorPickers mouseOverForKeyboardFocus optionalButtons passwordsOnPublish personalizedWorldMenu postscriptStoredAsEPS projectsSentToDisk projectViewsInWindows projectZoom purgeUndoOnQuit readDocumentAtStartup readDocumentAtStartup: restartAlsoProceeds reverseWindowStagger scrollBarsNarrow scrollBarsOnRight securityChecksEnabled serverMode showBoundsInHalo showDirectionForSketches showDirectionHandles showProjectNavigator showSecurityStatus showSharedFlaps showSplitterHandles signProjectFiles smartUpdating standaloneSecurityChecksEnabled startInUntrustedDirectory swapMouseButtons systemWindowEmbedOK timeStampsInMenuTitles tinyDisplay traceMessages turnOffPowerManager twentyFourHourFileStamps uniqueNamesInHalos useButtonPropertiesToFire useUndo visualExplorer warnAboutInsecureContent warnIfNoChangesFile warnIfNoSourcesFile wordStyleCursorMovement)('themes' outOfTheBox personal)('*PreferenceBrowser' addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:viewRegistry:)('private' compileAccessorForPreference: compileAccessorForPreferenceNamed:value: preference:category:description:type: preference:categoryList:description:type:)('prefs - fonts' aaFontsColormapDepth chooseBalloonHelpFont chooseCodeFont chooseFixedFont chooseFlapsFont chooseFontWithPrompt:andSendTo:withSelector:highlightSelector: chooseHaloLabelFont chooseListFont chooseMenuFont chooseStandardButtonFont chooseSystemFont chooseWindowTitleFont decreaseFontSize fontConfigurationMenu fontConfigurationMenu: increaseFontSize printStandardSystemFonts refreshFontSettings restoreDefaultFonts restoreDefaultFontsForJapanese restoreFontsAfter: setBalloonHel pFontTo: setButtonFontTo: setCodeFontTo: setDemoFonts setFixedFontTo: setFlapFontTo: setFlapsFontTo: setHaloLabelFontTo: setListFontTo: setMenuFontTo: setPaintBoxButtonFontTo: setSystemFontTo: setWindowTitleFontTo: standardBalloonHelpFont standardButtonFont standardCodeFont standardDefaultTextFont standardFixedFont standardFlapFont standardHaloLabelFont standardListFont standardMenuFont standardPaintBoxButtonFont standardSystemFont standardWindowTitleFont subPixelRenderColorFonts subPixelRenderFonts windowTitleFont windowTitleStyle)('support - misc' acceptAnnotationsFrom: addModelItemsToWindowMenu: automaticFlapLayoutString initialExtent inspectPreferences letUserPersonalizeMenu navigatorShowingString personalizeUserMenu: setArrowheads staggerPolicyString wantsChangeSetLogging)('add/remove - specific' addBooleanPreference:categories:default:balloonHelp: addBooleanPreference:category:default:balloonHelp: addColorPreference:categories:default:balloonHelp: addColorPreference:category:default:balloonHelp: addFontPreference:categories:default:balloonHelp: addFontPreference:category:default:balloonHelp: addNumericPreference:categories:default:balloonHelp: addNumericPreference:category:default:balloonHelp: addTextPreference:categories:default:balloonHelp: addTextPreference:category:default:balloonHelp:)('add/remove' addPragmaPreference: addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:type: removeAllPreferencesSuchThat: removePreference:)('add/remove - convenience' addPreference:categories:default:balloonHelp: addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: addPreference:category:default: addPreference:category:default:balloonHelp: addPreference:default:)('prefs - annotations' annotationInfo defaultAnnotationInfo defaultAnnotationRequests defaultAnnotationRequests:)('updating - system' annotationPanesChanged displaySizeChanged infiniteUndoChanged optionalButtonsChanged roundedWindowCornersChanged sharedFlapsSettingChanged showProjectNavigatorChanged smartUpdatingChanged)('prefs - misc' balloonHelpDelayTime borderColorWhenRunning cmdKeysInText defaultAuthorName defaultWorldColor desktopColor desktopColor: desktopMenuTitle enableProjectNavigator maxBalloonHelpLineLength maxBalloonHelpLineLength: metaMenuDisabled preserveCommandExcursions scrollBarColor scrollBarWidth suppressWindowTitlesInInstanceBrowsers useFormsInPaintBox:)('themes - tools' browseThemes installTheme: offerThemesMenu themeChoiceButtonOfColor:font:)('support' categoryList categoryListOfPreference: giveHelpWithPreferences okayToChangeProjectLocalnessOf: preferencesInCategory: typeForValue:)('prefs - halos' classicHaloSpecs classicHalosInForce customHaloSpecs customHalosInForce editCustomHalos haloSpecifications haloSpecificationsForWorld haloTheme iconicHaloSpecifications iconicHalosInForce installClassicHaloSpecs installCustomHaloSpecs installHaloSpecsFromArray: installHaloTheme: installIconicHaloSpecs installSimpleHaloSpecs resetHaloSpecifications showChooseGraphicHaloHandle simpleFullHaloSpecifications simpleHalosInForce)('defaults' defaultValueTableForCurrentRelease unclassifiedCategory)('get/set - flags' disable: enable: setFlag:toValue: setFlag:toValue:during: toggle: valueOfFlag: valueOfFlag:ifAbsent:)('initialization - misc' disableProgrammerFacilities enableProgrammerFacilities setDefaultAnnotationInfo setNotificationParametersForStandardPreferences)('support - file list services' fileReaderServicesForFile:suffix: serviceLoadPreferencesFromDisk services)('initialization - save/load' loadPreferencesFrom: restorePersonalPreferences restorePreferencesFromDisk restorePreferencesFromDisk: savePersonalPreferences storePreferencesIn: storePreferencesToDisk)('updating' localeChanged prefEvent:)('*60Deprecated-menu colors' menuBorderColor menuBorderWidth menuColor menuLineColor menuSelectionColor menuTitleBorderColor menuTitleBorderWidth menuTitleColor)('*morphicextras' rotationAndScaleHandlesInPaintBox)('*60Deprecated-prefs-text' chooseInsertionPointColor chooseKeyboardFocusColor chooseTextHighlightColor initializeTextHighlightingParameters insertionPointColor insertionPointColor: keyboardFocusColor keyboardFocusColor: textHighlightColor textHighlightColor:)('*60Deprecated-Etoys-Squeakland-window colors' windowColorHelp windowSpecificationPanel)('*60Deprecated-parameters' parameterAt:default:)!!PolygonMorph reorganize!('access' isClosed isCurve isOpen makeOpenOrClosed midVertices openOrClosePhrase smoothOrSegmentedPhrase vertices)('accessing' borderColor: borderDashSpec borderStyle: borderWidth: couldHaveRoundedCorners)('caching' loadCachedState releaseCachedState)('dashes' borderDashOffset dashedBorder dashedBorder: removeVertex: vertexAt:)('debug and other' installModelIn: rotateTestFlip:)('drawing' areasRemainingToFill: drawArrowOn:at:from: drawArrowsOn: drawBorde rOn: drawBorderOn:usingEnds: drawClippedBorderOn:usingEnds: drawDashedBorderOn: drawDashedBorderOn:usingEnds: drawOnFormCanvas: drawOn:)('editing' addHandles clickVertex:event:fromHandle: deleteVertexAt: dragVertex:event:fromHandle: dragVertex:fromHandle:vertIndex: dropVertex:event:fromHandle: dropVertex:fromHandle:vertIndex: handleColorAt: insertVertexAt:put: newVertex:event:fromHandle: newVertex:fromHandle:afterVert: updateHandles verticesAt:put:)('event handling' handlesMouseDown: mouseDown:)('geometry' arrowsContainPoint: bounds: closestPointTo: closestSegmentTo: extent: flipHAroundX: flipVAroundY: intersectionsWith: intersectionWithLineSegmentFromCenterTo: intersects: isBordered lineBorderColor lineBorderColor: lineBorderWidth lineBorderWidth: lineColor lineColor: lineWidth lineWidth: mergeDropThird:in:from: merge: nextDuplicateVertexIndex reduceVertices straighten transformedBy:)('geometry testing' containsPoint:)('initialization' beSmoothCurve beStraightSegments defaultBord erColor defaultColor initialize vertices:color:borderWidth:borderColor:)('menu' addCustomMenuItems:hand: addPolyArrowMenuItems:hand: addPolyLIneCurveMenuItems:hand: addPolyShapingMenuItems:hand: arrowLength: arrowSpec: arrows customizeArrows: handlesShowingPhrase makeBackArrow makeBothArrows makeClosed makeForwardArrow makeNoArrows makeOpen quickFill: removeHandles setRotationCenterFrom: showingHandles showOrHideHandles specifyDashedLine standardArrows toggleHandles toggleSmoothing unrotatedLength unrotatedLength: unrotatedWidth unrotatedWidth:)('objects from disk' convertToCurrentVersion:refStream:)('rotate scale and flex' addFlexShellIfNecessary heading heading: referencePosition rotationCenter rotationCenter: rotationDegrees rotationDegrees:)('smoothing' coefficients computeNextToEndPoints derivs:first:second:third: lineSegmentsDo: nextToFirstPoint nextToLastPoint slopes: straightLineSegmentsDo:)('stepping' step stepTime wantsSteps)('testing' hasArrows isCurvier isCurvy isLineMorph)('visual properties' canHaveFillStyles fillStyle fillStyle:)('*MorphicExtras-geometry eToy' scale:)('private' arrowBoundsAt:from: arrowForms borderForm computeArrowFormAt:from: computeBounds curveBounds filledForm getVertices includesHandle: lineSegments privateMoveBy: setVertices: transformVerticesFrom:to:)('shaping' diamondOval rectOval)('attachments' defaultAttachmentPointSpecs endShapeColor: endShapeWidth: firstVertex lastVertex midpoint nudgeForLabel: totalLength)('rounding' cornerStyle:)('*MorphicExtras-Postscript Canvases' drawPostscriptOn:)!PluggableTextMorph removeSelector: #tileForIt!PasteUpMorphTest removeSelector: #testCursorWrapped!PasteUpMorphTest removeSelector: #testCursorWrappedWithFraction!PasteUpMorphTest removeSelector: #testGridToGradient!PasteUpMorph initialize!PasteUpMorph class removeSelector: #supplementaryPartsDescriptions!!PasteUpMorph class reorganize!('printing' defaultNameStemForInstances)('project' newWorldForProject:)('scripting' authoringPrototype)('preferences' globalCommandKeysEnabled globalCommandKeysEnabled:)('recompilation' postRecompileAction)('*MorphicExtras-class initialization' initialize registerInFlapsRegistry unload)('*MorphicExtras-project' newWorldTesting)('*MorphicExtras-parts bin')('parts bin' descriptionForPartsBin)!PartsBin removeSelector: #morphToDropFrom:!PasteUpMorph removeSelector: #abandonCostumeHistory!PasteUpMorph removeSelector: #abandonVocabularyPreference!PasteUpMorph removeSelector: #adaptedToWorld:!PasteUpMorph removeSelector: #addPenMenuItems:hand:!PasteUpMorph removeSelector: #addPenTrailsMenuItemsTo:!PasteUpMorph removeSelector: #addPlayfieldMenuItems:hand:!PasteUpMorph removeSelector: #addStackMenuItems:hand:!PasteUpMorph removeSelector: #allScriptEditors!PasteUpMorph removeSelector: #allScriptors!PasteUpMorph removeSelector: #allTileScriptingElements!PasteUpMorph removeSelector: #assureNotPaintingEvent:!PasteUpMorph removeSelector: #automaticPhraseExpansion!PasteUpM orph removeSelector: #automaticViewing!PasteUpMorph removeSelector: #behaveLikeHolder!PasteUpMorph removeSelector: #behaveLikeHolder:!PasteUpMorph removeSelector: #behavingLikeAHolder!PasteUpMorph removeSelector: #browseAllScriptsTextually!PasteUpMorph removeSelector: #buildDebugMenu:!PasteUpMorph removeSelector: #closedViewerFlapTabs!PasteUpMorph removeSelector: #couldMakeSibling!PasteUpMorph removeSelector: #cursor!PasteUpMorph removeSelector: #cursor:!PasteUpMorph removeSelector: #cursorWrapped:!PasteUpMorph removeSelector: #detachableScriptingSpace!PasteUpMorph removeSelector: #drawOn:!PasteUpMorph removeSelector: #dumpPresenter!PasteUpMorph removeSelector: #hideViewerFlaps!PasteUpMorph removeSelector: #hideViewerFlapsOtherThanFor:!PasteUpMorph removeSelector: #indicateCursor!PasteUpMorph removeSelector: #indicateCursor:!PasteUpMorph removeSelector: #indicateCursorString!PasteUpMorph removeSelector: #installVectorVocabulary!PasteUpMorph removeSelector: #isPlayfieldLike!PasteUp Morph removeSelector: #makeNewDrawing:!PasteUpMorph removeSelector: #makeNewDrawing:at:!PasteUpMorph removeSelector: #makeNewDrawingWithin!PasteUpMorph removeSelector: #makeVectorUseConformToPreference!PasteUpMorph removeSelector: #mouseOverHalosString!PasteUpMorph removeSelector: #newDrawingFromMenu:!PasteUpMorph removeSelector: #numberAtCursor!PasteUpMorph removeSelector: #openScrapsBook:!PasteUpMorph removeSelector: #paintArea!PasteUpMorph removeSelector: #paintAreaFor:!PasteUpMorph removeSelector: #paintingBoundsAround:!PasteUpMorph removeSelector: #paintingFlapTab!PasteUpMorph removeSelector: #prepareToBeSaved!PasteUpMorph removeSelector: #prepareToPaint!PasteUpMorph removeSelector: #prepareToPaint:!PasteUpMorph removeSelector: #presentCardAndStackMenu!PasteUpMorph removeSelector: #presentPlayfieldMenu!PasteUpMorph removeSelector: #presenter!PasteUpMorph removeSelector: #printScriptSummary!PasteUpMorph removeSelector: #putUpPenTrailsSubmenu!PasteUpMorph removeSelector: #reasonablePaintingExtent!PasteUpMorph removeSelector: #rectifyCursor!PasteUpMorph removeSelector: #referencePlayfield!PasteUpMorph removeSelector: #referencePool!PasteUpMorph removeSelector: #releaseViewers!PasteUpMorph removeSelector: #removeAllViewers!PasteUpMorph removeSelector: #restoreBoundsOfSubmorphs!PasteUpMorph removeSelector: #resumeScriptsPausedByPainting!PasteUpMorph removeSelector: #roundUpStrays!PasteUpMorph removeSelector: #saveBoundsOfSubmorphs!PasteUpMorph removeSelector: #selectedRect!PasteUpMorph removeSelector: #sendTextContentsBackToDonor!PasteUpMorph removeSelector: #showStatusOfAllScripts!PasteUpMorph removeSelector: #showingListView!PasteUpMorph removeSelector: #sortSubmorphsBy:!PasteUpMorph removeSelector: #standardPlayerHit!PasteUpMorph removeSelector: #startRunningAll!PasteUpMorph removeSelector: #stepAll!PasteUpMorph removeSelector: #stopRunningAll!PasteUpMorph removeSelector: #toggleAutoLineLayout!PasteUpMorph removeSelector: #toggleClassicNavigatorIfAppropriate!PasteUpMorph removeSelector: #toggleMouseOverHalos!PasteUpMorph removeSelector: #triggerClosingScripts!PasteUpMorph removeSelector: #triggerOpeningScripts!PasteUpMorph removeSelector: #updateStatusForAllScriptEditors!PasteUpMorph removeSelector: #valueAtCursor!PasteUpMorph removeSelector: #valueAtCursor:!PasteUpMorph removeSelector: #viewingNormally!PasteUpMorph removeSelector: #wantsHaloFor:!PasteUpMorph removeSelector: #wantsMouseOverHalos!PasteUpMorph removeSelector: #wantsMouseOverHalos:!BorderedMorph subclass: #PasteUpMorph instanceVariableNames: 'model padding isPartsBin worldState' classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler' poolDictionaries: '' category: 'Morphic-Worlds'!!PasteUpMorph reorganize!('accessing' assureFlapWidth: flapTab lastKeystroke lastKeystroke: modelOrNil useRoundedCorners)('alarms-scheduler' addAlarm:withArguments:for:at: removeAlarm:for:)('caching' releaseCachedState)('change rep orting' invalidRect:from:)('classification' isWorldMorph)('copying' veryDeepCopyWith:)('display' gradientFillColor: setGradientColor:)('dropping/grabbing' acceptDroppingMorph:event: dropEnabled hasTransferMorphConverter justDroppedInto:event: morphToDropForTransferMorph: morphToDropFrom: originAtCenter positionNear:forExtent:adjustmentSuggestion: repelsMorph:event: resetTransferMorphConverter transferMorphConverter transferMorphConverter: wantsDroppedMorph:event: wantsDroppedTransferMorph:)('event handling' dropExplorerField:from:event: dropFiles:event: dropInspectorField:event: dropSourceCode:event: handleDroppedItem:event: handlesKeyboard: handlesMouseDown: keyStroke: morphToGrab: mouseDown: mouseUp: wantsEasySelection wantsKeyboardFocusFor: wantsWindowEvent: windowEvent: windowEventHandler windowEventHandler:)('events-processing' filterEvent:for: processEvent:using: tryInvokeHalo: tryInvokeKeyboardShortcut: tryInvokeMetaMenu:)('geometry' bringTopmostsToFront extent: position:)('ge ometry testing' fullContainsPoint:)('halos and balloon help' defersHaloOnClickTo: wantsDirectionHandles wantsHaloFromClick)('initialization' addKeyboardShortcuts addMouseShortcuts becomeActiveDuring: defaultBorderColor defaultBorderWidth defaultColor initialize initializeKeyboardShortcuts initializeMouseShortcuts newResourceLoaded removeKeyboardShortcuts)('interaction loop' doOneCycleNow)('layout' addCenteredAtBottom:offset: convertAlignment laySubpartsOutInOneRow layoutChanged)('menu & halo' addCustomMenuItems:hand: addScalingMenuItems:hand: addWorldHaloMenuItemsTo:hand: addWorldToggleItemsToHaloMenu: autoLineLayoutString currentlyUsingVectorVocabulary defineApplicationView defineFactoryView deleteBalloonTarget: isPartsBinString originAtCenterString reformulateUpdatingMenus showApplicationView showExpandedView showFactoryView showFullView showReducedView showThumbnailString showWorldMainDockingBarString toggleShowWorldMainDockingBar transformToShow:)('misc' alwaysShowThumbnail cachedOrNewThumbnailFrom: cartesianOrigin heightForThumbnails hideFlapsOtherThan:ifClingingTo: innocuousName maxHeightToAvoidThumbnailing maximumThumbnailWidth mouseX mouseY nameForCopyIfAlreadyNamed: padding: smallThumbnailForPageSorter thumbnailForPageSorter unhideHiddenObjects)('model' createCustomModel model setModel:)('name' unusedMorphNameLike:)('objects from disk' convertToCurrentVersion:refStream: fixUponLoad:seg: saveOnFile)('options' autoLineLayout autoLineLayout: isPartsBin: replaceTallSubmorphsByThumbnails resizeToFit resizeToFitString setPartsBinStatusTo: toggleIsPartsBin toggleResizeToFit)('parts bin' initializeToStandAlone isPartsBin residesInPartsBin)('printing' printOn:)('project' project releaseSqueakPages storeProjectsAsSegments)('project state' canvas canvas: firstHand hands handsDo: handsReverseDo: isStepping: isStepping:selector: listOfSteppingMorphs stepListSize stepListSummary steppingMorphsNotInWorld viewBox viewBox:)('stepping' cleanseStepList runLocalStepMethods runStepMethods startStepping: startStepping:at:selector:arguments:stepTime: step stepTime stopStepping: stopStepping:selector:)('structure' primaryHand world)('testing' isEasySelecting)('undo' clearCommandHistory commandHistory onceAgainDismiss: reintroduceIntoWorld:)('update cycle' startBackgroundProcess)('user interface' modelWakeUp)('naming' defaultNameStemForInstances)('visual properties' canHaveFillStyles fillStyle: setAsBackground:)('WiW support' addMorphInLayer: installAsActiveSubprojectIn:at:titled: installAsActiveSubprojectIn:titled: restartWorldCycleWithEvent: shouldGetStepsFrom: validateMouseEvent:)('world menu' activateObjectsTool addUndoItemsTo: bringWindowsFullOnscreen buildWorldMenu: closeUnchangedWindows collapseAll collapseNonWindows commandKeySelectors connectRemoteUser connectRemoteUserWithName:picture:andIPAddress: delayedInvokeWorldMenu: deleteNonWindows disconnectAllRemoteUsers disconnectRemoteUser dispatchCommandKeyInWorld:event: drawingClass expandAll extractScreenRegion:andPutSketchInHand: findAChangeSorter: findAFileList: findAMessageNamesWindow: findAPreferencesPanel: findATranscript: findAWindowSatisfying:orMakeOneUsing: findDirtyBrowsers: findDirtyWindows: findWindow: getWorldMenu: grabDrawingFromScreen: grabFloodFromScreen: grabLassoFromScreen: grabRubberBandFromScreen: initializeDesktopCommandKeySelectors invokeWorldMenu: keyboardNavigationHandler keyboardNavigationHandler: keystrokeInWorld: putUpNewMorphMenu putUpWorldMenu: putUpWorldMenuFromEscapeKey reportLocalAddress respondToCommand:bySending:to: undoOrRedoCommand yellowButtonClickOnDesktopWithEvent:)('world state' abandonAllHalos addHand: addMorph:centeredNear: addMorphsAndModel: allNonFlapRelatedSubmorphs allNonWindows assureNotPaintingElse: assuredCanvas beWorldForProject: checkCurrentHandForObjectToPaste checkCurrentHandForObjectToPaste2 chooseClickTarget colorAt:belowMorph: deEmphasizeViewMVC: deleteAllHalos displayWorld displayWorldAsTwoTone displayWorldNonIncrementally displayWorldSafely doOneCycle doOneCycleInBackground doOneSubCycle dragThroughOnDesktop: embeddedProjectDisplayMode endDrawing: exit flashRects:color: fullRepaintNeeded goBack haloMorphs initForProject: install installFlaps jumpToProject nextPage noDisplayDuring: optimumExtentFromAuthor paintBox paintBoxOrNil patchAt:without:andNothingAbove: pauseEventRecorder previousPage privateOuterDisplayWorld removeHand: repairEmbeddedWorlds repositionFlapsAfterScreenSizeChange restoreFlapsDisplay restoreMainDockingBarDisplay restoreMorphicDisplay saveAsWorld sketchEditorOrNil sleep someHalo specialNameInModelFor: startSteppingSubmorphsOf:)('*Tools' defaultDesktopCommandKeyTriplets findAMonticelloBrowser)('private' privateFullMoveBy: privateMoveBy:)('thumbnail' icon)('polymorph' modalLockTo: modalUnlockFrom:)('recompilation' updateStatePostRecompile)('submorphs - add/remove' addAllMorphs: addMorphFront:)('submorphs - accessing' allMorphs Do: morphsInFrontOf:overlapping:do:)('flaps' accommodateFlap: addGlobalFlaps assureFlapTabsFitOnScreen correspondingFlapTab deleteGlobalFlapArtifacts enableGlobalFlaps flapTabs localFlapTabs offsetForAccommodating:onEdge: removeAccommodationForFlap:)('Nebraska' addRemoteClient: convertRemoteClientToBuffered: hasRemoteServer releaseRemoteServer remoteServer remoteServer: removeRemoteClient: transferRemoteServerFrom:)('*60Deprecated-menu & halo' isOpenForDragNDropString)('*services-base' focusedRequestor openWorldMenu requestor worldMenu)('*60Deprecated-accessing' modalWindow: removeModalWindow)('*MorphicExtras-flaps' deleteAllFlapArtifacts)('*ST80-Support' standardSystemController)('*Protocols' currentVocabulary)!ParagraphEditor class removeSelector: #yellowButtonExpertMenu!ParagraphEditor class removeSelector: #yellowButtonNoviceMenu!PackageDependencyTest removeSelector: #testEtoys!ObjectlandMorph removeSelector: #createEtoysProject!ObjectExplorer removeSelector: #viewerForValue!NativeImageSegment removeSelector: #findRogueRootsAllMorphs:!NativeImageSegment removeSelector: #rootsIncludingPlayers!NativeImageSegment removeSelector: #savePlayerReferences:!MorphicModel removeSelector: #addModelYellowButtonMenuItemsTo:forMorph:hand:!!MorphicModel reorganize!('accessing' model modelOrNil slotName wantsSlot)('caching' releaseCachedState)('classification' isMorphicModel)('compilation' addPartNameLike:withValue: compileAccessForSlot: compilePropagationMethods nameFor: propagate:as: removeAll slotSelectorFor: use:orMakeModelSelectorFor:in:)('debug and other' installModelIn:)('drag and drop' allowSubmorphExtraction isOpen)('geometry' charactersOccluded newBounds: recomputeBounds)('initialization' defaultBorderColor defaultBounds defaultColor duplicate:from: initialize model: model:slotName:)('menu' addCustomMenuItems:hand: closeToEdits openToEdits)('naming' choosePartName)('printing' initString)('submorphs - accessing' allKnownNames)('submorphs - add/remove' delete)('*MorphicExtras-compilation' compileInitMethods)!MorphExtension removeSelector: #player!MorphExtension removeSelector: #player:!Object subclass: #MorphExtension instanceVariableNames: 'locked visible sticky balloonText balloonTextSelector externalName isPartsDonor actorState eventHandler otherProperties' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Kernel'!!MorphExtension reorganize!('accessing' actorState actorState: balloonText balloonTextSelector balloonTextSelector: balloonText: eventHandler eventHandler: externalName: locked locked: sticky sticky: visible visible:)('accessing - layout properties' layoutFrame layoutFrame: layoutPolicy layoutPolicy: layoutProperties layoutProperties:)('accessing - other properties' assureOtherProperties hasOtherProperties hasProperty: initializeOtherProperties otherProperties privateOtherProperties: removeOtherProperties removeProperty: setProperty:toValue: sortedPropertyNames valueOfProper ty: valueOfProperty:ifAbsentPut: valueOfProperty:ifAbsent:)('connectors-copying' copyWeakly propertyNamesNotCopied veryDeepFixupWith: veryDeepInner:)('initialization' initialize)('objects from disk' comeFullyUpOnReload:)('other' isDefault)('printing' printOn:)('viewer' externalName)('*MorphicExtras-copying' updateReferencesUsing:)('*MorphicExtras-Undo' removeUndoCommands)('parts bin' isPartsDonor isPartsDonor:)('*60Deprecated-other' inspectElement)!ImageMorph class removeSelector: #descriptionForPartsBin!!ImageMorph class reorganize!('accessing' defaultForm)('class initialization' initialize registerInFlapsRegistry unload)('instance creation' fromString: fromString:font:)('scripting' authoringPrototype)!Morph class removeSelector: #selectionBackground!!Morph class reorganize!('class initialization' initialize)('fileIn/Out' fileReaderServicesForFile:suffix: fromFileName: serviceLoadMorphFromFile services)('initialize-release' unload)('instance creation' initializedInstance newBoun ds: newBounds:color: newSticky)('misc' morphsUnknownToTheirOwners)('new-morph participation' includeInNewMorphMenu newStandAlone partName:categories:documentation: partName:categories:documentation:sampleImageForm:)('scripting' authoringPrototype)('testing' allSketchMorphClasses allSketchMorphForms isSketchMorphClass)('preferences' haloForAll haloForAll: indicateKeyboardFocus indicateKeyboardFocus: metaMenuForAll metaMenuForAll: preferredCornerRadius preferredCornerRadius: themeProperties useSoftDropShadow useSoftDropShadow:)('*Tools-icons' toolIcon)('defaults')('layer names' backmostLayer balloonLayer defaultLayer dialogLayer frontmostLayer haloLayer menuLayer navigatorLayer progressLayer windowLayer)('*MorphicExtras-arrow head size' defaultArrowheadSize obtainArrowheadFor:defaultValue:)('*MorphicExtras-parts bin' supplementaryPartsDescriptions)('*MorphicExtras-new-morph participation' addPartsDescriptorQuadsTo:if:)!MenuMorph removeSelector: #allWordings!MenuMorph removeSelector : #allWordingsNotInSubMenus:!MenuMorph removeSelector: #undoGrabCommand!!MenuMorph reorganize!('accessing' addBlankIconsIfNecessary: commandKeyHandler commandKeyHandler: defaultTarget hasItems hasSubMenu: itemWithWording: items lastItem lastSelection matchString matchString: popUpOwner popUpOwner: rootMenu stayUp stayUp:)('construction' add:action: add:help:action: add:icon:help:subMenu: add:icon:subMenu: add:selector:argument: add:subMenu: add:subMenu:target:selector:argumentList: add:target:action: add:target:selector: add:target:selector:argument: add:target:selector:argumentList: addAllFrom: addItem: addLine addList: addMenuItem: addService:for: addServices2:for:extraLines: addServices:for:extraLines: addStayUpIcons addStayUpItem addStayUpItemSpecial addTitle: addTitle:icon: addTitle:icon:updatingSelector:updateTarget: addTitle:updatingSelector:updateTarget: addTranslatedList: addUpdating:action: addUpdating:enablement:action: addUpdating:enablementSelector:target:selector:argumentList: addUpdating:target:action: addUpdating:target:selector:argumentList: addUpdatingItem: addWithLabel:enablement:action: addWithLabel:enablementSelector:target:selector:argumentList: balloonTextForLastItem: defaultTarget: labels:lines:selections: title:)('control' activeSubmenu: deleteIfPopUp deleteIfPopUp: popUpAdjacentTo:forHand:from: popUpAt:forHand:in: popUpAt:forHand:in:allowKeyboard: popUpEvent:in: popUpForHand:in: popUpInWorld popUpInWorld: popUpNoKeyboard selectItem:event: updateColor wantsToBeDroppedInto:)('copying' veryDeepFixupWith: veryDeepInner:)('dropping/grabbing' justDroppedInto:event:)('events' activate: deactivate: handlesMouseDown: handlesMouseOver: mouseDown: mouseLeave: mouseMove: mouseUp: processFocusEvent:using: wantsEveryMouseMove)('initialization' delete initialize setDefaultParameters setTitleParameters setTitleParametersFor:)('keyboard control' displayFiltered: handlesKeyboard: keyStroke: matchString:event: moveSelectionDown:event: removeMatchString removeMatchString: selectCurrentItem: selectMoreItem:)('menu' addCustomMenuItems:hand: addItem addTitle detachSubMenu: doButtonAction removeStayUpBox removeStayUpItems setInvokingView: setTarget: target: toggleStayUp: toggleStayUpIgnore:evt: updateItemsWithTarget:orWithHand:)('modal control' informUserAt:during: invokeAt:in:allowKeyboard: invokeModal invokeModal: invokeModalAt:in: invokeModalAt:in:allowKeyboard: isModalInvokationDone isModalInvokationDone: modalSelection modalSelection:)('private' invokeMetaMenu: positionAt:relativeTo:inWorld: selectedItem)('update' applyUserInterfaceTheme updateMenu)('keystroke helpers' handleCRStroke: handleCommandKeyPress: handleDelStroke: handleDownStroke: handleEscStroke: handleFiltering: handleLeftStroke: handlePageDownStroke: handlePageUpStroke: handleRightStroke: handleUpStroke: hideKeyboardHelp keyStrokeHandlers noteRootMenuHasUsedKeyboard showKeyboardHelp stepIntoSubmenu:)('rounding' wantsRoundedCorners)('testing' indicateKeyboardFocus)('*ToolBuilder-Morphic-opening' openAsTool)('*MorphicExtras-accessing')('*60Deprecated-keyboard control' filterListWith: unfilterOrEscape:)!MenuItemMorph removeSelector: #adaptToWorld:!MenuItemMorph removeSelector: #allWordingsNotInSubMenus:!!MenuItemMorph reorganize!('accessing' action: addSubMenu: addUpdatingSubMenu: arguments arguments: colorToUse contentString contentString: contents: contents:withMarkers: contents:withMarkers:inverse: hasIcon hasIconOrMarker hasMarker hasSubMenu hasSubMenu: help: icon icon: isEnabled isEnabled: isStayUpItem itemWithWording: selector selector: subMenu subMenu: subMenuUpdater:selector: subMenuUpdater:selector:arguments: target target:)('copying' veryDeepFixupWith: veryDeepInner:)('drawing' drawBackgroundOn: drawIconOn: drawLabelOn: drawOn: drawSubMenuMarkerOn:)('events' activateOwnerMenu: activateSubmenu: doButtonAction handleMouseUp: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: invokeWithEvent: mouseDown: mouseEnter: mouseEnterDragging: mouseUp:)('grabbing' aboutToBeGrabbedBy: duplicateMorph:)('initialization' defaultBounds deleteIfPopUp: initialize)('layout' doLayoutIn: minHeight minWidth stringMargin)('selecting' adjacentTo deselect: isSelected isSelected: select:)('private' bottomArrow createSubmenu createUpdatingSubmenu deselectItem iconForm leftArrow offImage onImage rightArrow selectionFillStyle subMenuMarker upArrow updateLayoutInDockingBar)('browse' browseImplementationOfActionSelector buildDebugMenu: debugAction effectiveActionSelector effectiveActionTarget)('testing' isMenuItemMorph)('updating' applyUserInterfaceTheme)!!LassoPatchMorph reorganize!('dropping' justDroppedInto:event: wantsToBeDroppedInto:)('initialization' initialize initializeToStandAlone)!!GrabPatchMorph reorganize!('dropping' justDroppedInto:event: wantsToBeDroppedInto:)('initialization' initialize initializeToStandAlone)!!ImageM orph reorganize!('accessing' borderStyle: borderWidth: color: form image image: isOpaque isOpaque: preferredExtent setNewImageFrom: wantsRecolorHandle withSnapshotBorder)('caching' releaseCachedState)('drawing' drawOn:)('geometry' extent:)('initialization' initialize)('menu' changeOpacity opacityString)('menu commands' grabFromScreen readFromFile)('menus' addCustomMenuItems:hand:)('other' newForm:)('parts bin' initializeToStandAlone)('testing' isImageMorph)('*MorphicExtras-Postscript Canvases' drawPostscriptOn:)!HandMorph removeSelector: #removePendingHaloFor:!HandMorph removeSelector: #spawnMagicHaloFor:!HandMorph removeSelector: #triggerHaloFor:after:!!HandMorph reorganize!('accessing' anyButtonPressed colorForInsets lastEvent mouseOverHandler noButtonPressed targetOffset targetPoint userInitials userPicture userPicture:)('balloon help' addBalloonHelp: balloonHelpList deleteBalloonTarget: removePendingBalloonFor: resetBalloonHelp: spawnBalloonFor: triggerBalloonFor:after:)('cach ing' releaseCachedState)('change reporting' invalidRect:from:)('classification' isHandMorph)('copying' veryDeepCopyWith:)('cursor' cursorBounds showTemporaryCursor: showTemporaryCursor:hotSpotOffset: temporaryCursor)('double click support' resetClickState waitForClicksOrDrag:event: waitForClicksOrDrag:event:selectors:threshold:)('drawing' drawOn: fullDrawOn: hasChanged hasUserInformation needsToBeDrawn nonCachingFullDrawOn: restoreSavedPatchOn: savePatchFrom: shadowForm showHardwareCursor: updateCacheCanvas: visible:)('drop shadows' shadowOffset)('event handling' cursorPoint flushEvents noticeMouseOver:event: processEvents)('events-processing' handleEvent: isCapturingGesturePoints sendFilterEventCaptureAgain:for:)('focus handling' keyboardFocus keyboardFocus: mouseFocus mouseFocus: newKeyboardFocus: newMouseFocus: newMouseFocus:event: releaseAllFoci releaseKeyboardFocus releaseKeyboardFocus: releaseMouseFocus releaseMouseFocus:)('genie-stubs' autoFocusRectangleBoundsFor: disableGe nieFocus enableGenie focusStartEvent genieGestureProcessor isGenieAvailable isGenieEnabled isGenieFocused)('geometry' position position: userInitials:andPicture:)('grabbing/dropping' attachMorph: dropMorphs dropMorphs: dropMorph:event: grabMorph:from: targetOffset:)('halo handling' halo: obtainHalo: releaseHalo: removeHalo removeHaloFromClick:on:)('halos and balloon help' halo)('initialization' becomeActiveDuring: initForEvents initialize interrupted resourceJustLoaded)('layout' fullBounds)('meta-actions' copyToPasteBuffer: grabMorph:)('multilingual' clearKeyboardInterpreter keyboardInterpreter)('objects from disk' objectForDataStream:)('paste buffer' objectToPaste pasteBuffer pasteBuffer: pasteMorph)('updating' applyUserInterfaceTheme changed)('private events' generateDropFilesEvent: generateKeyboardEvent: generateMouseEvent: generateMouseWheelEvent: generateMouseWheelEvent:direction: generateWindowEvent: mouseDragTrailFrom: mouseTrailFrom: moveToEvent: sendEvent:focus: sendEvent:focus:clear: sendFocusEvent:to:clear: sendKeyboardEvent: sendListenEvent:to: sendListenEvents: sendMouseEvent:)('selected object' selectedObject)('*MorphicExtras-event handling' pauseEventRecorderIn:)('gridded cursor' gridPointRaw gridTo:origin: griddedPoint: griddingOn turnOffGridding turnOnGridding)('events-listening' addEventListener: addKeyboardListener: addListener:to: addMouseListener: eventListeners eventListeners: keyboardListeners keyboardListeners: mouseListeners mouseListeners: removeEventListener: removeKeyboardListener: removeListener:from: removeMouseListener:)('events-filtering-bubbling' eventBubbleFilters keyboardBubbleFilters mouseBubbleFilters)('events-filtering-capturing' eventCaptureFilters eventCaptureFilters: keyboardCaptureFilters keyboardCaptureFilters: mouseCaptureFilters mouseCaptureFilters:)('events-debugging' logEvent: showEvent:)('events-filtering' filterEvent:for: ignoreEvent:)('Multilingual-ImmPlugin' compositionWindowManager)('initialize-release' cleanUp:)!!GraphMorph reorganize!('accessing' color: cursor cursor: cursorAtEnd cursorColor cursorColor: cursorColorAtZeroCrossing cursorColorAtZeroCrossings: cursorWrapped: data data: dataColor dataColor: interpolatedValueAtCursor lastValue lastValue: startIndex startIndex: valueAtCursor valueAtCursor:)('commands' appendValue: centerCursor clear loadSineWave loadSound: loadSoundData: playOnce reverse)('drawing' drawOn:)('event handling' handlesMouseDown: mouseMove:)('initialization' defaultColor initialize)('layout' layoutChanged)('objects from disk' convertToCurrentVersion:refStream:)('stepping' step)('private' asNumber: drawCursorOn: drawDataOn: flushCachedForm keepIndexInView:)('sound' addCustomMenuItems:hand: openWaveEditor readDataFromFile)!DockingBarMorph removeSelector: #isSticky!DockingBarMorph removeSelector: #resistsRemoval!BookMorph removeSelector: #goToPage:transitionSpec:runTransitionScripts:!BookMorph removeSelecto r: #goToPageMorph:runTransitionScripts:!BookMorph removeSelector: #goToPageMorph:transitionSpec:runTransitionScripts:!BookMorph removeSelector: #goto:!BookMorph removeSelector: #keepTogether!BooklikeMorph removeSelector: #currentPlayerDo:!!BooklikeMorph reorganize!('menu commands' clearNewPagePrototype firstPage insertPage sortPages)('menus' addCustomMenuItems:hand:)('misc' addBookMenuItemsTo:hand: move pageSize pageSize: playPageFlipSound: showingFullScreenString showingPageControlsString)('page controls' addPageControlMorph: fewerPageControls fullControlSpecs hidePageControls indexForPageControls makeDescriptionViewer makePageControlsFrom: makePageNumberItem setEventHandlerForPageControls: shortControlSpecs showPageControls showPageControls:)!!BookPageSorterMorph reorganize!('copying' veryDeepFixupWith: veryDeepInner:)('dropping/grabbing' wantsToBeDroppedInto:)('initialization' addControls book:morphsToSort: defaultBorderWidth defaultColor initialize)('buttons' acceptSort getPartsBinStatus togglePartsBinStatus)('private' changeExtent: closeButtonOnly columnWith: rowWith: wrapperFor:)('accessing' pageHolder)!!AlignmentMorph reorganize!('classification' isAlignmentMorph)('event handling' wantsKeyboardFocusFor:)('geometry' addTransparentSpacerOfSize:)('initialization' defaultBorderWidth defaultColor initialize openInWindowLabeled:inWorld:)('object fileIn' convertOldAlignmentsNov2000:using:)('objects from disk' convertToCurrentVersion:refStream:)('visual properties' canHaveFillStyles)('*MorphicExtras-initialization' basicInitialize)!!BorderedMorph reorganize!('accessing' borderColor: borderStyle: borderWidth: hasTranslucentColor useRoundedCorners useSquareCorners)('drawing' areasRemainingToFill:)('geometry' acquireBorderWidth: closestPointTo: intersectionWithLineSegmentFromCenterTo:)('initialization' borderInitialize borderInset borderRaised borderSimple defaultBorderColor defaultBorderStyle defaultBorderWidth initialize)('menu' addBorderStyleMenuItems:hand: changeBorderColor: changeBorderWidth:)('resize handling' addCellGapToLayoutFrames addCornerGrips addEdgeGrips addGrips addMorph:fullFrame: addPaneHSplitterAtBottomOfRow: addPaneHSplitters addPaneSplitters addPaneVSplitterAtRightOfColumn: addPaneVSplitters changeCellGapOfLayoutFrames: cornerGrips doFastWindowReframe: edgeGrips fastFramingOn grips linkSubmorphsToSplitters paneMorphs removeCellGapFromLayoutFrames removeCornerGrips removeEdgeGrips removeGrips removePaneSplitters splitters wantsGrips wantsGrips: wantsPaneSplitters wantsPaneSplitters:)('printing' fullPrintOn:)('layout properties' cellGap:)('display scale' displayScaleChangedBy: handlesDisplayScaleChangedBy:)('*MorphicExtras-initialization' basicInitialize)('*60Deprecated-private' setBorderWidth:borderColor: setColor:borderWidth:borderColor:)('*60Deprecated-accessing' doesBevels)!Morph removeSelector: #adaptToWorld:!Morph removeSelector: #addMagicHaloFor:!Morph removeSelector: #addMorphNearBack:!Morph removeSelector: #addPaintingItemsTo:hand:!Morph removeSelector: #allMenuWordings!Morph removeSelector: #allMorphsAndBookPagesInto:!Morph removeSelector: #allMorphsWithPlayersDo:!Morph removeSelector: #applyStatusToAllSiblings:!Morph removeSelector: #asNumber:!Morph removeSelector: #automaticViewing!Morph removeSelector: #bringAllSiblingsToMe:!Morph removeSelector: #chooseNewGraphic!Morph removeSelector: #chooseNewGraphicCoexisting:!Morph removeSelector: #chooseNewGraphicFromHalo!Morph removeSelector: #couldMakeSibling!Morph removeSelector: #currentPlayerDo:!Morph removeSelector: #cursor!Morph removeSelector: #cursor:!Morph removeSelector: #decimalPlacesForGetter:!Morph removeSelector: #defaultValueOrNil!Morph removeSelector: #demandsBoolean!Morph removeSelector: #demandsThumbnailing!Morph removeSelector: #doMenuItem:!Morph removeSelector: #embedInWindow!Morph removeSelector: #embeddedInMorphicWindowLabeled:!Morph removeSelector: #getNumericValue!Morph removeSelector: #gridFormOrigin:grid:background:line:!Morph removeSelector: #handUserASibling!Morph removeSelector: #indicateAllSiblings!Morph removeSelector: #inspectArgumentsPlayerInMorphic:!Morph removeSelector: #isAViewer!Morph removeSelector: #isCompoundTileMorph!Morph removeSelector: #isKedamaMorph!Morph removeSelector: #isLikelyRecipientForMouseOverHalos!Morph removeSelector: #isModalShell!Morph removeSelector: #isNumericReadoutTile!Morph removeSelector: #isPhraseTileMorph!Morph removeSelector: #isPlayfieldLike!Morph removeSelector: #isSoundTile!Morph removeSelector: #isStandardViewer!Morph removeSelector: #isStickySketchMorph!Morph removeSelector: #isSyntaxMorph!Morph removeSelector: #isTileEditor!Morph removeSelector: #isTileMorph!Morph removeSelector: #isTilePadMorph!Morph removeSelector: #isViewer!Morph removeSelector: #makeGraphPaper!Morph removeSelector: #makeGraphPaperGrid:background:line:!Morph removeSelector: #makeMultipleSiblings:!Morph removeSelector: #makeNascentScript!Morph removeSelector: #makeNewPlayerInstance:!Morph removeSelector: #makeSiblings:!Morph removeSelector: #makeSiblingsLookLikeMe:!Morph removeSelector: #menuItemAfter:!Morph removeSelector: #menuItemBefore:!Morph removeSelector: #methodCommentAsBalloonHelp!Morph removeSelector: #mustBeBackmost!Morph removeSelector: #noteDecimalPlaces:forGetter:!Morph removeSelector: #objectViewed!Morph removeSelector: #offerCostumeViewerMenu:!Morph removeSelector: #openAPropertySheet!Morph removeSelector: #openViewerForArgument!Morph removeSelector: #overlapsShadowForm:bounds:!Morph removeSelector: #pasteUpMorphHandlingTabAmongFields!Morph removeSelector: #player!Morph removeSelector: #player:!Morph removeSelector: #playerRepresented!Morph removeSelector: #preferredDuplicationHandleSelector!Morph removeSelector: #presenter!Morph removeSelector: #readoutForField:!Morph removeSelector: #referencePlayfield!Morph removeSelector: #renameInternal:!Morph removeSelector: #rotationStyle!Morph removeSelector: #rotationStyle:!Morph removeSelector: #roundUpStrays!Morph removeSelector: #saveDocPane!Morph removeSelector: #screenLocation!Morph removeSelector: #screenRectangle!Morph removeSelector: #setAsActionInButtonProperties:!Morph removeSelector: #setNumericValue:!Morph removeSelector: #setStandardTexture!Morph removeSelector: #shouldRememberCostumes!Morph removeSelector: #shuffleSubmorphs!Morph removeSelector: #standardPalette!Morph removeSelector: #tabAmongFields!Morph removeSelector: #textureParameters!Morph removeSelector: #unlockOneSubpart!Morph removeSelector: #updateAllScriptingElements!Morph removeSelector: #usableSiblingInstance!Morph removeSelector: #viewMorphDirectly!Morph removeSelector: #wantsHalo!Morph removeSelector: #wantsHaloFor:!Morph removeSelector: #wantsScriptorHaloHandle!Morph removeSelector: #wouldAcceptKeyboardFocusUponTab!Morph removeSelector: #wrappedInWindow:!Morph removeSelector: #wrappedInWindowWithTitle:!!Morph reorganize!('accessing' actorState: actorStateOrNil adoptPaneColor: balloonText balloonText: balloonTextSelector balloonTextSelector: beFlap: beSticky beTransparent beUnsticky borderColor borderColor: borderStyle borderStyle: borderStyleForSymbol: borderWidth borderWidth: borderWidthForRounding clearArea color color: colorForInsets couldHaveRoundedCorners defaultNameStemForInstances eventHandler eventHandler: hasTranslucentColor highlight highlightColor highlightColor: insetColor isFlap isLocked isShared isSticky lock lock: modelOrNil raisedColor regularColor regularColor: rememberedColor rememberedColor: resistsRemoval resistsRemoval: scaleFactor setBorderStyle: sqkPage sticky: toggleLocked toggleResistsRemoval toggleStickiness unHighlight unlock unlockContents url userString viewBox visibleClearArea wantsToBeCachedByHand)('accessing - extension' assureExtension extension hasExtension initializeExtension privateExtension: resetExtension)('accessing - properties' hasProperty: otherProperties removeProperty: setProperties: setProperty:toValue: valueOfProperty: valueOfProperty:ifAbsent: valueOfProperty:ifAbsentPut: valueOfProperty:ifPresentDo:)('caching' fullLoadCachedState fullReleaseCachedState loadCachedState releaseCachedState)('change reporting' addedMorph: colorChangedForSubmorph: invalidRect: invalidRect:from: privateInvalidateMorph: userSelectedColor:)('classification' isAlignmentMorph isBalloonHelp isButton isFlapOrTab isFlapTab isFlexMorph isHandMorph isRenderer isTextMorph isWorldMorph isWorldOrHandMorph)('connectors-scripting' wantsConnectorVocabulary)('converting' asSnapshotThumbnail)('copying' copy deepCopy duplicate duplicateMorphCollection: okayToDuplicate updateReferencesUsing: veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:)('creation' asMorph)('debug and other' addDebuggingItemsTo:hand: addMouseActionIndicatorsWidth:color: addMouseUpAction addMouseUpActionWith: addViewingItemsTo: allStringsAfter: allStringsAfter:do: altSpecial Cursor0 altSpecialCursor1 altSpecialCursor2 altSpecialCursor3 altSpecialCursor3: buildDebugMenu: defineTempCommand deleteAnyMouseActionIndicators hasStrings inspectOwnerChain installModelIn: mouseUpCodeOrNil ownerChain programmedMouseDown:for: programmedMouseEnter:for: programmedMouseLeave:for: programmedMouseUp:for: removeMouseUpAction resumeAfterDrawError resumeAfterLayoutError resumeAfterStepError tempCommand)('dispatching' disableSubmorphFocusForHand:)('drawing' areasRemainingToFill: boundingBoxOfSubmorphs boundsWithinCorners changeClipSubmorphs clipLayoutCells clipLayoutCells: clipSubmorphs clipSubmorphs: clippingBounds doesOwnRotation drawDropHighlightOn: drawDropShadowOn: drawErrorOn: drawKeyboardFocusIndicationOn: drawMouseDownHighlightOn: drawOn: drawOverlayOn: drawRolloverBorderOn: drawSubmorphsOn: expandFullBoundsForDropShadow: expandFullBoundsForRolloverBorder: flashBounds fullDrawOn: hasClipSubmorphsString hide highlightedForMouseDown highlightedForMouseDown: imageForm imageForm:backgroundColor:forRectangle: imageForm:forRectangle: imageFormDepth: imageFormForRectangle: imageFormWithout:andStopThere: keyboardFocusColor keyboardFocusWidth refreshWorld shadowForm show updateDropShadowCache visible visible:)('drop shadows' addDropShadow addDropShadowMenuItems:hand: changeShadowColor hasDropShadow hasDropShadow: hasDropShadowString hasRolloverBorder hasRolloverBorder: removeDropShadow setShadowOffset: shadowColor shadowColor: shadowOffset shadowOffset: shadowPoint: toggleDropShadow useSoftDropShadow useSoftDropShadow:)('dropping/grabbing' aboutToBeGrabbedBy: acceptDroppingMorph:event: disableDragNDrop dragEnabled dragEnabled: dragNDropEnabled dragSelectionColor dropEnabled dropEnabled: dropHighlightColor dropSuccessColor enableDrag: enableDragNDrop enableDragNDrop: enableDrop: formerOwner formerOwner: formerPosition formerPosition: grabTransform handledOwnDraggingBy:on: highlightForDrop highlightForDrop: highlightedForDrop justDroppedInto:event : justGrabbedFrom: morphToDropInPasteUp: nameForUndoWording rejectDropMorphEvent: repelsMorph:event: resetHighlightForDrop separateDragAndDrop slideBackToFormerSituation: slideToTrash: startDrag:with: transportedMorph undoGrabCommand vanishAfterSlidingTo:event: wantsDroppedMorph:event: wantsToBeDroppedInto: wantsToBeOpenedInWorld willingToBeDiscarded)('event handling' click click: cursorPoint doubleClick: doubleClickTimeout: firstClickTimedOut: handlerForMouseDown: handlerForYellowButtonDown: handlesKeyboard: handlesKeyboardOnlyOnFocus handlesKeyboardOnlyOnFocus: handlesMouseDown: handlesMouseMove: handlesMouseOver: handlesMouseOverDragging: handlesMouseStillDown: handlesMouseWheel: hasFocus hasKeyboardFocus hasKeyboardFocus: hasMouseFocus hasMouseFocus: keyDown: keyStroke: keyUp: keyboardFocusChange: keyboardFocusDelegate mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: mouseMove: mouseStillDown: mouseStillDownThreshold mouseUp: mouseWheel: moveOrResizeFromKeystroke: on:send:to: on:send:to:withValue: removeLink: restoreSuspendedEventHandler startDrag: suspendEventHandler transformFrom: transformFromOutermostWorld transformFromWorld wantsEveryMouseMove wantsKeyboardFocus wantsKeyboardFocusFor: wantsWindowEvents: windowEvent: wouldAcceptKeyboardFocus yellowButtonActivity:)('events-accessing' actionMap updateableActionMap)('events-alarms' addAlarm:after: addAlarm:at: addAlarm:with:after: addAlarm:with:at: addAlarm:with:with:after: addAlarm:with:with:at: addAlarm:withArguments:after: addAlarm:withArguments:at: alarmScheduler removeAlarm: removeAlarm:at:)('events-processing' containsPoint:event: defaultEventDispatcher handleDropMorph: handleEvent: handleFocusEvent: handleKeyDown: handleKeyUp: handleKeystroke: handleListenEvent: handleMouseDown: handleMouseEnter: handleMouseLeave: handleMouseMove: handleMouseOver: handleMouseStillDown: handleMouseUp: handleMouseWheel: handleUnknownEvent: handleWindowEvent: mouseDownPr iority mouseDownPriority: processEvent: processEvent:using: processFocusEvent: processFocusEvent:using: rejectDropEvent: rejectsEvent: sendFilterEvent:for:to: sendFilterEventBubble:for: sendFilterEventBubbleAgain:for: sendFilterEventCapture:for: sendFilterEventCaptureAgain:for: transformedFrom:)('events-removing' releaseActionMap)('fileIn/out' attachToResource prepareToBeSaved reserveUrl: saveAsResource saveOnFile saveOnURL saveOnURL: saveOnURLbasic updateAllFromResources updateFromResource)('filter streaming' drawOnCanvas:)('geometry' bottom bottom: bottomCenter bottomLeft bottomLeft: bottomRight bottomRight: bounds bounds: center center: extent extent: height height: left left: leftCenter pointAtFraction: position position: right right: rightCenter top top: topCenter topLeft topLeft: topRight topRight: width width:)('geometry testing' containsPoint: fullContainsPoint: obtrudesBeyondContainer)('halos and balloon help' addHalo addHalo: addHandlesTo:box: addOptionalHandlesTo:box: addSimpleHandlesTo:box: addWorldHandlesTo:box: balloonColor balloonColor: balloonFont balloonFont: balloonHelpAligner balloonHelpDelayTime balloonHelpTextForHandle: balloonMorphClass boundsForBalloon comeToFrontAndAddHalo createHalo defaultBalloonColor defaultBalloonFont defaultHaloDispatcher defersHaloOnClickTo: deleteBalloon editBalloonHelpContent: editBalloonHelpText halo haloClass haloDelayTime hasHalo hasHalo: mouseDownOnHelpHandle: noHelpString okayToAddDismissHandle okayToAddGrabHandle okayToBrownDragEasily okayToExtractEasily okayToResizeEasily okayToRotateEasily removeHalo setBalloonText: setBalloonText:maxLineLength: setCenteredBalloonText: showBalloon showBalloon: showBalloon:at: showBalloon:hand: transferHalo: transferHalo:using: wantsBalloon wantsDirectionHandles wantsDirectionHandles: wantsHaloFromClick wantsHaloFromClick: wantsHaloHandleWithSelector:inHalo: wantsRecolorHandle wantsSimpleSketchMorphHandles)('initialization' basicInitialize defaultBounds defaultC olor inAScrollPane initialize openCenteredInWorld openInHand openInWindow openInWindowLabeled: openInWindowLabeled:inWorld: openInWorld openInWorld: openNear: openNear:in: openNearMorph: resourceJustLoaded)('layout' adjustLayoutBounds checkCellSpacingProperty: checkListSpacingProperty: checkResizingProperty: doLayout doLayoutIn: doLayoutSafely fullBounds layoutChanged layoutComputed layoutInBounds: layoutInBounds:positioning: layoutProportionallyIn: layoutProportionallyInBounds:positioning: minExtent minExtent: minHeight minHeight: minWidth minWidth: ownerChanged ownerChangedHandler ownerChangedHandler: privateFullBounds privateFullBoundsForRedraw setExtentFromLayout: setLayoutBoundsFromLayout: setPositionFromLayout: submorphBounds submorphBoundsForShrinkWrap)('layout-menu' addCellLayoutMenuItems:hand: addLayoutMenuItems:hand: addTableLayoutMenuItems:hand: cellPositioningString: cellSpacingString: changeCellGap: changeCellInset: changeClipLayoutCells changeDisableTableLayout changeHeightForWidth changeLayoutInset: changeListDirection: changeMaxCellSize: changeMinCellSize: changeNoLayout changeProportionalLayout changeReverseCells changeRubberBandCells changeTableLayout changeWidthForHeight changesHeightForWidth changesWidthForHeight hResizingString: hasClipLayoutCellsString hasDisableTableLayoutString hasNoLayoutString hasProportionalLayoutString hasReverseCellsString hasRubberBandCellsString hasTableLayoutString layoutMenuPropertyString:from: listCenteringString: listDirectionString: listSpacingString: vResizingString: wrapCenteringString: wrapDirectionString:)('macpal' flash)('menu' addBorderStyleMenuItems:hand: addGestureMenuItems:hand: addGraphModelYellowButtonItemsTo:event: addModelYellowButtonItemsTo:event: addMyYellowButtonMenuItemsToSubmorphMenus addNestedYellowButtonItemsTo:event: addTitleForHaloMenu: addYellowButtonMenuItemsTo:event: buildYellowButtonMenu: hasYellowButtonMenu outermostOwnerWithYellowButtonMenu startWiring wantsMetaMenu wantsMetaMenu: wantsYellowButtonMenu wantsYellowButtonMenu:)('menus' absorbStateFromRenderer: addAddHandMenuItemsForHalo:hand: addCopyItemsTo: addCustomHaloMenuItems:hand: addCustomMenuItems:hand: addExportMenuItems:hand: addFillStyleMenuItems:hand: addHaloActionsTo: addMiscExtrasTo: addStandardHaloMenuItemsTo:hand: addToggleItemsToHaloMenu: addWorldTargetSightingItems:hand: adhereToEdge adhereToEdge: adjustedCenter adjustedCenter: changeColor changeDirectionHandles changeDrag changeDragAndDrop changeDrop collapse defaultArrowheadSize exploreInMorphic exploreInMorphic: exportAsBMP exportAsBMPNamed: exportAsGIF exportAsGIFNamed: exportAsJPEG exportAsJPEGNamed: exportAsPNG exportAsPNGNamed: hasDirectionHandlesString hasDragAndDropEnabledString hasDragEnabledString hasDropEnabledString helpButton inspectInMorphic inspectInMorphic: lockUnlockMorph lockedString maybeAddCollapseItemTo: model presentHelp reasonableBitmapFillForms reasonableForms resetForwardDirection resistsRemovalS tring setArrowheads setRotationCenter setRotationCenterFrom: setToAdhereToEdge: snapToEdgeIfAppropriate stickinessString transferStateToRenderer: uncollapseSketch)('meta-actions' addEmbeddingMenuItemsTo:hand: beThisWorldsModel buildHandleMenu: buildMetaMenu: changeColorTarget:selector:originalColor:hand: copyToPasteBuffer: dismissMorph dismissMorph: duplicateMorph: duplicateMorphImage: embedInto: grabMorph: inspectAt:event: invokeMetaMenu: invokeMetaMenuAt:event: maybeDuplicateMorph maybeDuplicateMorph: openATextPropertySheet potentialEmbeddingTargets potentialTargets potentialTargetsAt: resizeFromMenu resizeMorph: saveAsPrototype showActions showHiders sightTargets: sightWorldTargets: subclassMorph targetFromMenu: targetWith:)('miscellaneous' setExtentFromHalo: setFlexExtentFromHalo:)('naming' assureExternalName downshiftedNameOfObjectRepresented externalName innocuousName knownName name: nameForFindWindowFeature nameInModel nameOfObjectRepresented renameTo: setNamePropertyTo: set NameTo: specialNameInModel tryToRenameTo:)('objects from disk' objectForDataStream: storeDataOn:)('other events' menuButtonMouseEnter: menuButtonMouseLeave:)('parts bin' inPartsBin initializeToStandAlone isPartsBin isPartsDonor isPartsDonor: markAsPartsDonor partRepresented residesInPartsBin)('printing' clipText colorString: constructorString fullPrintOn: initString morphReport morphReportFor: morphReportFor:on:indent: pagesHandledAutomatically printConstructorOn:indent: printConstructorOn:indent:nodeDict: printOn: printSpecs printSpecs: printStructureOn:indent: reportableSize structureString textToPaste)('rotate scale and flex' addFlexShell addFlexShellIfNecessary assureFlexShell forwardDirection forwardDirection: heading heading: keepsTransform newTransformationMorph referencePosition referencePosition: referencePositionInWorld referencePositionInWorld: removeFlexShell rotationCenter rotationCenter: rotationDegrees rotationDegrees: setDirectionFrom:)('rounding' cornerRadius cornerR adius: cornerStyle cornerStyle: roundedCorners roundedCornersString toggleCornerRounding wantsRoundedCorners)('stepping' arrangeToStartStepping arrangeToStartSteppingIn: isStepping isSteppingSelector: start startStepping startStepping:at:arguments:stepTime: startSteppingIn: startSteppingSelector: step stepAt: stepTime stop stopStepping stopSteppingSelector: stopSteppingSelfAndSubmorphs wantsSteps)('structure' activeHand allOwners allOwnersDo: containingWindow firstOwnerSuchThat: hasOwner: isInDockingBar isInSystemWindow isInWorld morphPreceding: nearestOwnerThat: orOwnerSuchThat: outermostMorphThat: outermostWorldMorph owner ownerThatIsA: ownerThatIsA:orA: pasteUpMorph primaryHand renderedMorph root rootAt: topPasteUp topRendererOrSelf withAllOwners withAllOwnersDo: world)('testing' canDrawAtHigherResolution canDrawBorder: completeModificationHash indicateKeyboardFocus isDockingBar isFlexed isFullOnScreen isImageMorph isLineMorph isMenuItemMorph isMorph isSafeToServe isSelectionMorp h isSketchMorph isTransferMorph modificationHash shouldDropOnMouseUp)('text-anchor' addTextAnchorMenuItems:hand: asTextAnchor textAnchorProperties)('thumbnail' icon iconOrThumbnail iconOrThumbnailOfSize: morphRepresented permitsThumbnailing representativeNoTallerThan:norWiderThan:thumbnailHeight: thumbnail updateThumbnailUrl updateThumbnailUrlInBook:)('undo' commandHistory undoMove:redo:owner:bounds:predecessor:)('updating' applyUserInterfaceTheme changed)('user interface' defaultLabelForInspector doCancel initialExtent playSoundNamed:)('visual properties' canApplyUserInterfaceTheme canHaveFillStyles defaultBitmapFillForm fillStyle fillStyle: fillWithRamp:oriented: useBitmapFill useDefaultFill useGradientFill useSolidFill)('WiW support' eToyRejectDropMorph:event: randomBoundsFor: shouldGetStepsFrom:)('private' canBeEncroached privateAddAllMorphs:atIndex: privateAddMorph:atIndex: privateBounds: privateColor: privateDeleteWithAbsolutelyNoSideEffects privateFullBounds: privateFull MoveBy: privateMoveBy: privateOwner: privateRemove: privateRemoveMorphWithAbsolutelyNoSideEffects: privateSubmorphs privateSubmorphs:)('accessing-backstop' target:)('geniestubs' allowsGestureStart: isGestureStart: mouseStillDownStepRate redButtonGestureDictionaryOrName: yellowButtonGestureDictionaryOrName:)('*morphic-Postscript Canvases' asPostscript clipPostscript drawPostscriptOn: fullDrawPostscriptOn: printPSToFile)('button' doButtonAction)('model access' models)('other' removeAllButFirstSubmorph)('selected object' selectedObject)('polymorph' modalLockTo: modalUnlockFrom: openModal:)('*Morphic-Sound-piano rolls' addMorphsTo:pianoRoll:eventTime:betweenTime:and: encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: justDroppedIntoPianoRoll:event: pauseFrom: resetFrom: resumeFrom: triggerActionFromPianoRoll)('events-filtering-bubbling' addEventBubbleFilter: addKeyboardBubbleFilter: addMouseBubbleFilter: eventBubbleFilters eventBubbleFilters: keyboardBubbleFilters keyboardBubbleFilters: mouseBubbleFilters mouseBubbleFilters: removeEventBubbleFilter: removeKeyboardBubbleFilter: removeMouseBubbleFilter:)('events-filtering-capturing' addEventCaptureFilter: addKeyboardCaptureFilter: addMouseCaptureFilter: eventCaptureFilters eventCaptureFilters: keyboardCaptureFilters keyboardCaptureFilters: mouseCaptureFilters mouseCaptureFilters: removeEventCaptureFilter: removeKeyboardCaptureFilter: removeMouseCaptureFilter:)('events-filtering' addFilter:to: eventFilterDocumentation removeFilter:from:)('*ToolBuilder-Morphic-opening' buildWith: openAsTool)('geometry - misc' align:with: positionSubmorphs setConstrainedPosition:hangOut: shiftSubmorphsOtherThan:by: transformedBy: worldBounds worldBoundsForHalo)('geometry - local/global' bounds:from: bounds:in: boundsIn: boundsInWorld fullBoundsInWorld globalPointToLocal: intersects: localPointToGlobal: point:from: point:in: pointFromWorld: pointInWorld: positionInWorld)('geometry - layout' innerBounds inner Bounds: innerExtent innerExtent: innerPosition innerPosition: layoutBounds layoutBounds: layoutExtent layoutExtent: layoutPosition layoutPosition: minimumExtent minimumExtent: minimumHeight minimumHeight: minimumWidth minimumWidth: outerBounds outerBounds: outerExtent outerExtent: outerPosition outerPosition:)('Multilingual-ImmPlugin' preferredKeyboardBounds preferredKeyboardPosition)('*ToolBuilder-Morphic' inspectorClass)('submorphs - add/remove' abandon addAllMorphs: addAllMorphs:after: addAllMorphs:behind: addAllMorphs:inFrontOf: addAllMorphsBack: addAllMorphsFront: addMorph: addMorph:after: addMorph:asElementNumber: addMorph:atIndex: addMorph:behind: addMorph:inFrontOf: addMorphBack: addMorphFront: comeToFront delete goBehind privateDelete removeAllMorphs removeAllMorphsIn: removeMorph:)('submorphs - misc' actWhen actWhen: addMorph:fullFrame: addMorphCentered: addMorphFront:fromWorldPosition: addMorphFrontFromWorldPosition: allNonSubmorphMorphs copyWithoutSubmorph: deleteDockingB ars deleteSubmorphsWithProperty: deleteUnlessHasFocus dismissViaHalo dockingBars findA: findDeepSubmorphThat:ifAbsent: findDeeplyA: findSubmorphBinary: hasSubmorphWithProperty: indexOfMorphAbove: mainDockingBars morphsAt:behind:unlocked: morphsInFrontOf:overlapping:do: morphsInFrontOverlapping: morphsInFrontOverlapping:do: replaceSubmorph:by: rootMorphsAt: rootMorphsAtGlobal: submorphAfter submorphBefore submorphOfClass: submorphWithProperty:)('submorphs - layers' addAllMorphsBackInLayers: addAllMorphsFrontInLayers: addAllMorphsInLayers: addMorphBackInLayer: addMorphFrontInLayer: addMorphInLayer: morphicLayerNumber morphicLayerNumber: reorderSubmorphsInLayers wantsToBeTopmost)('submorphs - accessing' allKnownNames allMorphs firstSubmorph lastSubmorph morphsAt: morphsAt:unlocked: morphsAt:unlocked:useFullBounds: submorphCount submorphIndexOf: submorphNamed: submorphNamed:ifNone: submorphThat:ifNone: submorphs submorphsSatisfying:)('submorphs - enumerating' allMorphsBreadthFirstDo: allMorphsBreadthFirstDo:sorted: allMorphsDepthFirstDo: allMorphsDo: allSubmorphNamesDo: morphsAt:unlocked:do: morphsAt:unlocked:useFullBounds:do: submorphsBehind:do: submorphsDo: submorphsInFrontOf:do: submorphsReverseDo:)('layout properties' assureGridLayoutProperties assureLayoutProperties assureTableLayoutProperties copyLayoutProperties disableLayout disableLayout: disableTableLayout disableTableLayout: hResizing hResizing: layoutInset layoutInset: layoutPolicy layoutPolicy: layoutProperties layoutProperties: vResizeToFit: vResizing vResizing:)('layout properties - table' cellGap cellGap: cellInset cellInset: cellPositioning cellPositioning: cellSpacing cellSpacing: listCentering listCentering: listDirection listDirection: listSpacing listSpacing: maxCellSize maxCellSize: minCellSize minCellSize: reverseTableCells reverseTableCells: rubberBandCells rubberBandCells: spaceFillWeight spaceFillWeight: wrapCentering wrapCentering: wrapDirection wrapDirection:)('layout propertie s - grid' gridModulus gridModulus: gridOrigin gridOrigin:)('submorphs - testing' hasSubmorphs)('submorphs - callbacks' intoWorld: noteNewOwner: outOfWorld: removedMorph:)('layout properties - proportional' layoutFrame layoutFrame:)('halo notification' aboutToBeDraggedViaHalo aboutToBeGrownViaHalo aboutToBeRotatedViaHalo aboutToBeScaledViaHalo changedViaHalo:)('display scale' displayScaleChangedBy: handlesDisplayScaleChangedBy:)('*60Deprecated-events-processing' handleDropFiles:)('*MorphicExtras-menus' dismissButton printPSToFileNamed:)('*60Deprecated-rotate scale and flex' degreesOfFlex)('*60Deprecated-text-anchor' changeDocumentAnchor changeInlineAnchor changeParagraphAnchor hasDocumentAnchorString hasInlineAnchorString hasParagraphAnchorString relativeTextAnchorPosition relativeTextAnchorPosition: textAnchorType textAnchorType:)('*MorphicExtras' nextOwnerPage previousOwnerPage)('*60Deprecated-event handling' dropFiles: wantsDropFiles:)('*60Deprecated-geometry' gridPoint: griddedPoint:)('*services-base' requestor)('*60Deprecated-accessing' doesBevels)('*60Deprecated-meta-actions' blueButtonDown: blueButtonUp: handlerForBlueButtonDown: handlerForMetaMenu:)('*60Deprecated-user-interface' becomeModal)('*MorphicExtras-books' updateCachedThumbnail)('*60Deprecated-initialization' inATwoWayScrollPane)('*MorphicExtras-geometry' shiftSubmorphsBy:)('*60Deprecated-dropping/grabbing' toggleDragNDrop)('*60Deprecated-copying' fullCopy)('*MorphicExtras-postscript' asEPS asPostscriptPrintJob exportAsEPS exportAsEPSNamed:)('*60Deprecated-WiW support' addMorphInFrontOfLayer: morphicLayerNumberWithin:)('*60Deprecated-MorphicExtras-accessing' highlightOnlySubmorph:)('*61Deprecated-drawing' highlightForMouseDown highlightForMouseDown:)!InstanceBrowser removeSelector: #viewViewee!!Lexicon reorganize!('basic operation' annotation displaySelector: messageListIndex:)('category list' categoriesPane categoryDefiningSelector: categoryList categoryListIndex categoryListIn dex: categoryListKey:from: categoryListMenu:shifted: categoryListMenuTitle categoryWithNameSpecifiedBy: chooseCategory: mainCategoryListMenu: newCategoryPane reformulateCategoryList selectCategoryAll selectWithinCurrentCategoryIfPossible: selectedCategoryName selectorsReferringToClassVar showCategoriesPane)('contents' contents)('control buttons' customButtonSpecs)('history' navigateToNextMethod navigateToPreviousMethod navigateToRecentMethod removeFromSelectorsVisited removeFromSelectorsVisited: selectorsVisited updateSelectorsVisitedfrom:to:)('initialization' customButtonsFrame: initListFrom:highlighting: listFrame:fromLeft:width:)('limit class' chooseLimitClass initialLimitClass limitClass limitClass: limitClassString setLimitClass:)('menu commands' offerMenu removeMessage showCategory showHomeCategory showMainCategory)('message category functions' canShowMultipleMessageCategories)('message list menu' messageListKey:from:)('model glue' doItReceiver okayToAccept targetObject)('ne w-window queries' browseVariableAssignments browseVariableReferences)('search' hasSearchPane lastSearchString lastSearchString: lastSendersSearchSelector methodListFromSearchString: obtainNewSearchString selectorsMatching setMethodListFromSearchString showSearchPane toggleSearch)('selection' categoryOfSelector: selectImplementedMessageAndEvaluate: selectSelectorItsNaturalCategory: selectWithinCurrentCategory: selectedClassOrMetaClass selectedMessage setToShowSelector:selectCategory:)('senders' navigateToASender selectorsSendingSelectedSelector setSendersSearch)('transition' maybeReselectClass:selector: noteAcceptanceOfCodeFor: preserveSelectorIfPossibleSurrounding: reformulateList reformulateListNoting: retainMethodSelectionWhileSwitchingToCategory:)('vocabulary' chooseVocabulary switchToVocabulary: useVocabulary:)('window title' addModelItemsToWindowMenu: adjustWindowTitle startingWindowTitle)('within-tool queries' currentQueryParameter methodsWithInitials methodsWithInitials: queryCharacterization seeAlso seeAlso: selectorsChanged selectorsDefiningInstVar selectorsReferringToInstVar selectorsRetrieved setLocalClassVarRefs setLocalInstVarDefs setLocalInstVarRefs showMethodsInCurrentChangeSet showMethodsWithInitials showMethodsWithInitials: showQueryResultsCategory)('toolbuilder' addSpecialButtonsTo:with: buildCategoryListWith: buildCustomButtonsWith: buildWith: openOnClass:inWorld:showingSelector: openOnClass:showingSelector: wantsAnnotationPane)('morphic' representsSameBrowseeAs: targetClass)('message list' formattedLabel:forSelector:inClass: messageHelpAt: messageIconAt:)('user interface' defaultWindowColor)('private' contents:notifying: contents:oldSelector:in:classified:notifying: targetForContents:)!Object subclass: #MenuIcons instanceVariableNames: '' classVariableNames: 'Icons ScriptingIcons TranslatedIcons TranslationLocale' poolDictionaries: '' category: 'Morphic-Menus'!Inspector removeSelector: #addEtoysItemsTo:!!Inspector reorganize!('accessing' context context: customFields doItContext doItReceiver fields object object: selectionIndex selectionIndex:)('private' allInstVarsTranslated)('toolbuilder' buildCodePaneWith: buildExploreButtonWith: buildFieldListWith: buildValuePaneWith: buildWith: replaceInspectorWithExplorer)('*Protocols-Tools' browseFullProtocol spawnFullProtocol spawnProtocol)('*60Deprecated-selecting' selectedSlotName)('user interface - styling' aboutToStyle:requestor: fieldListStyler typeValue: updateStyler: updateStyler:requestor:)('menu - construction' addClassItemsTo: addCollectionItemsTo: addFieldItemsTo: addInstVarItemsTo: addObjectItemsTo:)('fields - custom' addCustomField addCustomField: hasCustomFields newCustomField removeCustomField: requestCustomFieldOrCancel:)('user interface' applyUserInterfaceTheme defaultIntegerBase fieldList getContents representsSameBrowseeAs: textColorForError valuePane)('menu - commands' browseClass browseClassHierarchy browseVariableAssignmen ts browseVariableReferences chaseSelectionPointers copyExpression copyName exploreSelection exploreSelectionPointers inspectOne inspectOneOf: inspectOneOfFrom:to: inspectSelection inspectSelectionBasic objectReferencesToSelection removeSelection)('selection - convenience' classOfSelection selectedClass selectedInstVarName selectionIsReadOnly selectionOrObject typeOfSelection)('accessing - contents' contents:notifying: contentsTyped contentsTyped: expression expression:)('fields - error handling' contentsForErrorDoing: emphasizeError: streamError:on: streamErrorDoing:on:)('fields - truncation' contentsForTruncationOf: streamOn:truncate:collectFields: streamOn:truncate:collectFields:ellipsisFrom: truncationLimit truncationTail)('fields - drag and drop' dragFromFieldList: dragTypeInFieldListAt: dropOnFieldList:at:shouldCopy:)('selection' ensureSelectedField hasSelection noteSelectionIndex:for: replaceSelectionValue: selectField: selectFieldNamed: selectFieldSuchThat: selectedField selectedFieldName selection)('fields' expressionForField: fieldAllInstVars fieldSelf newFieldForType: newFieldForType:key:)('initialization' fieldClass initialExtent initialize inspect: resetContents resetFields setContents: setContentsTyped: setExpression:)('menu' fieldListMenu: fieldListMenu:shifted: inspectorKey:from: mainFieldListMenu: metaFieldListMenu:)('user interface - window' labelString objectOkToClose okToClose okToDiscardCustomFields)('updating - steps' modelWakeUpIn: stepAt:in: stepTimeIn: updateListsAndCodeIn: wantsStepsIn:)('fields - streaming' streamBaseFieldsOn: streamCustomFieldsOn: streamFieldsOn: streamIndexedVariablesOn: streamInstanceVariablesOn: streamVariableFieldsOn:)('updating' update update: update:with: updateContentsSafely updateFieldList updateFields)('*60Deprecated-menu' classHierarchy)('*60Deprecated-toolbuilder' exploreObject)('copying' veryDeepInner:)('private - collections' elementAt: elementGetterAt:)('user edits' okToRevertChanges:)!!Image Segment reorganize!('access' allObjectsDo: arrayOfRoots arrayOfRoots:)('read/write segment' install loadSegmentFrom:outPointers: localName readFromFile)('error checking' checkAndReportLoadError)('fileIn' comeFullyUpOnReload: declare: declareAndPossiblyRename: dependentsCancel: dependentsRestore: fixCapitalizationOfSymbols processRoots rehashDictionaries: reshapeClasses:refStream: restoreEndianness:)('fileIn/Out' acceptSingleMethodSource: endianness restoreEndianness scanFrom: scanFrom:environment:)('testing' errorWrongState forFile:outPointers:)('private' forgetDoItsInClass: segmentFormatFrom:)!Form removeSelector: #graphicForViewerTab!!Form reorganize!('accessing' bits bitsSize bits: defaultCanvasClass depth depth: extent form getCanvas hasBeenModified hasBeenModified: nativeDepth offset offset: size)('analyzing' cgForPixelValue:orNot: colorsUsed dominantColor innerPixelRectFor:orNot: pixelCompare:with:at: primCountBits rectangleEnclosingPixelsNotOfColor: tallyPixelValues tallyPixelValuesInRect:into: xTallyPixelValue:orNot: yTallyPixelValue:orNot:)('bordering' borderFormOfWidth:sharpCorners: borderWidth: borderWidth:color: borderWidth:fillColor: border:width:rule:fillColor: shapeBorder:width: shapeBorder:width:interiorPoint:sharpCorners:internal:)('color mapping' balancedPatternFor: bitPatternFor: colormapFromARGB colormapIfNeededForDepth: colormapIfNeededFor: colormapToARGB makeBWForm: mapColors:to: mapColor:to: maskingMap newColorMap pixelValueFor: pixelWordFor: reducedPaletteOfSize: rgbaBitMasks)('converting' adjustBrightness: adjustSaturation: as8BitColorForm asCursorForm asFormOfDepth: asGrayScale asSourceForm asTextAnchor blendColor: collectColors: collectPixels: colorReduced copyWithColorsReducedTo: darker dimmed dyed: flipVertically lighter orderedDither32To16)('copying' blankCopyOf:scaledBy: contentsOfArea: contentsOfArea:into: copyBits:at:translucent: copyBits:from:at:clippingBox:rule:fillColor: copyBits:from:at:clippingBox:rule:fillColor:map: copyBits:from:at:colorMap: copy: copy:from:in:rule: copy:from:to:rule: deepCopy postCopy veryDeepCopyWith:)('display box access' boundingBox center computeBoundingBox height width)('displaying' displayInterpolatedIn:on: displayInterpolatedOn: displayOnPort:at: displayOn:at:clippingBox:rule:fillColor: displayOn:transformation:clippingBox:align:with:rule:fillColor: displayResourceFormOn: displayScaledOn: drawLine:from:to:clippingBox:rule:fillColor: paintBits:at:translucent:)('editing' bitEdit bitEditAt:scale: edit)('fileIn/Out' comeFullyUpOnReload: hibernate objectForDataStream: printOn: readAttributesFrom: readBitsFrom: readFromOldFormat: readFrom: replaceByResource: storeBitsOn:base: storeOn: storeOn:base: unhibernate writeAttributesOn: writeBitsOn: writeBMPfileNamed: writeJPEGfileNamed: writeJPEGfileNamed:progressive: writeOnMovie: writeOn: writePNGfileNamed: writeUncompressedOn:)('filling' anyShapeFill bitPatternForDepth: convexShapeFill: eraseShape: fillFromXColorBlock: fillFromXYColorBlock: fillFromYColorBlock: fill:rule:fillColor: findShapeAroundSeedBlock: floodFill2:at: floodFillMapFrom:to:mappingColorsWithin:to: floodFill:at: floodFill:at:tolerance: shapeFill:interiorPoint: shapeFill:seedBlock:)('image manipulation' replaceColor:withColor: smear:distance: trimBordersOfColor:)('initialize-release' allocateForm: finish flush fromDisplay: shutDown swapEndianness)('other' fillAlpha: fixAlpha formForColorCount: preMultiplyAlpha primPrintHScale:vScale:landscape: relativeTextAnchorPosition setAsBackground)('pixel access' colorAt: colorAt:put: isTransparentAt: pixelValueAt: pixelValueAt:put: primPixelValueAtX:y: primPixelValueAtX:y:put:)('postscript generation' bitsPerComponent bytesPerRow decodeArray numComponents paddedWidth printPostscript:operator: rowPadding setColorspaceOn: store15To24HexBitsOn: store32To24HexBitsOn: storeBits:to:on: storeHexBitsOn: storePostscriptHexOn:)('resources' readNativeResourceFrom: readResourceFrom: resourceTag storeResourceOn:)('scaling, rotation' clippedToSize: flipBy:centerAt: magnifyBy: magnify:by: magnify:by:smoothing: rotateBy: rotateBy:centerAt: rotateBy:magnify:smoothing: rotateBy:smoothing: scaledToHeight: scaledToSize: scaledToSize:smoothing: scaledToWidth: shrink:by:)('testing' hasNonStandardPalette isAllWhite isBigEndian isDisplayScreen isForm isGrayScale isLittleEndian isStatic isTranslucent isVirtualScreen shouldPreserveContents)('transitions' fadeImageCoarse:at: fadeImageFine:at: fadeImageHorFine:at: fadeImageHor:at: fadeImageSquares:at: fadeImageVert:at: fadeImage:at:indexAndMaskDo: pageImage:at:corner: pageWarp:at:forward: slideImage:at:delta: wipeImage:at:clippingBox:rectForIndex: wipeImage:at:delta: wipeImage:at:delta:clippingBox: zoomInTo:at: zoomIn:orOutTo:at:vanishingPoint: zoomOutTo:at:)('*MorphicExtras-postscript generation' encodePostscriptOn:)('*nebraska-encoding' addDeltasFrom: deltaFrom: deltaFrom:at: encodeForRemoteCanvas)('private' hackBits: initFromArray: privateFloodFillValue: setExtent:depth: setExtent:depth:bits: setResourceBits:)('*Morphic' asMorph blankCopyOf: iconOrThumbnailOfSize: scaledIntoFormOfSize: scaledIntoFormOfSize:smoothing:)('*Morphic-Support-image manipulation' stencil)('processing' approxGaussianBlur at:bias: dither: edgeDetect emboss processUsingKernel: processUsingKernel:factor:bias: sharpen)('*System-icon scaling' scaleIconToDisplay)('*Morphic-Text Support' textAnchorProperties)('*Tools-Inspector' inspectorClass)('*TrueType-displaying' advanceWidth)!Flaps class removeSelector: #addAndEnableEToyFlaps!Flaps class removeSelector: #defaultsQuadsDefiningPlugInSuppliesFlap!Flaps class removeSelector: #defaultsQuadsDefiningScriptingFlap!Flaps class removeSelector: #enableEToyFlaps!Flaps class removeSelector: #newLoneSuppliesFlap!Flaps class removeSelector: #newPaintingFlap!Flaps class removeSelector: #paintFlapButton!Flaps class removeSelector: #possiblyReplaceEToyFlaps!Flaps class removeSelector: #setUpSuppliesFlapOnly!!Flaps class reorganize!('class initialization' initialize)('construction support' addMorph:asElementNumber:inGlobalFlapSatisfying: addMorph:asElementNumber:inGlobalFlapWithID: addToSuppliesFlap:asElementNumber: deleteMorphsSatisfying:fromGlobalFlapSatisfying:)('flap mechanics' clobberFlapTabList freshFlapsStart reinstateDefaultFlaps removeFlapTab:keepInList:)('flaps registry' defaultsQuadsDefiningStackToolsFlap defaultsQuadsDefiningSuppliesFlap defaultsQuadsDefiningToolsFlap defaultsQuadsDefiningWidgetsFlap initializeFlapsQuads registeredFlapsQuads registeredFlapsQuadsAt: registerQuad:forFlapNamed: unregisterQuadsWithReceiver: unregisterQuadsWithReceiver:fromFlapNamed: unregisterQuad:forFlapNamed:)('menu commands' disableGlobalFlaps disableGlobalFlaps: disableGlobalFlapWithID: enableDisableGlobalFlapWithID: enableGlobalFlapWithID: explainFlaps explainFlapsText)('menu support' addIndividualGlobalFlap ItemsTo: enableGlobalFlaps globalFlapWithIDEnabledString: showSharedFlaps suppressFlapsString)('miscellaneous' automaticFlapLayoutChanged doAutomaticLayoutOfFlapsIfAppropriate enableClassicNavigatorChanged fileOutChanges makeNavigatorFlapResembleGoldenBar orientationForEdge: removeFromGlobalFlapTabList:)('new flap' addLocalFlap addLocalFlap: addLocalFlap:titled:onEdge: askForEdgeOfNewFlap defaultColorForFlapBackgrounds newFlapTitled:onEdge: newFlapTitled:onEdge:inPasteUp:)('predefined flaps' addNewDefaultSharedFlaps addStandardFlaps initializeStandardFlaps newNavigatorFlap newObjectsFlap newSqueakFlap newStackToolsFlap newSuppliesFlap newSuppliesFlapFromQuads:positioning: newToolsFlap newWidgetsFlap quadsDefiningPlugInSuppliesFlap quadsDefiningStackToolsFlap quadsDefiningSuppliesFlap quadsDefiningToolsFlap quadsDefiningWidgetsFlap quadsDeiningScriptingFlap twiddleSuppliesButtonsIn:)('replacement' replaceGlobalFlapwithID: replacePartSatisfying:inGlobalFlapSatisfying:with: replacePartSatisfying:inGlobalFlapWithID:with: replaceToolsFlap)('shared flaps' addGlobalFlap: enableOnlyGlobalFlapsWithIDs: globalFlapTabOrDummy: globalFlapTabs globalFlapTabsIfAny globalFlapTabsWithID: globalFlapTabWithID: globalFlapTab: positionNavigatorAndOtherFlapsAccordingToPreference positionVisibleFlapsRightToLeftOnEdge:butPlaceAtLeftFlapsWithIDs: removeDuplicateFlapTabs sharedFlapsAllowed sharedFlapsAlongBottom)('testing' anyFlapsVisibleIn:)!EventHandler removeSelector: #adaptToWorld:!DeepCopier removeSelector: #mapUniClasses!DeepCopier removeSelector: #newUniClasses!DeepCopier removeSelector: #newUniClasses:!DeepCopier removeSelector: #uniClasses!Object subclass: #DeepCopier instanceVariableNames: 'references' classVariableNames: '' poolDictionaries: '' category: 'System-Object Storage'!!DeepCopier reorganize!('like fullCopy' checkBasicClasses checkClass: checkDeep checkVariables fixDependents initialize initialize: objInMemory: references warnIverNotCopiedIn:sel:)!ChangeList removeSelector: #buildMorphicCodePaneWith:!CodeHolder removeSelector: #installTextualCodingPane!CodeHolder removeSelector: #restoreTextualCodingPane!!CodeHolder reorganize!('annotation' addPriorVersionsCountForSelector:ofClass:to: annotation annotation: annotationForClassCommentFor: annotationForClassDefinitionFor: annotationForHierarchyFor: annotationForSelector:ofClass: annotationPaneMenu:shifted: annotationRequests annotationSeparator)('categories' categoryFromUserWithPrompt:for: categoryOfCurrentMethod changeCategory letUserReclassify:in: methodCategoryChanged selectedMessageCategoryName selectedSystemCategoryName)('categories & search pane' listPaneWithSelector: newSearchPane searchTextMorph)('commands' adoptMessageInCurrentChangeset browseImplementors browseSenders copyUpOrCopyDown offerMenu offerShiftedClassListMenu offerUnshiftedClassListMenu shiftedYellowButtonActivity spawn: spawnToClass: spawnToCollidingClass: unshiftedYellowButtonActivity)('construction' buildClassBrowserEditString: buildMessageBrowserEditString: buildMessageCategoryBrowserForCategory:class:selector:editString: buildMorphicCodePaneWith:)('contents' commentContents contents contentsChanged contentsSymbol contentsSymbol: editContents editContentsWithDefault: isModeStyleable)('controls' codePaneProvenanceString contentsSymbolQuints decorateButtons optionalButtonPairs sourceAndDiffsQuintsOnly)('diffs' defaultDiffsSymbol diffFromPriorSourceFor: showDiffs showDiffs: showPrettyDiffs: showRegularDiffs: showingAnyKindOfDiffs showingPrettyDiffs showingPrettyDiffsString showingRegularDiffs showingRegularDiffsString toggleDiffing togglePlainSource togglePrettyDiffing togglePrettyPrint toggleRegularDiffing wantsDiffFeedback)('message category functions' canShowMultipleMessageCategories removeMessageCategory)('message list' decompiledSourceIntoContents decompiledSourceIntoContentsWithTempNames: formattedLabel: formattedLabel:forSelector:inClass: messageHelpForMethod: messageHelpTruncated: selectedBytecodes selectedMessage sourceStringPrettifiedAndDiffed validateMessageSource:forSelector:inClass:)('message list menu' messageListKey:from: messageListMenuMore: shiftedMessageListMore:)('misc' addModelItemsToWindowMenu: getSelectorAndSendQuery:to: getSelectorAndSendQuery:to:with: informPossiblyCorruptSource isThereAnOverride isThisAnOverride modelWakeUpIn: okayToAccept priorSourceOrNil refreshAnnotation refusesToAcceptCode releaseCachedState sampleInstanceOfSelectedClass sendQuery:to: sendQuery:to:with: setClassAndSelectorIn: suggestCategoryToSpawnedBrowser: useSelector:orGetSelectorAndSendQuery:to:)('self-updating' didCodeChangeElsewhere stepIn: updateCodePaneIfNeeded updateListsAndCodeIn: wantsStepsIn:)('toolbuilder' annotationFrame annotationPaneHeight browseButtonEnabled buildAnnotationPaneWith: buildCodePaneWith: buildCodeProvenanceButtonWith: buildOptionalButtonsWith: buttonHeight hierarchyButtonEnabled inheritanceButtonColor inheritanceButtonEnabled optionalButtonsFrame receiverClass textFrame variablesButtonEnabled versionsButtonEnabled)('traits' makeSampleInstance showUnreferencedClassVars showUnreferencedInstVars spawnHierarchy)('what to show' offerWhatToShowMenu prettyPrintString setContentsToForceRefetch showByteCodes: showDecompile: showDocumentation: showingByteCodes showingByteCodesString showingDecompile showingDecompileString showingDocumentation showingDocumentationString showingEditContentsOption showingPlainSource showingPlainSourceString showingPrettyPrint showingSource toggleDecompile toggleShowDocumentation toggleShowingByteCodes wantsCodeProvenanceButton)('*services-base' messageListMenuServices: requestor)('*Protocols-Tools' spawnFullProtocol spawnProtocol)('multi-window support' multiWindowState multiWindowState:)('message functions' exploreMethod inspectMethod removeMessage)('*SUnitTools-running' testAskToCreateNewTest: testBinarySelectorNames testBrowseClassNamed:possibleMessageNamed: testFindTest testFindTested testRunSuite: testSelectorFrom:)('*SUnitTools-message list functions' testDebugTest testRunTest)('*SUnitTools-menus' testsMessageListMenu: testsTestFindingMenu:)('breakpoints' isBreakOnEntry toggleBreakOnEntry)('code pane' aboutToStyle: compileMessage:notifying:)('accessing' contents:notifying: doItReceiver metaClassIndicated selectedClass selectedClassOrMetaClass selectedMessageName systemOrganizer)('initialize-release' defaultBrowserTitle labelString setClass:selector:)('*monticello-revisions' classListMenuMonticello: messageListMenuMonticello:)('class functions' removeClass)('system category functions' removeSystemCategory)('*60Deprecated-annotation' defaultAnnotationPaneHeight defaultButtonPaneHeight)('*60Deprecated-categories & search pane' searchPane)!Object removeSelector: #adaptedToWorld:!Object removeSelector: #beViewed!Object removeSelector: #belongsToUniClass!Object removeSelector: #costumes!Object removeSelector: #defaultFloatPrecisionFor:!Object removeSelector: #evaluateUnloggedForSelf:!Object removeSelector: #isPlayer!Object removeSelector: #isPrimitiveCostume!Object removeSelector: #isScriptEditorMorph!Object removeSelector: #isUniversalTiles!Object removeSelector: #methodInterfacesForCategory:inVocabulary:limitClass:!Object removeSelector: #methodInterfacesForInstanceVariablesCategoryIn:!Object removeSelector: #methodInterfacesForScriptsCategoryIn:!Object removeSelector: #presenter!Object removeSelector: #renameInternal:!Object removeSelector: #scriptPerformer!Object removeSelector: #selfWrittenAsIll!Object removeSelector: #selfWrittenAsIm!Object removeSelector: #selfWrittenAsMe!Object removeSelector: #selfWrittenAsMy!Object removeSelector: #selfWrittenAsThis!Object removeSelector: #slotInfo!Object removeSelector: #veryDeepCopySibling!!Object reorganize!('accessing' at: at:modify: at:put: basicAt: basicAt:put: basicSize bindWithTemp : enclosedSetElement in: readFromString: size yourself)('associating' ->)('binding' bindingOf:)('casing' caseOf: caseOf:otherwise:)('class membership' class inheritsFromAnyIn: isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass)('comparing' = closeTo: hash identityHashPrintString literalEqual: ~=)('converting' adaptToFloat:andCompare: adaptToFloat:andSend: adaptToFraction:andCompare: adaptToFraction:andSend: adaptToInteger:andCompare: adaptToInteger:andSend: adaptToScaledDecimal:andCompare: adaptToScaledDecimal:andSend: as: asOrderedCollection asSetElement asString asStringOrText changeClassTo: complexContents mustBeBoolean mustBeBooleanIn: printDirectlyToDisplay withoutListWrapper)('copying' copy copyAddedStateFrom: copyFrom: copySameFrom: copyTwoLevel deepCopy initialDeepCopierSize postCopy shallowCopy veryDeepCopy veryDeepCopyUsing: veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:)('debugging' evaluate:wheneverChangeIn: haltIf: haltOnceIf: meetsHaltCondition: needsWork)('debugging-haltOnce' checkHaltCountExpired clearHaltOnce decrementAndCheckHaltCount decrementHaltCount doExpiredHaltCount doExpiredHaltCount: doExpiredInspectCount halt:onCount: haltIfNil haltOnCount: haltOnce haltOnce: haltOnceEnabled hasHaltCount inspectOnCount: inspectOnce inspectUntilCount: removeHaltCount setHaltCountTo: setHaltOnce toggleHaltOnce)('dependents access' addDependent: breakDependents canDiscardEdits dependents hasUnacceptedEdits myDependents myDependents: release removeDependent:)('drag and drop' acceptDroppingMorph:event:inMorph: dragPassengerFor:inMorph: dragStartedFor:transferMorph: dragTransferTypeForMorph: wantsDroppedMorph:event:inMorph:)('error handling' assert: assert:description: assert:descriptionBlock: backwardCompatibilityOnly: caseError deprecated deprecated: deprecated:block: doesNotUnderstand: dpsTrace: dpsTrace:levels: dpsTrace:levels:withContext: error error: halt halt: handles: notify: notify:at: primitiveFailed primitiveFailed: shouldBeImplemented shouldNotImplement subclassResponsibility traitConflict)('evaluating' value valueWithArguments:)('filter streaming' byteEncode: drawOnCanvas: elementSeparator encodePostscriptOn: flattenOnStream: fullDrawPostscriptOn: putOn: writeOnFilterStream:)('flagging' isThisEverCalled isThisEverCalled: logEntry logExecution logExit)('graph model' addModelYellowButtonMenuItemsTo:forMorph:hand: hasModelYellowButtonMenuItems)('macpal' codeStrippedOut: contentsChanged flash instanceVariableValues objectRepresented refusesToAcceptCode)('message handling' executeMethod: perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:with:with:with:with: perform:with:with:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: perform:withEnoughArguments: with:executeMethod: with:with:executeMethod: with:with:with:executeMethod: with:with:with:with:executeMethod: withArgs:executeMethod:)('objects from disk' comeFullyUpOnReload: convertToCurrentVersion:refStream: fixUponLoad:seg: objectForDataStream: readDataFrom:size: saveOnFile saveOnFileNamed: storeDataOn:)('printing' fullPrintString isLiteral longPrintOn: longPrintOn:limitedTo:indent: longPrintString longPrintStringLimitedTo: nominallyUnsent: printOn: printString printStringLimitedTo: printWithClosureAnalysisOn: reportableSize storeOn: storeString stringForReadout stringRepresentation)('system primitives' asOop become: becomeForward: becomeForward:copyHash: className creationStamp instVarAt: instVarAt:put: instVarNamed: instVarNamed:put: oopString primitiveChangeClassTo: rootStubInImageSegment: someObject)('testing' isArray isBehavior isBlock isBoolean isCharacter isClassReference isClosure isCodeReference isCollection isColor isColorForm isCompiledCode isCompiledCodeClass isCompiledMethod isComplex isContext isDictionary isFloat isForm isFraction isHeap isInteger isInterval isMessageSend isMethodContext isMethodProperties isMethodReference isMor ph isMorphicEvent isMorphicModel isNumber isPoint isPromise isRectangle isScaledDecimal isSketchMorph isStream isString isSymbol isSystemWindow isText isTextView isTrait isTransparent isVariableBinding isWebBrowser isWindowForModel: knownName name nameForViewer renameTo: shouldBePrintedAsLiteral shouldBePrintedAsLiteralVisiting: showDiffs stepAt:in: stepIn: stepTime stepTimeIn: vocabularyDemanded wantsDiffFeedback wantsSteps wantsStepsIn:)('updating' changed changed: changed:with: handledListVerification noteSelectionIndex:for: okToChange okToClose update: update:with: updateListsAndCodeIn: windowIsClosing)('user interface' addModelItemsToWindowMenu: addModelMenuItemsTo:forMorph:hand: asExplorerString defaultLabelForInspector launchPartVia: launchPartVia:label: launchTileToRefer modelSleep modelWakeUp modelWakeUpIn: mouseUpBalk: notYetImplemented windowActiveOnFirstClick windowReqNewLabel:)('*monticello' isConflict)('*system-support' isPrimitiveError systemNavigation)('*Tools-Ex plorer' explore exploreWithLabel:)('*tools-browser' browseHierarchy)('private' errorImproperStore errorNonIntegerIndex errorNotIndexable errorSubscriptBounds: setPinned: species storeAt:inTempFrame:)('thumbnail' iconOrThumbnailOfSize:)('*Morphic-Explorer' explorerContents hasContentsInExplorer)('futures' future future: futureDo:at:args: futureSend:at:args:)('*Tools-MessageSets' browseAllCallsOn: browseAllCallsOn:requestor: browseAllImplementorsOf: browseAllImplementorsOf:requestor:)('*Tools-multi-window support' canHaveUnacceptedEdits)('*morphic' asMorph asStringMorph asTextMorph isPluggableListMorph openAsMorph)('tracing' inboundPointers inboundPointersExcluding: outboundPointers outboundPointersDo:)('*Tools-Debugger' canonicalArgumentName chasePointers explorePointers shouldFollowOutboundPointers)('*System-Object Events-accessing' actionForEvent: actionForEvent:ifAbsent: actionMap actionSequenceForEvent: actionsDo: createActionMap hasActionForEvent: setActionSequence:forEvent: updateableActionMap)('*System-Change Notification-events' actionsWithReceiver:forEvent: renameActionsWithReceiver:forEvent:toEvent:)('*System-Change Notification-converting' asActionSequence asActionSequenceTrappingErrors)('*System-Tools-breakpoint' break)('*ToolBuilder-Kernel-error handling' confirm: confirm:orCancel:)('*ToolBuilder-Kernel-user interface' inform:)('*System-Support-user interface' initialExtent)('*System-Localization-locales' localeChanged localeChangedGently translatedNoop)('*System-Object Events-accessing-removing' releaseActionMap removeAction:forEvent: removeActionsForEvent: removeActionsSatisfying: removeActionsSatisfying:forEvent: removeActionsWithReceiver: removeActionsWithReceiver:forEvent:)('*System-Object Events-accessing-triggering' triggerEvent: triggerEvent:ifNotHandled: triggerEvent:with: triggerEvent:with:ifNotHandled: triggerEvent:withArguments: triggerEvent:withArguments:ifNotHandled:)('*System-Object Events-accessing-registering' when:evalua te: when:send:to: when:send:to:with: when:send:to:withArguments:)('*Traits' explicitRequirement requirement)('*Graphics-KernelExtensions' fullScreenSize)('*System-Finalization' actAsExecutor executor finalizationRegistry finalize hasMultipleExecutors retryWithGC:until: toFinalizeSend:to:with:)('*collections' asLink compareSafely:)('*Tools-Browsing' browse)('*System-Recovery-error handling' primitiveError:)('*SUnit-testing' isTestClass)('*Morphic-Events-Filtering' filterEvent:for:)('*System-Preferences' applyUserInterfaceTheme canApplyUserInterfaceTheme userInterfaceTheme)('*Tools' environment)('pinning' isPinned pin unpin)('literals' allLiteralsDo: hasLiteral: hasLiteralSuchThat:)('write barrier' attemptToAssign:withIndex: beReadOnlyObject beWritableObject isReadOnlyObject setIsReadOnlyObject:)('*Tools-Inspector' basicInspect inspect inspectWithLabel: inspectorClass)('*Morphic-Kernel-accessing' currentEvent currentHand currentWorld)('*Monticello-Patching-testing' isMCPatchOperation)('*JSON' asJsonString)('*60Deprecated-accessing' ifNil:ifNotNilDo: ifNotNilDo: ifNotNilDo:ifNil:)('*MorphicExtras-Undo' capturedState commandHistory purgeAllCommands redoFromCapturedState: refineRedoTarget:selector:arguments:in: refineUndoTarget:selector:arguments:in: rememberCommand: rememberUndoableAction:named: undoFromCapturedState:)('*Protocols' currentVocabulary haveFullProtocolBrowsed haveFullProtocolBrowsedShowingSelector:)('*services-base' requestor)('*60Deprecated-copying' clone)('*60Deprecated-Tools' exploreAndYourself notifyWithLabel:)('*MorphicExtras-PartsBin' descriptionForPartsBin)!| currentChanges |currentChanges := ChangeSet current.Smalltalk globals removeKey: #References.Smalltalk globals removeKey: #CustomEventsRegistry.Smalltalk globals removeKey: #ScriptingSystem.ChangeSet newChanges: (ChangeSet new name: 'unload-etoys-more').(Smalltalk classNamed: #StandardScriptingSystem) removeFromSystem.(Smalltalk classNamed: #Presenter) removeFromSystem.(Smalltalk classNamed: #MethodHolder) removeFromSystem.(Smalltalk classNamed: #PaintInvokingMorph) removeFromSystem.(Smalltalk classNamed: #ViewerFlapTab) removeFromSystem.(Smalltalk classNamed: #AcceptableCleanTextMorph) removeFromSystem.(Smalltalk classNamed: #BrowserCommentTextMorph) removeFromSystem.(Smalltalk classNamed: #BorderedSubpaneDividerMorph) removeFromSystem.(Smalltalk classNamed: #TextFieldMorph) removeFromSystem.(Smalltalk classNamed: #KeyboardBuffer) removeFromSystem.(Smalltalk classNamed: #PluggableTabButtonMorph) removeFromSystem.(Smalltalk classNamed: #MorphWithSubmorphsWrapper) removeFromSystem.(Smalltalk classNamed: #TwoWayScrollPane) removeFromSystem.Preferences removePreference: #noviceMode.Preferences removePreference: #eToyFriendly.Preferences removePreference: #universalTiles.Preferences removePreference: #uniTilesClassic.Preferences removePreference: #tileTranslucentDrag.Preferences removePreference: #typeCheckingInTileScripting.Preferences removePreference: #compactViewerFlaps.Preferences removePreference: #viewersInFlaps.Preferences removePreference: #batchPenTrails.Preferences removePreference: #keepTickingWhilePainting.Preferences removePreference: #unlimitedPaintArea.Preferences removePreference: #mvcProjectsAllowed.Preferences removePreference: #eToyLoginEnabled.Preferences removePreference: #oliveHandleForScriptedObjects.Preferences removePreference: #dropProducesWatcher.Preferences removePreference: #automaticViewerPlacement.Preferences removePreference: #capitalizedReferences.Preferences removePreference: #fenceEnabled.Preferences removePreference: #fenceSoundEnabled.Preferences removePreference: #haloTransitions.Preferences removePreference: #selectiveHalos.Preferences removePreference: #useVectorVocabulary.Preferences removePreference: #simpleMenus.Preferences removePreference: #propertySheetFromHalo.Preferences removePreference: #menuColorFromWorld.Preferences removePreference: #enableVirtualOLPCDisplay.Preferences removePreference: #enablePortraitMode.Preferences removePreference: #magicHalos.Preferences removePreference: #tabAmongFields.Preferences removePreference: #sugarAutoSave.Preferences removePreference: #showAdvancedNavigatorButtons.FileServices removeObsolete.ChangeSet newChanges: currentChanges.ChangeSet newChanges: (ChangeSet new name: 'clean-up-categories').SystemChangeNotifier uniqueInstance doSilently: [Smalltalk allClassesDo: [:cls | cls organization renameCategory: 'stepping and presenter' toBe: 'stepping']].Smalltalk removeEmptyMessageCategories.ChangeSet newChanges: currentChanges.Preferences resetHaloSpecifications.TheWorldMainDockingBar updateInstances.Flaps initializeFlapsQuads; initializeStandardFlaps.Vocabulary initializeStandardVocabularies.UserInterfaceTheme cleanUpAndReset."Next: Remove Etoys package from update map."!
Thanks a lot! :-)
Best,
Christoph
________________________________ Von: Taeumel, Marcel via Squeak-dev squeak-dev@lists.squeakfoundation.org Gesendet: Montag, 6. November 2023 08:05:19 An: The general-purpose Squeak developers list Cc: Taeumel, Marcel Betreff: [squeak-dev] Re: Let's discuss the future of Etoys in Squeak 6.1 (and beyond)
Hi Dave! 😊
Thank you for the effort!
Best, Marcel
________________________________ From: lewis@mail.msen.com lewis@mail.msen.com Sent: Sunday, November 5, 2023 5:29:46 PM To: The general-purpose Squeak developers list squeak-dev@lists.squeakfoundation.org Subject: [squeak-dev] Re: Let's discuss the future of Etoys in Squeak 6.1 (and beyond)
I have pushed a number of updates to trunk with class and method recategorization for Etoys. I am attaching for reference an updated RecategorizeForEtoys.st that includes scripts that I have been using to make the changes.
So for, the changes do two things: 1) Clean up category names, based the cleanups in Marcel's Etoys removal script. 2) Move classes an methods from Etoys to base packages if they are used outside of Etoys.
I have also made, but not committed, a bunch of updates that move methods into Etoys if they are used only by Etoys. These changes should be safe for trunk, but I want to spend some more time reviewing them before committing them for real.
Meanwhile any feedback is appreciated :-)
Dave
On 2023-10-03 15:24, David T. Lewis wrote:
On Tue, Aug 29, 2023 at 03:47:19PM +0200, Marcel Taeumel via Squeak-dev wrote:
Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
I have been working with Marcel's excellent Etoys removal script and trying to figure out if it might be possible to maintain images with and without Etoys over time. I have been using Monticello with a local disk based repository to look at the differences between trunk images with and without the Etoys removal.
Just for the record, and in case anyone else is playing around with similar ideas, I am attaching RecategorizeExtensionsForEtoys.st which I have been using to move methods that are different into a separate 'Extensions' package. This separates out the methods that are necessarily different between images with and without Etoys. I don't (yet?) see how this helps with maintainability but it does give a view of the methods that could potentially be refactored in better ways. Basically I think the idea would be to make the 'Extensions' package be as small a possible (right now it is rather large).
I was hoping to find that moving these conflicting methods into a separate package would leave the rest of the packages reasonable similar between the full trunk image and the no-Etoys trunk image. But of course it is not quite that simple.
One encouraging thing is that, after moving the conflicting methods (Etoys image versus no-Etoys) I find a large number of methods in other packages that are referenced only by Etoys, even though that would not be obvious just from looking at those methods in the full image. I think that there is a lot of stuff that could be safely moved to the 'EToys' package without impacting the base image.
Just a few observations that may be of interest, hopefully more to follow.
Dave
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras:
- Games
- Sketches and PaintBox
- Flaps
- CalendarMorph
- SpectrumAnalyzerMorph
Here is what would still "work" through the package System:
- Object storage (ImageSegment etc.)
- ProjectLoading
Here is what would still work through the package Protocols:
- Lexicon tool
- Vocabulary framework
Here is what would be gone:
- Tiles, viewers, and scripts
- Players and costumes
- Pen trails, Turtles, ...
- References, CustomEventsRegistry, ScriptingSystem
- Siblings for (Player-only) uni-classes
- DeepCopier support for (Player-only) uni-classes
- Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
So...should we remove Etoys from Trunk at this point?
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel ???'From Squeak6.1alpha of 26 July 2023 [latest update: #22682] on 29 August 2023 at 3:33:41 pm'!| currentChanges |currentChanges := ChangeSet current.MenuIcons addClassVarName: #ScriptingIcons.MenuIcons classPool at: #ScriptingIcons put: ((Smalltalk globals at: #ScriptingSystem) formDictionary associationsSelect: [:assoc | true "keep all for now" "(assoc key beginsWith: 'Halo-') or: [assoc key beginsWith: 'Debugger']"]).ChangeSet newChanges: (ChangeSet new name: 'move-etoys-games-to-morphicextras').#( "Keep the games as standalone example applications"'Etoys-Squeakland-Morphic-Games' 'MorphicExtras-Games''Etoys-Squeakland-Morphic-Games-Chess' 'MorphicExtras-Games-Chess''Etoys-Squeakland-Morphic-Games-Chess960' 'MorphicExtras-Games-Chess960''Etoys-Squeakland-Morphic-Demo' 'MorphicExtras-Demo') pairsDo: [:oldCat :newCat | (SystemOrganization listAtCategoryNamed: oldCat) do: [:className | (self environment classNamed: className) category: newCat]]."Rescue more examples from Etoys over to MorphicExtras"(Smalltalk classNamed: #CalendarMorph) category: 'MorphicExtras-Demo'.(Smalltalk classNamed: #SpectrumAnalyzerMorph) category: 'MorphicExtras-SoundInterface'.ChangeSet newChanges: currentChanges.(MCPackage named: #EToys) unload.!Object subclass: #DeepCopier instanceVariableNames: 'references uniClasses newUniClasses ' classVariableNames: '' poolDictionaries: '' category: 'System-Object Storage'!!DeepCopier commentStamp: 'mt 8/28/2023 15:05' prior: 0!DeepCopier does a veryDeepCopy.It is a complete tree copy using a dictionary. Any object that is 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. See Object|veryDeepCopy which calls (self veryDeepCopyWith: aDeepCopier).When a tree of morphs points at a morph outside of itself, that morph should not be copied. Use our own kind of weak pointers for the 'potentially outside' morphs. Default is that any new class will have all of its fields deeply copied. If a field needs to be weakly copied, define veryDeepInner: and veryDeepFixupWith:. veryDeepInner: has the loop that actually copies the fields. If a class defines its own copy of veryDeepInner: (to leave some fields out), then veryDeepFixupWith: will be called on that object at the end. veryDeepInner: can compute an alternate object to put in a field. (Object veryDeepCopyWith: discovers which superclasses did not define veryDeepInner:, and very deeply copies the variables defined in those classes). To decide if a class needs veryDeepInner: and veryDeepFixupWith:, ask this about an instance: If I duplicate this object, does that mean that I also want to make duplicates of the things it holds onto? If yes, (i.e. a Paragraph does want a new copy of its Text) then do nothing. If no, (i.e. an undo command does not want to copy the objects it acts upon), then define veryDeepInner: and veryDeepFixupWith:. Here is an analysis for the specific case of a morph being held by another morph. Does field X contain a morph? If not, no action needed.Is the morph in field X already a submorph of the object? Is it down lower in the submorph tree? If so, no action needed.Could the morph in field X every appear on the screen (be a submorph of some other morph)? If not, no action needed. If it could, you must write the methods veryDeepFixupWith: and veryDeepInner:, and in them, refrain from sending veryDeepCopyWith: to the contents of field X.----- Things Ted is still considering -----Rule: If object A has object C in a field, and A says (^ C) for the copy, but object B has A in a normal field and it gets deepCopied, and A in encountered first, then there will be two copies of C. (just be aware of it)Dependents are now fixed up. Suppose a model has a dependent view. In the DependentFields dictionary, model -> (view ...). If only the model is copied, no dependents are created (no one knows about the new model). If only the view is copied, it is inserted into DependentFields on the right side. model -> (view copiedView ...). If both are copied, the new model has the new view as its dependent. If additional things depend on a model that is copied, the caller must add them to its dependents.August 2023: There is no support for uni-classes at this time!!!Model subclass: #FancyMailComposition instanceVariableNames: 'messageText theLinkToInclude to subject' classVariableNames: '' poolDictionaries: '' category: 'Nebraska-Network-Mail'!Object subclass: #MenuIcons instanceVariableNames: '' classVariableNames: 'Icons TranslatedIcons TranslationLocale ScriptingIcons ' poolDictionaries: '' category: 'Morphic-Menus'!Object subclass: #MorphExtension instanceVariableNames: 'locked visible sticky balloonText balloonTextSelector externalName isPartsDonor actorState player eventHandler otherProperties ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Kernel'!BorderedMorph subclass: #PasteUpMorph instanceVariableNames: 'presenter model cursor padding turtleTrailsForm turtlePen lastTurtlePositions isPartsBin indicateCursor wantsMouseOverHalos worldState ' classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler ' poolDictionaries: '' category: 'Morphic-Worlds'!AbstractLauncher subclass: #ProjectLauncher instanceVariableNames: 'showSplash splashURL whichFlaps eToyAuthentificationServer ' classVariableNames: 'SplashMorph ' poolDictionaries: '' category: 'System-Download'!Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl eToyUserListUrl eToyUserList keepAlive encodingName ' classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers ' poolDictionaries: '' category: 'Network-RemoteDirectory'!!SmartRefStream commentStamp: 'mt 8/28/2023 15:44' prior: 0!Ordinary ReferenceStreams assume that the names and order of instance variables is exactly the same when an object file is written and read. SmartRefStream allows object files to be read even after instance variables have changed or the entire class has been renamed.When an object file is written, no one knows how the classes will change in the future. Therefore, all conversion must be done when the file is read. The key is to store enough information in the file about the names of the instance variables of all outgoing classes. SmartRefStream works best with only one tree of objects per file. You can nextPut: more than once, but each object tree gets its own class structure description, which is big. Conversion of old objects is done by a method in each class called (convertToCurrentVersion: varDict refStream: smartRefStrm). At fileOut time, ChangeSet>>checkForConversionMethods creates a prototype of this method (if Preference #conversionMethodsAtFileOut is true). The programmer must edit this method to (1) test if the incoming object needs conversion, (2) put non-nil values into any new inst vars that need them, and (3) save the data of any inst vars that are being deleted. Determining which old version is represented by the incoming object can be done in several ways: - noticing that a current inst var is nil when it should have data, - noticing that there is an older inst var name in the variable dictionary (varDict), - checking kinds of objects in one or more inst vars, or - retrieving the classVersion of the incoming object from the ref stream. If a class is renamed, a method goes into SmartRefStream telling the new name. The conversion method of the new class must be prepared to accept instances of the old class also. If no inst var names have changed, the conversion method does nothing.An example: Suppose we change the representation of class Rectangle from ('origin' 'corner') to ('origin' 'extent'). Suppose lots of Rectangle instances are already out on files (in .pr project files, especially). The programmer changes the class definition, modifies all the methods, and filesOut. A series of dialogs appear, asking if instances Rectangle might be in an object file, if 'extent' needs to be non-nil (yes), and if the info in 'corner' needs to be preserved (yes). This method appears:Rectangle >> convertToCurrentVersion: varDict refStream: smartRefStrm "These variables are automatically stored into the new instance: #('origin'). Test for this particular conversion. Get values using expressions like (varDict at: 'foo')." "New variables: #('extent'). If a non-nil value is needed, please assign it." "These are going away #('corner'). Possibly store their info in some other variable?" "Move your code above the ^ super... Delete extra comments." ^ super convertToCurrentVersion: varDict refStream: smartRefStrmThe programmer modifies it to be:Rectangle >> convertToCurrentVersion: varDict refStream: smartRefStrm(varDict includesKey: 'extent') ifFalse: ["old version!!" "Create the new extent, and preserve the info from the old corner" extent := (varDict at: 'corner') - origin. ].^ super convertToCurrentVersion: varDict refStream: smartRefStrm This conversion method stays in the system and is ready to convert the old format of Rectangle whenever one is encountered in an object file. Note that the subclasses of Rectangle, (B3DViewport, CharacterBlock, and Quadrangle) do not need conversion methods. Their instances will be converted by the code in Rectangle. Files written by SmartRefStream are in standard fileout format. You can mix raw objects with code to be filed in. The file starts out in the normal fileOut format. Definitions of new classes on the front.structures Dictionary of (#Rectangle -> #(<classVersionInteger> 'origin' 'corner')). Inst var names are strings.steady Set of Classes who have the same structure now as on the incoming file. Includes classes with same inst vars except for new ones added on the end.reshaped Dictionary of Classes who have a different structure now from the incoming file. Includes those with same inst vars but new version number. (old class name -> method selector to fill in data for version to version)renamed Dictionary of Classes who have a different name. Make an instance of the new class, and send it the conversion call. (old class name symbol -> new class name). renamedConv Dictionary of conversion selector for Classes who have a different name. (old class name symbol -> conversion selector). topCall Tells if next or nextPut: are working on the top object in the tree. nil if outside, the top object if deep inside.See DataStream.typeIDFor: for where the tangle of objects is clipped, so the whole system will not be written on the file.No object that is written on the file is ever a class. All class definitions are filed in. A class may be stored inside an ImageSegment that itself is stored in a SmartRefStream.UniClasses are classes for the instance specific behavior of just one instance. See #newSubclass. When a UniClass is read in, and a class of the same name already exists, the incoming one is renamed. ObjectScanner converts the filed-in code.Values in instance variables of UniClasses are stored in the array that tells the class structure. It is the fourth of the four top level objects. #(version (class-structure) the-object ((#Player25 scripts slotInfo costumeDictionary) (#Player26 scripts slotInfo costumeDictionary))).There is a separate subclass for doing veryDeepCopy (in memory). Currently, any object for which objectToStoreOnDataStream return an object other than self, does this: The new object (a DiskProxy) is traced. When it comes time to go through the fields of the old object, they are not found as keys in references (DiskProxies are there instead). So the old field value is left in the new object. That is OK for StrikeFont, Class, MetaClass, DisplayScreen. But the DiskProxies are evaluated, which takes a lot of time.Some metaclasses are put into the structures table. This is for when a block has a receiver that is a class. See checkFatalReshape:.ImageSegments: A ReferenceStream is used to enumerate objects to put inside an ImageSegment. If an instance of a UniClass is seen, the class is put in also. A SmartRefStream is used to store the ImageSegment. Roots are nil, and the segment is a wordArray. We are encoding the outPointers. Structures contains all classes from both places. Must filter out UniClasses for some things, and do include them for putting source code at end of file. Do not write any class inst vars in file.--Ted Kaehler and Bob Arning.How are the selectors in the '*Morphic-conversion' protocol ending with something like ttfclpomsswfpp0constructed and what does it mean?Answer:It is the initials of all instance variables followed by the class version integer. The initials allow to detect most changes to the instance variables, but if this is not sufficient (perhaps because the new var had the same initial, or the vars did not change in name at all) we still have the class version.Most classes are still at version 0, but if you check implementers of classVersion you can find a few that were incremented to force a conversion on load.!!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:05'!veryDeepCopy "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." | copier new | copier := DeepCopier new: self initialDeepCopierSize. new := self veryDeepCopyWith: copier. copier references associationsDo: [:assoc | assoc value veryDeepFixupWith: copier]. copier fixDependents. ^ new! !!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:05'!veryDeepCopyUsing: copier "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. Same as veryDeepCopy except copier (with dictionary) is supplied. ** do not delete this method, even if it has no callers **" | new refs | new := self veryDeepCopyWith: copier. copier references associationsDo: [:assoc | assoc value veryDeepFixupWith: copier]. "Fix dependents" refs := copier references. DependentsFields associationsDo: [:pair | pair value do: [:dep | | newDep newModel | (newDep := refs at: dep ifAbsent: [nil]) ifNotNil: [ newModel := refs at: pair key ifAbsent: [pair key]. newModel addDependent: newDep]]]. ^ new! !!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:07'!veryDeepCopyWith: deepCopier "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." | class index sub subAss new sup has mine | deepCopier references at: self ifPresent: [:newer | ^ newer]. "already did him" class := self class. class isMeta ifTrue: [^ self]. "a class" new := self shallowCopy. deepCopier references at: self put: new. "remember" (class isVariable and: [class isPointers]) ifTrue: [index := self basicSize. [index > 0] whileTrue: [sub := self basicAt: index. (subAss := deepCopier references associationAt: sub ifAbsent: [nil]) ifNil: [new basicAt: index put: (sub veryDeepCopyWith: deepCopier)] ifNotNil: [new basicAt: index put: subAss value]. index := index - 1]]. "Ask each superclass if it wants to share (weak copy) any inst vars" new veryDeepInner: deepCopier. "does super a lot" "other superclasses want all inst vars deep copied" sup := class. index := class instSize. [has := sup compiledMethodAt: #veryDeepInner: ifAbsent: [nil]. has := has ifNil: [class isSystemDefined not "is a uniClass"] ifNotNil: [true]. mine := sup instVarNames. has ifTrue: [index := index - mine size] "skip inst vars" ifFalse: [1 to: mine size do: [:xx | sub := self instVarAt: index. (subAss := deepCopier references associationAt: sub ifAbsent: [nil]) "use association, not value, so nil is an exceptional value" ifNil: [new instVarAt: index put: (sub veryDeepCopyWith: deepCopier)] ifNotNil: [new instVarAt: index put: subAss value]. index := index - 1]]. (sup := sup superclass) == nil] whileFalse. new rehash. "force Sets and Dictionaries to rehash" ^ new! !!Object methodsFor: 'testing' stamp: 'mt 3/8/2023 10:43'!knownName ^ nil! !!Class methodsFor: 'testing' stamp: 'mt 8/28/2023 14:56'!officialClass "I am not a UniClass. (See MorphicModel officialClass). Return the class you use to make new subclasses." ^ self! !!Class methodsFor: 'fileIn/Out' stamp: 'mt 8/28/2023 14:56'!objectForDataStream: refStrm "I am about to be written on an object file. Write a reference to a class in Smalltalk instead." refStrm insideASegment ifFalse: ["Normal use" ^ DiskProxy global: self theNonMetaClass name selector: #withClassVersion: args: {self classVersion}] ifTrue: ["recording objects to go into an ImageSegment" self isSystemDefined ifFalse: [^ self]. "do trace uni-classes" (refStrm rootObject includes: self) ifTrue: [^ self]. "is in roots, intensionally write out, ^ self" "A normal class. remove it from references. Do not trace." refStrm references removeKey: self ifAbsent: []. "already there" ^ nil]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!toggleDiffing "Toggle whether diffs should be shown in the code pane. If any kind of diffs were being shown, stop showing diffs. If no kind of diffs were being shown, start showing whatever kind of diffs are called for by default." | wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingAnyKindOfDiffs. self showDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!togglePlainSource "Toggle whether plain source shown in the code pane" | wasShowingPlainSource | self okToChange ifTrue: [wasShowingPlainSource := self showingPlainSource. wasShowingPlainSource ifTrue: [self showDocumentation: true] ifFalse: [contentsSymbol := #source]. self setContentsToForceRefetch. self changed: #contents]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!togglePrettyDiffing "Toggle whether pretty-diffing should be shown in the code pane" | wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingPrettyDiffs. self showPrettyDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!togglePrettyPrint "Toggle whether pretty-print is in effectin the code pane" self okToChange ifTrue: [self showingPrettyPrint ifTrue: [contentsSymbol := #source] ifFalse: [contentsSymbol := #prettyPrint]. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!toggleRegularDiffing "Toggle whether regular-diffing should be shown in the code pane" | wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingRegularDiffs. self showRegularDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'misc' stamp: 'mt 3/23/2023 11:24'!refusesToAcceptCode "Answer whether receiver, given its current contentsSymbol, could accept code happily if asked to" ^ (#(byteCodes documentation) includes: self contentsSymbol)! !!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'!toggleDecompile "Toggle the setting of the showingDecompile flag, unless there are unsubmitted edits that the user declines to discard" | wasShowing | self okToChange ifTrue: [wasShowing := self showingDecompile. self showDecompile: wasShowing not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'!toggleShowDocumentation "Toggle the setting of the showingDocumentation flag, unless there are unsubmitted edits that the user declines to discard" | wasShowing | self okToChange ifTrue: [wasShowing := self showingDocumentation. self showDocumentation: wasShowing not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'!toggleShowingByteCodes "Toggle whether the receiver is showing bytecodes" self showByteCodes: self showingByteCodes not. self setContentsToForceRefetch. self contentsChanged! !!Command class methodsFor: 'dog simple ui' stamp: 'mt 7/31/2023 11:10'!undoRedoButtons "Answer a morph that offers undo and redo buttons" | wrapper | "self currentHand attachMorph: Command undoRedoButtons" wrapper := AlignmentMorph newColumn. wrapper color: Color veryVeryLightGray lighter; borderWidth: 0; layoutInset: 0; vResizing: #shrinkWrap; hResizing: #shrinkWrap. #((CrudeUndo undoLastCommand 'undo last command done' undoEnabled CrudeUndoDisabled CrudeUndoDisabled) (CrudeRedo redoNextCommand 'redo last undone command' redoEnabled CrudeRedoDisabled CrudeRedoDisabled)) do: [:tuple | | aButton | wrapper addTransparentSpacerOfSize: (8@0). aButton := UpdatingThreePhaseButtonMorph new. aButton onImage: (MenuIcons formAtKey: tuple first); offImage: (MenuIcons formAtKey: tuple fifth); pressedImage: (MenuIcons formAtKey: tuple sixth); getSelector: tuple fourth; color: Color transparent; target: self; actionSelector: tuple second; setNameTo: tuple second; setBalloonText: tuple third; extent: aButton onImage extent. wrapper addMorphBack: aButton. wrapper addTransparentSpacerOfSize: (8@0)]. ^ wrapper! !!Debugger methodsFor: 'toolbuilder' stamp: 'mt 3/10/2023 11:26'!buildNotifierWith: builder label: label message: messageString | windowSpec listSpec textSpec panelSpec quads | windowSpec := builder pluggableWindowSpec new model: self; extent: self initialExtentForNotifier; label: label asString; children: OrderedCollection new. panelSpec := builder pluggablePanelSpec new. panelSpec children: OrderedCollection new. quads := self preDebugButtonQuads. (self interruptedContext selector == #doesNotUnderstand:) ifTrue: [ quads := quads copyWith: { 'Create'. #createMethod. #magenta. 'create the missing method' } ]. (#(#notYetImplemented #shouldBeImplemented #requirement) includes: self interruptedContext selector) ifTrue: [ quads := quads copyWith: { 'Create'. #createImplementingMethod. #magenta. 'implement the marked method' } ]. (self interruptedContext selector == #subclassResponsibility) ifTrue: [ quads := quads copyWith: { 'Create'. #createOverridingMethod. #magenta. 'create the missing overriding method' } ]. quads do:[:spec| | buttonSpec | buttonSpec := builder pluggableButtonSpec new. buttonSpec model: self. buttonSpec label: spec first. buttonSpec action: spec second. buttonSpec help: spec fourth. spec size >= 5 ifTrue: [buttonSpec enabled: spec fifth]. panelSpec children add: buttonSpec. ]. panelSpec layout: #horizontal. "buttons" panelSpec frame: self preDebugButtonQuadFrame. windowSpec children add: panelSpec. messageString notNil ifFalse:[ listSpec := builder pluggableListSpec new. listSpec model: self; list: #contextStackList; getIndex: #contextStackIndex; setIndex: #debugAt:; icon: #messageIconAt:; helpItem: #messageHelpAt:; frame: self contextStackFrame. windowSpec children add: listSpec. ] ifTrue:[ message := messageString. textSpec := builder pluggableTextSpec new. textSpec model: self; getText: #preDebugMessageString; setText: nil; selection: nil; menu: #debugProceedMenu:; frame: self contextStackFrame. windowSpec children add: textSpec. ]. ^windowSpec! !!Debugger methodsFor: 'initialize' stamp: 'mt 3/10/2023 11:26'!preDebugButtonQuads ^{ {'Proceed' translated. #proceed. #blue. 'continue execution' translated. #interruptedProcessShouldResume}. self class showTerminateButton ifTrue: [ {'Terminate' translated. #terminateProcess. #black. 'terminate this execution and close this window' translated}]. self class showAbandonButton ifTrue: [ {'Abandon' translated. #abandon. #black. 'terminate this execution aggressively and close this window' translated}]. {'Debug' translated. #debug. #red. 'bring up a debugger' translated}} reject: [:quad | quad isNil]! !!DeepCopier methodsFor: 'like fullCopy' stamp: 'mt 3/10/2023 15:37'!checkBasicClasses "Check that no indexes of instance vars have changed in certain classes. If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated. The idea is to catch a change while it is still in the system of the programmer who made it. DeepCopier new checkVariables " | str objCls morphCls | str := '|veryDeepCopyWith: or veryDeepInner: is out of date.'. (objCls := self objInMemory: #Object) ifNotNil: [ objCls instSize = 0 ifFalse: [self error: 'Many implementers of veryDeepCopyWith: are out of date']]. (morphCls := self objInMemory: #Morph) ifNotNil: [ morphCls superclass == Object ifFalse: [self error: 'Morph', str]. (morphCls instVarNames copyFrom: 1 to: 6) = #('bounds' 'owner' 'submorphs' 'fullBounds' 'color' 'extension') ifFalse: [self error: 'Morph', str]]. "added ones are OK"! !!DeepCopier methodsFor: 'like fullCopy' stamp: 'mt 8/28/2023 15:08'!initialize: size references := IdentityDictionary new: size.! !!ExtendedClipboardUnixInterface methodsFor: 'general-api-read' stamp: 'mt 8/11/2023 15:20'!readHTMLClipboardData | bytes source | "Answer a HTMLDocument object" bytes := self readClipboardData: 'text/html'. (bytes beginsWith: '<!!DOCTYPE' asByteArray) ifTrue: ["BAD HACK for Abiword" source := bytes asString convertFromWithConverter: UTF8TextConverter new] ifFalse: ["BAD HACK for mozilla" source := bytes asString convertFromWithConverter: (UTF16TextConverter new useLittleEndian: SmalltalkImage current isLittleEndian)]. ^ source asTextFromHtml! !!FileList2 methodsFor: 'volume list and pattern' stamp: 'mt 8/16/2023 15:54'!listForPattern: pat "Make the list be those file names which match the pattern." | sizePad newList entries | directory ifNil: [^#()]. entries := directory entries. (fileSelectionBlock isKindOf: MessageSend) ifTrue: [ fileSelectionBlock arguments: {entries}. newList := fileSelectionBlock value. fileSelectionBlock arguments: #(). ] ifFalse: [ newList := entries select: [:entry | fileSelectionBlock value: entry value: pat]. ]. newList := newList asArray sort: self sortBlock. sizePad := (newList inject: 0 into: [:mx :entry | mx max: entry fileSize]) asStringWithCommas size - 1. ^newList collect: [ :e | self fileNameFormattedFrom: e sizePad: sizePad ]! !!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'!morphicViewGeneralLoaderInWorld: aWorld"FileList2 morphicViewGeneralLoaderInWorld: self currentWorld" | window aFileList buttons treePane textColor1 fileListPane pane2a pane2b fileTypeInfo fileTypeButtons fileTypeRow actionRow | fileTypeInfo := self endingSpecs. window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new directory: FileDirectory default. aFileList fileSelectionBlock: self projectOnlySelectionBlock; modalView: window. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1 px; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners. fileTypeButtons := fileTypeInfo collect: [ :each | (self blueButtonText: each first textColor: Color gray inWindow: window) setProperty: #enabled toValue: true; hResizing: #shrinkWrap; useSquareCorners ]. buttons := {{'OK'. Color lightGreen}. {'Cancel'. Color lightRed}} collect: [ :each | self blueButtonText: each first textColor: textColor1 color: each second inWindow: window ]. treePane := aFileList morphicDirectoryTreePane extent: 250 px @ 300 px; retractable: false; borderWidth: 0. fileListPane := aFileList morphicFileListPane extent: 350 px @ 300 px; retractable: false; borderWidth: 0. window addARow: {window fancyText: 'Find...' translated font: Preferences standardWindowTitleFont color: textColor1}. fileTypeRow := window addARowCentered: fileTypeButtons cellInset: 2 px. actionRow := window addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second } cellInset: 2 px. window addARow: { (window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2a fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). pane2b fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35)." buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]." fileTypeButtons do: [ :each | each on: #mouseUp send: #value:value: to: [ :evt :morph | self update: actionRow in: window fileTypeRow: fileTypeRow morphUp: morph. ] ]. buttons first on: #mouseUp send: #okHit to: aFileList. buttons second on: #mouseUp send: #cancelHit to: aFileList. aFileList postOpen. window position: aWorld topLeft + (aWorld extent - window extent // 2). aFileList directoryChangeBlock: [ :newDir | self update: actionRow in: window fileTypeRow: fileTypeRow morphUp: nil. self enableTypeButtons: fileTypeButtons info: fileTypeInfo forDir: newDir. ]. aFileList directory: aFileList directory. window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window openInWorld: aWorld.! !!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'!morphicViewProjectLoader2InWorld: aWorld reallyLoad: aBoolean dirFilterType: aSymbol | window aFileList buttons treePane textColor1 fileListPane pane2a pane2b treeExtent filesExtent | window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new. aFileList optionalButtonSpecs: aFileList servicesForProjectLoader; fileSelectionBlock: ( aSymbol == #limitedSuperSwikiDirectoryList ifTrue: [ MessageSend receiver: Project current selector: #latestProjectVersionsFromFileEntries: ] ifFalse: [ self projectOnlySelectionBlock ] ); "dirSelectionBlock: self hideSqueakletDirectoryBlock;" modalView: window. aFileList directory: FileDirectory default. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1 px; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners. buttons := {{'OK'. Color lightGreen}. {'Cancel'. Color lightRed}} collect: [ :each | self blueButtonText: each first textColor: textColor1 color: each second inWindow: window ]. aWorld width < 800 px ifTrue: [ treeExtent := 150 px @ 300 px. filesExtent := 350 px @ 300 px. ] ifFalse: [ treeExtent := 350 px @ 500 px. filesExtent := 550 px @500 px. ]. (treePane := aFileList morphicDirectoryTreePaneFiltered: aSymbol) extent: treeExtent; retractable: false; borderWidth: 0. fileListPane := aFileList morphicFileListPane extent: filesExtent; retractable: false; borderWidth: 0. window addARow: { window fancyText: 'Load A Project' translated font: Preferences standardWindowTitleFont color: textColor1 }; addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second }; addARow: { window fancyText: 'Please select a project' translated font: Preferences standardButtonFont color: textColor1 }; addARow: { (window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2a fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). pane2b fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35)." buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]." buttons first on: #mouseUp send: (aBoolean ifTrue: [#okHitForProjectLoader] ifFalse: [#okHit]) to: aFileList. buttons second on: #mouseUp send: #cancelHit to: aFileList. aFileList postOpen. window position: aWorld topLeft + (aWorld extent - window extent // 2). window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window openInWorld: aWorld.! !!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'!morphicViewProjectSaverFor: aProject"(FileList2 morphicViewProjectSaverFor: Project current) openInWorld" | window aFileList buttons treePane pane2 textColor1 option treeExtent buttonData buttonRow | textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new directory: ServerDirectory projectDefaultDirectory. aFileList dirSelectionBlock: self hideSqueakletDirectoryBlock. window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. aFileList modalView: window. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners. buttonData := Preferences enableLocalSave ifTrue: [{ {'Save'. #okHit. 'Save in the place specified below, and in the Squeaklets folder on your local disk'. Color lightGreen}. {'Save on local disk only'. #saveLocalOnlyHit. 'saves in the Squeaklets folder'. Color lightGreen}. {'Cancel'. #cancelHit. 'return without saving'. Color lightRed} }] ifFalse: [{ {'Save'. #okHit. 'Save in the place specified below, and in the Squeaklets folder on your local disk'. Color lightGreen}. {'Cancel'. #cancelHit. 'return without saving'. Color lightRed} }]. buttons := buttonData collect: [ :each | (self blueButtonText: each first textColor: textColor1 color: each fourth inWindow: window) setBalloonText: each third translated; hResizing: #shrinkWrap; on: #mouseUp send: each second to: aFileList ]. option := aProject world valueOfProperty: #SuperSwikiPublishOptions ifAbsent: [#initialDirectoryList]. aProject world removeProperty: #SuperSwikiPublishOptions. treeExtent := Project current world height < 500 px ifTrue: [ 350 px @ 150 px ] ifFalse: [ 350 px @ 300 px ]. (treePane := aFileList morphicDirectoryTreePaneFiltered: option) extent: treeExtent; retractable: false; borderWidth: 0. window addARowCentered: { window fancyText: 'Publish This Project' translated font: Preferences standardWindowTitleFont color: textColor1 }. buttonRow := OrderedCollection new. buttons do: [:button | buttonRow add: button] separatedBy: [buttonRow add: ((Morph new extent: 30 px @ 5 px) color: Color transparent)]." addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second. (Morph new extent: 30 px@ 5 px) color: Color transparent. buttons third };" window addARowCentered: buttonRow; addARowCentered: { (window inAColumn: {(ProjectViewMorph on: aProject) lock}) layoutInset: 4 px}; addARowCentered: { window fancyText: 'Please select a folder' translated font: Preferences standardButtonFont color: textColor1 }; addARow: { ( window inAColumn: { (pane2 := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) } ) layoutInset: 10 px }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2 fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35)." buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]." window morphicLayerNumber: window class dialogLayer. aFileList postOpen. window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window ! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:52'!defaultsQuadsDefiningStackToolsFlap "Answer a structure defining the items on the default system Stack Tools flap. previously in quadsDefiningStackToolsFlap" ^ { {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}. {#StackMorph. #stackHelpWindow. 'Stack Help' translatedNoop. 'Some hints about how to use Stacks' translatedNoop}. {#TextMorph . #authoringPrototype. 'Simple Text' translatedNoop. 'Text that you can edit into anything you wish' translatedNoop}. {#TextMorph . #fancyPrototype. 'Fancy Text' translatedNoop. 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop}. {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}. {#StackMorph. #previousCardButton. 'Previous Card' translatedNoop. 'A button that takes the user to the previous card in the stack' translatedNoop}. {#StackMorph. #nextCardButton. 'Next Card' translatedNoop. 'A button that takes the user to the next card in the stack' translatedNoop} } asOrderedCollection! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:52'!defaultsQuadsDefiningSuppliesFlap "Answer a list of quads which define the objects to appear in the default Supplies flap. previously in quadsDefiningSuppliesFlap" ^ { {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}. {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}. {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}. {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}. {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}. {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}. {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}. {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}. {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}. {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}. {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}. {#TabbedPalette. #authoringPrototype. 'TabbedPalette' translatedNoop. 'A structure with tabs' translatedNoop}. {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}. {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}. {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}. {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}} asOrderedCollection! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 14:38'!defaultsQuadsDefiningToolsFlap "Answer a structure defining the default Tools flap. previously in quadsDefiningToolsFlap" ^ OrderedCollection new addAll: #( (Browser prototypicalToolWindow 'Browser' 'A Browser is a tool that allows you to view all the code of all the classes in the system') (TranscriptStream openMorphicTranscript 'Transcript' 'A Transcript is a window usable for logging and debugging; browse references to #Transcript for examples of how to write to it.') (Workspace prototypicalToolWindow 'Workspace' 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.')); add: { FileList2 . #prototypicalToolWindow. 'File List'. 'A File List is a tool for browsing folders and files on disks and FTP servers.' }; addAll: #( (DualChangeSorter prototypicalToolWindow 'Change Sorter' 'Shows two change sets side by side') (SelectorBrowser prototypicalToolWindow 'Method Finder' 'A tool for discovering methods by providing sample values for arguments and results') (MessageNames prototypicalToolWindow 'Message Names' 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.') (PreferencesBrowser prototypicalToolWindow 'Preferences' 'Allows you to control numerous options') (Utilities recentSubmissionsWindow 'Recent' 'A message browser that tracks the most recently-submitted methods') (ProcessBrowser prototypicalToolWindow 'Processes' 'A Process Browser shows you all the running processes') (PackagePaneBrowser prototypicalToolWindow 'Packages' 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"') (ChangeSorter prototypicalToolWindow 'Change Set' 'A tool that allows you to view and manipulate all the code changes in a single change set')); yourself! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:53'!defaultsQuadsDefiningWidgetsFlap "Answer a structure defining the default Widgets flap. previously in quadsDefiningWidgetsFlap" ^ #( (TrashCanMorph new 'Trash' 'A tool for discarding objects') (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there') (GeeMailMorph new 'Gee-Mail' 'A place to present annotated content') (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.') (FrameRateMorph authoringPrototype 'FrameRate' 'An indicator of how fast your system is running') (MagnifierMorph newRound 'Magnifier' 'A magnifying glass') (ObjectsTool newStandAlone 'ObjectCatalog' 'A tool that lets you browse the catalog of objects') ) asOrderedCollection! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:50'!initializeFlapsQuads "initialize the list of dynamic flaps quads. self initializeFlapsQuads" FlapsQuads := nil. self registeredFlapsQuads at: 'Stack Tools' put: self defaultsQuadsDefiningStackToolsFlap; at: 'Supplies' put: self defaultsQuadsDefiningSuppliesFlap; at: 'Tools' put: self defaultsQuadsDefiningToolsFlap; at: 'Widgets' put: self defaultsQuadsDefiningWidgetsFlap. ^ self registeredFlapsQuads! !!Flaps class methodsFor: 'new flap' stamp: 'mt 8/4/2023 14:02'!addLocalFlap: anEvent titled: title onEdge: edge | flapTab menu world | flapTab := self newFlapTitled: title onEdge: edge. (world := anEvent hand world) addMorphFront: flapTab. menu := flapTab buildHandleMenu: anEvent hand. flapTab addTitleForHaloMenu: menu. flapTab computeEdgeFraction. menu popUpEvent: anEvent in: world.! !!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 8/10/2023 11:29'!addStandardFlaps "Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed. " SharedFlapTabs ifNil: [SharedFlapTabs := OrderedCollection new]. SharedFlapTabs add: self newSqueakFlap. SharedFlapTabs add: self newSuppliesFlap. SharedFlapTabs add: self newToolsFlap. SharedFlapTabs add: self newWidgetsFlap. SharedFlapTabs add: self newStackToolsFlap. Preferences showProjectNavigator ifTrue:[SharedFlapTabs add: self newNavigatorFlap]. SharedFlapTabs add: self newObjectsFlap. self disableGlobalFlapWithID: 'Stack Tools' translated. Preferences showProjectNavigator ifTrue:[self disableGlobalFlapWithID: 'Navigator' translated]. ^ SharedFlapTabs! !!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 7/31/2023 11:11'!newSqueakFlap "Answer a new default 'Squeak' flap for the left edge of the screen" | aFlap aFlapTab aButton aClock buttonColor anOffset bb aFont | aFlap := PasteUpMorph newSticky borderWidth: 0. aFlapTab := FlapTab new referent: aFlap. aFlapTab setName: 'Squeak' translated edge: #left color: Color brown lighter lighter. aFlapTab position: (0 @ ((Display height - aFlapTab height) // 2)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. aFlap cellInset: 14@14. aFlap beFlap: true. aFlap color: (Color brown muchLighter lighter "alpha: 0.3"). aFlap extent: 150 @ self currentWorld height. aFlap layoutPolicy: TableLayout new. aFlap wrapCentering: #topLeft. aFlap layoutInset: 2. aFlap listDirection: #topToBottom. aFlap wrapDirection: #leftToRight. "self addProjectNavigationButtonsTo: aFlap." anOffset := 16. aClock := ClockMorph newSticky. aClock color: Color red. aClock showSeconds: false. aClock font: (TextStyle default fontAt: 3). aClock step. aClock setBalloonText: 'The time of day. If you prefer to see seconds, check out my menu.' translated. aFlap addCenteredAtBottom: aClock offset: anOffset. buttonColor := Color cyan muchLighter. bb := SimpleButtonMorph new target: Smalltalk. bb color: buttonColor. aButton := bb copy. aButton actionSelector: #saveSession. aButton setBalloonText: 'Make a complete snapshot of the current state of the image onto disk.' translated. aButton label: 'save' translated font: (aFont := Preferences standardButtonFont). aFlap addCenteredAtBottom: aButton offset: anOffset. aButton := bb copy target: MCMcmUpdater. aButton actionSelector: #updateFromServer. aButton label: 'load code updates' translated font: aFont. aButton color: buttonColor. aButton setBalloonText: 'Check the Squeak server for any new code updates, and load any that are found.' translated. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton := SimpleButtonMorph new target: Smalltalk; actionSelector: #aboutThisSystem; label: 'about this system' translated font: aFont. aButton color: buttonColor. aButton setBalloonText: 'click here to find out version information' translated. aFlap addCenteredAtBottom: aButton offset: anOffset. aFlap addCenteredAtBottom: (Preferences themeChoiceButtonOfColor: buttonColor font: aFont) offset: anOffset. aButton := TrashCanMorph newSticky. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton startStepping. ^ aFlapTab"Flaps replaceGlobalFlapwithID: 'Squeak' translated "! !!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 8/28/2023 14:29'!newSuppliesFlapFromQuads: quads positioning: positionSymbol "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen. Use #center as the positionSymbol to have it centered at the bottom of the screen, or #right to have it placed off near the right edge." | aFlapTab aStrip hPosition | aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: quads. "self twiddleSuppliesButtonsIn: aStrip." aFlapTab := FlapTab new referent: aStrip beSticky. aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter. hPosition := positionSymbol == #center ifTrue: [(Display width // 2) - (aFlapTab width // 2)] ifFalse: [Display width - (aFlapTab width + 22)]. aFlapTab position: (hPosition @ (self currentWorld height - aFlapTab height)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. aStrip extent: self currentWorld width @ 136. aStrip beFlap: true. aStrip autoLineLayout: true. ^ aFlapTab"Flaps replaceGlobalFlapwithID: 'Supplies' translated"! !!Flaps class methodsFor: 'replacement' stamp: 'mt 8/4/2023 15:19'!replaceGlobalFlapwithID: flapID "If there is a global flap with flapID, replace it with an updated one." | replacement tabs | (tabs := self globalFlapTabsWithID: flapID) size = 0 ifTrue: [^ self]. tabs do: [:tab | self removeFlapTab: tab keepInList: false]. flapID = 'Stack Tools' translated ifTrue: [replacement := self newStackToolsFlap]. flapID = 'Supplies' translated ifTrue: [replacement := self newSuppliesFlap]. flapID = 'Tools' translated ifTrue: [replacement := self newToolsFlap]. flapID = 'Widgets' translated ifTrue: [replacement := self newWidgetsFlap]. flapID = 'Navigator' translated ifTrue: [replacement := self newNavigatorFlap]. flapID = 'Squeak' translated ifTrue: [replacement := self newSqueakFlap]. replacement ifNil: [^ self]. self addGlobalFlap: replacement. self currentWorld ifNotNil: [self currentWorld addGlobalFlaps]"Flaps replaceFlapwithID: 'Widgets' translated "! !!FontSubstitutionDuringLoading methodsFor: 'accessing' stamp: 'mt 8/11/2023 13:59'!defaultAction familyName ifNil: [ familyName := 'NoName' ]. pixelSize ifNil: [ pixelSize := 12 ]. ^((familyName beginsWith: 'Comic') ifTrue: [ TextStyle named: (Preferences standardDefaultTextFont familyName) ] ifFalse: [ TextStyle default ]) fontOfSize: pixelSize.! !!Form methodsFor: 'converting' stamp: 'mt 8/16/2023 16:54'!blendColor: aTranslucentColor | form canvas | form := self deepCopy asFormOfDepth: 32. canvas := form getCanvas. canvas stencil: form at: 0 @ 0 sourceRect: (0 @ 0 extent: form extent) color: aTranslucentColor. ^ canvas form! !!Form methodsFor: 'scaling, rotation' stamp: 'sw 4/16/2008 00:13'!scaledToHeight: newHeight "Answer the receiver, scaled such that it has the desired height." newHeight = self height ifTrue: [^ self]. ^self magnify: self boundingBox by: (newHeight / self height) smoothing: 2.! !!Form methodsFor: 'scaling, rotation' stamp: 'ct 9/17/2019 18:50'!scaledToWidth: newWidth "Answer the receiver, scaled such that it has the desired width." newWidth = self width ifTrue: [^ self]. ^self magnify: self boundingBox by: (newWidth / self width) smoothing: 2.! !!Form class methodsFor: '*MorphicExtras-examples' stamp: 'mt 8/14/2023 16:21'!gridFormExample "Original was in Morph
#setStandardTexture and #textureParameters and #makeGraphPaperGrid:... Morph new color: Form gridFormExample; extent: 500@500; openInHand " ^ self gridFormOrigin: 0@0 grid: 16 px background: Color black line: Color lightGreen lighter lighter ! !!Form class methodsFor: '*MorphicExtras-sprites' stamp: 'mt 8/14/2023 16:20'!gridFormOrigin: origin grid: smallGrid background: backColor line: lineColor | bigGrid gridForm gridOrigin | gridOrigin := origin \ smallGrid. bigGrid := (smallGrid asPoint x) @ (smallGrid asPoint y). gridForm := Form extent: bigGrid depth: Display depth. backColor ifNotNil: [gridForm fillWithColor: backColor]. gridOrigin x to: gridForm width by: smallGrid asPoint x do: [:x | gridForm fill: (x@0 extent: 1@gridForm height) fillColor: lineColor]. gridOrigin y to: gridForm height by: smallGrid asPoint y do: [:y | gridForm fill: (0@y extent: gridForm width@1) fillColor: lineC
olor]. ^ InfiniteForm with: gridForm! !!GetTextExporter class methodsFor: 'utilities' stamp: 'mt 8/4/2023 13:49'!listAllHelp "self listAllHelp" | spec specs oCatalog flap flapSelectors allKeys oCatalogHelp flapHelp | oCatalog := Dictionary new. Morph withAllSubclasses do: [:aClass | (aClass class includesSelector: #descriptionForPartsBin) ifTrue: [spec := aClass descriptionForPartsBin. oCatalog at: spec formalName put: spec documentation]]. Morph withAllSubclasses do: [:aClass | (aClass class includesSelector: #supplementaryPartsDescriptions) ifTrue: [specs := aClass supplementaryPartsDescriptions. specs do: [:each | oCatalog at: each formalName put: each documentation]]]. flap := Dictionary new. flapSelectors := #( #defaultsQuadsDefiningStackToolsFlap #defaultsQuadsDefiningSuppliesFlap #defaultsQuadsDefiningToolsFlap #defaultsQuadsDefiningWidgetsFlap ). flapSelectors do: [:selector | specs := Flaps perform: selector. specs do: [:each | flap at: each third put: each fourth]]. allKeys := oCatalog keys intersection: flap keys. allKeys asArray sort do: [:each | oCatalogHelp := oCatalog at: each ifAbsent: ['']. flapHelp := flap at: each ifAbsent: ['']. oCatalogHelp = flapHelp ifFalse: [Transcript cr; show: 'Name: ' , each. Transcript cr; show: 'O: ' , oCatalogHelp. Transcript cr; show: 'F: ' , flapHelp. Transcript cr.]]! !!ImageSegment methodsFor: 'fileIn' stamp: 'mt 8/16/2023 16:51'!declareAndPossiblyRename: classThatIsARoot | existing catInstaller | "The class just arrived in this segment. How fit it into the Smalltalk dictionary? If it had an association, that was ins talled with associationDeclareAt:." catInstaller := [ classThatIsARoot category: Object categoryForUniclasses. ]. classThatIsARoot superclass addSubclass: classThatIsARoot. (Smalltalk includesKey: classThatIsARoot name) ifFalse: [ "Class entry in Smalltalk not referred to in Segment, install anyway." catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. existing := Smalltalk at: classThatIsARoot name. existing xxxClass == ImageSegmentRootStub ifTrue: [ "We are that segment!! Must ask it carefully!!" catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. existing == false | (existing == nil) ifTrue: [ "association is in outPointers, just installed" catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. "Conflict with existing global or copy of the class" (existing isKindOf: Class) ifTrue: [ classThat IsARoot isSystemDefined not ifTrue: [ "UniClass. give it a new name" classThatIsARoot setName: MorphicModel chooseUniqueClassName. catInstaller value. "must be after new name" ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. "Take the incoming one" self inform: 'Using newly arrived version of ', classThatIsARoot name. classThatIsARoot superclass removeSubclass: classThatIsARoot. "just in case" (Smalltalk at: classThatIsARoot name) becomeForward: classThatIsARoot. catInstaller value. ^ classThatIsARoot superclass addSubclass: classThatIsARoot]. self error: 'Name already in use by a non-class: ', classThatIsARoot name.! !!ImageSegment class methodsFor: 'fileIn/Out' stamp: 'mt 8/28/2023 15:10'!copyFromRootsLocalFileFor: rootArray sizeHint: segSize ^ NativeImageSegment new copyFromRootsLocalFileFor: rootArray sizeHint: segSize! !!Inspector methodsFor: 'menu' stamp: 'mt 8/28/202 3 14:33'!inspectorKey: aChar from: view "Respond to a Command key issued while the cursor is over my field list" ^ aChar caseOf: { [$x] -> [self removeSelection]. [$i] -> [self inspectSelection]. [$I] -> [self exploreSelection]. [$b] -> [self browseClass]. [$h] -> [self browseClassHierarchy]. [$p] -> [self browseFullProtocol]. [$r] -> [self browseVariableReferences]. [$a] -> [self browseVariableAssignments]. [$N] -> [self browseClassRefs]. [$c] -> [self copyName] } otherwise: [self arrowKey: aChar from: view]! !!Inspector methodsFor: 'menu' stamp: 'mt 3/10/2023 15:12'!mainFieldListMenu: aMenu "Arm the supplied menu with items for the field-list of the receiver" <fieldListMenu> aMenu addStayUpItemSpecial. self addObjectItemsTo: aMenu. (#(self ellipsis element nil) includes: self typeOfSelection) ifTrue: [self addCollectionItemsTo: aMenu]. self typeOfSelection = #instVar ifTrue: [self addInstVarItemsTo: aMenu]. self addFieldItemsTo: aMenu. self addClassItemsTo: aMenu. ^ aMenu! !!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 7/31/2023 10:45'!formAtKey: aString "Answer the form saved under the given key" ^(Symbol lookup: aString) ifNotNil: [ :aKey | ScriptingIcons at: aKey ifAbsent: [ self blankIcon ] ] ifNil: [ self blankIcon ]! !!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:08'!formPressedAtKey: aSymbol "Answer the form for pressed button. It is automatically generated if unavailable." "(ScriptingSystem formPressedAtKey: #TryIt) asMorph openInHand" | pressedName pressedImage | pressedName := (aSymbol , 'Pressed') asSymbol. ((ScriptingIcons includesKey: aSymbol) and: [(ScriptingIcons includesKey: pressedName) not])
ifTrue: [pressedImage := ((self formAtKey: aSymbol) blendColor: (Color black alpha: 0.3)) colorReduced. ScriptingIcons at: pressedName put: pressedImage]. ^ self formAtKey: pressedName! !!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:11'!saveForm: aForm atKey: aKey ScriptingIcons at: aKey asSymbol put: aForm! !!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:05'!scriptingIcons ^ ScriptingIcons ifNil: [ScriptingIcons := IdentityDictionary new]! !!MessageSet methodsFor: 'filtering' stamp: 'mt 8/28/2023 15:11'!filterMessageList "Allow the user to refine the list of messages." | builder menuSpec | builder := ToolBuilder default. menuSpec := builder pluggableMenuSpec new model: self; yourself. menuSpec addList: #( ('unsent messages' filterToUnsentMessages 'filter to show only messages that have no senders') - ('messages that send...' filterToSendersOf 'filter to show only messages that send a selector I specify') ('messages that do not send...' filterToNotSendersOf 'filter to show only messages that do not send a selector I specify') - ('messages whose selector is...' filterToImplementorsOf 'filter to show only messages with a given selector I specify') ('messages whose selector is NOT...' filterToNotImplementorsOf 'filter to show only messages whose selector is NOT a seletor I specify') - ('messages in current change set' filterToCurrentChangeSet 'filter to show only messages that are in the current change set') ('messages not in current change set' filterToNotCurrentChangeSet 'filter to show only messages that are not in the current change set') - ('messages in any change set' filterToAnyChangeSet 'filter to show only messages that occur in at least one change set') ('messages not in any change set' filterToNotAnyChangeSet 'filter to show only messages that do not occur in any change set in the system') - ('messages authored by me' filterToCurrentAuthor 'filter to show only messages whose authoring stamp has my initials') ('messages not authored by me' filterToNotCurrentAuthor 'filter to show only messages whose authoring stamp does not have my initials') - ('messages logged in .changes file' filterToMessagesInChangesFile 'filter to show only messages whose latest source code is logged in the .changes file') ('messages only in .sources file' filterToMessagesInSourcesFile 'filter to show only messages whose latest source code is logged in the .sources file') - ('messages with prior versions' filterToMessagesWithPriorVersions 'filter to show only messages that have at least one prior version') ('messages without prior versions' filterToMessagesWithoutPriorVersions 'filter to show only messages that have no prior versions') - ('uncom mented messages' filterToUncommentedMethods 'filter to show only messages that do not have comments at the beginning') ('commented messages' filterToCommentedMethods 'filter to show only messages that have comments at the beginning') - ('messages in hardened classes' filterToMessagesWithHardenedClasses 'filter to show only messages of established classes (as opposed to Uniclasses such as MorphicModel23)') - ('methods in classes with matching names' filterToMatchingClassesNames 'filter to show only methods of classes with names that match the given criteria (wildcards are allowed)') ('methods in package...' filterToPackage 'filter to show only methods of a given package') ('methods not in package...' filterToNotPackage 'filter to show only methods not of a given package') - ('messages that...' filterToMessagesThat 'let me type in a block taking a class and a selector, which will specify yea or nay concerning which element s should remain in the list')). builder runModal: (builder open: menuSpec).! !!Lexicon methodsFor: 'toolbuilder' stamp: 'mt 7/31/2023 11:13'!addSpecialButtonsTo: buttonPanelSpec with: builder | homeCatBtnSpec menuBtnSpec mostGenericBtnSpec | homeCatBtnSpec := builder pluggableButtonSpec new model: self; action: #showHomeCategory; label: MenuIcons smallHomeIcon scaleIconToDisplay; help: 'show this method''s home category'; yourself. menuBtnSpec := builder pluggableButtonSpec new model: self; action: #offerMenu; label: (MenuIcons formAtKey: #TinyMenu) asMorph; help: 'click here to get a menu with further options'; yourself. mostGenericBtnSpec :=builder pluggableButtonSpec new model: self; action: #chooseLimitClass; label: #limitClassString; help: 'Governs which classes'' methods should be shown. If this is the same as the viewed class, then only methods implemented in that c lass will be shown. If it is ProtoObject, then methods of all classes in the vocabulary will be shown.'. buttonPanelSpec children add: homeCatBtnSpec; addFirst: mostGenericBtnSpec; addFirst: menuBtnSpec.! !!InstanceBrowser methodsFor: 'menu commands' stamp: 'mt 8/16/2023 16:52'!offerMenu "Offer a menu to the user, in response to the hitting of the menu button on the tool pane" | aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu title: ('Messages of {1}' translated format: {objectViewed nameForViewer}). aMenu addStayUpItem. aMenu addTranslatedList: #( ('vocabulary...' chooseVocabulary) ('what to show...' offerWhatToShowMenu) - ('inst var refs (here)' setLocalInstVarRefs) ('inst var defs (here)' setLocalInstVarDefs) ('class var refs (here)' setLocalClassVarRefs) - ('navigate to a sender...' navigateToASender) ('recent...'
navigateToRecentMethod) ('show methods in current change set' showMethodsInCurrentChangeSet) ('show methods with initials...' showMethodsWithInitials) - "('toggle search pane' toggleSearch)" - - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' browseClassHierarchy) ('browse protocol (p)' browseFullProtocol) - ('fileOut' fileOutMessage) ('printOut' printOutMessage) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('versions (v)' browseVersions) ('inheritance (i)' methodHierarchy) - ('references... (r)' browseVariableReferences) ('assignments... (a)' browseVariableAssignments) - ('inspector on me' inspectViewee) - ('more...' shiftedYellowButtonActivity)). ^ aMenu popUpInWorld: self currentWorld! !!MethodCall methodsFor: 'initialization' stamp: 'mt 8/28/2023 14:54'!receiver: aReceiver methodInterface: aMethodInterface "Initialize me to have the given receiver and methodInterface" receiver := aReceiver. selector := aMethodInterface selector. methodInterface := aMethodInterface. arguments := aMethodInterface defaultArguments. lastValue := nil.! !!MethodFinder methodsFor: 'initialize' stamp: 'mt 3/10/2023 15:58'!initialize "The methods we are allowed to use. (MethodFinder new initialize) " Approved := Set new. AddAndRemove := Set new. Blocks := Set new. "These modify an argument and are not used by the MethodFinder: longPrintOn: printOn: storeOn: sentTo: storeOn:base: printOn:base: absPrintExactlyOn:base: absPrintOn:base: absPrintOn:base:digitCount: writeOn: writeScanOn: possibleVariablesFor:continuedFrom: printOn:format:""Object" #("in class, instance creation" categoryForUniclasses chooseUniqueClassName initialInstance isSystemDefined newFrom: officialClass readCarefullyFrom:"accessing" at: basicAt: basicSize bindWithTemp: in: size yourself "testing" basicType ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: isColor isFloat isFraction isInMemory isInteger isMorph isNil isNumber isPoint isText isTransparent isWebBrowser knownName notNil pointsTo: wantsSteps "comparing" = == closeTo: hash identityHash identityHashPrintString ~= ~~ "copying" copy shallowCopy "dependents access" canDiscardEdits dependents hasUnacceptedEdits "updating" changed changed: okToChange update: windowIsClosing "printing" fullPrintString isLiteral longPrintString printString storeString stringForReadout stringRepresentation "class membership" class isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass "error han dling" "user interface" addModelMenuItemsTo:forMorph:hand: defaultLabelForInspector fullScreenSize initialExtent modelWakeUp mouseUpBalk: newTileMorphRepresentative windowActiveOnFirstClick windowReqNewLabel: "system primitives" asOop instVarAt: instVarNamed: "private" "associating" -> "converting" as: asOrderedCollection asString "casing" caseOf: caseOf:otherwise: "binding" bindingOf: "macpal" contentsChanged currentEvent currentHand currentWorld flash instanceVariableValues "flagging" flag: "translation support" "objects from disk" "finalization" ) do: [:sel | Approved add: sel]. #(at:add: at:modify: at:put: basicAt:put: "NOT instVar:at:""message handling" perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: ) do: [:sel | AddAndRemove add: sel]."Boolean, True, False, UndefinedObject" #("logical operations" & eqv: not xor: |"controlling" and: ifFalse: ifFalse:ifTrue: ifTrue: ifTrue:ifF alse: or:"copying" "testing" isEmptyOrNil) do: [:sel | Approved add: sel]."Behavior" #("initialize-release""accessing" compilerClass decompilerClass evaluatorClass format methodDict parserClass sourceCodeTemplate subclassDefinerClass"testing" instSize instSpec isBits isBytes isFixed isPointers isVariable isWeak isWords"copying""printing" printHierarchy"creating class hierarchy""creating method dictionary""instance creation" basicNew basicNew: new new:"accessing class hierarchy" allSubclasses allSubclassesWithLevelDo:startingLevel: allSuperclasses subclasses superclass withAllSubclasses withAllSuperclasses"accessing method dictionary" allSelectors changeRecordsAt: compiledMethodAt: compiledMethodAt:ifAbsent: firstCommentAt: lookupSelector: selectors selectorsDo: selectorsWithArgs: "slow but useful ->" sourceCodeAt: sourceCodeAt:ifAbsent: sourceMethodAt: sourceMethodAt:ifAbsent:"accessing instances and variables" allClassVarNames allInstVarNames allSharedPools classVarNames instV arNames instanceCount sharedPools someInstance subclassInstVarNames"testing class hierarchy" inheritsFrom: kindOfSubclass"testing method dictionary" canUnderstand: classThatUnderstands: hasMethods includesSelector: whichClassIncludesSelector: whichSelectorsAccess: whichSelectorsReferTo: whichSelectorsReferTo:special:byte: whichMethodsStoreInto:"enumerating""user interface") do: [:sel | Approved add: sel]."ClassDescription" #("initialize-release" "accessing" classVersion isMeta name theNonMetaClass"copying" "printing" classVariablesString instanceVariablesString sharedPoolsString"instance variables" checkForInstVarsOK: "method dictionary" "organization" category organization whichCategoryIncludesSelector:"compiling" acceptsLoggingOfCompilation wantsChangeSetLogging"fileIn/Out" definition"private" ) do: [:sel | Approved add: sel]."Class" #("initialize-release" "accessing" classPool"testing""copying" "class name" "instance variables" "class variables" classVarAt: classVariableAssociationAt:"pool variables" "compiling" "subclass creation" "fileIn/Out" ) do: [:sel | Approved add: sel]. "Metaclass" #("initialize-release" "accessing" isSystemDefined soleInstance"copying" "instance creation" "instance variables" "pool variables" "class hierarchy" "compiling""fileIn/Out" nonTrivial ) do: [:sel | Approved add: sel]."Context, BlockContext" #(receiver client method receiver tempAt: "debugger access" pc selector sender shortStack sourceCode tempNames tempsAndValues"controlling" "printing" "system simulation" "initialize-release" "accessing" hasMethodReturn home numArgs"evaluating" value value:ifError: value:value: value:value:value: value:value:value:value: valueWithArguments:"controlling" "scheduling" "instruction decoding" "printing" "private" "system simulation" ) do: [:sel | Approved add: sel]. #(value: "<- Association has it as a store" ) do: [:sel | AddAndRemove add: sel]."Message" #("inclass, instance creation" select or: selector:argument: selector:arguments:"accessing" argument argument: arguments sends:"printing" "sending" ) do: [:sel | Approved add: sel]. #("private" setSelector:arguments:) do: [:sel | AddAndRemove add: sel]."Magnitude" #("comparing" < <= > >= between:and:"testing" max: min: min:max: ) do: [:sel | Approved add: sel]."Date, Time" #("in class, instance creation" fromDays: fromSeconds: fromString: newDay:month:year: newDay:year: today "in class, general inquiries" dateAndTimeNow dayOfWeek: daysInMonth:forYear: daysInYear: firstWeekdayOfMonth:year: indexOfMonth: leapYear: nameOfDay: nameOfMonth:"accessing" day leap monthIndex monthName weekday year"arithmetic" addDays: subtractDate: subtractDays:"comparing""inquiries" dayOfMonth daysInMonth daysInYear daysLeftInYear firstDayOfMonth previous:"converting" asSeconds"printing" mmddyyyy printFormat: "private" weekdayIndex "in class, instance creation" fromSeconds: now "in class, general inquiries" dateAndTimeFromSeconds: dateAndTimeNow millisecondClockValue millisecondsToRun: totalSeconds"accessing" hours minutes seconds"arithmetic" addTime: subtractTime:"comparing""printing" intervalString print24 "converting") do: [:sel | Approved add: sel]. #("private" ) do: [:sel | AddAndRemove add: sel]."Number" #("in class" readFrom:base: "arithmetic" * + - / // \ abs negated quo: reciprocal rem:"mathematical functions" arcCos arcSin arcTan arcTan: cos exp floorLog: ln log log: raisedTo: raisedToInteger: sin sqrt squared tan"truncation and round off" ceiling detentBy:atMultiplesOf:snap: floor roundTo: roundUpTo: rounded truncateTo: truncated"comparing""testing" even isDivisibleBy: isInfinite isNaN isZero negative odd positive sign strictlyPositive"converting" @ asInteger asNumber asPoint asSmallAngleDegrees degreesToRadians radiansToDegrees"intervals" to: to:by: "printing" printStringBase: storeStringBase: ) do: [:sel | Approved add: sel]."Integer" #("in class" primesUpTo:"testing" isPowerOfTwo"arithmetic" alignedTo:"comparing""truncation and round off" atRandom normalize"enumerating" timesRepeat:"mathematical functions" degreeCos degreeSin factorial gcd: lcm: take:"bit manipulation" << >> allMask: anyMask: bitAnd: bitClear: bitInvert bitInvert32 bitOr: bitShift: bitXor: lowBit noMask:"converting" asCharacter asColorOfDepth: asFloat asFraction asHexDigit"printing" asStringWithCommas hex hex8 radix:"system primitives" lastDigit replaceFrom:to:with:startingAt:"private" "benchmarks" ) do: [:sel | Approved add: sel]."SmallInteger, LargeNegativeInteger, LargePositiveInteger" #("arithmetic" "bit manipulation" highBit "testing" "comparing" "copying" "converting" "printing" "system primitives" digitAt: digitLength "private" fromString:radix: ) do: [:sel | Approved add: sel]. #(digitAt:put: ) do: [:sel | AddAndRemove add: sel]."Float" #("arithmetic""mathematical functions" reciprocalLogBase2 timesTwoPower:"comparing" "testing""trunc ation and round off" exponent fractionPart integerPart significand significandAsInteger"converting" asApproximateFraction asIEEE32BitWord asTrueFraction"copying") do: [:sel | Approved add: sel]."Fraction, Random" #(denominator numerator reduced next nextValue) do: [:sel | Approved add: sel]. #(setNumerator:denominator:) do: [:sel | AddAndRemove add: sel]."Collection" #("accessing" anyOne"testing" includes: includesAllOf: includesAnyOf: includesSubstringAnywhere: isEmpty isSequenceable occurrencesOf:"enumerating" collect: collect:thenSelect: count: detect: detect:ifNone: detectMax: detectMin: detectSum: inject:into: reject: select: select:thenCollect: intersection:"converting" asBag asCharacterSet asSet asSortedArray asSortedCollection asSortedCollection:"printing""private" maxSize"arithmetic""math functions" average max median min range sum) do: [:sel | Approved add: sel]. #("adding" add: addAll: addIfNotPresent:"removing" remove: remove:ifAbsent: removeAll: removeAllFo undIn: removeAllSuchThat: remove:ifAbsent:) do: [:sel | AddAndRemove add: sel]."SequenceableCollection" #("comparing" hasEqualElements:"accessing" allButFirst allButLast at:ifAbsent: atAll: atPin: atRandom: atWrap: fifth first fourth identityIndexOf: identityIndexOf:ifAbsent: indexOf: indexOf:ifAbsent: indexOf:startingAt:ifAbsent: indexOfSubCollection:startingAt: indexOfSubCollection:startingAt:ifAbsent: last second sixth third"removing""copying" , copyAfterLast: copyAt:put: copyFrom:to: copyReplaceAll:with: copyReplaceFrom:to:with: copyUpTo: copyUpToLast: copyWith: copyWithout: copyWithoutAll: forceTo:paddingWith: shuffled sorted:"enumerating" withIndexCollect: findFirst: findLast: pairsCollect: with:collect: withIndexCollect: polynomialEval:"converting" asArray asDictionary asFloat32Array asFloat64Array asIntegerArray asStringWithCr asWordArray reversed"private" copyReplaceAll:with:asTokens: ) do: [:sel | Approved add: sel]. #( swap:with:) do: [:sel | AddAndRemove add: sel]."ArrayedCollection, Bag" #("private" defaultElement "sorting" isSorted"accessing" cumulativeCounts sortedCounts sortedElements "testing" "adding" add:withOccurrences: "removing" "enumerating" ) do: [:sel | Approved add: sel]. #( mergeSortFrom:to:by: sort sort: add: add:withOccurrences:"private" setDictionary ) do: [:sel | AddAndRemove add: sel]."Other messages that modify the receiver" #(atAll:put: atAll:putAll: atAllPut: atWrap:put: replaceAll:with: replaceFrom:to:with: removeFirst removeLast) do: [:sel | AddAndRemove add: sel]. self initialize2."MethodFinder new initialize.MethodFinder new organizationFiltered: Set"! !!MissingFont methodsFor: 'handling' stamp: 'mt 3/7/2023 15:07'!defaultAction familyName ifNil: [ familyName := 'NoName' ]. pixelSize ifNil: [ pixelSize := 12 ]. ^((familyName beginsWith: 'Comic') ifTrue: [ TextStyle named: (Preferences standardButtonFont familyName) ] ifFalse: [ TextStyle default ]) fontOfSize: pixe lSize.! !!Morph methodsFor: 'accessing' stamp: 'mt 8/11/2023 16:29'!balloonText "Answer balloon help text or nil, if no help is available." "NB: subclasses may override such that they programatically construct the text, for economy's sake, such as model phrases in a Viewer." | balloonSelector | extension ifNil: [^ nil]. extension balloonText ifNotNil: [:balloonText | ^ balloonText]. balloonSelector := extension balloonTextSelector ifNil: [^ nil]. balloonSelector isUnary ifTrue: [ (self respondsTo: balloonSelector) ifTrue: [^ self perform: balloonSelector]. (self model respondsTo: balloonSelector) ifTrue: [^ self model perform: balloonSelector]]. ^ nil! !!Morph methodsFor: 'copying' stamp: 'mt 3/10/2023 14:51'!duplicate "Make and return a duplicate of the receiver" | newMorph aName w topRend | ((topRend := self topRendererOrSelf) ~~ self) ifTrue: [^ topRend duplicate]. self okayToDuplicate ifFalse: [^ self]. aName := (w := self world) ifNotNil: [w nameForCopyIfAlreadyNamed: self]. newMorph := self veryDeepCopy. aName ifNotNil: [newMorph setNameTo: aName]. newMorph arrangeToStartStepping. newMorph privateOwner: nil. "no longer in world" newMorph isPartsDonor: false. "no longer parts donor" ^ newMorph! !!Morph methodsFor: 'debug and other' stamp: 'mt 3/10/2023 15:09'!buildDebugMenu: aHand "Answer a debugging menu for the receiver. The hand argument is seemingly historical and plays no role presently" | aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu addStayUpItem. (self hasProperty: #errorOnDraw) ifTrue: [aMenu add: 'start drawing again' translated action: #resumeAfterDrawError. aMenu addLine]. (self hasProperty: #errorOnStep) ifTrue: [aMenu add: 'start stepping again' translated action: #resumeAfterStepError. aMenu addLine]. (self hasProperty: #errorOnLayout) ifTrue: [aMenu add: 'start layouting again' translated action: #resumeAfterLayoutError. aMenu addLine]. aMenu add: 'inspect morph' translated action: #inspectInMorphic:. aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain. Smalltalk isMorphic ifFalse: [aMenu add: 'inspect morph (in MVC)' translated action: #inspect]. self isMorphicModel ifTrue: [aMenu add: 'inspect model' translated target: self model action: #inspect; add: 'explore model' translated target: self model action: #explore]. aMenu add: 'explore morph' translated target: self selector: #exploreInMorphic:. aMenu addLine. aMenu add: 'browse morph class' translated target: self selector: #browseHierarchy. (self isMorphicModel) ifTrue: [aMenu add: 'browse model class' target: self model selector: #browseHierarchy]. aMenu addLine. self addViewingItemsTo: aMenu. aMenu add: 'make own subclass' translated action: #subclassMorph; add: 'save morph in file' translated action: #saveOnFile; addLine; add: 'call #tempCommand' translated action: #tempCommand; add: 'define #tempCommand' translated action: #defineTempCommand; addLine; add: 'control-menu...' translated target: self selector: #invokeMetaMenu:; add: 'edit balloon help' translated action: #editBalloonHelpText. ^ aMenu! !!Morph methodsFor: 'debug and other' stamp: 'mt 8/16/2023 17:11'!deleteAnyMouseActionIndicators self changed. (self valueOfProperty: #mouseActionIndicatorMorphs ifAbsent: [#()]) do: [ :each | each delete "one is probably enough, but be safe" ]. self removeProperty: #mouseActionIndicatorMorphs. self hasRolloverBorder: false. self removeProperty: #rolloverWidth. self removeProperty: #rolloverColor. self layoutChanged. self changed.! !!Morph methodsFor: 'dropping/grabbing' stamp: 'mt 8/4/2023 14:49'!justDroppedInto: aMorph event: anEvent "This message is sent to a dropped morph after it has been dropped on -- and been accepted by -- a drop-sensitive morph" | partsBinCase cmd | (self formerOwner notNil and: [self formerOwner ~~ aMorph]) ifTrue: [self removeHalo]. self formerOwner: nil. self formerPosition: nil. cmd := self valueOfProperty: #undoGrabCommand. cmd ifNotNil:[aMorph rememberCommand: cmd. self removeProperty: #undoGrabCommand]. (partsBinCase := aMorph isPartsBin) ifFalse: [self isPartsDonor: false]. (self isInWorld and: [partsBinCase not]) ifTrue: [self world startSteppingSubmorphsOf: self]. "Note an unhappy inefficiency here: the startStepping... call will often have already been called in the sequence leading up to entry to this method, but unfortunately the isPartsDonor: call often will not have already happened, with the result that the startStepping... call will not have resulted in the startage of the steppage."! !!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:54'!handleMouseDown: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseDown: and #mouseDown: in your custom morphs. See #handlerForMouseDown: and #mouseDownPriority." anEvent wasHandled ifTrue:[^self]. "not interested" anEvent hand removePendingBalloonFor: self. anEvent wasHandled: true. "Make me modal during mouse transitions" anEvent hand newMouseFocus: self event: anEvent. "this mouse down could be the start of a gesture, or the end of a gesture focus" (self isGestureStart: anEvent) ifTrue: [^ self gestureStart: anEvent]. self mouseDown: anEvent. (self handlesMouseStillDown: anEvent) ifTrue:[ self startStepping: #handleMouseStillDown: at: Time millisecondClockValue + self mouseStillDownThreshold arguments: {anEvent copy resetHandlerFields} stepTime: self mouseStillDownStepRate ].! !!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:54'!handleMouseEnter: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseOver: and #mouseEnter: in your custom morphs. Also see/use #handlesMouseOverDragging: and #mouseEnterDragging:." (anEvent isDraggingEvent) ifTrue:[ (self handlesMouseOverDragging: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseEnterDragging: anEvent]. ^self]. self wantsBalloon ifTrue:[anEvent hand triggerBalloonFor: self after: self balloonHelpDelayTime]. (self handlesMouseOver: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseEnter: anEvent. ].! !!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:55'!handleMouseLeave: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseOver: and #mouseLeave: in your custom morphs. Also see/ use #handlesMouseOverDragging: and #mouseLeaveDragging:." anEvent hand removePendingBalloonFor: self. anEvent isDraggingEvent ifTrue:[ (self handlesMouseOverDragging: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseLeaveDragging: anEvent]. ^self]. (self handlesMouseOver: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseLeave: anEvent. ].! !!Morph methodsFor: 'halos and balloon help' stamp: 'mt 8/14/2023 15:59'!addHandlesTo: aHaloMorph box: box "Add halo handles to the halo. Apply the halo filter if appropriate." aHaloMorph haloBox: box. Preferences haloSpecifications do: [:aSpec | (self wantsHaloHandleWithSelector: aSpec addHandleSelector inHalo: aHaloMorph) ifTrue: [aHaloMorph perform: aSpec addHandleSelector with: aSpec]]. aHaloMorph innerTarget addOptionalHandlesTo: aHaloMorph box: box! !!Morph methodsFor: 'halos and balloon help' stamp: 'mt 8/11/2023 16:50'!balloonHelpTextForHandle: aHandle "Answer a string providing balloon help for the given halo handle" | itsSelector | itsSelector := aHandle eventHandler firstMouseSelector. itsSelector == #doRecolor:with: ifTrue: [^ 'Change color']. itsSelector == #mouseDownInDimissHandle:with: ifTrue: [^ TrashCanMorph preserveTrash ifTrue: ['Move to trash'] ifFalse: ['Remove from screen']]. #(#(#addFullHandles 'More halo handles') #(#addSimpleHandles 'Fewer halo handles') #(#chooseEmphasisOrAlignment 'Emphasis & alignment') #(#chooseFont 'Change font') #(#chooseStyle 'Change style') #(#dismiss 'Remove') #(#doDebug:with: 'Debug') #(#doDirection:with: 'Choose forward direction') #(#doDup:with: 'Duplicate') #(#doMenu:with: 'Menu') #(#doGrab:with: 'Pick up') #(#editButtonsScript 'See the script for this button') #(#editDrawing 'Repaint') #(#mouseDownInCollapseHandle:with: 'Collapse') #(#mouseDownOnHelpHandle: 'Help') #(#paintBackground 'Paint background') #(#prepareToTrackCenterOfRotation:with: 'Move object or set center of rotation') #(#presentViewMenu 'Present the Viewing menu') #(#startDrag:with: 'Move') #(#startGrow:with: 'Change size (Ctrl + drag blue button)') #(#startRot:with: 'Rotate') #(#startScale:with: 'Change scale') #(#tearOffTile 'Make a tile representing this object') #(#trackCenterOfRotation:with: 'Set center of rotation') ) do: [:pair | itsSelector == pair first ifTrue: [^ pair last]]. ^ 'unknown halo handle'translated! !!Morph methodsFor: 'menu' stamp: 'mt 8/11/2023 14:44'!addYellowButtonMenuItemsTo: aMenu event: evt "Populate aMenu with appropriate menu items for a yellow-button (context menu) click." aMenu defaultTarget: self. "" aMenu addStayUpItem. "" self addModelYellowButtonItemsTo: aMenu event: evt. "" Preferences generalizedYellowButtonMenu ifFalse: [^ self]. "" aMenu addLine. aMenu add: 'insp ect' translated action: #inspect. "" aMenu addLine. self world selectedObject == self ifTrue: [aMenu add: 'deselect' translated action: #removeHalo] ifFalse: [aMenu add: 'select' translated action: #addHalo]. "" self isWorldMorph ifFalse: ["" aMenu addLine. aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: evt hand]. "" self isWorldMorph ifFalse: ["" Smalltalk at: #NCAAConnectorMorph ifPresent: [:connectorClass | aMenu addLine. aMenu add: 'connect to' translated action: #startWiring. aMenu addLine]. "" self isFullOnScreen ifFalse: [aMenu add: 'move onscreen' translated action: #goHome]]. "" self addLayoutMenuItems: aMenu hand: evt hand. (owner notNil and: [owner isTextMorph]) i fTrue: [self addTextAnchorMenuItems: aMenu hand: evt hand]. "" self isWorldMorph ifFalse: ["" aMenu addLine. self addToggleItemsToHaloMenu: aMenu]. "" aMenu addLine. self isWorldMorph ifFalse: [aMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:]. self hasStrings ifTrue: [ aMenu add: 'copy text' translated action: #clipText]. "" self addExportMenuItems: aMenu hand: evt hand. "" self isWorldMorph not ifTrue: ["" aMenu addLine. aMenu add: 'adhere to edge...' translated action: #adhereToEdge]. "" self addCustomMenuItems: aMenu hand: evt hand! !!Morph methodsFor: 'menu' stamp: 'mt 3/10/2023 16:07'!wantsYellowButtonMenu "Answer true if the receiver wants a yellow button menu" self valueOfProperty: #wantsYellowButtonMenu ifPresentDo: [:value | ^ value]. "" self isInSystemWindow ifTrue: [^ false]."" ^ Preferences generalizedYellowButtonMenu! !!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:59'!absorbStateFromRenderer: aRenderer "Transfer knownName, actorState, visible over from aRenderer, which was formerly imposed above me as a transformation shell but is now going away." | current | (current := aRenderer actorStateOrNil) ifNotNil: [self actorState: current. aRenderer actorState: nil]. (current := aRenderer knownName) ifNotNil: [self setNameTo: current. aRenderer setNameTo: nil]. self visible: aRenderer visible! !!Morph methodsFor: 'menus' stamp: 'mt 3/10/2023 14:25'!addHaloActionsTo: aMenu "Add items to aMenu representing actions requestable via halo" | subMenu | subMenu := MenuMorph new defaultTarget: self. subMenu addTitle: self externalName. subMenu addStayUpItemSpecial. subMenu addLine. subMenu add: 'delete' translated action: #dismissViaHalo. subMenu balloonTextForLastItem: 'Delete this object -- warning -- can be destructive!!' translated. self maybeAddCollapseItemTo: subMenu. subMenu add: 'grab' translated action: #openInHand. subMenu balloonTextForLastItem: 'Pick this object up -- warning, since this removes it from its container, it can have adverse effects.' translated. subMenu addLine. subMenu add: 'resize' translated action: #resizeFromMenu. subMenu balloonTextForLastItem: 'Change the size of this object' translated. subMenu add: 'duplicate' translated action: #maybeDuplicateMorph. subMenu balloonTextForLastItem: 'Hand me a copy of this object' translated. "Note that this allows access to the non-instancing duplicate even when this is a uniclass instance" subMenu addLine. subMenu add: 'set color' translated target: self renderedMorph action: #changeColor. subMenu balloonTextForLastItem: 'Change the color of this object' translated. subMenu addLine. subMenu add: 'inspect' translated target: self action: #inspect. subMenu balloonTextForLastItem: 'Open an Inspector on this object' translated. aMenu add: 'halo actions...' translated subMenu: subMenu! !!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:47'!addMiscExtrasTo: aMenu "Add a submenu of miscellaneous extra items to the menu." | realOwner realMorph subMenu | subMenu := MenuMorph new defaultTarget: self. self isWorldMorph ifFalse: [subMenu add: 'adhere to edge...' translated action: #adhereToEdge. subMenu addLine]. realOwner := (realMorph := self topRendererOrSelf) owner. (realOwner isKindOf: TextPlusPasteUpMorph) ifTrue: [subMenu add: 'GeeMail stuff...' translated subMenu: (realOwner textPlusMenuFor: realMorph)]. subMenu add: 'add mouse up action' translated action: #addMouseUpAction; add: 'remove mouse up action' translated action: #removeMouseUpAction; add: 'hand me tiles to fire this button' translated action: #handMeTilesToFire. subMenu addLine. subMe nu add: 'arrowheads on pen trails...' translated action: #setArrowheads. subMenu addLine. subMenu defaultTarget: self topRendererOrSelf. subMenu add: 'draw new path' translated action: #definePath. subMenu add: 'follow existing path' translated action: #followPath. subMenu add: 'delete existing path' translated action: #deletePath. subMenu addLine. self addGestureMenuItems: subMenu hand: self currentHand. aMenu add: 'extras...' translated subMenu: subMenu! !!Morph methodsFor: 'menus' stamp: 'mt 8/16/2023 15:58'!addStandardHaloMenuItemsTo: aMenu hand: aHandMorph "Add standard halo items to the menu" | unlockables | self isWorldMorph ifTrue: [^ self addWorldHaloMenuItemsTo: aMenu hand: aHandMorph]. aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: aHandMorph. aMenu addLine. self addFillStyleMenuItems: aMenu hand: aHandMorph. self addBorderStyleMenuItems: aMenu hand: aHandMorph. self addDropShadowMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph. self addHaloActionsTo: aMenu. owner isTextMorph ifTrue:[self addTextAnchorMenuItems: aMenu hand: aHandMorph]. aMenu addLine. self addToggleItemsToHaloMenu: aMenu. aMenu addLine. self addCopyItemsTo: aMenu. self addExportMenuItems: aMenu hand: aHandMorph. self addMiscExtrasTo: aMenu. self addDebuggingItemsTo: aMenu hand: aHandMorph. aMenu addLine. aMenu defaultTarget: self. aMenu addLine. unlockables := self submorphs select: [:m | m isLocked]. unlockables size = 1 ifTrue: [aMenu add: ('unlock "{1}"' translated format: unlockables first externalName) action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' translated action: #unlockContents]. aMenu defaultTarget: aHandMorph.! !!Morp h methodsFor: 'menus' stamp: 'mt 3/10/2023 16:06'!addToggleItemsToHaloMenu: aMenu "Add standard true/false-checkbox items to the memu" #( (resistsRemovalString toggleResistsRemoval 'whether I should be reistant to easy deletion via the pink X handle') (stickinessString toggleStickiness 'whether I should be resistant to a drag done by mousing down on me') (lockedString lockUnlockMorph 'when "locked", I am inert to all user interactions') (hasClipSubmorphsString changeClipSubmorphs 'whether the parts of objects within me that are outside my bounds should be masked.') (hasDirectionHandlesString changeDirectionHandles 'whether direction handles are shown with the halo') (hasDragEnabledString changeDrag 'whether I am open to having objects dragged out of me') (hasDropEnabledString changeDrop 'whether I am open to having objects dropped into me') ) do: [:each | aMenu addUpdating: each first action: eac h second. aMenu balloonTextForLastItem: each third translated]. self couldHaveRoundedCorners ifTrue: [aMenu addUpdating: #roundedCornersString action: #toggleCornerRounding. aMenu balloonTextForLastItem: 'whether my corners should be rounded' translated]! !!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:59'!transferStateToRenderer: aRenderer "Transfer knownName, actorState, visible over to aRenderer, which is being imposed above me as a transformation shell" | current | (current := self actorStateOrNil) ifNotNil: [aRenderer actorState: current. self actorState: nil]. (current := self knownName) ifNotNil: [aRenderer setNameTo: current. self setNameTo: nil]. aRenderer simplySetVisible: self visible ! !!Morph methodsFor: 'meta-actions' stamp: 'mt 3/10/2023 16:06'!buildHandleMenu: aHand "Build the morph menu for the given morph's halo's menu handle. This menu has two sections. The first section con tains commands that are interpreted by the hand; the second contains commands provided by the target morph. This method allows the morph to decide which items should be included in the hand's section of the menu." | menu | menu := MenuMorph new defaultTarget: self. menu addStayUpItem. menu addLine. self addStandardHaloMenuItemsTo: menu hand: aHand. menu defaultTarget: aHand. self addAddHandMenuItemsForHalo: menu hand: aHand. menu defaultTarget: self. self addCustomHaloMenuItems: menu hand: aHand. menu defaultTarget: aHand. ^ menu! !!Morph methodsFor: 'naming' stamp: 'mt 3/8/2023 10:49'!renameTo: aName self knownName = aName ifTrue: [^ aName]. self topRendererOrSelf setNameTo: aName. ^ aName! !!Morph methodsFor: 'stepping' stamp: 'mt 8/28/2023 15:14'!step "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message."! !!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:53'!stepAt: millisecondClockValue "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message. The millisecondClockValue parameter gives the value of the millisecond clock at the moment of dispatch. Default is to dispatch to the parameterless step method for the morph, but this protocol makes it possible for some morphs to do differing things depending on the clock value" self step! !!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:53'!stepTime "Answer the desired time between steps in milliseconds. This default implementation requests that the 'step' method be called once every second." ^ 1000! !!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:57'!wantsSteps "Return true if the receiver overrides the default Morph step method." "Details: Find first cla ss in superclass chain that implements #step and return true if it isn't class Morph." | c | self isPartsDonor ifTrue: [^ false]. c := self class. [c includesSelector: #step] whileFalse: [c := c superclass]. ^ c ~= Morph! !!Morph methodsFor: 'thumbnail' stamp: 'mt 8/14/2023 17:40'!representativeNoTallerThan: maxHeight norWiderThan: maxWidth thumbnailHeight: thumbnailHeight "Return a morph representing the receiver but which is no taller than aHeight. If the receiver is already small enough, just return it, else return a MorphThumbnail companioned to the receiver, enforcing the maxWidth. If the receiver personally *demands* thumbnailing, do it even if there is no size-related reason to do it." self permitsThumbnailing ifFalse: [^ self]. (self fullBounds height <= maxHeight and: [self fullBounds width <= maxWidth]) ifTrue: [^ self]. ^ MorphThumbnail new extent: maxWidth @ (thumbnailHeight min: self fullBounds height); morphRepresented: self! !!Morph metho dsFor: 'WiW support' stamp: 'mt 3/7/2023 15:07'!eToyRejectDropMorph: morphToDrop event: evt | tm am | tm := TextMorph new beAllFont: ((TextStyle named: Preferences standardButtonFont familyName) fontOfSize: 24); contents: 'GOT IT!!'. (am := AlignmentMorph new) color: Color yellow; layoutInset: 10; useRoundedCorners; vResizing: #shrinkWrap; hResizing: #shrinkWrap; addMorph: tm; fullBounds; position: (self bounds center - (am extent // 2)); openInWorld: self world. SoundService default playSoundNamed: 'yum' ifAbsentReadFrom: 'yum.aif'. morphToDrop rejectDropMorphEvent: evt. "send it back where it came from" am delete! !!Morph methodsFor: 'private' stamp: 'mt 3/10/2023 14:53'!privateMoveBy: delta "Private!! Use 'position:' instead." | fill | bounds := bounds translateBy: delta. fullBounds ifNotNil: [fullBounds := fullBounds translateBy: delta]. fill := self fillStyle. fill isOrientedFill ifTrue: [fill origin: fill origin + delta]! !!Morph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/10/2023 14:50'!delete "Remove the receiver as a submorph of its owner and make its new owner be nil." | oldWorld | self removeHalo. (oldWorld := self world) ifNotNil: [ self disableSubmorphFocusForHand: self activeHand. self activeHand releaseKeyboardFocus: self; releaseMouseFocus: self]. owner ifNotNil: [ self privateDelete. "remove from world"].! !!Morph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/10/2023 14:27'!goBehind "Move the receiver to bottom z-order." | topRend | topRend := self topRendererOrSelf. topRend owner ifNotNil: [:own | own addMorphBack: topRend]! !!Morph methodsFor: 'submorphs - layers' stamp: 'dgd 8/31/2004 16:21'!wantsToBeTopmost "Answer if the receiver want to be one of the topmost objects in its owner" ^ self isFlapOrTab! !!BorderedMorph method sFor: 'menu' stamp: 'mt 4/11/2018 08:30'!changeBorderWidth: evt | handle origin aHand newWidth oldWidth | aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand]. origin := aHand position. oldWidth := self borderWidth. (handle := HandleMorph new) forEachPointDo: [:newPoint | handle removeAllMorphs. handle addMorph: (LineMorph from: origin to: newPoint color: Color black width: 1). newWidth := (newPoint - origin) r asInteger // 5. self borderWidth: newWidth] lastPointDo: [:newPoint | handle deleteBalloon. self halo ifNotNil: [:halo | halo addHandles]. self rememberCommand: (Command new cmdWording: 'border change' translated; undoTarget: self selector: #borderWidth: argument: oldWidth; redoTarget: self selector: #borderWidth: argument: newWidth)]. aHand attachMorph: handle. handle setProperty: #helpAtCe nter toValue: true. handle showBalloon:'Move cursor farther fromthis point to increase border width.Click when done.' translated hand: evt hand. handle startStepping! !!AlignmentMorph methodsFor: 'geometry' stamp: 'mt 3/7/2023 14:37'!addTransparentSpacerOfSize: aPoint "Required for several MorphicExtras and other non-Etoys stuff." self addMorphBack: ((Morph new extent: aPoint asPoint) color: Color transparent)! !!BookPageSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'!addControls "Add the control bar at the top of the tool." | bb r str aCheckbox aWrapper | r := AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0. r wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. bb := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated font: Preferences standardButtonFont ; actionSelector: #acceptSort)). bb setBalloonText: 'Accept the changes made here as the new page-order for this book' translated. r addTransparentSpacerOfSize: 12. bb := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #delete)). bb setBalloonText: 'Forgot any changes made here, and dismiss this sorter' translated. "eliminate the parts-bin button on the book-page sorters... r addTransparentSpacerOfSize: 24 @ 0. aCheckbox := UpdatingThreePhaseButtonMorph checkBox. aCheckbox target: self; actionSelector: #togglePartsBinStatus; arguments: #(); getSelector: #getPartsBinStatus. str := StringMorph contents: 'Parts bin' translated font: Preferences standardButtonFont. aWrapper := AlignmentMorph newRow beTransparent. aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0. aWrapper
addMorphBack: (self wrapperFor: aCheckbox); addMorphBack: (self wrapperFor: str lock). r addMorphBack: aWrapper." self addMorphFront: r! !!BookPageSorterMorph methodsFor: 'initialization' stamp: 'mt 8/16/2023 13:52'!initialize "initialize the state of the receiver" super initialize. "" self extent: Display extent - 100; listDirection: #topToBottom; wrapCentering: #topLeft; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 3. pageHolder := PasteUpMorph new. pageHolder vResizeToFit: true; autoLineLayout: true. pageHolder extent: self extent - self borderWidth. pageHolder hResizing: #shrinkWrap. "pageHolder cursor: 0." "causes a walkback as of 5/25/2000" self addControls. self addMorphBack: pageHolder! !!BooklikeMorph methodsFor: 'misc' stamp: 'mt 8/4/2023 13:41'!playPageFlipSound: soundName PageFlipSoundOn "mechanism to suppress sounds at init time" ifTrue: [self playSoundNamed: soundName].! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:39'!addBookMenuItemsTo: aMenu hand: aHandMorph | controlsShowing subMenu | subMenu := MenuMorph new defaultTarget: self. subMenu add: 'previous page' translated action: #previousPage. subMenu add: 'next page' translated action: #nextPage. subMenu add: 'goto page' translated action: #goToPage. subMenu add: 'insert a page' translated action: #insertPage. subMenu add: 'delete this page' translated action: #deletePage. controlsShowing := self hasSubmorphWithProperty: #pageControl. controlsShowing ifTrue: [subMenu add: 'hide page controls' translated action: #hidePageControls. subMenu add: 'fewer page controls' translated action: #fewerPageControls] ifFalse: [subMenu add: 'show page controls' translated action: #showPageControls]. self isInFullScreenMode ifTrue: [ subMenu add: 'exit full screen' translated action: #exitFullScreen. ] ifFalse: [ subMenu add: 'show full screen' translated action: #goFullScreen. ]. subMenu addLine. subMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:. subMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:. subMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:. subMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:. subMenu addLine. subMenu add: 'sort pages' translated action: #sortPages:. subMenu add: 'uncache page sorter' translated action: #uncachePageSorter. (self hasProperty: #dontWrapAtEnd) ifTrue: [subMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true] ifFalse: [subMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false]. subMenu addLine. subMenu add: 'search for text' translated action: #textSearch. (aHandMorph pasteBuffer class isKindOf: PasteUpMorph class) ifTrue: [subMenu add: 'paste book page' translated action: #pasteBookPage]. subMenu add: 'send all pages to server' translated action: #savePagesOnURL. subMenu add: 'send this page to server' translated action: #saveOneOnURL. subMenu add: 'reload all from server' translated action: #reload. subMenu add: 'copy page url to clipboard' translated action: #copyUrl. subMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype. newPagePrototype ifNotNil: [subMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype]. aMenu add: 'book...' translated subMenu: subMenu! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/11/2023 14:44'!invokeBookMenu "Invoke the book's control panel menu." | aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'Book' translated. aMenu addStayUpItem. aMenu add: 'find...' translated action: #textSearch. aMenu add: 'go to page...' translated action: #goToPage. aMenu addLine. aMenu addList: { {'sort pages' translated. #sortPages}. {'uncache page sorter' translated. #uncachePageSorter}}. (self hasProperty: #dontWrapAtEnd) ifTrue: [aMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true] ifFalse: [aMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false]. aMenu addList: { {'make bookmark' translated. #bookmarkForThisPage}. {'make thumbnail' translated. #thumbnailForThisPage}}. aMenu addUpdating: #showingPageControlsString action: #toggleShowingOfPageControls. aMenu addUpdating: #showingFullScreenString action: #toggleFullScreen. aMenu addLine. aMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:. aMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:. aMen u add: 'visual effect for all pages' translated action: #menuPageVisualForAll:. aMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:. aMenu addLine. (self primaryHand pasteBuffer class isKindOf: PasteUpMorph class) ifTrue: [aMenu add: 'paste book page' translated action: #pasteBookPage]. aMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype. newPagePrototype ifNotNil: [ aMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype]. aMenu add: (self dragNDropEnabled ifTrue: ['close dragNdrop'] ifFalse: ['open dragNdrop']) translated action: #changeDragAndDrop. aMenu add: 'make all pages this size' translated action: #makeUniformPageSize. aMenu addUpdating: #keepingUniformPageSizeString target: self action: #toggleMaintainUniformPageSize. aMenu addLine. aMenu add: 'send all pages to server' translated action: #savePagesOnURL . aMenu add: 'send this page to server' translated action: #saveOneOnURL. aMenu add: 'reload all from server' translated action: #reload. aMenu add: 'copy page url to clipboard' translated action: #copyUrl. aMenu addLine. aMenu add: 'load PPT images from slide #1' translated action: #loadImagesIntoBook. aMenu add: 'background color for all pages...' translated action: #setPageColor. aMenu add: 'make a thread of projects in this book' translated action: #buildThreadOfProjects. aMenu popUpEvent: self world activeHand lastEvent in: self world! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:38'!saveAsNumberedURLs "Write out all pages in this book that are not showing, onto a server. The local disk could be the server. For any page that does not have a SqueakPage and a url already, name that page file by its page number. Any pages that are already totally out will stay that way." | stem list firstTime | firstTime := (self valueOfProperty: #url ) isNil. stem := self getStemUrl. "user must approve" stem isEmpty ifTrue: [^self]. firstTime ifTrue: [self setProperty: #futureUrl toValue: stem , '.bo']. self reserveUrlsIfNeeded. pages withIndexDo: [:aPage :ind | "does write the current page too" aPage isInMemory ifTrue: ["not out now" aPage saveOnURL: stem , ind printString , '.sp']]. list := pages collect: [:aPage | aPage sqkPage prePurge]. "knows not to purge the current page" list := (list select: [:each | each notNil]) asArray. "do bulk become:" (list collect: [:each | each contentsMorph]) elementsExchangeIdentityWith: (list collect: [:spg | MorphObjectOut new xxxSetUrl: spg url page: spg]). self saveIndexOnURL. firstTime ifTrue: ["Put a thumbnail into the hand" URLMorph grabForBook: self. self setProperty: #futureUrl toValue: nil " clean up"]! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:39'!saveOnUrlPage: pageMorph "Write out this single page in this book onto a server. See savePagesOnURL. (Don't compute the texts, only this page's is written.)" | stem ind response rand newPlace dir | "Don't give the chance to put in a different place. Assume named by number" ((self valueOfProperty: #url) isNil and: [pages first url notNil]) ifTrue: [response := Project uiManager chooseOptionFrom: {'Old book' translated. 'New book sharing old pages' translated} title: 'Modify the old book, or make a new book sharing its pages?' translated. response = 2 ifTrue: ["Make up new url for .bo file and confirm with user." "Mark as shared" [rand := String new: 4. 1 to: rand size do: [:ii | rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)]. (newPlace := self get StemUrl) ifEmpty: [^ self]. newPlace := (newPlace copyUpToLast: $/), '/BK', rand, '.bo'. dir := ServerFile new fullPath: newPlace. (dir includesKey: dir fileName)] whileTrue. "keep doing until a new file" self setProperty: #url toValue: newPlace]. response = 0 ifTrue: [^ self]]. stem := self getStemUrl. "user must approve" stem ifEmpty: [^ self]. ind := pages identityIndexOf: pageMorph ifAbsent: [self error: 'where is the page?' translated]. pageMorph isInMemory ifTrue: "not out now" [pageMorph saveOnURL: stem,(ind printString),'.sp']. self saveIndexOfOnly: pageMorph.! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:40'!savePagesOnURL "Write out all pages in this book onto a server. For any page that does not have a SqueakPage and a url already, ask the user for one. Give the option of naming all page files by page number. Any pages that are not in memory will stay that way. The local disk coul d be the server." | response list firstTime newPlace rand dir bookUrl | self getAllText. "stored with index later" response := Project uiManager chooseOptionFrom: {'Use page numbers' translated. 'Type in file names' translated. 'Save in a new place (using page numbers)' translated. 'Save in a new place (typing names)' translated. 'Save new book sharing old pages' translated. } title: 'Each page will be a file on the server. Do you want to page numbers be the names of the files? or name each one yourself?' translated. response = 1 ifTrue: [self saveAsNumberedURLs. ^ self]. response = 3 ifTrue: [self forgetURLs; saveAsNumberedURLs. ^ self]. response = 4 ifTrue: [self forgetURLs]. response = 5 ifTrue: ["Make up new url for .bo file and confirm with user." "Mark as shared" [rand := String new: 4. 1 to: rand size do: [:ii | rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)]. (newPlace := self getStemUrl) isEmpty ifTrue: [^ self]. newPlace := (newPlace copyUpToLast: $/), '/BK', rand, '.bo'. dir := ServerFile new fullPath: newPlace. (dir includesKey: dir fileName)] whileTrue. "keep doing until a new file" self setProperty: #url toValue: newPlace. self saveAsNumberedURLs. bookUrl := self valueOfProperty: #url. (SqueakPage stemUrl: bookUrl) = (SqueakPage stemUrl: currentPage url) ifTrue: [bookUrl := true]. "not a shared book" (URLMorph grabURL: currentPage url) book: bookUrl. ^ self]. response = 0 ifTrue: [^ self]. "self reserveUrlsIfNeeded. Need two passes here -- name on one, write on second" pages do: [:aPage | "does write the current page too" aPage isInMemory ifTrue: "not out now" [aPage saveOnURLbasic]]. "ask user if no url" list := pages collect: [:aPage | aPage sqkPage prePurge]. "knows not to purge the current page" list := (list select: [:each | each notNil]) asArray. "do bulk become:" (list collect: [:each | each contentsMorph]) elementsExchangeIdentityWith: (list collect: [:spg | MorphObjectOut new xxxSetUrl: spg url page: spg]). firstTime := (self valueOfProperty: #url) isNil. self saveIndexOnURL. firstTime ifTrue: "Put a thumbnail into the hand" [URLMorph grabForBook: self. self setProperty: #futureUrl toValue: nil]. "clean up"! !!BookMorph methodsFor: 'navigation' stamp: 'mt 8/4/2023 13:34'!goToPageMorph: aMorph "Set the given morph as the current page; run closing and opening scripts as appropriate" self goToPage: (pages identityIndexOf: aMorph ifAbsent: [^ self "abort"]) transitionSpec: nil! !!BookMorph methodsFor: 'navigation' stamp: 'mt 8/4/2023 13:30'!goToPageMorph: newPage transitionSpec: transitionSpec "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly. Apply the transitionSpec provided." | pageIndex aWorld oldPageIndex ascending tSpec readIn | pages isEmpty ifTrue: [^self]. self setProperty: #searchContainer toValue: nil. "forget previous search" self setProperty: #searchOffset toValue: nil. self setProperty: #searchKey toValue: nil. pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"]. readIn := newPage isInMemory not. oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil]. ascending := (oldPageIndex isNil or: [newPage == currentPage]) ifTrue: [nil] ifFalse: [oldPageIndex < pageIndex]. tSpec := transitionSpec ifNil: ["If transition not specified by requestor..." newPage valueOfProperty: #transitionSpec
ifAbsent: [" ... then consult new page" self transitionSpecFor: self " ... otherwise this is the default"]]. self flag: #arNote. "Probably unnecessary" (aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus]. currentPage ifNotNil: [currentPage updateCachedThumbnail]. self currentPage notNil ifTrue: [(((pages at: pageIndex) owner isKindOf: TransitionMorph) and: [(pages at: pageIndex) isInWorld]) ifTrue: [^self "In the process of a prior pageTurn"]. ascending ifNotNil: ["Show appropriate page transition and start new page when done" currentPage stopStepping. (pages at: pageIndex) position: currentPage position. ^(TransitionMorph effect: tSpec second direction: tSpec third inve rse: (ascending or: [transitionSpec notNil]) not) showTransitionFrom: currentPage to: (pages at: pageIndex) in: self whenStart: [self playPageFlipSound: tSpec first] whenDone: [currentPage delete; fullReleaseCachedState. self insertPageMorphInCorrectSpot: (pages at: pageIndex). self adjustCurrentPageForFullScreen. self snapToEdgeIfAppropriate. aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. aWorld := self world. readIn ifTrue: [currentPage updateThumbnailUrlInBook: self url. currentPage sqkPage computeThumbnail "just store it"]]]. "No transition, but at least decommission current page" currentPage delete; fullReleaseCachedState]. self insertPageMorphInCorrectSpot: (pages at: pageIndex). "sets currentPage" self adjustCurrentPageForFullScreen. self snapToEdgeIfAppropriate. aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. aWorld := self world. readIn ifTrue: [currentPage updateThumbnailUrl. currentPage sqkPage computeThumbnail "just store it"].! !!DockingBarMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 16:05'!wantsYellowButtonMenu "Answer true if the receiver wants a yellow button menu" ^ true! !!EventRecorderMorph methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:52'!makeStatusLightIn: aPoint ^statusLight := EllipseMorph new extent: aPoint; color: Color green ; borderWidth: 0! !!GraphMorph methodsFor: 'accessing'!valueAtCursor: aPointOrNumber data isEmpty ifTrue: [^ 0]. data at: ((cursor truncated max: 1) min: data size) put: (self asNumber: aPointOrNumber). self flushCachedForm.! !!GraphMorph methodsFor: 'commands'!appendValue: aPointOrNumber | newVal | (data isKindOf: OrderedCollection) ifFalse: [data := data asOrderedCollection]. newVal := self asNumber: aPointOrNumber. data addLast: newVal. newVal < minVal ifTrue: [minVal := newVal]. newVal > maxVal ifTrue: [maxVal := newVal]. self cursor: data size. self flushCachedForm.! !!GraphMorph methodsFor: 'private' stamp: 'mt 8/14/2023 16:25'!asNumber: aPointOrNumber ^ aPointOrNumber isPoint ifTrue: [aPointOrNumber r] ifFalse: [aPointOrNumber]! !!GraphicalDictionaryMenu methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'!initializeFor: aTarget fromDictionary: aDictionary "Initialize me for a target and a dictionary ." | anIndex aButton | self baseDictionary: aDictionary. target := aTarget. coexistWithOriginal := true. self extent: 210 @ 210. self clipSubmorphs: true. self layoutPolicy: ProportionalLayout new. aButton := (IconicButton new) borderWidth: 0; labelGraphic: (MenuIcons formAtKey: 'TinyMenu'); color: Color transparent; actWhen: #buttonDown; actionSelector: #showMenu; target: self; setBalloonText: 'menu'. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (-50 @ 6 extent: aButton extent)). aButton := (SimpleButtonMorph new) target: self; borderColor: Color black; label: 'Prev'; actionSelector: #downArrowHit; actWhen: #whilePressed; setBalloonText: 'show previous picture'; yourself. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (-24 @ 4 extent: aButton extent)). aButton := (SimpleButtonMorph new) target: self; borderColor: Color black; label: 'Next'; actionSelector: #upArrowHit; actWhen: #whilePressed; setBalloonText: 'show next pictutre'. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (24 @ 4 extent: aButton extent)). self addMorph: ((UpdatingStringMorph new) contents: ' '; target: self; putSelector: #renameGraphicTo:; getSelector: #truncatedNameOfGraphic; useStringFormat; setBalloonText: 'The name of the current graphic'; yourself) fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ 0) offsets: (10 @ 40 corner: -10 @ 60)). self addMorph: ((Morph new) extent: 100 @ 4; color: Color black) fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ 0) offsets: (0 @ 60 corner: 0 @ 64)). formDisplayMorph := (Thumbnail new) extent: 100 @ 100; useInterpolation: true; maxWidth: 300 minHeight: 100; yourself. formDisplayMorph layoutFrame: (LayoutFrame fractions: (0 @ 0 extent: 0@0) offsets: (8 @ 72 corner: 108 @ 172)). self addMorph: formDisplayMorph. self minimumExtent: 116@180. target ifNotNil: [(anIndex := formChoices indexOf: target form ifAbsent: []) ifNotNil: [currentIndex := anIndex]]. self updateThumbnail! !!GraphicalDictionaryMenu methodsFor: 'menu commands' stamp: 'mt 8/16/2023 13:50'!repaintEntry "Let the user enter into painting mode to repaint the item and save it back." | aWorld bn ds sketchEditor aPaintBox formToEdit | (aWorld := self world) assureNotPaintingElse: [^ self]. formToEdit := formChoices at: currentIndex. bnds := (submorphs second boundsInWorld origin extent: formToEdit extent) intersect: aWorld bounds. bnds := bnds expandBy: 60@60. sketchEditor := SketchEditorMorph new. aWorld addMorphFront: sketchEditor. sketchEditor initializeFor: ((aWorld drawingClass withForm: formToEdit) position: submorphs second positionInWorld) inBounds: bnds pasteUpMorph: aWorld paintBoxPosition: bnds topRight. sketchEditor afterNewPicDo: [:aForm :aRect | formChoices at: currentIndex put: aForm. baseDictionary at: (entryNames at: currentIndex) put: aForm. self updateThumbnail. (aPaintBox := aWorld paintBoxOrNil) ifNotNil: [aPaintBox delete]] ifNoBits: [(aPaintBox := aWorld paintBoxOrNil) ifNotNil: [aPaintBox delete]]. ! !!HandMorph methodsFor: 'paste buffer' stamp: ' mt 3/10/2023 14:49'!pasteMorph | aPastee | PasteBuffer ifNil: [^ self inform: 'Nothing to paste.' translated]. self attachMorph: (aPastee := self objectToPaste). aPastee align: aPastee center with: self position.! !!HandMorphForReplay methodsFor: 'event handling' stamp: 'mt 8/28/2023 14:05'!processEvents "Play back the next event" | evt hadMouse hadAny tracker | suspended == true ifTrue: [^ self]. hadMouse := hadAny := false. tracker := recorder objectTrackingEvents. [(evt := recorder nextEventToPlay) isNil] whileFalse: [ ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self]. tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp]. evt type == #EOF ifTrue: [recorder pauseIn: self currentWorld. ^ self]. evt type == #startSound ifTrue: [evt argument play. re corder synchronize. ^ self]. evt isMouse ifTrue: [hadMouse := true]. (evt isMouse or: [evt isKeyboard]) ifTrue: [self handleEvent: (evt setHand: self) resetHandlerFields. hadAny := true]]. (mouseClickState notNil and: [hadMouse not]) ifTrue: ["No mouse events during this cycle. Make sure click states time out accordingly" mouseClickState handleEvent: lastMouseEvent asMouseMove from: self]. hadAny ifFalse: ["No pending events. Make sure z-order is up to date" self mouseOverHandler processMouseOver: lastMouseEvent]! !!ImageMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:15'!setNewImageFrom: formOrNil "Change the receiver's image to be one derived from the supplied form. If nil is supplied, clobber any existing image in the receiver, and in its place put a default graphic, either the one known to the receiver as it s default value" formOrNil ifNotNil: [^ self image: formOrNil]. self image: (Form extent: 16@16 depth: 32)! !!GrabPatchMorph methodsFor: 'dropping' stamp: 'mt 8/14/2023 17:31'!wantsToBeDroppedInto: aMorph "Only into PasteUps that are not part bins" ^ aMorph isWorldMorph! !!GrabPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:11'!initialize "Initialize the receiver. Emblazon the GrabPatch icon on its face" super initialize. self image: (MenuIcons formAtKey: 'GrabPatch'). self setProperty: #ignorePartsBinDrop toValue: true! !!GrabPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:11'!initializeToStandAlone "Initialize the receiver. Emblazon the GrabPatch icon on its face" super initializeToStandAlone. self image: (MenuIcons formAtKey: 'GrabPatch')! !!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'mt 8/23/2023 13:48'!insertNewProject [MorphicProject openViewOn: nil] on: ProjectViewOpenNotifica tion do: [ :ex | ex resume: false].! !!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'mt 8/11/2023 14:44'!moreCommands "Put up a menu of options" | allThreads aMenu others target | allThreads := self class knownThreads. aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'navigation' translated. self flag: #deferred. "Probably don't want that stay-up item, not least because the navigation-keystroke stuff is not dynamically handled" aMenu addStayUpItem. others := (allThreads keys reject: [ :each | each = threadName]) asArray sort. others do: [ :each | aMenu add: ('switch to <{1}>' translated format:{each}) selector: #switchToThread: argument: each ]. aMenu addList: { {'switch to recent projects' translated. #getRecentThread}. #-. {'create a new thread' translated. #threadOfNoProjects}. {'edit this thread' translated. #editThisThread}. {'create thread of all projects' transl ated. #threadOfAllProjects}. #-. {'First project in thread' translated. #firstPage}. {'Last project in thread' translated. #lastPage} }. (target := self currentIndex + 2) > listOfPages size ifFalse: [ aMenu add: ('skip over next project ({1})' translated format:{(listOfPages at: target - 1) first}) action: #skipOverNext ]. aMenu addList: { {'jump within this thread' translated. #jumpWithinThread}. {'insert new project' translated. #insertNewProject}. #-. {'simply close this navigator' translated. #delete}. {'destroy this thread' translated. #destroyThread}. #- }. (self currentWorld keyboardNavigationHandler == self) ifFalse:[ aMenu add: 'start keyboard navigation with this thread' translated action: #startKeyboardNavigation ] ifTrue: [ aMenu add: 'stop keyboard navigation with this thread' translated action: #stopKeyboardNavigation ]. aMenu popUpInWorld.! !!LassoPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'!initialize "Initialize the receiver. Sets its image to the lasso picture" super initialize. self image: (MenuIcons formAtKey: 'Lasso')! !!LassoPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'!initializeToStandAlone "Initialize the receiver such that it can live on its own. Sets its image to the lasso picture" super initializeToStandAlone. self image: (MenuIcons formAtKey: 'Lasso')! !!Morph class methodsFor: 'fileIn/Out' stamp: 'mt 3/8/2023 09:07'!fromFileName: fullName "Reconstitute a Morph from the file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world" | aFileStream morphOrList | aFileStream := (MultiByteBinaryOrTextStream with: ((FileStream readOnlyFileNamed: fullName) binary contentsOfEntireFile)) binary reset. morphOrList := aFileStream fileInObjectAndCode. P roject current world addMorphsAndModel: morphOrList.! !!Morph class methodsFor: '*MorphicExtras-parts bin' stamp: 'mt 8/4/2023 14:43'!supplementaryPartsDescriptions "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol" ^ {DescriptionForPartsBin formalName: 'NextPage' translatedNoop categoryList: {'Multimedia' translatedNoop} documentation: 'A button which, when clicked, takes the reader to the next page of a book' translatedNoop globalReceiverSymbol: #BookMorph nativitySelector: #nextPageButton. DescriptionForPartsBin formalName: 'PreviousPage' translatedNoop categoryList: {'Multimedia'} documentation: 'A button which, when clicked, takes the reader to the previous page of a book' translatedNoop globalReceiverSymbol: #BookMorph
nativitySelector: #previousPageButton.}! !!GraphicalDictionaryMenu class methodsFor: 'example' stamp: 'mt 7/31/2023 11:13'!example "GraphicalDictionaryMenu example" | aDict | aDict := Dictionary new. #('ColorTilesOff' 'ColorTilesOn' 'Controls') do: [:aString | aDict at: aString put: (MenuIcons formAtKey: aString)]. self openOn: aDict withLabel: 'Testing One Two Three'! !!ImageMorph class methodsFor: 'scripting' stamp: 'mt 3/15/2023 14:10'!authoringPrototype | aMorph aForm | aMorph := super authoringPrototype. aForm := MenuIcons formAtKey: 'Image'. aForm ifNil: [aForm := aMorph image rotateBy: 90]. aMorph image: aForm. ^ aMorph! !!GrabPatchMorph class methodsFor: 'instance creation' stamp: 'mt 7/31/2023 11:11'!authoringPrototype "Answer a prototype for use in a parts bin" ^ self new image: (MenuIcons formAtKey: 'GrabPatch'); markAsPartsDonor; setBalloonText: 'Use this to grab a rectangular patch from the screen'; yourself! !!LassoPatchMorph class methodsFor: 'instance creation' stamp: 'mt 7/31/2023 11:13'!authoringPrototype "Answer a prototype for use in a parts bin" ^ self new image: (MenuIcons formAtKey: 'Lasso'); markAsPartsDonor; setBalloonText: 'Drop this on the desktop and you can then grab a patch from the screen with a lasso.'; yourself! !!MorphExtension methodsFor: 'accessing - other properties' stamp: 'mt 3/10/2023 14:57'!sortedPropertyNames "answer the receiver's property names in a sorted way" | props | props := WriteStream on: (Array new: 10). locked == true ifTrue: [props nextPut: #locked]. visible == false ifTrue: [props nextPut: #visible]. sticky == true ifTrue: [props nextPut: #sticky]. balloonText isNil ifFalse: [props nextPut: #balloonText]. balloonTextSelector isNil ifFalse: [props nextPut: #balloonTextSelector]. externalName isNil ifFalse: [props nextPut: #externalName]. isPartsDonor == true ifTrue: [props nextPut: #isPartsDonor]. act orState isNil ifFalse: [props nextPut: #actorState]. eventHandler isNil ifFalse: [props nextPut: #eventHandler]. otherProperties ifNotNil: [otherProperties associationsDo: [:a | props nextPut: a key]]. ^props contents sort: [:s1 :s2 | s1 <= s2]! !!MorphExtension methodsFor: 'connectors-copying' stamp: 'mt 3/10/2023 16:11'!veryDeepInner: deepCopier "Copy all of my instance variables. Some otherProperties need to be not copied at all, but shared. Their names are given by copyWeakly. Some otherProperties should not be copied or shared. Their names are given by propertyNamesNotCopied. This is special code for the dictionary. See DeepCopier, and veryDeepFixupWith:." | namesOfWeaklyCopiedProperties weaklyCopiedValues | super veryDeepInner: deepCopier. locked := locked veryDeepCopyWith: deepCopier. visible := visible veryDeepCopyWith: deepCopier. sticky := sticky veryDeepCopyWith: deepCopier. balloonText := balloonText veryDeepCopyWith: deepCopier.
balloonTextSelector := balloonTextSelector veryDeepCopyWith: deepCopier. externalName := externalName veryDeepCopyWith: deepCopier. isPartsDonor := isPartsDonor veryDeepCopyWith: deepCopier. actorState := actorState veryDeepCopyWith: deepCopier. eventHandler := eventHandler veryDeepCopyWith: deepCopier. "has its own restrictions" otherProperties ifNil: [ ^self ]. otherProperties := otherProperties copy. self propertyNamesNotCopied do: [ :propName | otherProperties removeKey: propName ifAbsent: [] ]. namesOfWeaklyCopiedProperties := self copyWeakly. weaklyCopiedValues := namesOfWeaklyCopiedProperties collect: [ :propName | otherProperties removeKey: propName ifAbsent: [] ]. "Now copy all the others." otherProperties := otherProperties veryDeepCopyWith: deepCopier. "And replace the weak ones." namesOfWeaklyCopiedProperties with: weaklyCopiedValues do: [ :name :value | value ifNotNil: [ otherProperties at: name put: value ]].! !!MorphE xtension methodsFor: 'other' stamp: 'mt 3/10/2023 16:11'!isDefault "Return true if the receiver is a default and can be omitted" locked == true ifTrue: [^ false]. visible == false ifTrue: [^ false]. sticky == true ifTrue: [^ false]. balloonText isNil ifFalse: [^ false]. balloonTextSelector isNil ifFalse: [^ false]. externalName isNil ifFalse: [^ false]. isPartsDonor == true ifTrue: [^ false]. actorState isNil ifFalse: [^ false]. eventHandler isNil ifFalse: [^ false]. otherProperties ifNotNil: [otherProperties isEmpty ifFalse: [^ false]]. ^ true! !!MorphExtension methodsFor: 'printing' stamp: 'mt 3/10/2023 16:11'!printOn: aStream "Append to the argument, aStream, a sequence of characters that identifies the receiver." super printOn: aStream. aStream nextPutAll: ' ' , self identityHashPrintString. locked == true ifTrue: [aStream nextPutAll: ' [locked] ']. visibl e == false ifTrue: [aStream nextPutAll: '[not visible] ']. sticky == true ifTrue: [aStream nextPutAll: ' [sticky] ']. balloonText ifNotNil: [aStream nextPutAll: ' [balloonText] ']. balloonTextSelector ifNotNil: [aStream nextPutAll: ' [balloonTextSelector: ' , balloonTextSelector printString , '] ']. externalName ifNotNil: [aStream nextPutAll: ' [externalName = ' , externalName , ' ] ']. isPartsDonor == true ifTrue: [aStream nextPutAll: ' [isPartsDonor] ']. eventHandler ifNotNil: [aStream nextPutAll: ' [eventHandler = ' , eventHandler printString , '] ']. (otherProperties isNil or: [otherProperties isEmpty ]) ifTrue: [^ self]. aStream nextPutAll: ' [other: '. self otherProperties keysDo: [:aKey | aStream nextPutAll: ' (' , aKey , ' -> ' , (self otherProperties at: aKey) printString , ')']. aStream nextPut: $]! !!MorphHierarchy class methodsFor: 'opening' stamp: 'mt 8/4/2023 14:46'!openOrDelete | oldMorph | oldMorph := Project current world submorphs detect: [:each | each hasProperty: #morphHierarchy] ifNone: [| newMorph | newMorph := self new asMorph. newMorph bottomLeft: self currentHand position. newMorph openInWorld. ^ self]. "" oldMorph delete! !!MorphListItemWrapper methodsFor: 'accessing' stamp: 'mt 3/10/2023 16:07'!contents "Answer the receiver's contents" | tentative submorphs | tentative := item submorphs collect: [:each | each renderedMorph]. submorphs := tentative reject: [:each | each isKindOf: HaloMorph]. ^ submorphs collect: [:each | self class with: each]! !!MorphicModel methodsFor: 'submorphs - accessing' stamp: 'mt 3/10/2023 14:52'!allKnownNames "Return a list of all known names based on the scope of the receiver. If the receiver is a member of a uniclass, incorporate the original 1997 logic that queries the known names of the values of all the instance variables." | superNames | superNames := super allKnownNames. "gather them from submorph tree" ^self class isUniClass ifTrue: [superNames , (self instanceVariableValues select: [:e | e notNil and: [e knownName notNil]] thenCollect: [:e | e knownName])] ifFalse: [superNames]! !!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 3/8/2023 11:01'!copyFromRootsForExport: rootArray "When possible, use copySmartRootsExport:. This way may not copy a complete tree of objects. Add to roots: all of the methods pointed to from the outside by blocks." | newRoots segSize symbolHolder | arrayOfRoots := rootArray. "self halt." symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers, so they will be in outPointers" "Creation of the segment happens here" self copyFromRoots: arrayOfRoots sizeHint: 0. segSize := segment size. [(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize]. "with methods pointed at from outside" [(newRoots := self rootsIncludingBlocks) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize]. "with methods, blocks from outPointers" "Zap sender of a homeContext. Can't send live stacks out." "Why not? eem 7/3/2017 15:31" 1 to: outPointers size do: [:ii | | outPointer | outPointer := outPointers at: ii. (outPointer isBlock or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil]]. symbolHolder size "Keep reference to symbolHolder until the last"! !!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/28/2023 15:10'!copyFromRootsLocalFileFor: rootArray sizeHint: segSize arrayOfRoots := rootArr ay. self copyFromRoots: arrayOfRoots sizeHint: segSize.! !!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/28/2023 15:40'!copySmartRootsExport: rootArray "Use SmartRefStream to find the object. Make them all roots. Create the segment in memory. Project should be in first five objects in rootArray." | newRoots segSize symbolHolder replacements naughtyBlocks allClasses sizeHint proj dummy world | world := Project current world. symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers, so they will be in outPointers" dummy := ReferenceStream on: (DummyStream on: nil). "Write to a fake Stream, not a file" "Collect all objects" dummy insideASegment: true. "So Uniclasses will be traced" dummy rootObject: rootArray. "inform him about the root" dummy nextPut: rootArray. (proj :=dummy project) ifNotNil: [self dependentsSave: dummy]. allClasses := SmartRefStream new uniClassInstVarsRefs: dummy. " catalog the extra objects in UniClass inst vars. Put into dummy" allClasses do: [:cls | dummy references at: cls class put: false. "put MorphicModel5 class in roots" dummy blockers removeKey: cls class ifAbsent: []]. "refs := dummy references." arrayOfRoots := self smartFillRoots: dummy. "guaranteed none repeat" replacements := dummy blockers. dummy project "recompute it" ifNil: [self error: 'lost the project!!']. dummy project class == DiskProxy ifTrue: [self error: 'saving the wrong project']. dummy := nil. "Allow dummy to be GC'ed below (bytesLeft)." naughtyBlocks := arrayOfRoots select: [ :each | each isContext and: [each hasInstVarRef]]. "since the caller switched ActiveWorld, put the real one back temporarily" naughtyBlocks isEmpty ifFalse: [world becomeActiveDuring: [world firstHand becomeActiveDuring: [ | goodToGo | goodToGo := (Project uiM anager chooseOptionFrom: #('keep going' 'stop and take a look') title: 'Some block(s) which reference instance variables are included in this segment. These may fail when the segment is loaded if the class has been reshaped. What would you like to do?') = 1. goodToGo ifFalse: [naughtyBlocks inspect. self error: 'Here are the bad blocks']]]]. "Creation of the segment happens here" "try using one-quarter of memory min: four megs to publish (will get bumped up later if needed)" sizeHint := (Smalltalk bytesLeft // 4 // 4) min: 1024*1024. self copyFromRoots: arrayOfRoots sizeHint: sizeHint areUnique: true. segSize := segment size. [(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true]. "with methods pointed at from outsi de" [(newRoots := self rootsIncludingBlocks) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true]. "with methods, blocks from outPointers" 1 to: outPointers size do: [:ii | | outPointer | outPointer := outPointers at: ii. (outPointer isBlock or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil]. "substitute new object in outPointers" (replacements includesKey: outPointer) ifTrue: [outPointers at: ii put: (replacements at: outPointer)]]. proj ifNotNil: [self dependentsCancel: proj]. symbolHolder. "hold onto symbolHolder until the last."! !!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/16/2023 16:58'!smartFillRoots: dummy | refs known ours ww blockers | "Put all traced objects into my arrayOfRoots. Remove somethat want to be in outPointers. Return blockers, anIdentityDictionary of objects to r eplace in outPointers." blockers := dummy blockers. known := (refs := dummy references) size. refs keys do: [:obj | "copy keys to be OK with removing items" (obj isSymbol) ifTrue: [refs removeKey: obj. known := known-1]. (obj class == PasteUpMorph) ifTrue: [ obj isWorldMorph & (obj owner == nil) ifTrue: [ (dummy project ~~ nil and: [obj == dummy project world]) ifFalse: [ refs removeKey: obj. known := known-1. blockers at: obj put: (StringMorph contents: 'The worldMorph of a different world')]]]. "Make a ProjectViewMorph here" "obj class == Project ifTrue: [Transcript show: obj; cr]." (blockers includesKey: obj) ifTrue: [ refs removeKey: obj ifAbsent: [known := known+1]. known := known-1]. ]. ours := (dummy project ifNil: [Project current]) world. refs keysDo: [:obj | obj isMorph ifTrue: [ ww := obj world. (ww == ours) | (ww == nil) ifFalse: [ refs removeKey: obj. known := known-1. blockers at: obj put: (StringMorph contents: obj printString, ' from another world')]]]. "keep original roots on the front of the list" dummy rootObject do: [:rr | refs removeKey: rr ifAbsent: []]. ^dummy rootObject, refs keys asArray! !!NativeImageSegment methodsFor: 'testing' stamp: 'mt 3/8/2023 11:01'!findRogueRootsImSeg: rootArray "This is a tool to track down unwanted pointers into the segment. If we don't deal with these pointers, the segment turns out much smaller than it should. These pointers keep a subtree of objects out of the segment.1) Break all owner pointers in submorphs and all scripts.2) Create the segment and look at outPointers.3) Remove those we expect.4) Remember to quit without saving -- the owner pointers are smashed."| suspects bag1 bag2 |arrayOfRoots := rootArray.self findRogueRootsPrep. "and free that context!!"Smalltalk garbageCollect.self copyFromRoots: arrayOfRoots sizeHint: 0.suspects := outPointers select: [:oo | oo isMorph].suspects size > 0 ifTrue: [suspects inspect].bag1 := Bag new. bag2 := Bag new.outPointers do: [:key | (key isKindOf: Class) ifTrue: [bag2 add: key class name] ifFalse: [(#(Symbol Point Rectangle True False String Float Color Form ColorForm StrikeFont Metaclass UndefinedObject TranslucentColor) includes: key class name) ifTrue: [bag2 add: key class name] ifFalse: [bag1 add: key class name]]]."(bag sortedCounts) is the SortedCollection"(StringHolder new contents: bag1 sortedCounts printString, '', bag2 sortedCounts printString) openLabel: 'Objects pointed at by the outside'.self halt: 'Examine local variables pointIn and inSeg'."Use this in inspectors: outPointers select: [:oo | oo class == <a Class>]. "! !!NativeImageSegment methodsFor: 'testing' stamp: 'm t 3/10/2023 15:12'!findRogueRootsPrep "Part of the tool to track down unwanted pointers into the segment. Break all owner pointers in submorphs, scripts, and viewers in flaps."| wld morphs |wld := arrayOfRoots detect: [:obj | obj isMorph ifTrue: [obj isWorldMorph] ifFalse: [false]] ifNone: [nil].wld ifNil: [wld := arrayOfRoots detect: [:obj | obj isMorph] ifNone: [^ self error: 'can''t find a root morph']].morphs := IdentitySet new: 400.wld allMorphsDo: [:m | morphs add: m].morphs do: [:mm | "break the back pointers" mm isInMemory ifTrue: [ (mm respondsTo: #target) ifTrue: [ mm nearestOwnerThat: [:ow | ow == mm target ifTrue: [mm target: nil. true] ifFalse: [false]]]. (mm respondsTo: #arguments) ifTrue: [ mm arguments do: [:arg | arg ifNotNil: [ mm nearestOwnerThat: [:ow | ow == arg ifTrue: [mm arguments at: (mm arguments indexOf: arg) put: nil. true] ifFalse: [fal se]]]]]. mm eventHandler ifNotNil: ["recipients point back up" (morphs includesAllOf: (mm eventHandler allRecipients)) ifTrue: [ mm eventHandler: nil]]. "temporary, until using Model for PartsBin" (mm isMorphicModel) ifTrue: [ (mm model isMorphicModel) ifTrue: [ mm model breakDependents]]. (mm isTextMorph) ifTrue: [mm setContainer: nil]]].(Smalltalk includesKey: #Owners) ifTrue: [Smalltalk at: #Owners put: nil]. "in case findOwnerMap: is commented out""self findOwnerMap: morphs."morphs do: [:mm | "break the back pointers" mm isInMemory ifTrue: [mm privateOwner: nil]]."more in extensions?"! !!NebraskaCommunicatorMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/11/2023 13:59'!textEntryFieldNamed: aSymbol with: aString help: helpString | f col | f := (StringMorph new contents: aString; font: Preferences standardDefaultTextFont; yourself) setBalloonText: helpString; on: #mouseUp send: #editEvent:for: to: sel f. self field: aSymbol is: f. col := (self inAColumn: {f}) color: Color white; hResizing: #shrinkWrap. ^col! !!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:52'!acceptTo: someText forMorph: aMorph | betterText | betterText := self improveText: someText forMorph: aMorph. self transmitStreamedObject: (SmartRefStream streamedRepresentationOf: betterText) to: self ipAddress. aMorph setText: '' asText. self appendMessage: self startOfMessageFromMe, ' - ', betterText, String cr. ^true! !!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:56'!appendMessage: aText receivingPane setText: (receivingPane text append: aText).! !!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:54'!improveText: someText forMorph: aMorph | betterText conversions fontForAll | fontForAll := TextStyle default. betterText := someText veryDeepCopy. conversions := OrderedCollection new. betterText runs withStartStopAndValueDo: [:start :stop :attributes | attributes do: [:att | (att isMemberOf: TextFontChange) ifTrue: [ conversions add: {att. start. stop} ] ] ]. conversions do: [ :old | | newAttr | betterText removeAttribute: old first from: old second to: old third. newAttr := TextFontReference toFont: (fontForAll fontAt: old first fontNumber). newAttr fontNumber: old first fontNumber. betterText addAttribute: newAttr from: old second to: old third. ]. ^betterText! !!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:57'!reportError: aString receivingPane setText: (receivingPane text append: (aString asText addAttribute: TextColor red), String cr).! !!NebraskaFridgeMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:52'!acceptDroppingMorph: morphToDrop event: evt | outData | (morphToDrop i sKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt ]. self eToyRejectDropMorph: morphToDrop event: evt. "we will keep a copy" (morphToDrop isKindOf: NebraskaSenderMorph) ifTrue: [ self class addRecipient: morphToDrop. ^self rebuild ]. self stopFlashing. "7 mar 2001 - remove #veryDeepCopy" outData := SmartRefStream streamedRepresentationOf: morphToDrop. self resetIndicator: #working. self class fridgeRecipients do: [ :each | self transmitStreamedObject: outData to: each ipAddress ].! !!NebraskaMorphsWelcomeMorph methodsFor: 'initialization' stamp: 'mt 8/11/2023 13:59'!initialize "initialize the state of the receiver" | earMorph | super initialize. "" self layoutInset: 8 @ 8. "earMorph := (EToyListenerMorph makeListeningToggle: true) asMorph." earMorph := TextMorph new contents: 'Morphswelcomehere'; fontName: Preferences standardDefaultTextFont familyName size: 18; centered; lock. self addARow: {earMorph}. self setBalloonText: 'My presence in this world means received morphs may appear automatically' translated! !!NebraskaMultiChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:52'!acceptTo: someText forMorph: aMorph | streamedMessage betterText | betterText := self improveText: someText forMorph: aMorph. streamedMessage := SmartRefStream streamedRepresentationOf: {targetIPAddresses. betterText}. targetIPAddresses do: [ :each | self transmitStreamedObject: streamedMessage to: each. ]. aMorph setText: '' asText. self appendMessage: self startOfMessageFromMe, ' - ', betterText, String cr. ^true! !!NebraskaSenderMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:53'!acceptDroppingMorph: morphToDrop event: evt | myCopy outData | (morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it" "7 mar 2001 - remove #veryDeepCopy" myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position. self stopFlashing. outData := SmartRefStream streamedRepresentationOf: myCopy. self resetIndicator: #working. self transmitStreamedObject: outData to: self ipAddress.! !!NebraskaSenderMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:53'!sendStatusReply | null | null := String with: 0 asCharacter. NebraskaPeerToPeer new sendSomeData: { NebraskaIncomingMessage typeStatusReply,null. Preferences defaultAuthorName,null. (SmartRefStream streamedRepresentationOf: (NebraskaGateKeeperMorph acceptableTypesFor: self ipAddress)). } to: self ipAddress for: self.! !!NebraskaServerMorph methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:54'!rebuild | myServer toggle closeBox font | font := StrikeFont familyName: #Palatino size: 14. self removeAllMorphs. self setColorsAndBorder. self updateCurrentStatusString. toggle := SimpleHierarchicalListMorph new perform: ( fullDisplay ifTrue: [#expandedForm] ifFalse: [#notExpandedForm] ). closeBox := SimpleButtonMorph new borderWidth: 0; label: 'X' font: Preferences standardButtonFont; color: Color transparent; actionSelector: #delete; target: self; extent: 14@14; setBalloonText: 'End Nebraska session' translated. self addARow: { self inAColumn: {closeBox}. self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentStatusString; contents: sel f currentStatusString; stepTime: 2000; lock. }. self inAColumn: { toggle asMorph on: #mouseUp send: #toggleFull to: self; setBalloonText: 'Show more or less of Nebraska Status' translated }. }. myServer := self server. (myServer isNil or: [fullDisplay not]) ifTrue: [ ^self world startSteppingSubmorphsOf: self ]. "--- the expanded display ---" self addARow: { self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentBacklogString; contents: self currentBacklogString; stepTime: 2000; lock. }. }. self addARow: { self inAColumn: { (StringMorph contents: '--clients--' translated) lock; font: font. }. }. myServer clients do: [ :each | self addARow: {
UpdatingStringMorph new useStringFormat; target: each; font: font; getSelector: #currentStatusString; contents: each currentStatusString; stepTime: 2000; lock. } ]. self world startSteppingSubmorphsOf: self.! !!NebraskaServerMorph methodsFor: 'initialization' stamp: 'mt 8/23/2023 13:26'!setColorsAndBorder self color: (Color r: 0.9 g: 0.9 b: 0.9). self borderStyle: (BorderStyle raised width: 1). self useRoundedCorners! !!NetworkTerminalMorph methodsFor: 'events-processing' stamp: 'mt 8/14/2023 11:29'!handleMouseDown: anEvent anEvent wasHandled ifTrue:[^self]. anEvent hand removePendingBalloonFor: self. anEvent wasHandled: true. anEvent hand newMouseFocus: self event: anEvent. anEvent hand removeHaloFromClick: anEvent on: self. self sendEventAsIs: anEvent.! !!NetworkTerminalMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:53'!acceptDroppingMorph: morphToDrop event: evt | myCopy outData null | (morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it" "7 mar 2001 - remove #veryDeepCopy" myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position. outData := SmartRefStream streamedRepresentationOf: myCopy. null := String with: 0 asCharacter. NebraskaPeerToPeer new sendSomeData: { NebraskaIncomingMessage typeMorph,null. Preferences defaultAuthorName,null. outData } to: connection remoteSocketAddress hostNumber for: self.! !!NewHandleMorph methodsFor: 'initialization' stamp: 'mt 3/10/2023 16:07'!initialize"initialize the state of the receiver" super initialize.""
waitingForClickInside := true.! !!ObjectExplorer methodsFor: 'menus' stamp: 'mt 8/28/2023 14:40'!explorerKey: aChar from: view event: event event anyModifierKeyPressed ifFalse: [^ false]. self object ifNotNil: [ aChar == $i ifTrue: [self inspectSelection. ^ true]. aChar == $I ifTrue: [self exploreSelection. ^ true]. aChar == $b ifTrue: [self browseFull. ^ true]. aChar == $h ifTrue: [self browseClassHierarchy. ^ true]. aChar == $c ifTrue: [self copyName. ^ true]. aChar == $p ifTrue: [self browseFullProtocol. ^ true]. aChar == $N ifTrue: [self browseClassRefs. ^ true]]. ^ false! !!ObjectlandMorph methodsFor: 'projects' stamp: 'mt 8/11/2023 15:16'!fillObjectlandProject ^ self fillObjectlandProjectWith: { self createGamesProject. self createGraphicsProject. self createToolsProject. self createSoundsProject }! !!ObjectsTool methodsFor: 'search' stamp: 'mt 8/11/2023 13:59'!newSearchPan e "Answer a type-in pane for searches" | aTextMorph | aTextMorph := TextMorph new setProperty: #defaultContents toValue: ('' asText allBold addAttribute: (TextFontChange font3)); setTextStyle: (TextStyle fontArray: { Preferences standardDefaultTextFont }); setDefaultContentsIfNil; on: #keyStroke send: #searchPaneCharacter: to: self; setNameTo: 'SearchPane'; setBalloonText: 'Type here and all entries that match will be shown.' translated; vResizing: #shrinkWrap; hResizing: #spaceFill; margins: 4 px @ 6 px; backgroundColor: Color white. ^ aTextMorph! !!PackageDependencyTest methodsFor: 'tests' stamp: 'mt 3/15/2023 14:59'!testMorphic self testPackage: #Morphic dependsExactlyOn: #( Balloon #'Chronology-Core' Collections Compiler Compression Files Graphics 'Installer-Core' "Because of TheWorldMainDockingBar's install feature ..." Kernel
MonticelloConfigurations MorphicExtras Multilingual Network Sound System SystemReporter #'ToolBuilder-Kernel' #'ToolBuilder-Morphic' Tools TrueType ).! !!PackageDependencyTest methodsFor: 'failures' stamp: 'mt 3/15/2023 14:58'!expectedFailures ^ #(testSystem testTools)! !!PaintBoxMorph methodsFor: 'actions' stamp: 'mt 8/10/2023 15:31'!currentColor: aColor currentColor := aColor.! !!PaintBoxMorph methodsFor: 'initialization' stamp: 'mt 8/28/2023 14:39'!addLabels self addGraphicLabels ifFalse: [self addTextualLabels].! !!PaintBoxMorph methodsFor: 'initialization' stamp: 'mt 8/10/2023 15:30'!beSupersized "Not supported."! !!PaintBoxMorph methodsFor: 'other' stamp: 'mt 8/28/2023 14:39'!offsetFromMaxBounds "location of normal PaintBox within maxBounds." | left | left := self left. self flag: #useBiggerPaintingBox. left := left - (( self width * 1.5)- self width). ^ left - colorM emory left @ 0! !!PaintBoxMorph class methodsFor: 'instance creation' stamp: 'mt 8/28/2023 15:42'!new | pb | pb := self prototype veryDeepCopy. pb stampHolder normalize. "Get the stamps to show" "Get my own copies of the brushes so I can modify them" #(brush1: brush2: brush3: brush4: brush5: brush6:) do: [:sel | | dualUse button | button := pb submorphNamed: sel. button offImage: button offImage deepCopy. dualUse := button onImage == button pressedImage. "sometimes shared" button onImage: button onImage deepCopy. dualUse ifTrue: [button pressedImage: button onImage] ifFalse: [button pressedImage: button pressedImage deepCopy]. ]. pb showColor. pb fixUpRecentColors. pb addLabels. ^ pb! !!ParagraphEditor methodsFor: 'editing keys' stamp: 'mt 8/11/2023 14:44'!changeEmphasis: characterStream "Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change. Keeps typeahead." | keyCode attribute oldAttributes index thisSel colors extras | "control 0..9 -> 0..9" keyCode := ('0123456789' indexOf: sensor keyboard ifAbsent: [1]) - 1. oldAttributes := paragraph text attributesAt: self pointIndex forStyle: paragraph textStyle. thisSel := self selection. "Decipher keyCodes for Command 0-9..." "(keyCode between: 1 and: 5) ifTrue: [ attribute := TextFontChange fontNumber: keyCode ]." keyCode = 5 ifTrue: [ | labels lines | colors := #(#black #magenta #red #yellow #green #blue #cyan #white ). extras := #('Link to comment of class' 'Link to definition of class' 'Link to hierarchy of class' 'Link to method' ). labels := colors , #('choose color...' 'Do it' 'Print it' ) , extras , #('be a web URL link' 'Edit hidden info' 'Copy hidden info' ). lines := Array with: colors size + 1. "index := (PopUpMenu labelArra y: labels lines: lines) startUp. " index := UIManager default chooseFrom: labels lines: lines. index = 0 ifTrue: [ ^ true]. index <= colors size ifTrue: [ attribute := TextColor color: (Color perform: (colors at: index)) ] ifFalse: [ index := index - colors size - 1. "Re-number!!!!!!" index = 0 ifTrue: [ attribute := self chooseColor ]. index = 1 ifTrue: [ attribute := TextDoIt new. thisSel := attribute analyze: self selection asString ]. index = 2 ifTrue: [ attribute := TextPrintIt new. thisSel := attribute analyze: self selection asString ]. extras size = 0 & (index > 2) ifTrue: [ index := index + 4 "skip those" ]. index = 3 ifTrue: [ attribute := TextLink new. thisSel := attribute a nalyze: self selection asString with: 'Comment' ]. index = 4 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Definition' ]. index = 5 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Hierarchy' ]. index = 6 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString ]. index = 7 ifTrue: [ attribute := TextURL new. thisSel := attribute analyze: self selection asString ]. index = 8 ifTrue: [ "Edit hidden info" thisSel := self hiddenInfo. "includes selection" attribute := TextEmphasis normal ]. index = 9 ifTrue: [ "Copy hidden info"
self copyHiddenInfo. ^ true ]. "no other action" thisSel ifNil: [ ^ true ] ] ]. (keyCode between: 6 and: 9) ifTrue: [ sensor leftShiftDown ifTrue: [ keyCode = 6 ifTrue: [ attribute := TextKern kern: -1 ]. keyCode = 7 ifTrue: [ attribute := TextKern kern: 1 ] ] ifFalse: [ "And remember this: nine is fine for underline, obliter-eight it as you see fit, seven has been bold for ever'n, which leaves six as the obivous fix to emphasize your poetics." attribute := TextEmphasis perform: (#(italic bold struckOut underlined) at: keyCode - 5). oldAttributes do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]] ] ]. keyCode = 0 ifTrue: [attribute := TextEmphasis normal]. attribute ifNil: [^ true]. beginTypeInBlock ~ ~ nil ifTrue: [ "only change emphasisHere while typing" self insertTypeAhead: characterStream. emphasisHere := Text addAttribute: attribute toArray: oldAttributes. ^ true ]. self replaceSelectionWith: (thisSel asText addAttribute: attribute). ^ true! !!ParagraphEditor class methodsFor: 'class initialization' stamp: 'mt 8/11/2023 14:47'!yellowButtonMenu ^ SelectionMenu fromArray: StringHolder yellowButtonMenuItems! !!ParagraphEditor class methodsFor: 'keyboard shortcut tables' stamp: 'mt 8/11/2023 14:45'!initializeCmdKeyShortcuts "Initialize the (unshifted) command-key (or alt-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "ParagraphEditor initialize" | cmdMap | cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash" cmdMap at: 1 + 1 put: #cursorHome:. "home key" cmdMap at: 4 + 1 put: #cursorEnd:. "end key" cmdM ap at: 8 + 1 put: #backspace:. "ctrl-H or delete key" cmdMap at: 11 + 1 put: #cursorPageUp:. "page up key" cmdMap at: 12 + 1 put: #cursorPageDown:. "page down key" cmdMap at: 13 + 1 put: #crWithIndent:. "cmd-Return" cmdMap at: 27 + 1 put: #offerMenuFromEsc:. "escape key" cmdMap at: 28 + 1 put: #cursorLeft:. "left arrow key" cmdMap at: 29 + 1 put: #cursorRight:. "right arrow key" cmdMap at: 30 + 1 put: #cursorUp:. "up arrow key" cmdMap at: 31 + 1 put: #cursorDown:. "down arrow key" cmdMap at: 32 + 1 put: #selectWord:. "space bar key" cmdMap at: 127 + 1 put: #forwardDelete:. "del key" '0123456789' do: [:char | cmdMap at: char asciiValue + 1 put: #changeEmphasis:]. "triplet = {character. comment selector. novice appropiated}" #( ($a #selectAll: ) ($b #browseIt: ) ($c #copySel ection: ) ($d #doIt: ) ($e #exchange: ) ($f #find: ) ($g #findAgain: ) ($h #setSearchString: ) ($i #inspectIt: ) ($j #doAgainOnce: ) ($k #offerFontMenu: ) ($l #cancel: ) ($m #implementorsOfIt: ) ($n #sendersOfIt: ) ($o #spawnIt: ) ($p #printIt: ) ($q #querySymbol: ) ($s #save: ) ($t #tempCommand: ) ($u #align: ) ($v #paste: ) ($w #backWord: ) ($x #cut: ) ($y #swapChars: ) ($z #undo: ) ) do:[:triplet | cmdMap at: triplet first asciiV alue + 1 put: triplet second]. CmdActions := cmdMap.! !!ParagraphEditor class methodsFor: 'keyboard shortcut tables' stamp: 'mt 8/11/2023 14:46'!initializeShiftCmdKeyShortcuts "Initialize the shift-command-key (or control-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the capitalized versions of the letters. TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values." | cmdMap | "shift-command and control shortcuts" cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash" cmdMap at: ( 1 + 1) put: #cursorHome:. "home key" cmdMap at: ( 4 + 1) put: #cursorEnd:. "end key" cmdMap at: ( 8 + 1) put: #forwardDelete:. "ctrl-H or delete key" cmdMap at: (11 + 1) put: #cursorPageUp:. "page up key" cmdMap at: (12 + 1) put: #cursorPageDown:. "page down key" cmdMap at: (13 + 1) put: #crWithIndent:. "ctrl-Return" cmdMap at: (27 + 1) put: #offerMenuFromEsc:. "escape key" cmdMap at: (28 + 1) put: #cursorLeft:. "left arrow key" cmdMap at: (29 + 1) put: #cursorRight:. "right arrow key" cmdMap at: (30 + 1) put: #cursorUp:. "up arrow key" cmdMap at: (31 + 1) put: #cursorDown:. "down arrow key" cmdMap at: (32 + 1) put: #selectWord:. "space bar key" cmdMap at: (45 + 1) put: #changeEmphasis:. "cmd-sh-minus" cmdMap at: (61 + 1) put: #changeEmphasis:. "cmd-sh-plus" cmdMap at: (127 + 1) put: #forwardDelete:. "del key" "triplet = {character. comment selector. novice appropiated}" #( ($a argAdvance: ) ($b browseItHere: ) ($c compareToClipboard: ) ($d debugIt:
) ($e methodStringsContainingIt:) ($f displayIfFalse: ) ($g fileItIn: ) ($h cursorTopHome: ) ($i exploreIt: ) ($j doAgainMany: ) ($k changeStyle: ) ($m selectCurrentTypeIn: ) ($n referencesToIt: ) ($p makeProjectLink: ) ($s search: ) ($t displayIfTrue: ) ($u changeLfToCr: ) ($v pasteInitials: ) ($w methodNamesContainingIt:) ($x makeLowercase: ) ($y makeUppercase: ) ($z makeCapitalized: ) ) do:[:triplet | cmdMap at: (triplet first asciiValue + 1) put: tr iplet second. "plain keys" cmdMap at: (triplet first asciiValue - 32 + 1) put: triplet second. "shifted keys" cmdMap at: (triplet first asciiValue - 96 + 1) put: triplet second. "ctrl keys" ]. ShiftCmdActions := cmdMap! !!PasteUpMorph methodsFor: 'accessing' stamp: 'mt 8/11/2023 16:19'!flapTab "Answer the tab affilitated with the receiver. Normally every flap tab is expected to have a PasteUpMorph which serves as its 'referent.'" self isFlap ifFalse: [^ nil]. ^ self flapTabs detect: [:any| any referent == self] ifNone: [nil]! !!PasteUpMorph methodsFor: 'caching' stamp: 'mt 3/10/2023 15:07'!releaseCachedState super releaseCachedState. self isWorldMorph ifTrue:[self cleanseStepList].! !!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'mt 8/14/2023 17:42'!acceptDroppingMorph: dropped event: evt "The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitatin g event is supplied" | aMorph | (self isWorldMorph and: [dropped isTransferMorph] and: [self hasTransferMorphConverter not]) ifTrue: [ dropped dragTransferType = #filesAndDirectories ifTrue: [^ self dropFiles: dropped passenger event: evt]. dropped dragTransferType = #sourceCode ifTrue: [^ self dropSourceCode: dropped passenger event: evt]. dropped dragTransferType = #inspectorField "See Tools-Inspector" ifTrue: [^ self dropInspectorField: dropped passenger event: evt]. dropped dragTransferType = #explorerField "See Tools-Explorer" ifTrue: [^ self dropExplorerField: dropped passenger from: dropped source model event: evt]]. aMorph := self morphToDropFrom: dropped. self isWorldMorph ifFalse: [super acceptDroppingMorph: aMorph event: evt] ifTrue: ["Add the given morph to this world and start s tepping it if it wants to be." aMorph isInWorld ifFalse: [aMorph position: evt position]. self addMorphFront: aMorph. (aMorph fullBounds intersects: self viewBox) ifFalse: [Beeper beep. aMorph position: self bounds center]]. aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]]. self isPartsBin ifTrue: [aMorph isPartsDonor: true. aMorph stopSteppingSelfAndSubmorphs. aMorph suspendEventHandler] ifFalse: [self world startSteppingSubmorphsOf: aMorph]. self bringTopmostsToFront.! !!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'mt 8/14/2023 17:41'!morphToDropFrom: aMorph "Given a morph being carried by the hand which the hand is about to drop, answer the actual morph to be deposited. Normally this would be just the morph itself, but several unusual cases arise, which this method is designed to service." | aNail rep resentee handy posBlock | handy := self isWorldMorph ifTrue: [self primaryHand] ifFalse: [self currentHand]. posBlock := [:z | | tempPos | tempPos := handy position - ((handy targetOffset - aMorph formerPosition) * (z extent / aMorph extent)) rounded. self pointFromWorld: tempPos]. self alwaysShowThumbnail ifTrue: [aNail := aMorph representativeNoTallerThan: self maxHeightToAvoidThumbnailing norWiderThan: self maximumThumbnailWidth thumbnailHeight: self heightForThumbnails. aNail == aMorph ifFalse: [aMorph formerPosition: aMorph position. aNail position: (posBlock value: aNail)]. ^aNail]. ((aMorph isKindOf: MorphThumbnail) and: [(representee := aMorph morphRepresented) owner isNil]) ifT rue: [representee position: (posBlock value: representee). ^representee]. ^aMorph morphToDropInPasteUp: self! !!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/15/2023 13:45'!handlesKeyboard: evt ^self isWorldMorph! !!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/15/2023 13:45'!keyStroke: anEvent "A keystroke has been made. Service event handlers and, if it's a keystroke presented to the world, dispatch it to #unfocusedKeystroke:" | selected | super keyStroke: anEvent. "Give event handlers a chance" selected := self selectedObject. selected isNil ifFalse:[ selected moveOrResizeFromKeystroke: anEvent ]. self isWorldMorph ifTrue: [self keystrokeInWorld: anEvent]! !!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 16:08'!mouseDown: evt "Handle a mouse down event." | grabbedMorph handHadHalos | (Preferences generalizedYellowButtonMenu and: [evt yellowButtonPressed])
ifTrue: [^ self yellowButtonActivity: evt shiftPressed]. grabbedMorph := self morphToGrab: evt. grabbedMorph ifNotNil:[ grabbedMorph isSticky ifTrue:[^self]. self isPartsBin ifFalse:[^evt hand grabMorph: grabbedMorph]. grabbedMorph := grabbedMorph partRepresented duplicate. grabbedMorph restoreSuspendedEventHandler. (grabbedMorph fullBounds containsPoint: evt position) ifFalse:[grabbedMorph position: evt position]. "Note: grabbedMorph is ownerless after duplicate so use #grabMorph:from: instead" ^ evt hand grabMorph: grabbedMorph from: self]. (super handlesMouseDown: evt) ifTrue:[^super mouseDown: evt]. handHadHalos := evt hand halo notNil. evt hand removeHalo. "shake off halos" evt hand releaseKeyboardFocus. "shake of keyboard foci" self submorphs select:[:each | each hasProperty: #morphHierarchy] thenDo:[:each | each delete]. (evt shiftPressed not and:[ self isWorldMorph not and:[ self wantsEasySelection not ]]) ifTrue:[ "explicitly ignore the event if we're not the world and we'll not select, so that we could be picked up if need be" evt wasHandled: false. ^ self. ]. ( evt shiftPressed or: [ self wantsEasySelection ] ) ifTrue:[ "We'll select on drag, let's decide what to do on click" | clickSelector | clickSelector := nil. evt shiftPressed ifTrue:[ clickSelector := #findWindow:. ] ifFalse:[ self isWorldMorph ifTrue:[ clickSelector := handHadHalos ifTrue: [ #delayedInvokeWorldMenu: ] ifFalse: [ #invokeWorldMenu: ] ] ]. evt hand waitForClicksOrDrag: self event: evt selectors: { clickSelector. nil. nil. #dragThroughOnDesktop: } threshold: Hand Morph dragThreshold. ] ifFalse:[ "We wont select, just bring world menu if I'm the world" self isWorldMorph ifTrue:[ handHadHalos ifTrue: [ self delayedInvokeWorldMenu: evt ] ifFalse: [ self invokeWorldMenu: evt ] ] ].! !!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/7/2023 18:18'!windowEvent: anEvent self windowEventHandler ifNotNil: [^self windowEventHandler windowEvent: anEvent]. anEvent type caseOf: { [#windowClose] -> [TheWorldMenu basicNew quitSession]. [#windowDeactivated] -> [ "The host window has been deactivated. Until it regains the focus, honor the fact that we will not receive keyboard events again by changing the current keyboard focus morph. windowHostFocusMorph represents the host system which now holds the keyboard focus instead of the previousFocus." (self valueOfProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | "There is currently no exact-once guarantee for this event type from the VM. Mark any older host focus morph as inactive, it will be held as the previousFocus of the next host focus morph." hostFocus active: false]. self setProperty: #windowHostFocusMorph toValue: (WindowHostFocusMorph new in: [:hostFocus | hostFocus previousFocus: anEvent hand keyboardFocus. anEvent hand newKeyboardFocus: hostFocus.]; yourself)]. [#windowActivated] -> [ "Alright, the spook is over!! We have back control over the keyboard focus, delete the windowHostFocusMorph and restore the previous focus holder." (self removeProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | hostFocus active: false. (anEvent hand keyboardFocus == hostFocus and: [hostFocus previousF ocus notNil]) ifTrue: [anEvent hand newKeyboardFocus: hostFocus previousFocus]]]. } otherwise: []! !!PasteUpMorph methodsFor: 'events-processing' stamp: 'mt 3/10/2023 16:09'!tryInvokeHalo: aUserInputEvent Morph haloForAll ifFalse: [ ^ self ]. (self transferHalo: aUserInputEvent) ifTrue: "The event was handled, don't let it cause any further side-effects." [ aUserInputEvent ignore ].! !!PasteUpMorph methodsFor: 'events-processing' stamp: 'mt 3/10/2023 11:27'!tryInvokeMetaMenu: anEvent | innerMost target | Morph metaMenuForAll ifFalse: [^ self]. innerMost := (self morphsAt: anEvent position unlocked: true) first. "Traverse the owner chain if some morph does not want to show its meta menu." target := innerMost. [target isNil or: [target wantsMetaMenu]] whileFalse: [target := target owner]. target ifNil: [^ self]. target invokeMetaMenu: anEvent. anEvent ignore.! !!PasteUpMorph methodsFor: 'ha los and balloon help' stamp: 'mt 3/7/2023 17:39'!wantsHaloFromClick (owner isSystemWindow) ifTrue: [^ false]. ^ true.! !!PasteUpMorph methodsFor: 'initialization' stamp: 'mt 3/10/2023 15:29'!initialize"initialize the state of the receiver" super initialize."" padding := 3. self enableDragNDrop. self clipSubmorphs: true. self initializeKeyboardShortcuts. self initializeMouseShortcuts.! !!PasteUpMorph methodsFor: 'menu & halo' stamp: 'mt 8/11/2023 16:18'!addCustomMenuItems: menu hand: aHandMorph "Add morph-specific menu itemns to the menu for the hand" super addCustomMenuItems: menu hand: aHandMorph. self isWorldMorph ifTrue: [ | twm | menu addLine. menu addUpdating: #showWorldMainDockingBarString action: #toggleShowWorldMainDockingBar. menu addLine. Flaps sharedFlapsAllowed ifTrue: [ menu addUpdating: #suppressFlapsString
target: Project current action: #toggleFlapsSuppressed. ]. twm := TheWorldMenu new. twm world: self project: Project current hand: aHandMorph. menu add: 'old desktop menu... (W)' translated subMenu: twm buildWorldMenu. ].! !!PasteUpMorph methodsFor: 'menu & halo' stamp: 'mt 8/16/2023 16:02'!addWorldHaloMenuItemsTo: aMenu hand: aHandMorph "Add standard halo items to the menu, given that the receiver is a World" | unlockables | self addFillStyleMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph. aMenu addLine. self addWorldToggleItemsToHaloMenu: aMenu. aMenu addLine. self addCopyItemsTo: aMenu. self addExportMenuItems: aMenu hand: aHandMorph. self addMiscExtrasTo: aMenu. self addDebuggingItemsTo: aMenu hand: aHandMorph. aMenu addLine. aMenu defaultTarget: self. aMenu addLine. unlockables := self submorphs select: [:m | m isLo cked]. unlockables size = 1 ifTrue: [aMenu add: ('unlock "{1}"' translated format:{unlockables first externalName})action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' translated action: #unlockContents]. aMenu defaultTarget: aHandMorph.! !!PasteUpMorph methodsFor: 'options' stamp: 'mt 8/4/2023 14:08'!autoLineLayout: aBoolean "Make the receiver be viewed with auto-line-layout, which means that its submorphs will be laid out left-to-right and then top-to-bottom in the manner of a word processor, or (if aBoolean is false,) cease applying auto-line-layout" aBoolean ifTrue:[ self layoutPolicy: TableLayout new. self layoutInset: 8; cellGap: 4. self listDirection: #leftToRight; wrapDirection: #topToBottom. ] ifFalse:[ self layoutPolicy: nil. self layoutInset: 0; cellGap: 0. ].! !!PasteUpMorph methodsFor: 'undo' stamp: 'fbs 12/31/2013 12:08'!onceAgainDismiss: aMorph "Occasioned by a r edo of a dismiss-via-halo" aMorph dismissMorph. TrashCanMorph preserveTrash ifTrue: [TrashCanMorph slideDismissalsToTrash ifTrue:[aMorph slideToTrash: nil] ifFalse:[TrashCanMorph moveToTrash: aMorph]]! !!PasteUpMorph methodsFor: 'undo' stamp: 'mt 8/4/2023 14:45'!reintroduceIntoWorld: aMorph "The given morph is being raised from the dead. Bring it back to life." (aMorph valueOfProperty: #lastPosition) ifNotNil: [:pos | aMorph position: pos]. aMorph openInWorld ! !!PasteUpMorph methodsFor: 'WiW support' stamp: 'raa 11/14/2017 07:47'!installAsActiveSubprojectIn: enclosingWorld at: newBounds titled: aString | window howToOpen tm boundsForWorld | howToOpen := self embeddedProjectDisplayMode. "#scaled may be the only one that works at the moment" submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." boundsForWorld := howToOpen == #naked ifTrue : [newBounds] ifFalse: [bounds]. worldState canvas: nil. worldState viewBox: boundsForWorld. self bounds: boundsForWorld. "self viewBox: Display boundingBox." "worldState handsDo: [:h | h initForEvents]." self installFlaps. "SystemWindow noteTopWindowIn: self." "self displayWorldSafely." howToOpen == #naked ifTrue: [enclosingWorld addMorphFront: self]. howToOpen == #window ifTrue: [window := (SystemWindow labelled: aString) model: self. window addMorph: self frame: (0 @ 0 extent: 1.0 @ 1.0). window openInWorld: enclosingWorld]. howToOpen == #frame ifTrue: [window := (AlignmentMorphBob1 new) minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color green; bounds: newBounds. window addMorph: self. window openInWorld: enclosingWorld]. howToOp en == #scaled ifTrue: [self position: 0 @ 0. window := (EmbeddedWorldBorderMorph new) minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color green; bounds: newBounds. tm := BOBTransformationMorph new. window addMorph: tm. tm addMorph: self. window openInWorld: enclosingWorld. tm changeWorldBoundsToShow: bounds. self arrangeToStartSteppingIn: enclosingWorld "tm scale: (tm width / self width min: tm height / self height) asFloat."]! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 8/14/2023 17:32'!findWindow: evt "Present a menu names of windows and naked morphs, and activate the one that gets chosen. Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo." | menu expanded collapsed nakedMorphs | menu := MenuMorph new. expanded := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed not]. collapsed := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed]. nakedMorphs := self submorphsSatisfying: [:m | m isSystemWindow not and: [(m isFlapTab) not]]. (expanded isEmpty & (collapsed isEmpty & nakedMorphs isEmpty)) ifTrue: [^ Beeper beep]. (expanded sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: (w label contractTo: 80) target: w action: #beKeyWindow. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. (expanded isEmpty | (collapsed isEmpty & nakedMorphs isEmpty)) ifFalse: [menu addLine]. (collapsed sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: (w labe l contractTo: 80) target: w action: #collapseOrExpand. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. nakedMorphs isEmpty ifFalse: [menu addLine]. (nakedMorphs sort: [:w1 :w2 | w1 nameForFindWindowFeature caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) do: [:w | menu add: (w nameForFindWindowFeature contractTo: 80) target: w action: #comeToFrontAndAddHalo]. menu addTitle: 'find window' translated. menu popUpEvent: evt in: self.! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 11:27'!invokeWorldMenu: evt "Put up the world menu, triggered by the passed-in event." self putUpWorldMenu: evt.! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 11:27'!keystrokeInWorld: evt "A keystroke was hit when no keyboard focus was set, so it is sent here to the world instead." | aChar isCmd ascii | aChar := evt keyCharacter. (ascii := aChar asciiValue) = Character escape asciiValue ifTrue: [evt commandKeyPressed ifFalse: [^ self putUpWorldMenuFromEscapeKey]]. (evt controlKeyPressed not and: [(#(1 4 8 28 29 30 31 32) includes: ascii) "home, end, backspace, arrow keys, space" and: [self keyboardNavigationHandler notNil]]) ifTrue: [self keyboardNavigationHandler navigateFromKeystroke: aChar]. isCmd := evt commandKeyPressed and: [Preferences cmdKeysInText]. (isCmd and: [Preferences honorDesktopCmdKeys]) ifTrue: [^ self dispatchCommandKeyInWorld: aChar event: evt]. "It was unhandled. Remember the keystroke." self lastKeystroke: evt keyString. self triggerEvent: #keyStroke! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/8/2023 10:36'!putUpNewMorphMenu "Put up the New Morph menu in the world" TheWorldMenu new world: self project: Project current hand: self currentHand; newMorph! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 16:08'!putUpWorldMenuFromEscapeKey
self putUpWorldMenu: self currentEvent.! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/10/2023 13:57'!allNonWindows "Answer all non-window submorphs" ^submorphs select: [:m | (m isSystemWindow) not and: [m wantsToBeTopmost not]]! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/10/2023 15:29'!beWorldForProject: aProject self privateOwner: nil. worldState := WorldState new. self addHand: HandMorph new. self setProperty: #optimumExtentFromAuthor toValue: Display extent. self startSteppingSubmorphsOf: self! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/15/2023 13:18'!initForProject: aWorldState worldState := aWorldState. self viewBox: Display boundingBox. self color: Preferences defaultWorldColor. self addHand: HandMorph new. self setProperty: #optimumExtentFromAuthor toValue: Display extent. self borderWidth: 0. model := nil.! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 8/11/2023 16:20'!install owner := nil. "since we may have been inside another world previously" submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." self viewBox: Display boundingBox. EventSensor default flushEvents. worldState handsDo: [:h | h initForEvents]. self installFlaps. self borderWidth: 0. "default" (Preferences showSecurityStatus and: [SecurityManager default isInRestrictedMode]) ifTrue: [self borderWidth: 2; borderColor: Color red]. SystemWindow noteTopWindowIn: self.! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 8/10/2023 15:27'!paintBox "Return the painting controls widget (PaintBoxMorph) to be used for painting in this world. If there is not already a PaintBox morph, or if it has been deleted from this world, create a new one." | newPaintBox refPoint | self allMorphsDo: [:m | (m isKindOf: PaintB oxMorph) ifTrue: [^ m]]. refPoint := self topRight. newPaintBox := PaintBoxMorph new. newPaintBox position: (refPoint - (newPaintBox width @ 0)). self addMorph: newPaintBox. ^ newPaintBox! !!PasteUpMorph methodsFor: 'world state' stamp: 'sw 9/2/1999 12:01'!paintBoxOrNil "Return the painting controls widget (PaintBoxMorph) to be used for painting in this world. If there is not already a PaintBox morph return nil" self allMorphsDo: [:m | (m isKindOf: PaintBoxMorph) ifTrue: [^ m]]. ^ nil! !!PasteUpMorph methodsFor: '*Tools' stamp: 'mt 3/10/2023 16:08'!defaultDesktopCommandKeyTriplets "Answer a list of triplets of the form <key> <receiver> <selector> [+ optional fourth element, a <description> for use in desktop-command-key-help] that will provide the default desktop command key handlers. If the selector takes an argument, that argument will be the command-key event" "World initializeDesktopCommandKeySelectors" | noviceKeys expertKeys | no viceKeys := { {$r. self. #restoreMorphicDisplay. 'Redraw the screen' translated}. {$M. self. #toggleShowWorldMainDockingBar. 'Show/Hide the Main Docking Bar' translated}. {$]. Smalltalk. #saveSession. 'Save the image.' translated}. }. expertKeys := { {$b. SystemBrowser. #defaultOpenBrowser. 'Open a new System Browser' translated}. {$k. Workspace. #open. 'Open a new Workspace' translated}. {$m. self. #putUpNewMorphMenu. 'Put up the "New Morph" menu' translated}. {$O. self. #findAMonticelloBrowser. 'Bring a Monticello window into focus.' translated}. {$t. self. #findATranscript:. 'Make a System Transcript visible' translated}. {$w. SystemWindow. #closeTopWindow. 'Close the topmost window' translated}. {Character escape. SystemWindow. #closeTopWindow. 'Close the topmost window' translated}. {$C. self. #findAChangeSorter:. 'Make a Change Sorter visible' translated}. {$L. self. #findAFileList:. 'Make a File List visible' translated}. {$P. self. #findAPreferencesPanel:. 'Activate the Preferences tool' translated}. {$R. Utilities. #browseRecentSubmissions. 'Make a Recent Submissions browser visible' translated}. {$W. self. #findAMessageNamesWindow:. 'Make a MessageNames tool visible' translated}. {$Z. ChangeList. #browseRecentLog. 'Browse recently-logged changes' translated}. {$. SystemWindow. #sendTopWindowToBack. 'Send the top window to the back' translated}. {$_. Smalltalk. #quitPrimitive. 'Quit the image immediately.' translated}. {$-. Preferences. #decreaseFontSize. 'Decrease all font sizes' translated}. {$+. Preferences. #increaseFontSize. 'Increase all font sizes' translated}. }. ^ noviceKeys, expertKeys! !!PasteUpMorph methodsFor: 'flaps' stamp: 'mt 8/4/2023 14:02'!addGlobalFlaps "Must make global flaps adapt to world. Do this even if not shown, so the old world will not be pointed at by the flaps." | use thisWorld | use := Flaps sharedFlapsAllowed. Project current flapsSuppressed ifTrue: [use := false]. "Smalltalk isMorphic ifFalse: [use := false]." thisWorld := use ifTrue: [self] ifFalse: [PasteUpMorph new initForProject: "fake to be flap owner" WorldState new; bounds: (0@0 extent: 4000@4000); viewBox: (0@0 extent: 4000@4000)]. Flaps globalFlapTabsIfAny do: [:aFlapTab | (Project current isFlapEnabled: aFlapTab) ifTrue: [(aFlapTab world == thisWorld) ifFalse: [thisWorld addMorphFront: aFlapTab]. "always do" use ifTrue: [aFlapTab spanWorld. aFlapTab adjustPositionAfterHidingFlap. aFlapTab flapShowing ifTrue: [aFlapTab showFlap]]]]! !!PasteUpMorph methodsFor: 'flaps' stamp: 'nice 12/27/2009 20:14'!localFlapTabs "Answer a list of local fla p tabs in the current project" | globalList aList | globalList := Flaps globalFlapTabsIfAny. aList := OrderedCollection new. submorphs do: [:m | | aFlapTab | ((m isFlapTab) and: [(globalList includes: m) not]) ifTrue: [aList add: m] ifFalse: [((m isFlap) and: [(aFlapTab := m submorphs detect: [:n | n isFlapTab] ifNone: [nil]) notNil]) ifTrue: [aList add: aFlapTab]]]. ^ aList! !!PasteUpMorph methodsFor: '*services-base' stamp: 'mt 8/4/2023 14:03'!openWorldMenu | menu | menu := (TheWorldMenu new world: self project: nil hand: self primaryHand) buildWorldMenu. menu addTitle: Preferences desktopMenuTitle translated. menu openInHand! !!PasteUpMorph methodsFor: '*services-base' stamp: 'mt 8/28/2023 14:42'!worldMenu ^ TheWorldMenu new world: self project: nil hand: self primaryHand! !!PasteUpMorph class methodsFor: 'scripting' stamp: 'mt 3/15/2023 13:30'!authoringPrototype "Answer an instance of the receiver suitable for placing in a parts bin for authors" | proto | proto := self new markAsPartsDonor. proto color: Color green muchLighter; extent: 100 @ 80; borderColor: (Color r: 0.645 g: 0.935 b: 0.161). proto extent: 300 @ 240. proto beSticky. ^ proto! !!PasteUpMorph class methodsFor: '*MorphicExtras-class initialization' stamp: 'mt 7/31/2023 11:14'!initialize "Initialize the class" self registerInFlapsRegistry.! !!PolygonMorph methodsFor: 'stepping' stamp: 'mt 3/10/2023 15:01'!stepTime "Answer the desired time between steps in milliseconds." ^ 100! !!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:59'!printStandardSystemFonts "self printStandardSystemFonts" | string | string := String streamContents: [ :s | #(standardDefaultTextFont standardListFont standardFlapFont standardMenuFont windowTitleFont standardBalloonHelpFont standardCodeFont standardButtonFont) do: [:selector | | font | font := Preferences perform: selector. s nextPutAll: selector; space; nextPutAll: font familyName; space; nextPutAll: (AbstractFont emphasisStringFor: font emphasis); nextPutAll: ' points: '; print: font pointSize; nextPutAll: ' height: '; print: font height; cr ]]. (StringHolder new) contents: string; openLabel: 'Current system font settings' translated.! !!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:58'!refreshFontSettings "Try to update all the current font settings to make things consistent." UserInterfaceTheme current applyAfter: [ self setFlapsFontTo: (self standardFlapFont); setWindowTitleFontTo: (self windowTitleFont); setListFontTo: (self standardListFont); setMenuFontTo: (self standardMenuFont);
setSystemFontTo: (TextStyle defaultFont); setCodeFontTo: (self standardCodeFont); setBalloonHelpFontTo: (BalloonMorph balloonFont)]. SystemWindow allSubInstancesDo: [ :s | | rawLabel | rawLabel := s getRawLabel. rawLabel owner vResizing: #spaceFill. rawLabel font: rawLabel font. s setLabel: s label. s replaceBoxes ].! !!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:59'!restoreFontsAfter: aBlock "Restore the currently chosen set of standard fonts after evaluating aBlock. Used for tests that modify the default fonts." | standardDefaultTextFont standardListFont standardMenuFont windowTitleFont standardBalloonHelpFont standardCodeFont standardButtonFont | standardDefaultTextFont := Preferences standardDefaultTextFont. standardListFont := Preferences standardListFont. standardMenuFont := Preferences standardMenuFont. windowTitleFont := Preferences windowTitleFont. standardBalloonHelpFont := Preferences standardBalloonHelpFont. standardCodeFont := Preferences standardCodeFont. standardButtonFont := Preferences standardButtonFont. ^ UserInterfaceTheme current applyAfter: [ aBlock ensure: [ Preferences setSystemFontTo: standardDefaultTextFont. Preferences setListFontTo: standardListFont. Preferences setMenuFontTo: standardMenuFont. Preferences setWindowTitleFontTo: windowTitleFont. Preferences setBalloonHelpFontTo: standardBalloonHelpFont. Preferences setCodeFontTo: standardCodeFont. Preferences setButtonFontTo: standardButtonFont]].! !!Preferences class methodsFor: 'support - misc' stamp: 'mt 3/7/2023 15:42'!personalizeUserMenu: aMenu "The user has clicked on the morphic desktop with the yellow mouse button (option+click on the Mac); a menu is being constructed to present to the user in response; its default target is the current world. In th is method, you are invited to add items to the menu as per personal preferences. The default implementation, for illustrative purposes, sets the menu title to 'personal', and adds items for go-to-previous-project, show/hide flaps, and load code updates" aMenu addTitle: 'personal' translated. "Remove or modify this as per personal choice" aMenu addStayUpItem. aMenu add: 'previous project' translated action: #goBack. aMenu add: 'load latest code updates' translated target: MCMcmUpdater action: #updateFromServer. aMenu add: 'about this system...' translated target: Smalltalk action: #aboutThisSystem.! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'!classicHaloSpecs "Non-iconic halos with traditional placements" "Preferences installClassicHaloSpecs" "Preferences resetHaloSpecifications" " <- will result in the standard default halos being reinstalled" "NB: listed below in clockwise order" ^ #( " selecto r horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addMenuHandle: left top (red) none) (addDismissHandle: leftCenter top (red muchLighter) 'Halo-Dismiss') (addGrabHandle: center top (black) none) (addDragHandle: rightCenter top (brown) none) (addDupHandle: right top (green) none) (addDebugHandle: right topCenter (blue veryMuchLighter) none) (addGrowHandle: right bottom (yellow) none) (addScaleHandle: right bottom (lightOrang e) none) (addFontEmphHandle: rightCenter bottom (lightBrown darker) none) (addFontStyleHandle: center bottom (lightRed) none) (addFontSizeHandle: leftCenter bottom (lightGreen) none) (addRecolorHandle: right bottomCenter (magenta darker) none) (addRotateHandle: left bottom (blue) none))! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/8/2023 11:41'!customHaloSpecs "Intended for you to modify to suit your personal preference. What is implemented in the default here is just a skeleton; in comment at the bottom of this method are some useful lines you may wish to paste in to the main body here, possibly modifying positions, colors, etc.. Note that in this example, we include: Dismiss handle, at top-left M enu handle, at top-right Resize handle, at bottom-right Rotate handle, at bottom-left Drag handle, at top-center Recolor handle, at left-center. (this one is NOT part of the standard formulary -- it is included here to illustrate how to add non-standard halos) Note that the optional handles for specialized morphs, such as Sketch, Text, PasteUp, are also included" ^ #( (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addMenuHandle: right top (red) 'Halo-Menu') (addDragHandle: center top (brown) 'Halo-Drag') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bot tom (lightOrange) 'Halo-Scale') (addRecolorHandle: left center (green muchLighter lighter) 'Halo-Recolor') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') ) " Other useful handles... selector horiz vert color info icon key --------- ------ ----------- ------------------------------- --------------- (addTileHandle: left bottomCenter (lightBrown) 'Halo-Tile') (addViewHandle: left center (cyan) 'Halo-View') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addFewerHandlesHandle: left topCenter (paleBuff) 'Halo-FewerHandles') (addPaintBgdHandle: right center (lightGray) 'Halo-Paint') (addRepaintHandle: right center (lightGray) 'Halo-Paint ') "! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/8/2023 11:30'!haloSpecificationsForWorld | desired | "Answer a list of HaloSpecs that describe which halos are to be used on a world halo, what they should look like, and where they should be situated" "Preferences resetHaloSpecifications" desired := #(addDebugHandle: addMenuHandle: addHelpHandle: addRecolorHandle:). ^ self haloSpecifications select: [:spec | desired includes: spec addHandleSelector]! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'!iconicHaloSpecifications "Answer an array that characterizes the locations, colors, icons, and selectors of the halo handles that may be used in the iconic halo scheme" "Preferences resetHaloSpecifications" ^ #( " selector horiz vert color info icon key --------- ------ ----------- -------------------------------
---------------" (addCollapseHandle: left topCenter (tan) 'Halo-Collapse') (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addMenuHandle: leftCenter top (red) 'Halo-Menu') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue)
'Halo-Help') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor') ) ! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'!simpleFullHaloSpecifications "This method gives the specs for the 'full' handles variant when simple halos are in effect" "Preferences resetHaloSpecifications" ^ #( " selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addMenuHandle: leftCenter top (red) 'Halo-Menu') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale') (addFewerHandlesHandle: left topCenter (paleBuff) 'Halo-FewerHandles') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor') ) ! !!Preferences class methodsFor: 'defaults' stamp: 'mt 8/29/2023 15:25'!defaultValueTableForCurrentRelease "Answer a table defining default values for all the prefere nces in the release. Returns a list of (pref-symbol, boolean-symbol) pairs" ^ #( (alternativeBrowseIt false) (annotationPanes false) (areaFillsAreTolerant false) (areaFillsAreVeryTolerant false) (automaticKeyGeneration false) (balloonHelpEnabled true) (balloonHelpInMessageLists false) (caseSensitiveFinds false) (changeSetVersionNumbers true) (checkForSlips true) (checkForUnsavedProjects true) (cmdDotEnabled true) (collapseWindowsInPlace false) (confirmFirstUseOfStyle true) (conversionMethodsAtFileOut false) (debugHaloHandle true) (debugPrintSpaceLog false) (debugShowDamage false) (decorateBrowserButtons true) (diffsInChangeList true) (diffsWithPrettyPrint false) (dismissAllOnOptionClose false) (fastDragWindowForMorphic true) (fullScreenLeavesDeskMargins true) (higherPerformance false) (honorDesktopCm dKeys true) (logDebuggerStackToFile true) (menuKeyboardControl false) (modalColorPickers true) (mouseOverForKeyboardFocus false) (navigatorOnLeftEdge true) (optionalButtons true) (passwordsOnPublish false) (personalizedWorldMenu true) (postscriptStoredAsEPS false) (projectViewsInWindows true) (projectZoom true) (projectsSentToDisk false) (readDocumentAtStartup true) (restartAlsoProceeds false) (reverseWindowStagger true) (roundedMenuCorners true) (scrollBarsNarrow false) (scrollBarsOnRight true) (securityChecksEnabled false) (showBoundsInHalo false) (showDirectionForSketches false) (showDirectionHandles false) (showProjectNavigator false) (showSecurityStatus true) (signProjectFiles true) (smartUpdating true) (startInUntrustedDirectory false) (systemWindowEmbedOK false) (timeStampsInMenuTitles true) (turnOffPowerManager false) (twentyFourHourFileStamps true) (uniqueNamesInHalos false) (useButtonPropertiesToFire false) (warnAboutInsecureContent true) (warnIfNoChangesFile true) (warnIfNoSourcesFile true))"Preferences defaultValueTableForCurrentRelease do: [:pair | (Preferences preferenceAt: pair first ifAbsent: [nil]) ifNotNilDo: [:pref | pref defaultValue: (pair last == true)]].Preferences chooseInitialSettings."! !!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/10/2023 16:09'!disableProgrammerFacilities "Warning: do not call this lightly!! It disables all access to menus, debuggers, halos. There is no guaranteed return from this, which is to say, you cannot necessarily reenable these things once they are disabled -- you can only use whatever the UI of the current project affords, and you cannot even snapshot -- you can only quit. You can completely r everse the work of this method by calling the dual Preferences method enableProgrammerFacilities, provided you have left yourself leeway to bring about a call to that method. To set up a system that will come up in such a state, you have to request the snapshot in the same breath as you disable the programmer facilities. To do this, put the following line into the 'do' menu and then evaluate it from that 'do' menu: Preferences disableProgrammerFacilities.You will be prompted for a new image name under which to save the resulting image." Beeper beep. (self confirm: 'CAUTION!!!!This is a drastic step!!Do you really want to do this?') ifFalse: [Beeper beep. ^self inform: 'whew!!']. self disable: #cmdDotEnabled. "No user-interrupt-into-debugger" self compileAccessorForPreferenceNamed: #cmdGesturesEnabled value: false. "No halos, etc." self compileAccessorForPreferenceNamed: #cmdKeysInText value: false. "No user commands invokable via cmd-key combos in text editor" self disable: #warnIfNoSourcesFile. self disable: #warnIfNoChangesFile. Smalltalk saveAs! !!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/10/2023 16:09'!enableProgrammerFacilities "Meant as a one-touch recovery from a #disableProgrammerFacilities call." "Preferences enableProgrammerFacilities" self enable: #cmdDotEnabled. self compileAccessorForPreferenceNamed: #cmdGesturesEnabled value: true. self compileAccessorForPreferenceNamed: #cmdKeysInText value: true. self enable: #warnIfNoSourcesFile. self enable: #warnIfNoChangesFile.! !!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/15/2023 13:50'!setNotificationParametersForStandardPreferences "Set up the notification parameters for the standard preferences that require need them. When adding new Preferences that require use of the notification mechanism, users declare the notifcation info as part of the call that adds the preference, or afterwards -- the two relevant methods for doing that are: Preferences.addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: and Preference changeInformee:changeSelector:" "Preferences setNotificationParametersForStandardPreferences" #( (annotationPanes annotationPanesChanged) (optionalButtons optionalButtonsChanged) (smartUpdating smartUpdatingChanged) ) do: [:pair | | aPreference | aPreference := self preferenceAt: pair first. aPreference changeInformee: self changeSelector: pair second]! !!Preferences class methodsFor: 'initialization - save/load' stamp: 'mt 3/7/2023 13:27'!loadPreferencesFrom: aFile | stream params dict desktopColor patternsToIgnore | patternsToIgnore := #('*updateMapName' '*defaultUpdateURL'). stream := ReferenceStream fileNamed: aFile. params := stream n ext. self assert: (params isKindOf: IdentityDictionary). params removeKey: #PersonalDictionaryOfPreferences. dict := stream next. self assert: (dict isKindOf: IdentityDictionary). desktopColor := stream next. stream close. dict rehash. "See http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217817.html" dict keys reject: [:key | patternsToIgnore anySatisfy: [:pattern | pattern match: key]] thenDo: [:key | | value | value := dict at: key. (self preferenceAt: key ifAbsent: [nil]) ifNotNil: [:pref | [pref preferenceValue: value preferenceValue] on: Deprecation do: [ : err | "Ignore preferences which may not be supported anymore."]]]. params keysAndValuesDo: [ :key :value | self setParameter: key to: value ]. Project current world fillStyle: desktopColor.! !!ProgressMorph methodsFor: 'private' stamp: 'mt 8/11/2023 14:00'!fontOfPointSize: size ^ (TextConstants at: Prefe rences standardDefaultTextFont familyName ifAbsent: [TextStyle default]) fontOfPointSize: size! !!Project methodsFor: 'displaying' stamp: 'mt 8/28/2023 14:08'!displayZoom: entering "Show the project transition when entering a new project" | newDisplay vanishingPoint | "Show animated zoom to new display" newDisplay := self imageForm. entering ifTrue: [vanishingPoint := Sensor cursorPoint] ifFalse: [vanishingPoint := self viewLocFor: CurrentProject]. Display zoomIn: entering orOutTo: newDisplay at: 0@0 vanishingPoint: vanishingPoint.! !!Project methodsFor: 'file in/out' stamp: 'mt 8/16/2023 15:46'!exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: noInteraction | exportChangeSet | "An experimental version to fileout a changeSet first so that a project can contain its own classes" "Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target i mage. Name it <project name>.extSeg. Player classes are included automatically." exportChangeSet := nil. (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [ (noInteraction or: [self confirm: 'Would you like to include all the changes in the change set as part of this publishing operation?' translated]) ifTrue: [ exportChangeSet := changeSet ]. ]. ^ self exportSegmentWithChangeSet: exportChangeSet fileName: aFileName directory: aDirectory withoutInteraction: noInteraction! !!Project methodsFor: 'menu messages' stamp: 'mt 8/23/2023 13:50'!validateProjectNameIfOK: aBlock | details | details := world valueOfProperty: #ProjectDetails. details ifNotNil: ["ensure project info matches real project name" details at: 'projectname' put: self name. ]. self doWeWantToRename ifTrue: [self notify: 'Please choose another name!!'] ifFalse: [aBlock value: details]! !!MorphicProj ect methodsFor: 'initialize' stamp: 'mt 3/8/2023 09:42'!initialize "Initialize a new Morphic Project" super initialize. world := PasteUpMorph newWorldForProject: self. self setWorldBackground: true. Locale switchToID: CurrentProject localeID. Project current isMorphic ifTrue: [ "Only trigger tool builders etc. if we are already in the same kind of project because there is global state that cannot yet be configured in a dynamic scope such as 'ToolBuilder default'." self assureMainDockingBarPresenceMatchesPreference].! !!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/16/2023 17:02'!exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileNamedirectory: aDirectory withoutInteraction: noInteraction "Store my project out on the disk as an *exported*ImageSegment. All outPointers will be in a form that can be resolvedin the target image. Name it <project name>.extSeg. Whatdo we doabout subProjects, especially if they are out as local imagesegments? Force them to come in? Player classes are included automatically." | is str ans revertSeg roots holder collector fd mgr stacks | "Files out a changeSet first, so that a project can containits own classes" world ifNil: [^ false]. ScrapBook default emptyScrapBook. world currentHand pasteBuffer: nil. "don't write the paste buffer." world currentHand mouseOverHandler initialize. "forget about any references here" "Display checkCurrentHandForObjectToPaste." Command initialize. world clearCommandHistory. world fullReleaseCachedState. world cleanseStepList. world localFlapTabs size = world flapTabs size ifFalse: [noInteraction ifTrue: [^ false]. self error: 'Still holding onto Global flaps']. world releaseSqueakPages. holder := Project allProjects. "force them in to outPointers, where DiskProxys are made" "Just export me, not my previous version" revertSeg := self parameterAt: #revert ToMe. self removeParameter: #revertToMe. roots := OrderedCollection new. roots add: self; add: world; add: transcript; add: aChangeSetOrNil; add: thumbnail; add: world activeHand. roots := roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail" fd := aDirectory directoryNamed: self resourceDirectoryName. fd assureExistence. "Clean up resource references before writing out" mgr := self resourceManager. self resourceManager: nil. ResourceCollector current: ResourceCollector new. ResourceCollector current localDirectory: fd. ResourceCollector current baseUrl: self resourceUrl. ResourceCollector current initializeFrom: mgr. ProgressNotification signal: '2:findingResources' extra:'(collecting resources...)' translated. "Must activate old world because this is run at #armsLength. Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent will not be captured correc tly if referenced from blocks or user code." world becomeActiveDuring: [is := ImageSegment copySmartRootsExport: roots asArray. "old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)"]. self resourceManager: mgr. collector := ResourceCollector current. ResourceCollector current: nil. ProgressNotification signal: '2:foundResources' extra: ''. is state = #tooBig ifTrue: [collector replaceAll. ^ false]. str := ''. "considered legal to save a project that has never been entered" (is outPointers includes: world) ifTrue: [str := str, '\Project''s own world is not in the segment.' translated withCRs]. str isEmpty ifFalse: [ans := Project uiManager chooseOptionFrom: {'Do not write file' translated. 'Write file anyway' translated. 'Debug' translated} title: str. ans = 1 ifTrue:
[revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. ^ false]. ans = 3 ifTrue: [collector replaceAll. self halt: 'Segment not written' translated]]. stacks := is findStacks. is writeForExportWithSources: aFileName inDirectory: fd changeSet: aChangeSetOrNil. SecurityManager default signFile: aFileName directory: fd. "Compress all files and update check sums" collector forgetObsolete. self storeResourceList: collector in: fd. self storeHtmlPageIn: fd. self storeManifestFileIn: fd. self writeStackText: stacks in: fd registerIn: collector. "local proj.005.myStack.t" self compressFilesIn: fd to: aFileName in: aDirectory resources: collector. "also deletes the resource directory" "Now update everything tha t we know about" mgr updateResourcesFrom: collector. revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. world flapTabs do: [:ft | (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. ^ true! !!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/11/2023 16:06'!storeSegment "Store my project out on the disk as an ImageSegment. Keep the outPointers in memory. Name it <project name>.seg. *** Caller must be holding (Project alInstances) to keep subprojects from going out. ***" | currentWorld is sizeHint | currentWorld := Project current world. (currentWorld == world) ifTrue: [^ false]. "self inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ false]. "already done" world ifNil: [^ false]. ScrapBook default emptyScrapBook. currentWorld checkCurrentHandForObjectToPaste. world releaseSqueakPages. sizeHint := self projectParame ters at: #segmentSize ifAbsent: [0]. is := ImageSegment copyFromRootsLocalFileFor: {world} sizeHint: sizeHint. is state = #tooBig ifTrue: [^ false]. is segment size < 2000 ifTrue: ["debugging" Transcript show: self name, ' only ', is segment size printString, 'bytes in Segment.'; cr]. self projectParameters at: #segmentSize put: is segment size. is extract; writeToFile: self name. ^ true! !!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/11/2023 16:08'!storeSegmentNoFile "For testing. Make an ImageSegment. Keep the outPointers in memory. Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)" | is currentWorld | currentWorld := Project current world. (currentWorld == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ self]. "already done" world ifNil: [^ self]. "Do this on project enter" ScrapBook de fault emptyScrapBook. currentWorld checkCurrentHandForObjectToPaste2. is := ImageSegment copyFromRootsLocalFileFor: {world} sizeHint: 0. is segment size < 800 ifTrue: ["debugging" Transcript show: self name, ' did not get enough objects'; cr. ^ Beeper beep]. is extract. "is instVarAt: 2 put: is segment clone." "different memory"! !!MorphicProject methodsFor: 'enter' stamp: 'mt 3/10/2023 15:01'!enterAsActiveSubprojectWithin: enclosingWorld "Install my ChangeSet, Transcript, and scheduled views as current globals. If returningFlag is true, we will return to the project from whence the current project was entered; don't change its previousProject link in this case. If saveForRevert is true, save the ImageSegment of the project being left. If revertFlag is true, make stubs for the world of the project being left. If revertWithoutAsking is true in the project being left, then always revert." "Experimental mods for i nitial multi-project work: 1. assume in morphic (this eliminated need for <showZoom>) 2. assume <saveForRevert> is false (usual case) - removed <old> 3. assume <revertFlag> is false 4. assume <revertWithoutAsking> is false - <forceRevert> now auto false <seg> n.u. 5. no zooming 6. assume <projectsSentToDisk> false - could be dangerous here 7. assume no isolation problems (isolationHead ==) 8. no closing scripts " self isCurrentProject ifTrue: [^ self]. "guards ifNotNil: [ guards := guards reject: [:obj | obj isNil]. guards do: [:obj | obj okayToEnterProject ifFalse: [^ self]] ]." "CurrentProject makeThumbnail." "--> Display bestGuessOfCurrentWorld triggerClosingScripts." CurrentProject displayDepth: Display depth. displayDepth == nil ifTrue: [displayDepth := Display depth]. "Display newDepthNoRestore: displayDepth." "(world hasProperty: #letTheMusicPlay) ifT rue: [world removeProperty: #letTheMusicPlay] ifFalse: [Smalltalk at: #ScorePlayer ifPresent: [:playerClass | playerClass allSubInstancesDo: [:player | player pause]]]." "returningFlag ifTrue: [nextProject := CurrentProject] ifFalse: [previousProject := CurrentProject]." "CurrentProject saveState." "CurrentProject := self." "Smalltalk newChanges: changeSet." "TranscriptStream newTranscript: transcript." "Sensor flushKeyboard." "recorderOrNil := Display pauseMorphicEventRecorder." "Display changeMorphicWorldTo: world." "Signifies Morphic" world installAsActiveSubprojectIn: enclosingWorld titled: self name. "recorderOrNil ifNotNil: [recorderOrNil resumeIn: world]." self removeParameter: #exportState. "self spawnNewProcessAndTerminateOld: true"! !!MorphicProject methodsFor: 'enter' stamp: 'mt 8/28/2023 14:28'!finalEnterActions: leavingP roject "Perform the final actions necessary as the receiver project is entered" | navigator armsLengthCmd navType thingsToUnhibernate | "If this image has a global World variable, update it now" Smalltalk globals at: #World ifPresent: [ :w | Smalltalk globals at: #World put: world ]. world install. world transferRemoteServerFrom: leavingProject world. "(revertFlag | saveForRevert | forceRevert) ifFalse: [ (Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [ self storeSomeSegment]]." "Transfer event recorder to me." leavingProject isMorphic ifTrue: [ leavingProject world pauseEventRecorder ifNotNil: [:rec | rec resumeIn: world]]. self initializeMenus. self projectParameters at: #projectsToBeDeleted ifPresent: [ :projectsToBeDeleted | self removeParameter: #projectsToBeDeleted. projectsToBeDeleted do: [:each | each delete]]. Locale switchToID: self localeID. thingsToUnhibernate := world valueOfProperty: #thingsToUnhibernate ifAbsent: [#()]. thingsToUnhibernate do: [:each | each unhibernate]. world removeProperty: #thingsToUnhibernate. navType := ProjectNavigationMorph preferredNavigator. armsLengthCmd := self parameterAt: #armsLengthCmd ifAbsent: [nil]. navigator := world findA: navType. (Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator and: [navigator isNil]]) ifTrue: [(navigator := navType new) bottomLeft: world bottomLeft; openInWorld: world]. navigator notNil & armsLengthCmd notNil ifTrue: [navigator color: Color lightBlue]. armsLengthCmd notNil ifTrue: [self flapsSuppressed: true. navigator ifNotNil: [navigator visible: false]. armsLengthCmd openInWorld: world]. world reformulateUpdatingMenus. self assureMainDockingBarPresenceMatchesPreference. world repairEmbeddedWorlds.! !!MorphicProject methodsFor: 'enter ' stamp: 'mt 8/11/2023 16:05'!finalExitActions: enteringProject "Pause sound players, subject to preference settings" (world hasProperty: #letTheMusicPlay) ifTrue: [world removeProperty: #letTheMusicPlay] ifFalse: [SoundService stop]. world sleep. (world findA: ProjectNavigationMorph) ifNotNil: [:navigator | navigator retractIfAppropriate]. self clearGlobalState. EventSensor default flushEvents. self world submorphsDo: [:ea | ea removeProperty: #dropShadow].! !!MorphicProject methodsFor: 'release' stamp: 'mt 3/10/2023 15:10'!prepareForDelete "The window in which the project is housed is about to deleted. Perform any necessary actions to prepare for deletion." Smalltalk at: #WonderlandCameraMorph ifPresent:[:aClass | world submorphs do: "special release for wonderlands" [:m | (m isKindOf: aClass) and: [m getWonderland release]]].! !!MorphicProject methodsFor: 'language' sta mp: 'mt 3/10/2023 16:07'!chooseNaturalLanguage "Put up a menu allowing the user to choose the natural language for the project" | aMenu availableLanguages | aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'choose language' translated. aMenu lastItem setBalloonText: 'This controls the human language in which tiles should be viewed. It is potentially extensible to be a true localization mechanism, but initially it only works in the classic tile scripting system. Each project has its own private language choice' translated. aMenu addStayUpItem. availableLanguages := NaturalLanguageTranslator availableLanguageLocaleIDs sorted:[:x :y | x displayName < y displayName]. availableLanguages do: [:localeID | aMenu addUpdating: #stringForLanguageNameIs: target: Locale selector: #switchToID: argumentList: {localeID}]. aMenu popUpInWorld"Project current chooseNaturalLanguage"! !!MorphicProject method sFor: 'language' stamp: 'mt 8/4/2023 15:20'!updateLocaleDependents "Set the project's natural language as indicated" Flaps disableGlobalFlaps: false. Flaps enableGlobalFlaps. (self isFlapIDEnabled: 'Navigator' translated) ifFalse: [Flaps enableDisableGlobalFlapWithID: 'Navigator' translated]. ScrapBook default emptyScrapBook. MenuIcons initializeTranslations. super updateLocaleDependents. "self setFlaps. self setPaletteFor: aLanguageSymbol."! !!MorphicProject methodsFor: 'scheduling & debugging' stamp: 'mt 3/10/2023 11:26'!interruptCleanUpFor: interruptedProcess "Clean up things in case of a process interrupt." super interruptCleanUpFor: interruptedProcess. self uiProcess == interruptedProcess ifTrue: [ self currentHand ifNotNil: [:hand | hand interrupted]. world removeProperty: #shouldDisplayWorld].! !!Project class methodsFor: 'utilities' stamp: 'mt 3/15/2023 14:01'!removeAll: projects "Project removeAll: (Pr oject allSubInstances copyWithout: Project current)" AllProjects := nil. Smalltalk garbageCollect. ProjectHistory currentHistory initialize. projects do: [:project | Project deletingProject: project]. Smalltalk garbageCollect. Smalltalk garbageCollect.! !!ProjectLauncher methodsFor: 'initialization' stamp: 'mt 8/4/2023 13:21'!setupFlaps "Only called when the image has been launched in a browser. If I am requested to show all flaps, then if flaps already exist, use them as is, else set up to show the default set of standard flaps." whichFlaps = 'all' ifTrue: [Flaps sharedFlapsAllowed ifFalse: [Flaps enableGlobalFlaps]]! !!ProjectLauncher methodsFor: 'running' stamp: 'mt 8/4/2023 13:23'!startUp | scriptName loader isUrl | self setupFlaps. Smalltalk firstArgMightBeDocument ifTrue: [scriptName := Smalltalk documentPath. scriptName := scriptName convertFromSystemString. scriptName isEmpty ifFalse: ["figure out if script name is a URL by itself" isUrl := (scriptName asLowercase beginsWith: 'http://') or: [(scriptName asLowercase beginsWith: 'file://') or: [scriptName asLowercase beginsWith: 'ftp://']]. isUrl ifFalse: [| encodedPath pathTokens | "Allow for ../dir/scriptName arguments" pathTokens := scriptName splitBy: FileDirectory slash. pathTokens := pathTokens collect: [:s | s encodeForHTTP]. encodedPath := pathTokens reduce: [:acc :each | acc , FileDirectory slash , each]. scriptName := (FileDirectory default uri resolveRelativeURI: encodedPath) asString]]] ifFalse: [scriptName := '']. scriptName isEmptyOrNil ifT rue: [^ self]. loader := CodeLoader new. loader loadSourceFiles: (Array with: scriptName). (scriptName asLowercase endsWith: '.pr') ifTrue: [self installProjectFrom: loader] ifFalse: [loader installSourceFiles]! !!ProjectLoading class methodsFor: 'accessing' stamp: 'mt 8/28/2023 13:46'!projectStreamFromArchive: archive | ext prFiles entry unzipped | ext := FileDirectory dot, Project projectExtension. prFiles := archive members select:[:any| any fileName endsWith: ext]. prFiles isEmpty ifTrue: ['']. entry := prFiles first. unzipped := MultiByteBinaryOrTextStream on: (ByteArray new: entry uncompressedSize). entry extractTo: unzipped. ^unzipped reset! !!ProjectLoading class methodsFor: 'loading' stamp: 'mt 8/28/2023 13:51'!openName: aFileName stream: preStream fromDirectory: aDirectoryOrNilwithProjectView: existingView clearOriginFlag: clearOriginFlag "Reconstitute a Morph from the selected file, presumed torepresent a Morph saved via the SmartRefStream mechanism, and open itin an appropriate Morphic world." | morphOrList archive mgr substituteFont numberOfFontSubstitutes resultArray anObject project manifests dict | ProgressNotification signal: '0.2'. archive := preStream isZipArchive ifTrue:[ZipArchive new readFrom: preStream] ifFalse:[nil]. archive ifNotNil:[ manifests := (archive membersMatching: '*manifest'). (manifests size = 1 and: [((dict := self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression']) ifTrue: [^ self notify: 'S-Expression format projects not supported. Use Squeak 6.0 or older.']]. morphOrList := self morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive. morphOrList ifNil: [^ self]. ProgressNotification signal: '0.4'. resultArray := self fileInName: aFileName archive: archive morphOrList: morphOrList. anObject := resultArray first. numberOfFontSubstitut es := resultArray second. substituteFont := resultArray third. mgr := resultArray fourth. preStream close. ProgressNotification signal: '0.7'. "the hard part is over" (anObject isKindOf: ImageSegment) ifTrue: [ project := self loadImageSegment: anObject fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr. project noteManifestDetailsIn: dict. clearOriginFlag ifTrue: [project forgetExistingURL]. ProgressNotification signal: '0.8'. ^ project ifNil: [self inform: 'No project found in this file' translated] ifNotNil: [ProjectEntryNotification signal: project]]. Project current openViewAndEnter: anObject! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'tak 9/3/2006 11:00'!checkSecurity: aFileName preStream: preStream projStream: projStream "Answer true if passed" | trusted enterRestricted | trusted := SecurityManager default positionToSecureContentsOf:projStream. trusted ifFalse: [enterRestricted := (preStream isTypeHTTP or:[aFileName isNil]) ifTrue: [Preferences securityChecksEnabled] ifFalse: [Preferences standaloneSecurityChecksEnabled]. enterRestricted ifTrue: [SecurityManager default enterRestrictedMode ifFalse: [preStream close. ^ false]]]. ^ true! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'mt 8/28/2023 13:49'!fileInName: aFileName archive: archive morphOrList: morphOrList | baseChangeSet substituteFont numberOfFontSubstitutes exceptions anObject mgr | ResourceCollector current: ResourceCollector new. baseChangeSet := ChangeSet current. self useTempChangeSet. "named zzTemp" "The actual reading happens here" substituteFont := Preference s standardDefaultTextFont copy. numberOfFontSubstitutes := 0. exceptions := Set new. [[anObject := morphOrList fileInObjectAndCodeForProject] on: MissingFont do: [ :ex | exceptions add: ex. numberOfFontSubstitutes := numberOfFontSubstitutes + 1. ex resume: substituteFont ]] ensure: [ ChangeSet newChanges: baseChangeSet]. mgr := ResourceManager new initializeFrom: ResourceCollector current. mgr fixJISX0208Resource. mgr registerUnloadedResources. archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName]. ResourceCollector current: nil. ^ {anObject. numberOfFontSubstitutes. substituteFont. mgr}! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'mt 8/28/2023 14:00'!loadImageSegment: morphOrList fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr | proj projectsToBeD eleted f | (f := (Flaps globalFlapTabWithID: 'Navigator' translated)) ifNotNil: [f hideFlap]. proj := morphOrList arrayOfRoots detect: [:mm | mm isKindOf: Project] ifNone: [^ nil]. proj projectParameterAt: #substitutedFont put: substituteFont. proj projectParameters at: #MultiSymbolInWrongPlace put: false. "Yoshiki did not put MultiSymbols into outPointers in older images!!" morphOrList arrayOfRoots do: [:obj | obj fixUponLoad: proj seg: morphOrList "imageSegment"]. (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [ morphOrList arrayOfRoots do: [:obj | (obj isKindOf: HashedCollection ) ifTrue: [obj rehash]]]. proj resourceManager: mgr. "proj versionFrom: preStream." proj lastDirectory: aDirectoryOrNil. proj setParent: Project current. projectsToBeDeleted := OrderedCollection new. existingView == #none ifFalse: [ self makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted]. ChangeSet allChangeSets add: proj changeSet. Project current projectParameters at: #deleteWhenEnteringNewProject ifPresent: [ :ignored | projectsToBeDeleted add: Project current. Project current removeParameter: #deleteWhenEnteringNewProject. ]. projectsToBeDeleted isEmpty ifFalse: [ proj projectParameters at: #projectsToBeDeleted put: projectsToBeDeleted. ]. ^ proj! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'pre 8/22/2019 15:03'!makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted existingView ifNil: [ Smalltalk isMorphic ifTrue: [ proj createViewIfAppropriate. ] ifFalse: [ ChangeSet allChangeSets add: proj changeSet. Project current openProject: proj. "Note: in MVC we get no further than the above" ]. ] ifNot Nil: [ (existingView project isKindOf: DiskProxy) ifFalse: [ existingView project changeSet name: ChangeSet defaultName. projectsToBeDeleted add: existingView project. ]. (existingView owner isSystemWindow) ifTrue: [ existingView owner model: proj ]. existingView project: proj. ].! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'cmm 10/23/2013 16:24'!morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive "Answer morphOrList or nil if problem happened" | projStream localDir morphOrList | projStream := archive ifNil: [preStream] ifNotNil: [self projectStreamFromArchive: archive]. (self checkSecurity: aFileName preStream: preStream projStream: projStream) ifFalse: [^nil]. localDir := Project squeakletDirectory. aFileName ifNotNil: [ (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName~= l ocalDir pathName]) ifTrue: [ localDir deleteFileNamed: aFileName. (localDir fileNamed: aFileName) binary nextPutAll: preStream remainingContents; close. ]. ]. morphOrList := projStream asUnZippedStream. preStream sleep. "if ftp, let the connection close" ^ morphOrList! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'yo 2/5/2008 17:15'!parseManifest: aString | dict line index key value aStream | aStream := aString readStream. dict := Dictionary new. [(line := aStream nextLine) notNil] whileTrue: [ index := line indexOf: $:. index > 0 ifTrue: [ key := line copyFrom: 1 to: index - 1. value := (line copyFrom: index + 1 to: line size) withBlanksTrimmed. dict at: key put: value. ]. ]. ^ dict.! !!ProjectNavigationMorph methodsFor: 'buttons' stamp: 'mt 8/10/2023 11:32'!makeTheAdvancedButtons ^{ self buttonNewProject.
self buttonShare. self buttonPrev. self buttonNext. self buttonPublish. self buttonNewer. self buttonTell. self buttonFind. self buttonFullScreen. "self buttonFlaps." }, ( Preferences includeSoundControlInNavigator ifTrue: [{self buttonSound}] ifFalse: [#()] ), { self buttonLanguage. self buttonUndo. self buttonQuit. }! !!ProjectNavigationMorph methodsFor: 'buttons' stamp: 'mt 8/28/2023 14:27'!makeTheButtons ^ self makeTheAdvancedButtons! !!ProjectNavigationMorph methodsFor: 'the actions' stamp: 'mt 8/23/2023 13:51'!doPublishButtonMenuEvent: evt | selection | selection := UIManager default chooseFrom: { 'Publish' translated. 'Publish As...' translated. 'Publish to Different Server' translated. } values: { [self publishProject]. [self publishProjectAs]. [self publishDifferent]. } title: 'Publish options' translated. sel ection ifNil: [^self]. selection value.! !!ProjectSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'!addControls "Add the control bar at the top of the tool." | b r partsBinButton newButton aWrapper | newButton := ImageMorph new image: (Project current makeThumbnail scaledToSize: 48@36). newButton on: #mouseDown send: #insertNewProject: to: self. newButton setBalloonText: 'Make a new Project' translated. (partsBinButton := UpdatingThreePhaseButtonMorph checkBox) target: self; actionSelector: #togglePartsBinStatus; arguments: #(); getSelector: #getPartsBinStatus. (r := AlignmentMorph newRow) color: Color transparent; borderWidth: 0; layoutInset: 0; cellInset: 10@0; wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black. r addMorphBack: (self wrapperFor: (b label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort)). b := SimpleButtonMorph new target: self; color: self defaultColor darker; borderColor: Color black. r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #delete)); addTransparentSpacerOfSize: 8 @ 0; addMorphBack: (self wrapperFor: (newButton)); addTransparentSpacerOfSize: 8 @ 0. aWrapper := AlignmentMorph newRow beTransparent. aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0. aWrapper addMorphBack: (self wrapperFor: partsBinButton); addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated font: Preferences standardButtonFont) lock). r addMorphBack: aWrapper. self addMorphFront: r.! !!ProjectSorterMorph methodsFor: 'initialization' stamp: 'mt 8/14/2023 16:22'!in itialize "initialize the state of the receiver" super initialize. self useRoundedCorners. pageHolder useRoundedCorners; borderWidth: 0; color: (Form gridFormOrigin: 0 @ 0 grid: 32 @ 32 background: Color white line: Color blue muchLighter)! !!ProjectSorterMorph methodsFor: 'controls' stamp: 'mt 8/23/2023 13:50'!insertNewProject: evt [MorphicProject openViewOn: nil] on: ProjectViewOpenNotification do: [ :ex | ex resume: false].! !!RecordingControlsMorph methodsFor: 'button commands' stamp: 'mt 8/22/2023 15:53'!makeTile "Make a tile representing my sound. Get a sound-name from the user by which the sound is to be known." | tile | recorder verifyExistenceOfRecordedSound ifFalse: [^ self]. recorder pause. tile := InterimSoundMorph new sound: (SampledSound samples: recorder condensedSamples samplingRate: recorder samplingRate). tile bounds: tile fullBounds. tile openInHand! !!ReferenceMorph methodsFor: 'menu' stamp: 'mt 8/14/2023 17:24'!changeTabGraphic | aGraphicalMenu | aGraphicalMenu := GraphicalMenu new initializeFor: submorphs first withForms: submorphs first reasonableForms coexist: true. self primaryHand attachMorph: aGraphicalMenu.! !!ReferenceMorph methodsFor: 'menu' stamp: 'mt 7/31/2023 11:15'!graphicalMorphForTab | formToUse | formToUse := self valueOfProperty: #priorGraphic ifAbsent: [MenuIcons formAtKey: 'squeakyMouse']. ^ SketchMorph withForm: formToUse! !!FlapTab methodsFor: 'show & hide' stamp: 'mt 8/4/2023 14:02'!showFlap "Open the flap up" | thicknessToUse flapOwner | "19 sept 2000 - going for all paste ups <- raa note" flapOwner := self pasteUpMorph. self referentThickness <= 0 ifTrue: [thicknessToUse := lastReferentThickness ifNil: [100]. self orientation == #horizontal ifTrue: [referent height: thicknessToUse] ifFalse: [referent width: thicknessToUse]]. inboard ifTrue: [self stickOntoReferent]. "makes referent my owner, and positions me accordingly" referent pasteUpMorph == flapOwner ifFalse: [flapOwner accommodateFlap: self. "Make room if needed" flapOwner addMorphFront: referent. flapOwner startSteppingSubmorphsOf: referent. self positionReferent]. inboard ifFalse: [self adjustPositionVisAVisFlap]. flapShowing := true. self pasteUpMorph hideFlapsOtherThan: self ifClingingTo: edgeToAdhereTo. flapOwner bringTopmostsToFront! !!ReferenceStream class methodsFor: 'accessing' stamp: 'mt 8/28/2023 15:43'!versionCode "Answer a number representing the 'version' of the ReferenceStream facility; this is stashed at the beginning of ReferenceStreams, as a secondary versioning mechanism (the primary one is the fileTyp eCode). At present, it serves for information only, and is not checked for compatibility at reload time, but could in future be used to branch to variant code. " " 1 = original version 1992" " 2 = HyperSqueak. PathFromHome used for Objs outside the tree. SqueakSupport SysLibrary for shared globals like Display and StrikeFonts. File has version number, class structure, then an IncomingObjects manager. 8/16/96 tk. Extended to SmartRefStream. class structure also keeps superclasse chain. Does analysis on structure to see when translation methods are needed. Embedable in file-ins. (factored out HyperSqueak support) Feb-May 97 tk" " 3 = Reference objects are byte offsets relative to the start of the object portion of the file. Rectangles with values -2048 to 2047 are encoded compactly." " 4 = If UniClasses have class instance variables, append their values in the form (#Class43 (val1 val2 vla3)). An array of those. Can still read version 3." ^ 4! !!Release Builder class methodsFor: 'scripts' stamp: 'mt 8/16/2023 15:43'!configureTools "Initialize well-known tools and other resources." FileList initialize. FileServices initialize. "register file reader services" RealEstateAgent standardSize: 650@425. SMLoaderPlus setDefaultFilters: #(filterSafelyAvailable). "Default applications and tools." SystemBrowser default: TreeBrowser. MailSender default: nil. SoundService default: BaseSoundSystem. ToolSet default: StandardToolSet. WebBrowser default: nil.! !!ReleaseBuilder class methodsFor: 'scripts - support' stamp: 'mt 3/7/2023 14:05'!discardUserObjects "Remove the classes." MorphicModel removeUninstantiatedSubclassesSilently. "Clean-up environment hick-ups." Environment default allClassesDo: [:cls | (cls isUniClass and: [cls environment ~~ Environment default]) ifTrue: [Environment default forgetClass: cls logged: false]]. Environment default declarations select: [:bindi ng | (binding value isBehavior and: [binding value isUniClass]) and: [binding value isObsolete]] thenDo: [:binding | SystemOrganization removeElement: binding key. Environment default removeKey: binding key]. "Remove auto-generated accessors. See Preferences." (MCPackage named: 'Autogenerated') unload. "Remove empty categories for user objects. See Object class >> #categoryForUniclasses." SystemOrganizer cleanUp: true.! !!RemoteHandMorph methodsFor: 'event handling' stamp: 'mt 8/28/2023 14:35'!transmitEvent: aMorphicEvent "Transmit the given event to all remote connections." | firstEvt | self readyToTransmit ifFalse: [^ self]. self lastEventTransmitted = aMorphicEvent ifTrue: [^ self]. sendBuffer ifNil: [sendBuffer := WriteStream on: (String new: 10000)]. sendBuffer nextPutAll: aMorphicEvent storeString; cr. self lastEventTransmitted: aMorphicEvent. sendSocket isConnected ifTrue:[ sendState = #opening ifTrue: [ "connection established; disable TCP delays on sends" sendSocket setOption: 'TCP_NODELAY' value: true. "send worldExtent as first event" firstEvt := MorphicUnknownEvent new setType: #worldBounds argument: self worldBounds extent. sendSocket sendData: firstEvt storeString, (String with: Character cr). Transcript show: 'Connection established with remote WorldMorph at '; show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. sendState := #connected]. sendSocket sendData: sendBuffer contents. ] ifFalse: [ owner primaryHand removeEventListener: self. sendState = #connected ifTrue: [ "other end has closed; close our end" Transcript show: 'Closing connection with remote WorldMorph at '; show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. sendSocket cl ose. sendState := #closing]]. sendBuffer reset.! !!ResourceCollector methodsFor: 'initialize' stamp: 'mt 3/15/2023 14:07'!initialize originalMap := IdentityDictionary new. stubMap := IdentityDictionary new. locatorMap := IdentityDictionary new. internalStubs := IdentityDictionary new.! !!ScreenController methodsFor: 'nested menus' stamp: 'mt 7/31/2023 11:19'!helpMenu "Answer the help menu to be put up as a screen submenu" ^ SelectionMenu labelList: #( 'about this system...' 'update code from server' 'preferences...' 'command-key help' 'font size summary' 'useful expressions' 'view graphical imports' 'standard graphics library'), (Array with: (SoundService soundEnablingString)) , #( 'set author initials...' 'vm statistics' 'space left') lines: #(1 4 6 11) selections: #( aboutThisSystem absorbUpdatesFromServereditPreferences openCommandKeyHelp fontSizeSummary openStandardWorkspace viewImageImportssoundOnOrOff setAuthorInitials vmStatistics garbageCollect)"ScreenController new helpMenu startUp"! !!ScrollableField methodsFor: 'menu' stamp: 'mt 8/11/2023 14:47'!getMenu: shiftKeyState ^ shiftKeyState not ifTrue: [TextEditor yellowButtonMenu] ifFalse: [TextEditor shiftedYellowButtonMenu]! !!SelectionMorph methodsFor: 'halo commands' stamp: 'mt 3/10/2023 15:26'!duplicate "Make a duplicate of the receiver and havbe the hand grab it" selectedItems := self duplicateMorphCollection: selectedItems. selectedItems reverseDo: [:m | (owner ifNil: [self currentWorld]) addMorph: m]. dupLoc := self position. self currentHand grabMorph: self.! !!ServerDirectory class methodsFor: 'school support' stamp: 'mt 3/10/2023 11:45'!projectDefaultDirectory ^ FileDirectory default! !!ServerDirectory class methodsFor: 'server prefs' stamp: 'mt 8/16 /2023 15:50'!parseServerEntryFrom: stream | server type directory entries serverName | entries := ExternalSettings parseServerEntryArgsFrom: stream. serverName := entries at: 'name' ifAbsent: [^nil]. directory := entries at: 'directory' ifAbsent: [^nil]. type := entries at: 'type' ifAbsent: [^nil]. type = 'file' ifTrue: [ server := self determineLocalServerDirectory: directory. entries at: 'userListUrl' ifPresent:[:value | "Ignore" ]. entries at: 'baseFolderSpec' ifPresent:[:value | "Ignore" ]. ^self addLocalProjectDirectory: server]. type = 'bss' ifTrue: [server := SuperSwikiServer new type: #http]. type = 'http' ifTrue: [server := HTTPServerDirectory new type: #ftp]. type = 'ftp' ifTrue: [server := ServerDirectory new type: #ftp]. server directory: directory. entries at: 'server' ifPresent: [:value | server server: value]. entries at: 'user' ifPresent: [:value | server user: value]. entries at: 'group' ifPresent: [:value | server groupName: value]. entries at: 'passwdseq' ifPresent: [:value | server passwordSequence: value asNumber]. entries at: 'url' ifPresent: [:value | server altUrl: value]. entries at: 'loaderUrl' ifPresent: [:value | server loaderUrl: value]. entries at: 'acceptsUploads' ifPresent: [:value | server acceptsUploads: value asLowercase = 'true']. entries at: 'userListUrl' ifPresent:[:value | "Ignore" ]. entries at: 'encodingName' ifPresent:[:value | server encodingName: value]. ServerDirectory addServer: server named: serverName.! !!IconicButton methodsFor: 'initialization' stamp: 'mt 3/7/2023 15:06'!initializeWithThumbnail: aThumbnail withLabel: aLabel andColor: aColor andSend: aSelector to: aReceiver "Initialize the receiver to show aThumbnail on its face, giving it the label supplied and arranging for it, when the button goes down on it, to obtain a new morph by sending the supplied selector to the supplied receiver" | labeledItem nonTranslucent | nonTranslucent := aColor asNontranslucentColor. labeledItem := AlignmentMorph newColumn. labeledItem color: nonTranslucent. labeledItem borderWidth: 0. labeledItem layoutInset: 4@0; cellPositioning: #center. labeledItem addMorph: aThumbnail. labeledItem addMorphBack: (Morph new extent: (4@4)) beTransparent. labeledItem addMorphBack: (TextMorph new backgroundColor: nonTranslucent; contentsAsIs: aLabel; beAllFont: Preferences standardButtonFont; centered). self beTransparent; labelGraphic: ((labeledItem imageForm: 32 backgroundColor: nonTranslucent forRectangle: labeledItem fullBounds) replaceColor: nonTranslucent withColor: Color transparent); borderWidth: 0; target: aReceiver; actionSelector: #launchPartVia:label:; arguments: {aSelector. aLabel}; actWhen: #buttonDown. self stationarySetup.! !!IconicButton methodsFor: 'initialization' stamp: 'mt 3/15/2023 14:10'!setDefaultLabel self labelGraphic: (MenuIcons formAtKey: 'squeakyMouse')! !!HaloMorph methodsFor: 'handles' stamp: 'mt 3/15/2023 13:34'!addDismissHandle: handleSpec "Add the dismiss handle according to the spec, unless my target resists dismissal" | dismissHandle | target okayToAddDismissHandle ifTrue: [dismissHandle := self addHandle: handleSpec on: #mouseDown send: #mouseDownInDimissHandle:with: to: self. dismissHandle on: #mouseUp send: #maybeDismiss:with: to: self. dismissHandle on: #mouseDown send: #setDismissColor:with: to: self. dismissHandle on: #mouseMove send: #setDismissColor:with: to: self]! !!HaloMorph methodsFor: 'handles' stamp: 'mt 8/11/2023 14:24'!addDupHandle: haloSpec "Add the halo that offers duplication" self addHandle: haloSpec on: #mouseDown send: #doDup:with: to: self! !!HaloMorph methodsFor: 'handles' stamp: 'sw 1/26/2000 16:16'!addHelpHan dle: haloSpec target balloonText ifNotNil: [(self addHandle: haloSpec on: #mouseDown send: #mouseDownOnHelpHandle: to: innerTarget) on: #mouseUp send: #deleteBalloon to: innerTarget]! !!HaloMorph methodsFor: 'handles' stamp: 'RAA 3/15/2001 11:24'!addRecolorHandle: haloSpec "Add a recolor handle to the receiver, if appropriate" | recolorHandle | "since this halo now opens a more general properties panel, allow it in all cases" "innerTarget canSetColor ifTrue:" recolorHandle := self addHandle: haloSpec on: #mouseUp send: #doRecolor:with: to: self. recolorHandle on: #mouseUp send: #doRecolor:with: to: self! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/15/2023 14:10'!addGraphicalHandleFrom: formKey at: aPoint "Add the supplied form as a graphical handle centered at the given point. Return the handle." | handle aForm | aForm := (MenuIcons formAtKey: formKey) ifNil: [MenuIcons formAtKey: #SolidMenu]. handle := ImageMorph new image: a Form; bounds: (Rectangle center: aPoint extent: aForm extent). handle borderColor: Color black; borderWidth: 2. handle wantsYellowButtonMenu: false. self addMorph: handle. handle on: #mouseUp send: #endInteraction: to: self. ^ handle! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/15/2023 14:10'!createHandleAt: aPoint color: aColor iconName: iconName | bou handle | bou := Rectangle center: aPoint extent: self handleSize asPoint. Preferences alternateHandlesLook ifTrue: [handle := RectangleMorph newBounds: bou color: aColor. handle useRoundedCorners. self setColor: aColor toHandle: handle] ifFalse: [handle := EllipseMorph newBounds: bou color: aColor]. handle borderWidth: 0; wantsYellowButtonMenu: false. "" iconName isNil ifFalse: [| form | form := MenuIcons formAtKey: iconName. form isNil ifFalse: [| image | image := ImageMorph new.
image image: form scaleIconToDisplay. image color: aColor makeForegroundColor. image lock. handle addMorphCentered: image]]. "" ^ handle! !!HaloMorph methodsFor: 'private' stamp: 'mt 2/19/2021 14:52'!doGrow: evt with: growHandle "Called while the mouse is down in the grow handle" | newExtent extentToUse scale | evt hand obtainHalo: self. newExtent := (target pointFromWorld: evt cursorPoint - positionOffset) - target topLeft. evt shiftPressed ifTrue: [ scale := (newExtent x / (originalExtent x max: 1)) min: (newExtent y / (originalExtent y max: 1)). newExtent := (originalExtent x * scale) asInteger @ (originalExtent y * scale) asInteger ]. (newExtent x < 1 or: [newExtent y < 1 ]) ifTrue: [^ self]. target renderedMorph setExtentFromHalo: (extentToUse := newExtent). growHandle position: evt cursorPoint - (growHandle extent // 2 ). self layoutChanged. (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | "Update the final extent" cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: extentToUse]! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/8/2023 11:29'!doRecolor: evt with: aHandle "The mouse went down in the 'recolor' halo handle. Allow the user to change the color of the innerTarget" evt hand obtainHalo: self. (aHandle containsPoint: evt cursorPoint) ifFalse: "only do it if mouse still in handle on mouse up" [self delete. target addHalo: evt] ifTrue: [innerTarget changeColor. self showingDirectionHandles ifTrue: [self addHandles]]! !!HaloMorph methodsFor: 'private' stamp: 'ul 12/12/2009 14:11'!doRot: evt with: rotHandle "Update the rotation of my target if it is rotatable. Keep the relevant command object up to date." | degrees | evt hand obtainHalo: self. degre es := (evt cursorPoint - (target pointInWorld: target referencePosition)) degrees. degrees := degrees - angleOffset degrees. degrees := degrees detentBy: 10.0 atMultiplesOf: 90.0 snap: false. degrees = 0.0 ifTrue: [self setColor: Color lightBlue toHandle: rotHandle] ifFalse: [self setColor: Color blue toHandle: rotHandle]. rotHandle submorphsDo: [:m | m color: rotHandle color makeForegroundColor]. self removeAllHandlesBut: rotHandle. self showingDirectionHandles ifFalse: [self showDirectionHandles: true addHandles: false]. self addDirectionHandles. target rotationDegrees: degrees. rotHandle position: evt cursorPoint - (rotHandle extent // 2). (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | "Update the final rotation" cmd redoTarget: target renderedMorph selector: #heading: argument: degrees]. self layoutChanged! !!HaloMorph methodsFor: 'private' stamp: 'ul 12/12/2009 14:11'!doScale: evt with: scaleHandle "Update the scale of my target if it is scalable." | newHandlePos colorToUse | evt hand obtainHalo: self. newHandlePos := evt cursorPoint - (scaleHandle extent // 2). target scaleToMatch: newHandlePos. colorToUse := target scale = 1.0 ifTrue: [Color yellow] ifFalse: [Color orange]. self setColor: colorToUse toHandle: scaleHandle. scaleHandle submorphsDo: [:m | m color: colorToUse makeForegroundColor]. scaleHandle position: newHandlePos. self layoutChanged. (self valueOfProperty: #commandInProgress) ifNotNil:[:cmd | "Update the final extent" cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent ].! !!HaloMorph methodsFor: 'private' stamp: 'mt 8/11/2023 17:00'!endInteraction: event "Clean up after a user interaction with the a halo control" | m | (target isInWorld not or: [owner isNil]) ifTrue: [^self]. [target isFlexMorph and: [target hasNoScaleOrRotation]] whileTrue: [m := target firstSubmorph. target removeFlexShell. target := m]. self restoreTargetDropShadows. target changedViaHalo: self. self isInWorld ifTrue: ["make sure handles show in front, even if flex shell added" self flag: #tofix. "mt: Try to avoid deleting and re-creating an event handler (here: the handle) while handling the event." self comeToFront. self addHandles. event hand newMouseFocus: self]. (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | self rememberCommand: cmd. self removeProperty: #commandInProgress].! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/10/2023 15:08'!maybeDismiss: evt with: dismissHandle "Ask hand to dismiss my target if mouse comes up in it." evt hand obtainHalo: self. (dismissHandle containsPoint: evt cursorPoint) ifFal se: [self delete. target addHalo: evt] ifTrue: [target resistsRemoval ifTrue: [(Project uiManager chooseOptionFrom: {'Yes' translated. 'Um, no, let me reconsider' translated.} title: 'Really throw this away?' translated) = 1 ifFalse: [^ self]]. evt hand removeHalo. self delete. target dismissViaHalo].! !!HaloMorph methodsFor: 'private' stamp: 'HenrikSperreJohansen 1/21/2011 18:34'!mouseDownInDimissHandle: evt with: dismissHandle evt hand obtainHalo: self. SoundService soundEnabled ifTrue: [TrashCanMorph playMouseEnterSound]. self removeAllHandlesBut: dismissHandle. self setColor: Color darkGray toHandle: dismissHandle.! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/10/2023 13:51'!startDrag: evt with: dragHandle "Drag my target without removing it from its owner." self obtainHaloForEvent: evt andRemoveAllHandlesBut: dragHandle. target aboutToBeDraggedViaHalo. positionOffset := dragHandle center - (target point: target position in: owner).! !!HaloMorph methodsFor: 'private' stamp: 'ct 2/28/2022 16:24'!startGrow: evt with: growHandle "Initialize resizing of my target. Launch a command representing it, to support Undo" | botRt | self obtainHaloForEvent: evt andRemoveAllHandlesBut: growHandle. self backupAndHideTargetDropShadows. target aboutToBeGrownViaHalo. botRt := target point: target bottomRight in: owner. positionOffset := (self world viewBox containsPoint: botRt) ifTrue: [evt cursorPoint - botRt] ifFalse: [0@0]. self setProperty: #commandInProgress toValue: (Command new cmdWording: ('resize ' translated, target nameForUndoWording); undoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent). originalExtent := target extent! !!HaloMorph methodsFor: 'p rivate' stamp: 'mt 8/11/2023 16:59'!startRot: evt with: rotHandle "Initialize rotation of my target if it is rotatable. Launch a command object to represent the action" self obtainHaloForEvent: evt andRemoveAllHandlesBut: rotHandle. self backupAndHideTargetDropShadows. target aboutToBeRotatedViaHalo. target isFlexMorph ifFalse: [target addFlexShellIfNecessary]. growingOrRotating := true. self removeAllHandlesBut: rotHandle. "remove all other handles" angleOffset := evt cursorPoint - (target pointInWorld: target referencePosition). angleOffset := Point r: angleOffset r degrees: angleOffset degrees - target rotationDegrees. self setProperty: #commandInProgress toValue: (Command new cmdWording: ('rotate ' translated, target nameForUndoWording); undoTarget: target renderedMorph selector: #heading: argument: target rotationDegrees)! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/7/2023 16:46'!startS cale: evt with: scaleHandle "Initialize scaling of my target." self obtainHaloForEvent: evt andRemoveAllHandlesBut: scaleHandle. self backupAndHideTargetDropShadows. target aboutToBeScaledViaHalo. target isFlexMorph ifFalse: [target addFlexShellIfNecessary]. growingOrRotating := true. positionOffset := 0@0. originalExtent := target extent! !!HaloMorph methodsFor: 'pop up' stamp: 'mt 3/15/2023 13:40'!popUpFor: morph at: position hand: hand super popUpFor: morph at: position hand: hand. self startStepping.! !!HaloMorph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/15/2023 13:40'!delete "Delete the halo. Tell the target that it no longer has the halo; accept any pending edits to the name; and then actually delete myself" self acceptNameEdit. super delete.! !!SketchEditorMorph methodsFor: 'initialization' stamp: 'mt 8/10/2023 15:28'!initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph." | paintBoxBounds worldBounds | self setProperty: #recipientPasteUp toValue: aPasteUpMorph. paintBoxBounds := self world paintBox bounds. worldBounds := self world bounds. self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: ((boundsToUse topRight extent: paintBoxBounds extent) translatedToBeWithin: worldBounds) topLeft.! !!SketchEditorMorph methodsFor: 'start & finish' stamp: 'mt 8/10/2023 15:34'!cancelOutOfPainting "The user requested to back out of a painting session without saving" self deleteSelfAndSubordinates. emptyPicBlock ifNotNil: [emptyPicBlock value]. "note no args to block!!" hostView ifNotNil: [hostView changed]. ^ nil! !!SketchEditorMorph methodsFor: 'start & finish' stamp: 'mt 8/10/2023 15:34'!deliverPainting: result evt: evt "Done painting. May come from resume, or from original call. Execute user's post painting instructions in the block. Always use this standard one. 4/21/97 tk" | newBox newForm ans | palette ifNotNil: "nil happens" [palette setAction: #paint: evt: evt]. "Get out of odd modes" "rot := palette getRotations." "rotate with heading, or turn to and fro" "palette setRotation: #normal." result == #cancel ifTrue: [ ans := Project uiManager chooseOptionFrom: { 'throw it away' translated. 'keep painting it' translated} title: 'Do you really want to throw away what you just painted?' translated. ^ ans = 1 ifTrue: [self cancelOutOfPainting] ifFalse: [nil]]. "cancelled out of cancelling." "hostView rotationStyle: rot." "rotate with heading, or turn to and fro" newBox := paintingForm rectangleEnclosingPixelsNotOfColor: Color transparent. registrationPoint ifNotNil:
[registrationPoint := registrationPoint - newBox origin]. "relative to newForm origin" newForm := Form extent: newBox extent depth: paintingForm depth. newForm copyBits: newBox from: paintingForm at: 0@0 clippingBox: newForm boundingBox rule: Form over fillColor: nil. newForm isAllWhite ifTrue: [(self valueOfProperty: #background) == true ifFalse: [^ self cancelOutOfPainting]]. newForm fixAlpha. "so alpha channel stays intact for 32bpp" self delete. "so won't find me again" dimForm ifNotNil: [dimForm delete]. newPicBlock value: newForm value: (newBox copy translateBy: bounds origin).! !!SketchMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:15'!setNewFormFrom: formOrNil "Set the receiver's form as indicated. If nil is provided, then a default form will be used" formOrNil ifNotNil: [^ self form: formOrNil]. self form: (Form extent: 16@16 depth: 32)! !!SketchMorph methodsFor: 'initialization' stamp: 'm t 3/15/2023 14:10'!initialize"initialize the state of the receiver" ^ self initializeWith: (MenuIcons formAtKey: 'Painting') deepCopy! !!SketchMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 14:30'!addPaintingItemsTo: aMenu hand: aHandMorph | subMenu movies | subMenu := MenuMorph new defaultTarget: self. subMenu add: 'repaint' translated action: #editDrawing; add: 'set rotation center' translated action: #setRotationCenter; add: 'reset forward-direction' translated action: #resetForwardDirection; add: 'set rotation style' translated action: #setRotationStyle; add: 'erase pixels of color' translated action: #erasePixelsUsing:; add: 'recolor pixels of color' translated action: #recolorPixelsUsing:; add: 'reduce color palette' translated action: #reduceColorPalette:; add: 'detect edges' translated action: #edgeDetect; add: 'sharpen' translated action: #sharpen; add: 'blur' translated action: #blur;
add: 'emboss' translated action: #emboss; add: 'add a border around this shape...' translated action: #addBorderToShape:. movies := (self world rootMorphsAt: aHandMorph targetPoint) select: [:m | (m isKindOf: MovieMorph) or: [m isSketchMorph]]. movies size > 1 ifTrue: [subMenu add: 'insert into movie' translated action: #insertIntoMovie:]. aMenu add: 'painting...' translated subMenu: subMenu! !!SketchMorph methodsFor: 'menu' stamp: 'mt 8/10/2023 15:33'!editDrawingIn: aPasteUpMorph forBackground: forBackground "Edit an existing sketch." | w bnds sketchEditor rotCenter aWorld aPaintBox | self world assureNotPaintingElse: [^self]. w := aPasteUpMorph world. w displayWorld. self visible: false. bnds := forBackground ifTrue: [aPasteUpMorph boundsInWorld] ifFalse: [self boundsInWorld expandBy: 60 @ 60]. sketchEditor := SketchEditorMorph new. forBackground ifTrue: [sketchEditor setProperty: #background toValue: true]. w addMorphFront: sketchEditor. sketchEditor initializeFor: self inBounds: bnds pasteUpMorph: aPasteUpMorph. rotCenter := self rotationCenter. sketchEditor afterNewPicDo: [:aForm :aRect | | tfx | self visible: true. self form: aForm. tfx := aPasteUpMorph transformFrom: aPasteUpMorph world. self topRendererOrSelf position: (tfx globalPointToLocal: aRect origin). self rotationStyle: sketchEditor rotationStyle. self forwardDirection: sketchEditor forwardDirection. (rotCenter notNil and: [(rotCenter = (0.5 @ 0.5)) not]) ifTrue: [self rotationCenter: rotCenter]. aWorld := self world. (aPaintBox := aWorld paintBox) ifNotNil: [aPaintBox delete]. forBackground ifTrue: [self goBehind "shouldn't be necessary"]] ifNoBits: []! !!SketchMorph met hodsFor: 'menus' stamp: 'mt 3/10/2023 16:09'!addToggleItemsToHaloMenu: aCustomMenu "Add toggle-items to the halo menu" super addToggleItemsToHaloMenu: aCustomMenu. aCustomMenu addUpdating: #useInterpolationString target: self action: #toggleInterpolation.! !!SketchMorph methodsFor: 'menus' stamp: 'mt 8/11/2023 13:42'!chooseNewGraphic "Allow the user to choose a different form for her form-based morph" | aGraphicalMenu | aGraphicalMenu := GraphicalMenu new initializeFor: self withForms: self reasonableForms coexist: true. self primaryHand attachMorph: aGraphicalMenu.! !!SketchMorph methodsFor: 'parts bin' stamp: 'mt 3/15/2023 14:10'!initializeToStandAlone super initializeToStandAlone. self initializeWith: (MenuIcons formAtKey: 'Painting') deepCopy! !!ColorPickerMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 14:01'!mouseUp: evt self stopStepping. sourceHand := nil. deleteOnMou seUp ifTrue: [self delete]. self updateTargetColor.! !!ColorPickerMorph methodsFor: 'menu' stamp: 'mt 3/15/2023 14:09'!pickUpColorFor: aMorph "Show the eyedropper cursor, and modally track the mouse through a mouse-down and mouse-up cycle" | aHand localPt | aHand := aMorph ifNil: [self activeHand] ifNotNil: [aMorph activeHand]. aHand ifNil: [aHand := self currentHand]. self addToWorld: aHand world near: (aMorph ifNil: [aHand world]) fullBounds. self owner ifNil: [^ self]. aHand showTemporaryCursor: (MenuIcons formAtKey: #Eyedropper) hotSpotOffset: 2@14. "<<<< the form was changed a bit??" self updateContinuously: false. [Sensor anyButtonPressed] whileFalse: [self trackColorUnderMouse]. self deleteAllBalloons. localPt := Sensor cursorPoint - self topLeft. self inhibitDragging ifFalse: [ (DragBox containsPoint: localPt) ifTrue: ["Click or drag the drag-dot means to anchor as a modeless pick er" ^ self anchorAndRunModeless: aHand]. ]. (clickedTranslucency := TransparentBox containsPoint: localPt) ifTrue: [selectedColor := originalColor]. self updateContinuously: true. [Sensor anyButtonPressed] whileTrue: [self updateTargetColorWith: self indicateColorUnderMouse]. aHand newMouseFocus: nil; showTemporaryCursor: nil; flushEvents. self delete. ! !!ColorPickerMorph methodsFor: 'private' stamp: 'mt 3/10/2023 14:01'!pickColorAt: aGlobalPoint | alpha selfRelativePoint pickedColor | clickedTranslucency ifNil: [clickedTranslucency := false]. selfRelativePoint := (self globalPointToLocal: aGlobalPoint) - self topLeft. (FeedbackBox containsPoint: selfRelativePoint) ifTrue: [^ self]. (RevertBox containsPoint: selfRelativePoint) ifTrue: [^ self updateColor: originalColor feedbackColor: originalColor]. "check for transparent color and update using appropriate feedback color " (TransparentBox containsPoint: selfRelativePoint) ifTrue: [clickedTranslucency ifFalse: [^ self]. "Can't wander into translucency control" alpha := (selfRelativePoint x - TransparentBox left - 10) asFloat / (TransparentBox width - 20) min: 1.0 max: 0.0. "(alpha roundTo: 0.01) printString , ' ' displayAt: 0@0." " -- debug" self updateColor: (selectedColor alpha: alpha) feedbackColor: (selectedColor alpha: alpha). ^ self]. "pick up color, either inside or outside this world" clickedTranslucency ifTrue: [^ self]. "Can't wander out of translucency control" self locationIndicator visible: false. self refreshWorld. pickedColor := Display colorAt: aGlobalPoint. self locationIndicator visible: true. self refreshWorld. self updateColor: ( (selectedColor isColor and: [selectedColor isTranslucentColor])
ifTrue: [pickedColor alpha: selectedColor alpha] ifFalse: [pickedColor] ) feedbackColor: pickedColor! !!SmartRefStream methodsFor: 'read write' stamp: 'mt 3/10/2023 15:43'!initKnownRenames renamed at: #FlasherMorph put: #Flasher; at: #AlansTextPlusMorph put: #TextPlusMorph; at: #Project put: #MorphicProject; at: #InputSensor put: #EventSensor; yourself! !!SmartRefStream methodsFor: 'read write' stamp: 'mt 3/10/2023 15:43'!restoreClassInstVars "Install the values of the class instance variables of UniClasses." self flag: #todo. "mt: See EToys in Squeak 6.0 and before."! !!SqueakToolsDebuggerHelp class methodsFor: 'pages' stamp: 'mt 3/15/2023 14:10'!showForm: aSymbol | form contents | form := MenuIcons formAtKey: aSymbol. contents := (String with: Character cr) asText, (Text string: ' ' attribute: (TextFontReference toFont: (FormSetFont new fromFormArray: (Array with: form) asciiStart: Character space asInteger ascent: form height))), (String with: Character cr) asText. ^contents! !!SystemWindow methodsFor: 'initialization' stamp: 'mt 3/10/2023 16:09'!initializeLabelArea "Initialize the label area (titlebar) for the window." labelString ifNil: [labelString := 'Untitled Window']. label := StringMorph new contents: labelString; font: (self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont]); yourself. "Add collapse box so #labelHeight will work" collapseBox := self createCollapseBox. stripes := Array with: (RectangleMorph newBounds: bounds) with: (RectangleMorph newBounds: bounds). "see extent:" self addLabelArea. se lf setLabelWidgetAllowance. self addCloseBox. self class moveMenuButtonRight ifTrue: [self addLabel. self addMenuControl] ifFalse: [self addMenuControl. self addLabel]. self addExpandBox. labelArea addMorphBack: collapseBox. self setFramesForLabelArea.! !!SystemWindow methodsFor: 'menu' stamp: 'dao 10/1/2004 12:57'!fullScreenMaximumExtent "Zoom Window to Full World size with possible DeskMargins obey the maximum extent rules" | left right possibleBounds | left := right := 0. self paneMorphs do: [:pane | ((pane isKindOf: ScrollPane) and: [pane retractableScrollBar]) ifTrue: [pane scrollBarOnLeft ifTrue: [left := left max: pane scrollBarThickness] ifFalse: [right := right max: pane scrollBarThickness]]]. possibleBounds := self worldBounds insetBy: (left @ 0 corner: right @ 0 ). self maximumExtent ifNotNil: [possibleBounds := possibleBounds origin extent: ( self maximumExtent min: ( possibleBounds extent ))]. ((Flaps sharedFlapsAllowed and: [Project current flapsSuppressed not]) or: [Preferences fullScreenLeavesDeskMargins]) ifTrue: [possibleBounds := possibleBounds insetBy: 22]. self bounds: possibleBounds! !!SystemWindow methodsFor: 'menu' stamp: 'mt 3/10/2023 14:27'!sendToBack | aWorld nextWindow | aWorld := self world. nextWindow := aWorld submorphs detect: [:m | (m isSystemWindow) and: [m ~~ self]] ifNone: [^self]. nextWindow beKeyWindow. aWorld addMorphBack: self! !!SystemWindow methodsFor: 'open/close' stamp: 'mt 3/7/2023 17:40'!delete | thisWorld | self mustNotClose ifTrue: [^self]. model okToClose ifFalse: [^self]. thisWorld := self world. self activeHand removeKeyboardListener: self. self isFlexed ifTrue: [owner delet e] ifFalse: [super delete]. model windowIsClosing; release. model := nil. SystemWindow noteTopWindowIn: thisWorld! !!SystemWindow methodsFor: 'stepping' stamp: 'mt 8/28/2023 15:51'!stepAt: millisecondClockValue "If the receiver is not collapsed, step it, after first stepping the model." (isCollapsed not or: [self wantsStepsWhenCollapsed]) ifTrue: [model ifNotNil: [model stepAt: millisecondClockValue in: self]. super stepAt: millisecondClockValue]"Since this method ends up calling step, the model-stepping logic should not be duplicated there."! !!SystemWindow methodsFor: 'stepping' stamp: 'mt 3/10/2023 15:01'!wantsSteps "Return true if the model wants its view to be stepped. For an open system window, we give the model to offer an opinion" self isPartsDonor ifTrue: [^ false]. ^ isCollapsed not and: [model wantsStepsIn: self]! !!SystemWindow methodsFor: 'top window' stamp: 'mt 3/7/2023 17:40'!comeToFront "Modal windows: Walk along the modal owner chain, the bring all to top." self modalOwner ifNotNil: [:mo | mo isSystemWindow ifTrue: [ ^ mo modalOwner ifNil: [mo comeToFrontModally] ifNotNil: [:omo | omo comeToFront]]]. self modalChild ifNotNil: [^ self comeToFrontModally]. "Now show me." super comeToFront. "Label should be visible to interact with." self assureLabelAreaVisible.! !!TabMorph methodsFor: 'tabs' stamp: 'mt 8/4/2023 13:36'!tabSelected "Called when the receiver is hit. First, bulletproof against someone having taken the structure apart. My own action basically requires that my grand-owner be a TabbedPalette" (owner isKindOf: IndexTabs) ifFalse: [^ Beeper beep]. (owner owner isKindOf: TabbedPalette) ifFalse: [^ Beeper beep]. owner owner selectTab: self! !!TabSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'!addControls "Add the control bar at the top of the tool." | b r | b := SimpleButtonMorph ne w target: self; borderColor: Color black. r := AlignmentMorph newRow. r color: b color; borderWidth: 0; layoutInset: 0. r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. r wrapCentering: #topLeft. r addMorphBack: (b label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort). b := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (b label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #cancelSort). self addMorphFront: r.! !!TabSorterMorph methodsFor: 'initialization' stamp: 'mt 8/16/2023 13:52'!initialize "Initialize the receiver." super initialize. self removeAllMorphs. self extent: 300@100. pageHolder := PasteUpMorph new. pageHolder vResizeToFit: true; autoLineLayout: true. pageHolder extent: self extent - self borderWidth. pageHolder padding: 8. pageHolder cursor: 0. self addControls. self addMorphBack: pageHolder ! !!TabbedPalette methodsFor: 'palette menu' stamp: 'mt 8/4/2023 13:42'!addBookMenuItemsTo: aCustomMenu hand: aHandMorph aCustomMenu add: 'add palette menu' translated action: #addMenuTab.! !!TabbedPalette methodsFor: 'palette menu' stamp: 'mt 7/31/2023 11:20'!addMenuTab "Add the menu tab. This is ancient code, not much in the spirit of anything current" | aMenu aTab aGraphic sk | aMenu := MenuMorph new defaultTarget: self. aMenu stayUp: true. "aMenu add: 'clear' translated action: #showNoPalette." aMenu add: 'sort tabs' translated action: #sortTabs:. aMenu add: 'choose new colors for tabs' translated action: #recolorTabs. aMenu setProperty: #paletteMenu toValue: true. "aMenu add: 'make me the Standard palette' translated action: #becomeStandardPalette." aTab := self addTabForBook: aMenu withBalloonText: 'a menu of palette-related controls' translated. aTab highlightColor: tabsMorph highlightColor; regularColor: tabsMorph regularColor.
tabsMorph laySubpartsOutInOneRow; layoutChanged. aGraphic := MenuIcons formAtKey: 'TinyMenu'. aGraphic ifNotNil: [aTab removeAllMorphs. aTab addMorph: (sk := Project current world drawingClass withForm: aGraphic). sk position: aTab position. sk lock. aTab fitContents]. self layoutChanged! !!TabbedPalette methodsFor: 'user-interface' stamp: 'mt 8/4/2023 13:36'!selectTab: aTab | currentPalette morphToInstall oldTab aSketchEditor | oldTab := tabsMorph highlightedTab. (oldTab notNil and: [(morphToInstall := oldTab morphToInstall) isKindOf: PaintBoxMorph]) ifTrue: [(aSketchEditor := self world submorphOfClass: SketchEditorMorph) ifNotNil: [aSketchEditor cancelOutOfPainting]. morphToInstall delete]. tabsMorph selectTab: aTab. morphToInstall := aTab morphToInstall. (morphToInstall isKindOf: PaintBoxMorph) "special case, maybe generalize this need?" ifFalse: [se lf goToPageMorph: morphToInstall] ifTrue: [self showNoPaletteAndHighlightTab: aTab. self world addMorphFront: morphToInstall. morphToInstall position: ((self left max: 90) "room for the pop-out-to-left panel" @ (tabsMorph bottom))]. (currentPalette := self currentPalette) ifNotNil: [currentPalette layoutChanged]. self snapToEdgeIfAppropriate! !!TabbedPalette class methodsFor: 'scripting' stamp: 'mt 7/31/2023 11:20'!authoringPrototype | aTabbedPalette aBook aTab | aTabbedPalette := self new markAsPartsDonor. aTabbedPalette pageSize: 200 @ 300. aTabbedPalette tabsMorph highlightColor: Color red regularColor: Color blue. aTabbedPalette addMenuTab. aBook := BookMorph new setNameTo: 'one'; pageSize: aTabbedPalette pageSize. aBook color: Color blue muchLighter. aBook removeEverything; insertPage; showPageControls. aBook currentPage addMorphBack: (Project current world drawingClass withFo rm: (MenuIcons formAtKey: 'squeakyMouse')). aTab := aTabbedPalette addTabForBook: aBook. aBook := BookMorph new setNameTo: 'two'; pageSize: aTabbedPalette pageSize. aBook color: Color red muchLighter. aBook removeEverything; insertPage; showPageControls. aBook currentPage addMorphBack: CurveMorph authoringPrototype. aTabbedPalette addTabForBook: aBook. aTabbedPalette selectTab: aTab. aTabbedPalette beSticky. aTabbedPalette tabsMorph hResizing: #spaceFill. ^ aTabbedPalette! !!TextMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 16:10'!getMenu: shiftKeyState ^ shiftKeyState not ifTrue: [TextEditor yellowButtonMenu] ifFalse: [TextEditor shiftedYellowButtonMenu]! !!TextMorph methodsFor: 'events-processing' stamp: 'mt 3/15/2023 13:46'!handleKeystroke: anEvent "Overwritten to support tab-among-fields preference." anEvent wasHandled ifTrue:[^self]. (self handlesKeyboard: anEvent) ifFalse: [^ self]. (anEvent hand keyboard Focus ~~ self and: [self handlesKeyboardOnlyOnFocus]) ifTrue: [^ self]. ^ super handleKeystroke: anEvent! !!TextMorph methodsFor: 'menu' stamp: 'mt 8/16/2023 13:54'!addCustomMenuItems: aCustomMenu hand: aHandMorph | outer | super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu add: 'text properties...' translated action: #changeTextColor. aCustomMenu addUpdating: #autoFitString target: self action: #autoFitOnOff. aCustomMenu addUpdating: #wrapString target: self action: #wrapOnOff. aCustomMenu add: 'text margins...' translated action: #changeMargins:. aCustomMenu add: 'add predecessor' translated action: #addPredecessor:. aCustomMenu add: 'add successor' translated action: #addSuccessor:. outer := self owner. outer ifNotNil: [ outer isLineMorph ifTrue: [container isNil ifTrue: [Smalltalk at: #TextOnCurveContainer ifPresent: [:ignored | aCustomMenu add: 'follow owner''s curve' translated actio n: #followCurve]] ifFalse: [aCustomMenu add: 'reverse direction' translated action: #reverseCurveDirection. aCustomMenu add: 'set baseline' translated action: #setCurveBaseline:]] ifFalse: [self fillsOwner ifFalse: [aCustomMenu add: 'fill owner''s shape' translated action: #fillingOnOff] ifTrue: [aCustomMenu add: 'rectangular bounds' translated action: #fillingOnOff]. self avoidsOcclusions ifFalse: [aCustomMenu add: 'avoid occlusions' translated action: #occlusionsOnOff] ifTrue: [aCustomMenu add: 'ignore occlusions' translated action: #occlusionsOnOff]]].! !!TextMorph class methodsFor: 'parts bin' stamp: 'mt 3/7/2023 15:07'!fancyPrototype | t | t := self authoringPrototype. t autoFit: false; extent: 150@75. t borderWidth: 2; margins: 4@0; useRoundedCorners. "Why not rounded?" "fancy font, shadow, rounded" t fontName: Preferences standardButtonFont familyName size: 18; textColor: Color blue; fillStyle: Color lightBrown. t addDropShadow."Strangeness here in order to avoid two offset copies of the default contents when operating in an mvc project before cursor enters the morphic window" t paragraph. ^ t! !!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 8/11/2023 15:18'!extrasMenuOn: aDockingBar aDockingBar addItem: [ :it| it contents: 'Extras' translated; addSubMenu: [:menu| menu addItem:[:item| item contents: 'Recover Changes' translated; help: 'Recover changes after a crash' translated; icon: MenuIcons smallDocumentClockIcon; target: ChangeList; selector: #browseRecentLog]. menu addItem:[:item| item contents: 'Recover Method Versions' translated; help: 'Recover ve rsions of deleted methods' translated; target: ChangeList; selector: #browseMethodVersions]. menu addLine. menu addItem:[:item| item contents: 'Themes & Colors' translated; subMenuUpdater: self selector: #themesAndWindowColorsOn: ]. menu addItem:[:item| item contents: 'Scale Factor' translated; subMenuUpdater: self selector: #scaleFactorsOn:]. menu addItem:[:item| item contents: 'Language' translated; subMenuUpdater: self selector: #languageTranslatorsOn: ]. menu addItem:[:item| item contents: 'Set Author Initials' translated; help: 'Sets the author initials' translated; icon: MenuIcons smallUserQuestionIcon; target: Utilities; selector: #setAuthorInitials]. menu addItem:[:item| item contents: 'Restore Display (r)' translated; help: 'Redraws the entire display' translated; target: Project current; selector: #restoreDisplay]. menu addItem:[:item| item contents: 'Rebuild Menus' translated; help: 'Rebuilds the menu bar' translated; target: TheWorldMainDockingBar; selector: #updateInstances]. menu addLine. menu addItem:[:item| item contents: 'Start Profiler' translated; help: 'Starts the profiler' translated; icon: MenuIcons smallTimerIcon; target: self; selector: #startMessageTally]. menu addItem:[:item| item contents: 'Collect Garbage' translated; help: 'Run the garbage collector and report space usage' translated; target: Utilities; selector: #garbageCollectAndReport]. menu addItem:[:item| item contents: 'Purge Undo Records' translated; help: 'Save space by removing all the undo information remembered in all projects' translated; target: CommandHistory; selector: #resetAllHistory]. menu addItem:[:item| item contents: 'VM statistics' translated; help: 'Virtual Machine infor mation' translated; target: self; selector: #vmStatistics]. menu addLine. menu addItem:[:item| item contents: 'Graphical Imports' translated; help: 'View the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList' translated; target: (Imports default); selector: #viewImages]. menu addItem:[:item| item contents: 'Browse My Changes' translated; help: 'Browse all of my changes since the last time #condenseSources was run.' translated; target: SystemNavigation new; selector: #browseMyChanges]. ] ]! !!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 3/7/2023 13:59'!themesAndWindowColorsOn: menu | themes | menu addItem:[:item| item contents: 'Fonts' translated; subMenuUpdater: Preferences selector: #fontConfigurationMenu:; icon: MenuIcons smallFontsIcon]. menu addLine. menu addItem:[:item| item contents: (Model useColorfulWindows ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Colorful Windows' translated; target: self; selector: #toggleColorfulWindows]. menu addItem:[:item| item contents: (SystemWindow gradientWindow not ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Flat Widget Look' translated; target: self; selector: #toggleGradients]. menu addLine. menu addItem:[:item | item contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Soft Shadows' translated; target: self; selector: #toggleSoftShadows]. menu addItem:[:item | item contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow not]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Hard Shadows' translated; target: self; selector: #toggleHardShadows]. menu addLine. menu addItem:[:item | item contents: (SystemWindow roundedWindowCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Window/Dialog Look' translated; target: self; selector: #toggleRoundedWindowLook]. menu addItem:[:item | item contents: (PluggableButtonMorph roundedButtonCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Button/Scrollbar/Menu Look' translated; target: self; selector: #toggleRoundedButtonLook]. menu addLine. themes := UserInterfaceTheme allThemes asArray sort: #name ascending. themes := themes select: [ :each | each isGenuine]. themes ifEmpty: [ menu addIt em: [ :item | item contents: '(No UI themes found.)' translated; isEnabled: false ] ]. themes do: [ :each | menu addItem: [ :item | item contents: (UserInterfaceTheme current name = each name ifTrue: ['<yes>'] ifFalse: ['<no>']), each name; target: each; selector: #applyScaled ] ]. menu addLine; add: 'Restore UI theme background' translated target: self selector: #restoreThemeBackground; add: 'Reset all UI themes' translated target: self selector: #resetAllThemes; add: 'Edit current UI theme...' translated target: self selector: #editCurrentTheme.! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/4/2023 13:59'!addObjectsAndTools: menu self fillIn: menu from: { nil. { 'objects (o)'. { #myWorld. #activateObjectsTool }. 'A tool for finding and obtaining many kinds of objects' }. { 'new morph. ..'. { self. #newMorph }. 'Offers a variety of ways to create new objects' }. nil. { 'flaps...'. { self. #flapsDo }. 'A menu relating to use of flaps. For best results, use "keep this menu up"' }. { 'projects...'. { self. #projectDo }. 'A menu of commands relating to use of projects' }. { 'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}. nil }! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:54'!addPrintAndDebug: menu self fillIn: menu from: { { 'make screenshot'. {self. #saveScreenshot}. 'makes a screenshot and saves it to disk'}. "{ 'print PS to file...'. { self. #printWorldOnFile }. 'write the world into a postscript file' }." { 'debug...'. { self. #debugDo }. 'a menu of debugging items' } }! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:58'!addUtilities: menu self
fillIn: menu from: { { 'open...'. { self. #openWindow } }. { 'windows...'. { self. #windowsDo } }. { 'changes...'. { self. #changesDo } } }. self fillIn: menu from: { { 'help...'. { self. #helpDo }. 'puts up a menu of useful items for updating the system, determining what version you are running, and much else' }. { 'appearance...'. { self. #appearanceDo }. 'put up a menu offering many controls over appearance.' } }. self fillIn: menu from: { { 'do...'. { Utilities. #offerCommonRequests }. 'put up an editible list of convenient expressions, and evaluate the one selected.' } }! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:57'!appearanceMenu "Build the appearance menu for the world." ^self fillIn: (self menu: 'appearance...') from: { {'preferences...' . { self . #openPreferencesBrowser} . 'Opens a "Preferences Browser" which allows you to alter many settings' } . {'preferences wizard...' . { self . #openPreferencesWizard} . 'Opens a "Preferences Wizard" which allows you to alter many settings in a guided fashion' } . {'choose set of preferences...' . { Preferences . #offerThemesMenu} . 'Presents you with a menu of sets or preferences; each item''s balloon-help will tell you about the particular set. If you choose one, many different preferences that come along are set at the same time; you can subsequently change any settings by using a Preferences Panel'} . nil . {'system fonts...' . { self . #standardFontDo} . 'Choose the standard fonts to use for code, lists, menus, window titles, etc.'}. nil. {'full screen on' . { DisplayScreen . #fullScreenOn} . 'puts you in full-screen mode, if not already there.'}. {'full screen off' . { DisplayScreen . #fullScreenOff} . 'if in full-screen mode, takes you out of it.'}. nil. {'set display depth ...' . {self. #setDisplayDepth} . 'choose how many bits per pixel.'}. {'set desktop color...' . {self. #changeBackgroundColor} . 'choose a uniform color to use as desktop background.'}. {'set gradient color...' . {self. #setGradientColor} . 'choose second color to use as gradient for desktop background.'}. }! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 7/31/2023 11:19'!helpMenu "Build the help menu for the world." | menu | menu := self menu: 'help...'. self fillIn: menu from: { {'about this system...'. {Smalltalk. #aboutThisSystem}. 'current version information.'}. {'update code from server'. {MCMcmUpdater. #updateFromServer}. 'load latest code updates via the internet'}. {'preferences...'. {self. #openPreferencesBrowser}. 'view and change various options.'}. {'set language...' . {Project. #chooseNaturalLanguage}. 'choose the language in which tiles should be displaye d.'} . nil. {'command-key help'. { TheWorldMainDockingBar instance . #commandKeyHelp}. 'summary of keyboard shortcuts.'} }. self addGestureHelpItemsTo: menu. self fillIn: menu from: { {'world menu help'. { self . #worldMenuHelp}. 'helps find menu items buried in submenus.'}. "{'info about flaps' . { Utilities . #explainFlaps}. 'describes how to enable and use flaps.'}." {'font size summary' . { TextStyle . #fontSizeSummary}. 'summary of names and sizes of available fonts.'}. {'useful expressions' . { Utilities . #openStandardWorkspace}. 'a window full of useful expressions.'}. {'annotation setup...' . { Preferences . #editAnnotations}. 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools'}. nil. {'graphical imports' . { Imports default . #viewImages}. 'view the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList'}. nil. {'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}. {#soundEnablingString . { SoundService . #toggleSoundEnabled}. 'turning sound off will completely disable Squeak''s use of sound.'}. nil. {'set author initials...' . { Utilities . #setAuthorInitials }. 'supply initials to be used to identify the author of code and other content.'}. {'vm statistics' . { self . #vmStatistics}. 'obtain some intriguing data about the vm.'}. nil. {'purge undo records' . { CommandHistory . #resetAllHistory }. 'save space by removing all the undo information remembered in all projects.'}. {'space left' . { self . #garbageCollect}. 'perform a full garbage-co llection and report how many bytes of space remain in the image.'}. }. ^menu! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/16/2023 11:24'!newMorph "The user requested 'new morph' from the world menu. Put up a menu that allows many ways of obtaining new morphs." | menu | menu := self menu: 'Add a new morph'. menu add: 'from paste buffer' translated target: myHand action: #pasteMorph; add: 'from alphabetical list' translated subMenu: self alphabeticalMorphMenu; add: 'from a file...' translated target: self action: #readMorphFromAFile. menu addLine. menu add: 'grab rectangle from screen' translated target: myWorld action: #grabDrawingFromScreen:; add: 'grab with lasso from screen' translated target: myWorld action: #grabLassoFromScreen:; add: 'grab rubber band from screen' translated target: myWorld action: #grabRubberBandFromScreen:; add: 'grab flood area from screen' translated target: myWorld action: #grabFloodFromScreen:. menu addLine. menu add: 'make link to project...' translated target: self action: #projectThumbnail. self doPopUp: menu.! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/11/2023 16:37'!openMenu "Build the open window menu for the world." | menu | menu := self menu: 'open...'. menu defaultTarget: ToolSet default. menu addList: ToolSet menuItems. menu defaultTarget: self. self fillIn: menu from: { nil. {'file...' . { self . #openFileDirectly} . 'Lets you open a window on a single file'}. {'transcript (t)' . {self . #openTranscript}. 'A window used to report messages sent to Transcript' }. "{'inner world' . { WorldWindow . #test1} }." nil. }. self fillIn: menu from: self class registeredOpenCommands. menu addLine. self fillIn: menu from: { {'morphic project' . {self. #openMorphicProject} . 'Creates a new morphic project'}. {'mvc project' . {self. #openMVCProj ect} . 'Creates a new project of the classic "mvc" style'} }. ^menu! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/11/2023 16:37'!projectMenu "Build the project menu for the world." | menu | self flag: #bob0302. menu := self menu: 'projects...'. self fillIn: menu from: { { 'save on server (also makes a local copy)' . { #myProject . #storeOnServer } }. { 'save to a different server' . { #myProject . #saveAs } }. { 'save project on local file only' . { #myWorld . #saveOnFile } }. { 'see if server version is more recent...' . { #myProject . #loadFromServer } }. { 'load project from file...' . { self . #loadProject } }. nil. }. self fillIn: menu from: { { 'create new morphic project' . { self . #openMorphicProject } }. { 'create new mvc project'. { self . #openMVCProject } }. }. self fillIn: menu from: { nil. { 'go to previous project' . { Project . #returnToPreviousProject } }. { 'go to next project' . { Project . #advanceToNextProject } }. { 'jump to project...' . { #myWorld . #jumpToProject } }. }. self fillIn: menu from: { nil. { 'save for future revert' . { #myProject . #saveForRevert } }. { 'revert to saved copy' . { #myProject . #revert } }. }. ^ menu! !!TheWorldMenu methodsFor: '*MorphicExtras-windows & flaps menu' stamp: 'mt 8/4/2023 15:18'!formulateFlapsMenu: aMenu "Fill aMenu with appropriate content" aMenu addTitle: 'flaps' translated. aMenu addStayUpItem. Preferences classicNavigatorEnabled ifTrue: [aMenu addUpdating: #navigatorShowingString enablementSelector: #enableProjectNavigator target: Preferences selector: #toggle: argumentList: #(showProjectNavigator). aMenu balloonTextForLastItem: (Preferences preferenceAt: #showProjectNavigator) helpString translated]. Flaps sharedFlapsAllowed ifTrue:
[self fillIn: aMenu from: {{#suppressFlapsString. {Project current. #toggleFlapsSuppressed}. 'Whether prevailing flaps should be shown in the project right now or not.'}}. aMenu addUpdating: #automaticFlapLayoutString target: Preferences selector: #toggle: argumentList: #(automaticFlapLayout). aMenu balloonTextForLastItem: (Preferences preferenceAt: #automaticFlapLayout) helpString translated. aMenu addLine. Flaps addIndividualGlobalFlapItemsTo: aMenu]. self fillIn: aMenu from: { nil. {'make a new flap'. {Flaps. #addLocalFlap}. 'Create a new flap. You can later make it into a shared flap is you wish.'}. nil.}. Flaps sharedFlapsAllowed ifTrue: [aMenu addWithLabel: 'put shared flaps on bottom' translated enablementSelector: #showSharedFlaps target: Flaps selector: #sharedFlapsAlongBottom argumentList: #(). aMenu balloonTextForLastItem: 'Group all the standard shared flaps along the bottom edge of the screen' translated. self fillIn: aMenu from: { {'destroy all shared flaps'. {Flaps. #disableGlobalFlaps}. 'Destroy all the shared flaps and disable their use in all projects.'}}] ifFalse: [aMenu add: 'install default shared flaps' translated target: Flaps action: #enableGlobalFlaps. aMenu balloonTextForLastItem: 'Create the default set of shared flaps' translated. aMenu addLine]. self fillIn: aMenu from: { nil. {'about flaps...'. {Flaps . #explainFlaps}. 'Gives a window full of details about how to use flaps.'}}! !!ThreePhaseButtonMorph class methodsFor: 'class initialization' stamp: 'mt 3/15/2023 14:11'!initialize "ThreePhaseButtonMorph initialize" | extent inset | extent := 12@12. inset := 3. #('CheckBoxOff' 'CheckBoxOn' 'CheckBoxPressed') do: [:button | | f r | f := ColorForm extent: extent depth: 1. f colors: {Color transparent. Color black}. f borderWidth: 1. r := f boundingBox insetBy: inset. button = 'CheckBoxPressed' ifTrue: [f border: r width: 1]. button = 'CheckBoxOn' ifTrue: [f fillBlack: r]. MenuIcons saveForm: f atKey: button]. #('RadioButtonOff' 'RadioButtonOn' 'RadioButtonPressed') do: [:button | | f r c | f := ColorForm extent: extent depth: 1. f colors: {Color transparent. Color black}. r := f boundingBox. c := f getCanvas. c frameOval: r color: Color black. r := r insetBy: inset. button = 'RadioButtonPressed' ifTrue: [c frameOval: r color: Color black]. button = 'RadioButtonOn' ifTrue: [c fillOval: r color: Color black]. MenuIcons saveForm: f atKey: button]! !!ThreePhaseButtonMorph class methodsFor: 'instance creation' stamp: 'mt 3/15/2023 14:09'!labelSymbol: aSymbol "(self labelSymbol: #TryIt) openInHand" | aButton form | aButton := ThreePhaseButtonMorph new. form := MenuIcons formAtKey: aSymbol. aButton offImage: form. aButton image: form. aButton pressedImage: (MenuIcons formPressedAtKey: aSymbol). ^ aButton! !!ThumbnailMorph methodsFor: 'stepping' stamp: 'mt 8/28/2023 14:37'!stepTime "Adjust my step time to the time it takes drawing my referent" drawTime ifNil:[^ 250]. ^(20 * drawTime) max: 250.! !!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'!actualViewee "Return the actual morph to be viewed, or nil if there isn't an appropriate morph to view." | aMorph actualViewee | aMorph := self morphToView ifNil: [^ nil]. aMorph isInWorld ifFalse: [^ nil]. actualViewee := viewSelector ifNil: [aMorph] ifNotNil: [objectToView perform: viewSelector]. actualViewee == 0 ifTrue: [^ nil]. "valueAtCu rsor result for an empty HolderMorph" actualViewee ifNil: [actualViewee := objectToView]. (actualViewee isMorph and: [actualViewee isFlexMorph and: [actualViewee submorphs size = 1]]) ifTrue: [actualViewee := actualViewee firstSubmorph]. ^ actualViewee! !!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'!formOrMorphToView "Answer the form to be viewed, or the morph to be viewed, or nil" | actualViewee | (objectToView isForm) ifTrue: [^objectToView]. actualViewee := viewSelector ifNil: [objectToView] ifNotNil: [objectToView perform: viewSelector]. ^actualViewee == 0 ifTrue: [nil "valueAtCursor result for an empty HolderMorph"] ifFalse: [actualViewee]! !!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'!morphToView "If the receiver is viewing some object, answer a morph can be thought of as being viewed; A gesture is made toward generalizing this beyond the morph/p layer regime, in that a plain blue rectangle is returned rather than simply failing if the referent is not itself displayable." objectToView ifNil: [^ nil]. ^ objectToView isMorph ifTrue: [objectToView] ifFalse: [RectangleMorph new color: Color blue]! !!TransformationMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 15:02'!removeFlexShell "Remove the shell used to make a morph rotatable and scalable." | oldHalo unflexed myWorld refPos aPosition | self isInWorld ifFalse: [^self]. refPos := self referencePosition. myWorld := self world. oldHalo := self halo. submorphs isEmpty ifTrue: [^ self delete]. aPosition := (owner submorphIndexOf: self) ifNil: [1]. unflexed := self firstSubmorph. self submorphs do: [:m | m position: self center - (m extent // 2). owner addMorph: m asElementNumber: aPosition]. unflexed absorbStateFromRenderer: self. oldHalo ifNotNil: [oldHalo setTarget: unflexed]. myWorld ifNotNil: [myWorld startSteppingSubmorphsOf: unflexed]. self delete. unflexed referencePosition: refPos. ^ unflexed! !!TransformationMorph methodsFor: 'private' stamp: 'mt 3/10/2023 11:18'!adjustAfter: changeBlock "Cause this morph to remain centered where it was before, and choose appropriate smoothing, after a change of scale or rotation." | oldRefPos | oldRefPos := self referencePosition. changeBlock value. self chooseSmoothing. self layoutChanged. owner ifNotNil: [owner invalidRect: bounds]! !!TranslucentProgessMorph methodsFor: 'drawing' stamp: 'mt 3/7/2023 15:07'!drawOn: aCanvas | revealPercentage revealingStyle revealingColor revealingBounds revealToggle x baseColor revealTimes secondsRemaining stringToDraw where fontToUse innerBounds | innerBounds := bounds. opaqueBackgroundColor ifNotNil: [ aCanvas frameAndFillRectangle: bounds fillColor: opaqueBackgroundColor borderWidth: 8
borderColor: Color blue. innerBounds := innerBounds insetBy: 8. ]. revealTimes := (self valueOfProperty: #revealTimes) ifNil: [^self]. revealPercentage := (revealTimes first / revealTimes second) asFloat. revealingStyle := self revealingStyle. x := self valueOfProperty: #progressStageNumber ifAbsent: [1]. baseColor := Color perform: (#(red blue green magenta cyan yellow) atPin: x). revealingColor := baseColor alpha: 0.2. revealingStyle = 3 ifTrue: [ "wrap and change color" revealPercentage > 1.0 ifTrue: [ revealingColor := baseColor alpha: (0.2 + (revealingStyle / 10) min: 0.5). ]. revealPercentage := revealPercentage fractionPart. ]. revealingStyle = 2 ifTrue: [ "peg at 75 and blink" revealPercentage > 0.75 ifTrue: [ revealToggle := self valueOfProperty: #revealToggle ifAbsent: [true]. self setProperty: #revealToggle toValue: revealToggle not. revealToggle ifTru e: [revealingColor := baseColor alpha: 0.8.]. ]. revealPercentage := revealPercentage min: 0.75. ]. revealingBounds := innerBounds withLeft: innerBounds left + (innerBounds width * revealPercentage) truncated. aCanvas fillRectangle: revealingBounds color: revealingColor. secondsRemaining := (revealTimes second - revealTimes first / 1000) rounded. secondsRemaining > 0 ifTrue: [ fontToUse := StrikeFont familyName: Preferences standardButtonFont familyName size: 24. stringToDraw := secondsRemaining printString. where := innerBounds corner - ((fontToUse widthOfString: stringToDraw) @ fontToUse height). aCanvas drawString: stringToDraw in: (where corner: innerBounds corner) font: fontToUse color: Color black. aCanvas drawString: stringToDraw in: (where - (1@1) corner: innerBounds corner) font: fontToUse color: Color white. ]. ! !!TrashCanMorph methodsFor: 'event handling' stamp: 'mt 8/11/2023 13:45'!doubleClick: evt evt hand world addMorphCentered: ScrapBook default scrapBook! !!UpdatingRectangleMorph methodsFor: 'setting' stamp: 'mt 3/10/2023 15:02'!valueProvider "Answer the object to which my get/set messages should be sent. This is inefficient and contorted in order to support grandfathered content for an earlier design" ^ target! !!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:28'!decimalPlaces: aNumber "Set the receiver's number of decimal places to be shown." | constrained | self setProperty: #decimalPlaces toValue: (constrained := aNumber min: 11). self pvtFloatPrecision: (Utilities floatPrecisionForDecimalPlaces: constrained).! !!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 15:45'!target: anObject target := anObject. floatPrecision := 1.! !!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:02'!valueFromContents "Return a new value from the current contents string." format = #symbol ifTrue: [^ lastValue]. format = #string ifTrue: [^ contents]. ^ Compiler evaluate: contents! !!UpdatingStringMorph methodsFor: 'target access' stamp: 'mt 3/10/2023 14:13'!readFromTarget "Update my readout from my target" | v ret | (target isNil or: [getSelector isNil]) ifTrue: [^contents]. ret := self checkTarget. ret ifFalse: [^ '0']. v := target perform: getSelector. "scriptPerformer" (v isKindOf: Text) ifTrue: [v := v asString]. ^self acceptValueFromTarget: v! !!UserInterfaceTheme methodsFor: 'private - fonts' stamp: 'mt 7/31/2023 11:21'!installSystemFont: aFont "Establish the default text font and style. Update the #defaultFontIndex in all known text styles to reflect the system's new default point size." | aStyle | self flag: #todo. "mt: Support derivatives such as bold and italic." aStyle := aFont textStyleOrNil. "mt: Must b e installed and thus never be nil!!" aStyle defaultFontIndex: (aStyle fontIndexOfPointSize: aFont pointSize "drop emphasis"). TextStyle setDefault: aStyle. TextStyle actualTextStyles "no defaults" do: [:ea | ea isTTCStyle ifTrue: [ea defaultFont asPointSize: aFont pointSize "May generate new pointSize"]. ea defaultFontIndex: (ea fontIndexOfPointSize: aFont pointSize)]. RealEstateAgent resetScaleFactor. Flaps replaceToolsFlap.! !!CommunityTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addDarkWindowColors: aUserInterfaceTheme "self createDark apply." aUserInterfaceTheme set: #uniformWindowColor for: #Model to: Color darkGray; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color darker] ]; set: #unfocusedLabelColor for: #SystemWindow to: Color veryLightGray; set: #focusedLabelColor for: #SystemWindow to: Color white; set: #customWindowColor for: #Br owser to: self dbBlue; set: #customWindowColor for: #ChangeList to: self dbBlue; set: #customWindowColor for: #ChangeSorter to: self dbBlue; set: #customWindowColor for: #ChatNotes to: self dbPurple twiceDarker; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self dbPurple twiceDarker; set: #customWindowColor for: #Debugger to: self dbRed; set: #customWindowColor for: #DualChangeSorter to: self dbOrange twiceDarker; set: #customWindowColor for: #FileContentsBrowser to: self dbGray; set: #customWindowColor for: #FileList to: self dbGray; set: #customWindowColor for: #Inspector to: self dbYellow duller; set: #customWindowColor for: #InstanceBrowser to: self dbYellow duller; set: #customWindowColor for: #Lexicon to: self dbGreen; set: #customWindowColor for: #MCTool to: self dbOrange twiceDarker; set: #customWindowColor for: #MessageNames to: self dbGreen; set: #customWindow Color for: #MessageSet to: self dbGreen; set: #customWindowColor for: #ObjectExplorer to: self dbYellow duller; set: #customWindowColor for: #PackagePaneBrowser to: self dbBlue; set: #customWindowColor for: #PluggableFileList to: self dbGray; set: #customWindowColor for: #PreferenceBrowser to: self dbBlue; set: #customWindowColor for: #ProcesBrowser to: self dbAqua; set: #customWindowColor for: #SMLoader to: self dbOrange twiceDarker; set: #customWindowColor for: #SMLoaderPlus to: self dbOrange twiceDarker; set: #customWindowColor for: #SMReleaseBrowser to: self dbOrange twiceDarker; set: #customWindowColor for: #SelectorBrowser to: self dbBlue; set: #customWindowColor for: #StringHolder to: self dbGray; set: #customWindowColor for: #TestRunner to: self dbPink darker; set: #customWindowColor for: #TranscriptStream to: self dbGray; set: #customWindowColor for: #VersionsBrowser to: self dbPurpl e twiceDarker; set: #customWindowColor for: #Workspace to: self dbPink darker.! !!MonokaiTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addDarkWindowColors: theme "self createDark apply." theme set: #uniformWindowColor for: #Model to:( self invisibleColor adjustBrightness: 0.16) "lighter twice"; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: -0.16 "darker twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: [ Model useColorfulWindows ifTrue: [(Color r: 0.285 g: 0.282 b: 0.242) "invisible color"] ifFalse: [(Color r: 0.972 g: 0.972 b: 0.948) "foreground color"] ]; set: #focusedLabelColor for: #SystemWindow to: [ Model useColorfulWindows ifTrue: [(Color r: 0.152 g: 0.156 b: 0.133) "background color"] ifFalse: [(Color r: 0.901 g: 0.858 b: 0.455) "yellow"] ]; set: #customWindowColor for: #Browser to: self green duller; set: #customWindowColor for: #ChangeList to: self blue duller; set: #customWindowColor for: #ChangeSorter to: self blue duller; set: #customWindowColor for: #ChatNotes to: self magenta duller; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet duller; set: #customWindowColor for: #Debugger to: self red duller; set: #customWindowColor for: #DualChangeSorter to: self blue duller; set: #customWindowColor for: #FileContentsBrowser to: self yellow duller; set: #customWindowColor for: #FileList to: self yellow duller; set: #customWindowColor for: #InstanceBrowser to: self cyan duller; set: #customWindowColor for: #Lexicon to: self cyan duller; set: #customWindowColor for: #MCTool to: self violet duller; set: #customWindowColor for: #MessageNames to: self green duller; set: #customWindowColor for: #MessageSet to: se lf cyan duller; set: #customWindowColor for: #PackagePaneBrowser to: self green duller; set: #customWindowColor for: #PluggableFileList to: self yellow duller; set: #customWindowColor for: #PreferenceBrowser to: self cyan duller; set: #customWindowColor for: #SMLoader to: self orange duller; set: #customWindowColor for: #SMLoaderPlus to: self orange duller; set: #customWindowColor for: #SMReleaseBrowser to: self orange duller; set: #customWindowColor for: #SelectorBrowser to: self cyan duller; set: #customWindowColor for: #StringHolder to: self yellow duller; set: #customWindowColor for: #TestRunner to: self orange duller; set: #customWindowColor for: #TranscriptStream to: self orange duller; set: #customWindowColor for: #VersionsBrowser to: self violet duller.! !!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addDarkWindowColors: theme "doIt: [self createDark apply.]" theme set: #uniformWindowColor for: #Model to: (self darkBackgroundHighlights adjustBrightness: 0.16 "lighter twice"); set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: -0.16 "darker twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: self darkContentEmphasized; set: #focusedLabelColor for: #SystemWindow to: self darkContentEmphasizedMore; set: #customWindowColor for: #Browser to: self green; set: #customWindowColor for: #ChangeList to: self blue; set: #customWindowColor for: #ChangeSorter to: self blue; set: #customWindowColor for: #ChatNotes to: self magenta; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet; set: #customWindowColor for: #Debugger to: self red; set: #customWindowColor for: #DualChangeSorter to: self blue; set: #customWindowColor for: #FileContentsBrowser to: self yellow; set: #customWindowColor for: # FileList to: self yellow; set: #customWindowColor for: #InstanceBrowser to: self cyan; set: #customWindowColor for: #Lexicon to: self cyan; set: #customWindowColor for: #MCTool to: self violet; set: #customWindowColor for: #MessageNames to: self green; set: #customWindowColor for: #MessageSet to: self cyan; set: #customWindowColor for: #PackagePaneBrowser to: self green; set: #customWindowColor for: #PluggableFileList to: self yellow; set: #customWindowColor for: #PreferenceBrowser to: self cyan; set: #customWindowColor for: #SMLoader to: self orange; set: #customWindowColor for: #SMLoaderPlus to: self orange; set: #customWindowColor for: #SMReleaseBrowser to: self orange; set: #customWindowColor for: #SelectorBrowser to: self cyan; set: #customWindowColor for: #StringHolder to: self yellow; set: #customWindowColor for: #TestRunner to: self orange; set: #customWindowColor for: #TranscriptStream to: self orange; set: #customWindowColor for: #VersionsBrowser to: self violet.! !!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addLightWindowColors: theme "You have to create dark first. doIt: [self createDark. self createLight apply.]" theme set: #uniformWindowColor for: #Model to: (self lightBackgroundHighlights adjustBrightness: -0.16 "darker twice"); set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: 0.16 "lighter twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: self lightContentEmphasized; set: #focusedLabelColor for: #SystemWindow to: self lightContentEmphasizedMore; set: #customWindowColor for: #Browser to: self green; set: #customWindowColor for: #ChangeList to: self blue; set: #customWindowColor for: #ChangeSorter to: self blue; set: #customWindowColor for: #ChatNotes to: self magenta; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet; set: #customWindowColor for: #Debugger to: (self red adjustSaturation: -0.27 brightness: 0.27); set: #customWindowColor for: #DualChangeSorter to: self blue; set: #customWindowColor for: #FileContentsBrowser to: self yellow; set: #customWindowColor for: #FileList to: self yellow; set: #customWindowColor for: #InstanceBrowser to: self cyan; set: #customWindowColor for: #Lexicon to: self cyan; set: #customWindowColor for: #MCTool to: self violet; set: #customWindowColor for: #MessageNames to: self green; set: #customWindowColor for: #MessageSet to: self cyan; set: #customWindowColor for: #PackagePaneBrowser to: self green; set: #customWindowColor for: #PluggableFileList to: self yellow; set: #customWindowColor for: #PreferenceBrowser to: self cyan; set: #customWindowColor for: #SMLoader to: (self orange adjustSaturation : -0.18 brightness: 0.18); set: #customWindowColor for: #SMLoaderPlus to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SMReleaseBrowser to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SelectorBrowser to: self cyan; set: #customWindowColor for: #StringHolder to: self yellow; set: #customWindowColor for: #TestRunner to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #TranscriptStream to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #VersionsBrowser to: self violet.! !!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addDullerWindowColors: theme theme set: #uniformWindowColor for: #Model to: Color veryVeryLightGray duller; set: #customWindowColor for: #Browser to: (Color r: 0.764 g: 0.9 b: 0.63) duller; set: #customWindowColor f or: #ChangeList to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #ChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #ChatNotes to: (Color r: 1.0 g: 0.7 b: 0.8) duller; set: #customWindowColor for: #ClassCommentVersionsBrowser to: (Color r: 0.753 g: 0.677 b: 0.9) duller; set: #customWindowColor for: #Debugger to: (Color r: 0.9 g: 0.719 b: 0.719) duller; set: #customWindowColor for: #DualChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #FileContentsBrowser to: (Color r: 0.7 g: 0.7 b: 0.508) duller; set: #customWindowColor for: #FileList to: (Color r: 0.65 g: 0.65 b: 0.65) duller; set: #customWindowColor for: #InstanceBrowser to: (Color r: 0.726 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #Lexicon to: (Color r: 0.79 g: 0.9 b: 0.79) duller; set: #customWindowColor for: #MCTool to: (Color r: 0.65 g: 0.691 b: 0.876) duller; set: #customWindowColor for: #MessageNames to: (Color r: 0.639 g: 0.9 b: 0.497) duller; set: #customWindowColor for: #MessageSet to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #PackagePaneBrowser to: (Color r: 0.9 g: 0.9 b: 0.63) duller; set: #customWindowColor for: #PluggableFileList to: Color lightYellow duller; set: #customWindowColor for: #PreferenceBrowser to: (Color r: 0.671 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #SMLoader to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SMLoaderPlus to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SMReleaseBrowser to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SelectorBrowser to: (Color r: 0.45 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #StringHolder to: (Color r: 0.9 g: 0.9 b: 0.719) duller; set: #customWindowColor for: #TestRunn er to: (Color r: 0.9 g: 0.576 b: 0.09) duller; set: #customWindowColor for: #TranscriptStream to: (Color r: 0.9 g: 0.75 b: 0.45) duller; set: #customWindowColor for: #VersionsBrowser to: (Color r: 0.782 g: 0.677 b: 0.9) duller.! !!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addWindowColors: theme theme set: #titleFont for: #SystemWindow to: [Preferences windowTitleFont]; set: #borderColorModifier for: #SystemWindow to: [ [:c | c adjustBrightness: -0.3] ]; set: #borderColorModifier for: #ScrollPane to: [ [:c | c adjustBrightness: -0.3] ]; set: #borderWidth for: #SystemWindow to: 1; derive: #resizerColorModifier for: #AbstractResizerMorph from: #SystemWindow at: #borderColorModifier; set: #uniformWindowColor for: #Model to: Color veryVeryLightGray; derive: #uniformWindowColor for: #TranscriptStream from: #Model; derive: #color for: #SystemWindow from: #Model at: #uniformWind owColor; "Fall back for windows without models." set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color darker] ]; set: #unfocusedLabelColor for: #SystemWindow to: Color darkGray; set: #focusedLabelColor for: #SystemWindow to: Color black; set: #customWindowColor for: #Browser to: (Color r: 0.764 g: 0.9 b: 0.63); set: #customWindowColor for: #ChangeList to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #ChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #ChatNotes to: (Color r: 1.0 g: 0.7 b: 0.8); set: #customWindowColor for: #ClassCommentVersionsBrowser to: (Color r: 0.753 g: 0.677 b: 0.9); set: #customWindowColor for: #Debugger to: (Color r: 0.9 g: 0.719 b: 0.719); set: #customWindowColor for: #DualChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #FileContentsBrowser to: (Color r: 0.7 g: 0.7 b: 0.508) ; set: #customWindowColor for: #FileList to: (Color r: 0.65 g: 0.65 b: 0.65); set: #customWindowColor for: #InstanceBrowser to: (Color r: 0.726 g: 0.9 b: 0.9); set: #customWindowColor for: #Lexicon to: (Color r: 0.79 g: 0.9 b: 0.79); set: #customWindowColor for: #MCTool to: (Color r: 0.65 g: 0.691 b: 0.876); set: #customWindowColor for: #MessageNames to: (Color r: 0.639 g: 0.9 b: 0.497); set: #customWindowColor for: #MessageSet to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #PackagePaneBrowser to: (Color r: 0.9 g: 0.9 b: 0.63); set: #customWindowColor for: #PluggableFileList to: Color lightYellow; set: #customWindowColor for: #PreferenceBrowser to: (Color r: 0.671 g: 0.9 b: 0.9); set: #customWindowColor for: #SMLoader to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SMLoaderPlus to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SMReleaseBrowser to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SelectorBrowser to: (Color r: 0.45 g: 0.9 b: 0.9); set: #customWindowColor for: #StringHolder to: (Color r: 0.9 g: 0.9 b: 0.719); set: #customWindowColor for: #TestRunner to: (Color r: 0.9 g: 0.576 b: 0.09); set: #customWindowColor for: #TranscriptStream to: (Color r: 0.9 g: 0.75 b: 0.45); set: #customWindowColor for: #VersionsBrowser to: (Color r: 0.782 g: 0.677 b: 0.9).! !!TrimTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addWindowColors: theme | windowColorBrightnessAdjustment | windowColorBrightnessAdjustment := -0.35. theme set: #titleFont for: #SystemWindow to: [Preferences windowTitleFont]; set: #borderColorModifier for: #SystemWindow to: [ [:c | c adjustBrightness: -0.1] ]; set: #borderColorModifier for: #ScrollPane to: [ [:c | c adjustBrightness: 0.1] ]; set: #borderWidth for: #SystemWindow to: 1;
set: #uniformWindowColor for: #Model to: self gray76; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color alphaMixed: 0.5 with: self gray40] ]; set: #unfocusedLabelColor for: #SystemWindow to: self gray168; set: #focusedLabelColor for: #SystemWindow to: Color white; set: #customWindowColor for: #Browser to: ((Color r: 0.764 g: 0.9 b: 0.63) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChangeList to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChangeSorter to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChatNotes to: ((Color r: 1.0 g: 0.7 b: 0.8) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ClassCommentVersionsBrowser to: ((Color r: 0.753 g: 0.677 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #Debugger to: ((Color r: 0.9 g: 0.719 b: 0.719) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #DualChangeSorter to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #FileContentsBrowser to: ((Color r: 0.7 g: 0.7 b: 0.508) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #FileList to: ((Color r: 0.65 g: 0.65 b: 0.65) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #InstanceBrowser to: ((Color r: 0.726 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #Lexicon to: ((Color r: 0.79 g: 0.9 b: 0.79) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MCTool to: ((Color r: 0.65 g: 0.691 b: 0.876) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MessageNames to: ((Color r: 0.639 g: 0.9 b: 0.497) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MessageSet to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PackagePaneBrowser to: ((Color r: 0.9 g: 0.9 b: 0.63) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PluggableFileList to: (Color lightYellow adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PreferenceBrowser to: ((Color r: 0.671 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMLoader to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMLoaderPlus to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMReleaseBrowser to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SelectorBrowser to: ((Color r: 0.45 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #StringHolder to: ((Color r: 0.9 g: 0.9 b: 0.719) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #TestRunner to: ((Color r: 0.9 g: 0.576 b: 0.09) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #TranscriptStream to: ((Color r: 0.9 g: 0.75 b: 0.45) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #VersionsBrowser to: ((Color r: 0.782 g: 0.677 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment).! !!Utilities class methodsFor: 'common requests' stamp: 'mt 8/11/2023 15:01'!initializeCommonRequestStrings "Initialize the common request strings, a directly-editable list of expressions that can be evaluated from the 'do...' menu." CommonRequestStrings := StringHolder new contents: 'Utilities emergencyCollapse.Utilities closeAllDebuggers.RecentMessages default revertMostRecent.-MCFileBasedRepository flushAllCaches-Sensor keyboard.ParagraphEditor abandonChangeText.Cursor normal show.-CommandHistory resetAllHistory.Project allInstancesDo: [:p | p displayDepth: 16].ScriptingSystem inspectFormDictionary.Form fromUser bitEdit.Display border: (0@0 extent: 640@480) width: 2.-Undeclared inspect.Undeclared removeUnreferencedKeys; inspect.Transcript clear.GIFReadWriter grabScreenAndSaveOnDisk.FrameRateMorph new openInHand.-Utilities reconstructTextWindowsFromFileNamed: ''TW''.Utilities storeTextWindowContentsToFileNamed: ''TW''.ChangeSet removeEmptyUnnamedChangeSets.ChangesOrganizer reorderChangeSets.'"Utilities initializeCommonRequestStrings"! !!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:55'!addControls | slider aWrapper m aButton | aWrapper := AlignmentMorph newRow. aWrapper color: Color transparent; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 @ 5. aWrapper wrapCentering: #topLeft. aButton := self buttonName: 'X' action: #delete. aButton setBalloonText: 'Close WaveEditor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Menu' translated action: #invokeMenu. aButton setBalloonText: 'Open a menu' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play' translated action: #play. aButton setBalloonText: 'Play sound' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play Before' translated action: #playBeforeCur sor. aButton setBalloonText: 'Play before cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play After' translated action: #playAfterCursor. aButton setBalloonText: 'Play after cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play Loop' translated action: #playLoop. aButton setBalloonText: 'Play the loop' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Test' translated action: #playTestNote. aButton setBalloonText: 'Test the note' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Save' translated action: #saveInstrument. aButton setBalloonText: 'Save the sound' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1 . aButton := self buttonName: 'Set Loop End' translated action: #setLoopEnd. aButton setBalloonText: 'Set loop end at cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set One Cycle' translated action: #setOneCycle. aButton setBalloonText: 'Set one cycle' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set Loop Start' translated action: #setLoopStart. aButton setBalloonText: 'Set the loop start at cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. self addMorphBack: aWrapper. aWrapper := AlignmentMorph newRow. aWrapper color: self color; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5 @ 20; wrapCentering: #center; cellPositioning: #leftCenter. m := Strin gMorph new contents: 'Index: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #cursor; putSelector: #cursor:; font: Preferences standardButtonFont; growable: false; width: 71; step. aWrapper addMorphBack: m. m := StringMorph new contents: 'Value: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #valueAtCursor; putSelector: #valueAtCursor:; font: Preferences standardButtonFont; growable: false; width: 50; step. aWrapper addMorphBack: m. slider := SimpleSliderMorph new color: color; extent: 200 @ 10; target: self; actionSelec tor: #scrollTime:. aWrapper addMorphBack: slider. m := Morph new color: aWrapper color; extent: 10 @ 5. "spacer" aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #startIndex; putSelector: #startIndex:; font: Preferences standardButtonFont; width: 40; step. aWrapper addMorphBack: m. self addMorphBack: aWrapper! !!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:56'!addLoopPointControls | m aWrapper | aWrapper := AlignmentMorph newRow. aWrapper color: self color; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter. m := StringMorph new contents: 'Loop end: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopEn d; putSelector: #loopEnd:; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Loop length: ' translated ; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopLength; putSelector: #loopLength:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m.aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Loop cycles: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopCycles; putSelector: #loopCycles:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m.aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Frequency: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #perceivedFrequency; putSelector: #perceivedFrequency:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. self addMorphBack: aWrapper! !!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:53'!buttonName: aString action: aSymbol "Create a button with the given label and action selector, and answer it." ^ SimpleButtonMorph new target: self; label: aString font: Preferences standardButtonFont; actionSelector: aSymbol! !WebCamMorph class removeSelector: #additionsToViewerCategories!SymbolListType removeSelector: #initialValueForASlotFor:!StringType removeSelector: #initialValueForASlotFor:!SoundType removeSele ctor: #initialValueForASlotFor:!PointType removeSelector: #initialValueForASlotFor:!NumberType removeSelector: #initialValueForASlotFor:!GraphicType removeSelector: #initialValueForASlotFor:!!GraphicType reorganize!('initial value')('initialization' initialize)!ColorType removeSelector: #initialValueForASlotFor:!BooleanType removeSelector: #initialValueForASlotFor:!DataType removeSelector: #initialValueForASlotFor:!Vocabulary removeSelector: #isEToyVocabulary!UpdatingStringMorph removeSelector: #isEtoyReadout!!UpdatingStringMorph reorganize!('accessing' autoAcceptOnFocusLoss autoAcceptOnFocusLoss: decimalPlaces decimalPlaces: floatPrecision format getSelector getSelector: growable growable: maximumWidth maximumWidth: minWidth minWidth: putSelector putSelector: pvtFloatPrecision: target target: valueFromContents)('copying' veryDeepFixupWith: veryDeepInner:)('editing' acceptContents acceptValue: addCustomMenuItems:hand: doneWithEdits lostFocusWithoutAccepting setDecimalPlaces: setFon tSize setFontStyle setPrecision setToAllowTextEdit toggleGrowability userEditsAllowed)('event handling' handlesMouseDown: mouseDown: wouldAcceptKeyboardFocus)('events-processing' handlerForMouseDown:)('formats' useDefaultFormat useStringFormat useSymbolFormat)('initialization' defaultMaximumWidth defaultMinimumWidth initialize)('stepping' step stepTime stepTime: updateContentsFrom:)('target access' acceptValueFromTarget: checkTarget informTarget readFromTarget setDecimalPlacesFromTypeIn: stringForNumericValue:)('layout' fitContents)('*MorphicExtras-accessing' floatPrecision:)!UpdatingRectangleMorph removeSelector: #isEtoyReadout!!UpdatingRectangleMorph reorganize!('accessing' contents contents: getSelector getSelector: putSelector putSelector: target target: userEditsAllowed)('copying' veryDeepFixupWith: veryDeepInner:)('event handling' handlesMouseDown: mouseUp:)('initialization' defaultBorderColor)('setting' setTargetColor: valueProvider)('stepping' step stepTime)('target access' readFromTarget)!UpdatingMenuItemMorph removeSelector: #adaptToWorld:!ThumbnailMorph removeSelector: #isEtoyReadout!!ThumbnailMorph reorganize!('accessing' getSelector getSelector: putSelector target)('caching' releaseCachedState)('copying' veryDeepFixupWith: veryDeepInner:)('display' drawForForm:on: drawMeOn: scaleFor:in:)('drawing' drawOn:)('initialization' defaultBorderWidth defaultColor initialize objectToView: objectToView:viewSelector:)('stepping' step stepTime)('texture support' installAsWonderlandTextureOn:)('what to view' actualViewee formOrMorphToView morphToView)!ThreePhaseButtonMorph initialize!!ThreePhaseButtonMorph class reorganize!('class initialization' initialize)('instance creation' checkBox labelSymbol: radioButton)('preferences' themeProperties)!ThreePhaseButtonMorph removeSelector: #adaptToWorld:!TheWorldMenu removeSelector: #adaptToWorld:!TheWorldMenu removeSelector: #menuColorString!TheWorldMenu removeSelector: #mvcProjectsAllowed!TheWorldMenu removeSele ctor: #roundedCornersString!TheWorldMenu removeSelector: #toggleMenuColorPolicy!!TheWorldMenu reorganize!('action' commandKeyTypedIntoMenu: doMenuItem:with: projectThumbnail saveScreenshot setGradientColor soundEnablingString staggerPolicyString toggleRoundedCorners toggleWindowPolicy)('commands' changeBackgroundColor cleanUpWorld garbageCollect loadProject lookForSlips newMorphOfClass:event: openBrowser openFileDirectly openFileList openMorphicProject openMVCProject openPreferencesBrowser openPreferencesWizard openTranscript openWorkspace projectForMyWorld quitSession readMorphFromAFile saveAndQuit saveWorldInFile setDisplayDepth splitNewMorphList:depth: startMessageTally vmStatistics worldMenuHelp)('construction' addObjectsAndTools: addPrintAndDebug: addProjectEntries: addRestoreDisplay: addSaveAndQuit: addUtilities: alphabeticalMorphMenu appearanceMenu buildWorldMenu changesMenu colorForDebugging: debugMenu fillIn:from: helpMenu makeConvenient: newMorph openMenu projectMenu remoteMenu)('mechanics' menu: world:project:hand:)('menu' addGestureHelpItemsTo:)('popups' appearanceDo changesDo debugDo doPopUp: helpDo openWindow projectDo remoteDo standardFontDo)('windows & flaps menu' suppressFlapsString windowsDo windowsMenu)('*MorphicExtras-action' createStandardPartsBin launchCustomPartsBin toggleFlapSuppressionInProject)('*MorphicExtras-construction' myMenuColor)('*MorphicExtras-mechanics')('*MorphicExtras-windows & flaps menu' flapsDo flapsMenu formulateFlapsMenu: globalFlapsEnabled newGlobalFlapString)('*Tools' browseRecentLog openChangeSorter1 openChangeSorter2 openMessageNames openProcessBrowser openSelectorBrowser startThenBrowseMessageTally)('*MorphicExtras-Postscript Canvases' printWorldOnFile)!TextMorphForEditView removeSelector: #wouldAcceptKeyboardFocusUponTab!!TextMorph class reorganize!('class initialization' cleanUp defaultEditorClass defaultEditorClass: initialize registerInFlapsRegistry unload)('connectorstext-parts bin' boldAuthoringPrototype)('new-morph participation' includeInNewMorphMenu)('parts bin' borderedPrototype exampleBackgroundLabel fancyPrototype)('scripting' authoringPrototype defaultNameStemForInstances)('instance creation' string:fontName: string:fontName:size: string:fontName:size:wrap: string:size:)('*MorphicExtras-parts bin' supplementaryPartsDescriptions)!TextMorph removeSelector: #cursor!TextMorph removeSelector: #cursorWrapped:!TextMorph removeSelector: #getAllButFirstCharacter!TextMorph removeSelector: #holderForCharacters!TextMorph removeSelector: #insertCharacters:!TextMorph removeSelector: #insertContentsOf:!TextMorph removeSelector: #setAllButFirstCharacter:!TextMorph removeSelector: #wouldAcceptKeyboardFocusUponTab!!TextMorph reorganize!('accessing' autoFit: backgroundColor backgroundColor: borderWidth: caretColor caretColor: contents contentsAsIs: contentsWrapped: contents: contents:wrappedTo: crAction crAction: editor elementCount font: getFirstCharacter getLastC haracter hasTranslucentColor isAutoFit isWrapped margins margins: newContents: plainTextOnly plainTextOnly: readOnly readOnly: selectAll selectFrom:to: selectInterval: selection selectionColor selectionColor: selectionInterval selectionInterval: setCharacters: setFirstCharacter: setLastCharacter: text textAlignment textAlignmentSymbol textColor textColor: textStyle textStyle: unfocusedSelectionColor unfocusedSelectionColor: userString wrapFlag:)('alignment' centered justified leftFlush rightFlush)('anchors' adjustTextAnchor: anchorMorph:at:type:)('caching' loadCachedState releaseCachedState)('change reporting' ownerChanged)('classification' isTextMorph)('containment' avoidsOcclusions fillingOnOff fillsOwner fillsOwner: occlusionsOnOff recognizerArena setContainer:)('copying' copy veryDeepFixupWith: veryDeepInner:)('drawing' areasRemainingToFill: debugDrawLineRectsOn: drawNullTextOn: drawOn:)('editing' acceptContents acceptOnCR cancelEdits cancelEditsSafely chooseAlignment chooseEmphas is chooseEmphasisOrAlignment chooseFont chooseStyle handleEdit: handleInteraction:fromEvent: hasUnacceptedEdits: passKeyboardFocusTo: setCompositionWindow xeqLinkText:withParameter:)('event handling' click: getMenu: handlesKeyboard: handlesMouseDown: handlesMouseMove: handlesMouseOver: handlesMouseStillDown: hasFocus keyboardFocusChange: keyStroke: mouseDown: mouseEnter: mouseLeave: mouseMove: mouseUp: startDrag: wantsKeyboardFocus yellowButtonActivity:)('events-processing' handleKeystroke:)('geometry' bounds container defaultLineHeight extent: maximumContainerExtent privateMoveBy: textBounds)('geometry testing' containsPoint:)('initialization' beAllFont: defaultBorderWidth defaultColor fontName:pointSize: fontName:size: initialize setTextStyle: string:fontName:size: string:fontName:size:wrap:)('layout' acceptDroppingMorph:event: averageLineLength averageLineLength: doLayoutIn: layoutChanged minCompositionHeight minCompositionWidth minHeight minWidth)('linked frames' addPredeces sor: addSuccessor: firstCharacterIndex firstInChain isLinkedTo: lastCharacterIndex predecessor recomposeChain startingIndex successor withSuccessorsDo:)('menu' addCustomMenuItems:hand: autoFitOnOff autoFitString changeMargins: changeTextColor followCurve reverseCurveDirection setCurveBaseline: wrapOnOff wrapString)('multi level undo' editHistory)('objects from disk' convertToCurrentVersion:refStream: fixUponLoad:seg:)('visual properties' fillStyle fillStyle:)('*MorphicExtras-accessing' getCharacters)('*MorphicExtras-copying' updateReferencesUsing:)('private' adjustLineIndicesBy: clippingRectangle composeToBounds compositionRectangle createParagraph editorClass fit installEditorToReplace: paragraph paragraphClass predecessorChanged predecessor:successor: privateOwner: releaseEditor releaseParagraph releaseParagraphReally removedMorph: selectionChanged selectionChanged: setDefaultContentsIfNil setPredecessor: setSuccessor: text:textStyle: text:textStyle:wrap:color:predecessor:succes sor: updateFromParagraph)('blinking' blinkStart blinkStart: onBlinkCursor resetBlinkCursor startBlinking stopBlinking)('layout-properties' hResizing hResizing: vResizing vResizing: wrapDirection)('printing' fullPrintOn:)('Multilingual-ImmPlugin' preferredKeyboardPosition)('submorphs - add/remove' addMorphFront:fromWorldPosition: delete goBehind)('converting' asText withNoLineLongerThan:)!TabbedPalette removeSelector: #becomeStandardPalette!!TabbedPalette reorganize!('dropping/grabbing' wantsDroppedMorph:event:)('halos and balloon help' defersHaloOnClickTo:)('initialization' addTabFor:font: addTabForBook: addTabForBook:withBalloonText: defaultColor defaultPageSize initialize newTabs: setInitialState)('misc menu items' recolorTabs showNoPalette showNoPaletteAndHighlightTab: sortTabs:)('miscellaneous' currentPalette tabsMorph)('navigation' transitionSpecFor:)('other' setExtentFromHalo:)('palette menu' addBookMenuItemsTo:hand: addMenuTab)('scraps tab' hasScrapsTab scrapsBook showScrapsTab)('user-interface' selectTab: selectTabNamed: selectTabOfBook: tabMorphs tabNamed:)('submorphs - add/remove' replaceSubmorph:by:)!SystemWindow removeSelector: #extantSketchEditor!SystemWindow removeSelector: #wantsExpandBox!SystemWindow removeSelector: #wantsHalo!!SystemWindow reorganize!('drawing' areasRemainingToFill: colorForInsets makeMeVisible wantsRoundedCorners)('events' doFastFrameDrag: filterEvent:for: handleListenEvent: handleMouseDown: handleMouseUp: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: paneTransition: secondaryPaneTransition:divider: startDragFromLabel: wantsToBeDroppedInto:)('geometry' extent: justDroppedInto:event: labelRect paneMorphs panelRect position: removeMenuBox setPaneRectsFromBounds)('initialization' addCloseBox addExpandBox addGrips addKeyboardShortcuts addLabelArea addMenuControl applyModelExtent boxExtent createBox: createCloseBox createCollapseBox createExpandBox createMenuBox defaultBounds defaultColor initialize initializeKeyboardShortcuts initializeLabelArea initializeWithLabel: maximumExtent maximumExtent: model: removeKeyboardShortcuts replaceBoxes setDefaultParameters setFramesForLabelArea)('label' addLabel getRawLabel knownName label labelArea labelHeight labelWidgetAllowance relabel relabelEvent: setLabel: setLabelWidgetAllowance tryToRenameTo: update: widthOfFullLabelText)('layout' assureLabelAreaVisible changeCellGapOfLayoutFrames: convertAlignment displayScaleChangedBy: layoutBounds putLabelItemsInLabelArea)('menu' addCustomMenuItems:hand: buildWindowMenu changeColor deleteCloseBox fullScreen fullScreenMaximumExtent makeClosable makeSecondTopmost makeUnclosable offerWindowMenu sendToBack setWindowColor takeOutOfWindow wantsYellowButtonMenu)('object fileIn' convertToCurrentVersion:refStream:)('open/close' anyOpenWindowLikeMeIn: closeBoxHit delete initialExtent mustNotClose openAsIs openAsIsI n: openInWorld: openInWorld:extent: openInWorldExtent: postAcceptBrowseFor:)('panes' addMorph:frame: addMorph:fullFrame: holdsTranscript paneMorphSatisfying: replacePane:with: setUpdatablePanesFrom: titleAndPaneText updatablePanes updateBox:color: updateBoxesColor:)('resize/collapse' allowReframeHandles allowReframeHandles: collapse collapseOrExpand collapsedFrame contractToOriginalSize dragToEdgeDistance dragToEdgesSelectorFor:in: expand expandBoxHit expandToFullScreen fastFramingOn fullFrame getBoundsWithFlex getCollapsedFrame isCollapsed isPoint:nearBottomLeftOf: isPoint:nearBottomOf: isPoint:nearBottomRightOf: isPoint:nearLeftOf: isPoint:nearRightOf: isPoint:nearTopLeftOf: isPoint:nearTopOf: isPoint:nearTopRightOf: mouseLeaveEvent:fromPane: paneWithLongestSide:near: reframePanesAdjoining:along:to: setBoundsWithFlex: unexpandedFrame unexpandedFrame:)('stepping' amendSteppingStatus stepAt: stepTime wantsSteps wantsStepsWhenCollapsed)('testing' isSystemWindow isWindowForModel: shouldDropOnMouseUp wantsToBeCachedByHand)('top window' beKeyWindow beKeyWindowIfNeeded: comeToFront comeToFrontModally dimWindowButtons isKeyWindow undimWindowButtons updatePanesFromSubmorphs)('thumbnail' icon)('polymorph' modalChild modalLockTo: modalOwner modalUnlockFrom: rememberedKeyboardFocus)('focus' activate defaultFocusMorph defaultFocusMorph: isActive isActive: isLookingFocused isLookingFocused: lockWindowDecorations lockWindowTitle lookFocused lookUnfocused passivate passivateIfNeeded unlockWindowDecorations unlockWindowTitle updateFocusLookAtHand updateFocusLookForKeyboardFocus windowDecorations)('colors' existingPaneColor gradientWithColor: paneColor paneColor: paneColorToUse paneColorToUseWhenNotActive raisedColor refreshWindowColor restoreDefaultPaneColor setStripeColorsFrom: setWindowColor: updatePaneColors)('user interface' applyUserInterfaceTheme)('*ToolBuilder-Morphic-opening' openAsTool)('*services-base' requestor topWindow)('*60Deprecated-open/close' anyOpenWindowLikeMe)!SuperSwikiServer removeSelector: #matchingEntries:!StringButtonMorph removeSelector: #adaptToWorld:!!StringButtonMorph reorganize!('accessing' actionSelector actionSelector: arguments arguments: target target:)('button' doButtonAction)('copying' updateReferencesUsing: veryDeepFixupWith: veryDeepInner:)('event handling' handlesMouseDown: handlesMouseStillDown: mouseDown: mouseMove: mouseStillDown: mouseUp:)('initialization' initialize)('menu' addCustomMenuItems:hand: addTargetingMenuItems:hand: clearTarget setActWhen setActionSelector setArguments setLabel setTarget:)('submorphs - add/remove' actWhen:)('classification' isButton)!SqueakFurtherCorePackagesHelp class removeSelector: #etoys!!SmartRefStream reorganize!('accessing' structures: superclasses:)('class changed shape' catalogValues:size: conversionMethodsFor: storeInstVarsIn:from: writeClassRename:was: writeClassRenameMethod:was:fromInstVars: writeConversionMethod:class:was:fromInstVars:to: writeConversionMethodIn:fromInstVars:to:renamedFrom:)('conversion' inputSensorx0 worldMorphbosfcebbfgccpmcpbttloiairfidcuwhavcdsll0)('import image segment' applyConversionMethodsTo:className:varMap: checkFatalReshape: convert1:to:allVarMaps: convert2:allVarMaps: mapClass:origName: reshapedClassesIn:)('read write' appendClassDefns checkCrLf initKnownRenames initShapeDicts instVarInfo: mapClass: moreObjects next nextAndClose nextPut: nextPutObjOnly: noHeader readInstance readInstanceSize:clsname:refPosn: readShortInst readWordLike recordImageSegment: renamed renamedConv restoreClassInstVars saveClassInstVars scanFrom: scanFrom:environment: setStream: setStream:reading: structures superclasses uniClasesDo: uniClassInstVarsRefs: verifyStructure versionSymbol:)('*Morphic-conversion' bookPageMorphbosfcepcbbfgcc0 clippingMorphbosfcep0 clippingMorphbosfcepc0 dropShadowMorphbosfces0 layoutMorphbosfcepbbochvimol0 layoutMorphbosfcepcbbochvimol0 morphicEventtcbks0 morphicSoundEventtcbkss 0 multiNewParagraphttfclpomsswfpp0 myMorphbosfce0 newMorphicEventts0)('*ST80-conversion' scrollControllermvslrrsmsms0)('*Graphics-conversion' transparentColorrcc0)('strings-conversion' abstractStringx0 multiStringx0 multiSymbolx0)!ColorPickerMorph removeSelector: #delete!ColorPickerMorph removeSelector: #getColorFromKedamaWorldIfPossible:!!ColorPickerMorph reorganize!('accessing' argument argument: deleteOnMouseUp deleteOnMouseUp: locationIndicator originalColor: selectedColor selector selector: sourceHand sourceHand: target target: updateContinuously updateContinuously:)('drawing' drawOn:)('event handling' handlesMouseDown: inhibitDragging mouseDown: mouseUp:)('geometry testing' containsPoint:)('halos and balloon help' isLikelyRecipientForMouseOverHalos)('initialization' buildChartForm choseModalityFromPreference initialize initializeForPropertiesPanel initializeModal: updateSelectorDisplay)('menu' addCustomMenuItems:hand: pickUpColorFor: toggleDeleteOnMouseUp toggleUpdateContinuously)('other' addToWorld:near: bestPositionNear:inWorld: indicateColorUnderMouse putUpFor:near: trackColorUnderMouse)('stepping' step stepTime)('private' anchorAndRunModeless: argumentsWith: deleteAllBalloons modalBalloonHelpAtPoint: pickColorAt: positionOfColor: trackColorAt: updateAlpha: updateColor:feedbackColor: updateTargetColor updateTargetColorWith:)('submorphs - add/remove' delete)!SketchMorph removeSelector: #firstIntersectionWithLineFrom:to:!!SketchMorph reorganize!('accessing' form form: framesToDwell framesToDwell: keepAspectRatio keepAspectRatio: nominalForm: originalForm: rotatedForm scaleFactor scalePoint scalePoint: setNewFormFrom: useInterpolation useInterpolation: wantsSimpleSketchMorphHandles)('caching' releaseCachedState)('drawing' canBeEnlargedWithB3D drawHighResolutionOn:in: drawInterpolatedImage:on: drawOn: generateInterpolatedForm generateRotatedForm)('support' baseGraphic baseGraphic: flipHorizontal flipVertical rotationStyle rotationStyle: wantsRecolorHandle)('geometry' extent:)('geometry testing' containsPoint:)('halos and balloon help' isLikelyRecipientForMouseOverHalos wantsDirectionHandles wantsDirectionHandles:)('initialization' initialize initializeWith:)('layout' layoutChanged)('menu' addBorderToShape: addCustomMenuItems:hand: addPaintingItemsTo:hand: blur callThisBaseGraphic edgeDetect editDrawing editDrawingIn:forBackground: emboss erasePixelsOfColor: erasePixelsUsing: insertIntoMovie: recolorPixelsOfColor:with: recolorPixelsUsing: reduceColorPalette: restoreBaseGraphic restoreBaseGraphicFromMenu setRotationStyle sharpen toggleInterpolation useInterpolationString)('menus' addFillStyleMenuItems:hand: addToggleItemsToHaloMenu: changePixelsOfColor:toColor: chooseNewGraphic collapse)('objects from disk' convertToCurrentVersion:refStream:)('other' newForm: replaceSelfWithMovie)('parts bin' initializeToStandAlone)('pen support' clearExtent:fillColor: penOnMyForm revealPenStrokes)('rotate scale and flex' forwardDirection: heading:)('*MorphicExtras-testing' canDrawAtHigherResolution)!SketchEditorMorph removeSelector: #wantsHaloFromClick!SimpleSliderMorph removeSelector: #isLikelyRecipientForMouseOverHalos!!SimpleSliderMorph reorganize!('accessing' actionSelector actionSelector: arguments arguments: maxVal maxVal: minVal minVal: target target:)('copying' updateReferencesUsing: veryDeepFixupWith: veryDeepInner:)('initialization' initialize)('menu' addCustomMenuItems:hand: addSliderMenuItems:hand: addTargetingMenuItems:hand: clearTarget descendingString setActionSelector setArguments setLabel setMaxVal setMinVal setMinVal: setTarget: toggleDescending toggleTruncate truncateString)('model access' setValue:)('parts bin' initializeToStandAlone)('private' adjustToValue: getScaledValue setMaxVal: setScaledValue: truncate truncate:)!SimpleHierarchicalListMorph class removeSelector: #submorphsExample!!SimpleHierarchicalListMorph class reorganize!('instance creation' expandedForm notExpandedForm on:list:selected:changeSelected: on:list:selected:changeSelected:menu: on:list:selected:changeSelected:menu:keystroke:)('preferences' applyUserInterfaceTheme expandAllLimit expandAllLimit: themeProperties wrappedNavigation wrappedNavigation:)!HaloMorph removeSelector: #addChooseGraphicHandle:!HaloMorph removeSelector: #addMakeSiblingHandle:!HaloMorph removeSelector: #addPaintBgdHandle:!HaloMorph removeSelector: #addPoohHandle:!HaloMorph removeSelector: #addRepaintHandle:!HaloMorph removeSelector: #addScriptHandle:!HaloMorph removeSelector: #addTileHandle:!HaloMorph removeSelector: #addViewHandle:!HaloMorph removeSelector: #addViewingHandle:!HaloMorph removeSelector: #doDupOrMakeSibling:with:!HaloMorph removeSelector: #doMakeSibling:with:!HaloMorph removeSelector: #doMakeSiblingOrDup:with:!HaloMorph removeSelector: #fadeIn!HaloMorph removeSelector: #fadeInInitially!HaloMorph removeSelector: #fadeOut!HaloMorph removeSelector: #fadeOutFinally!HaloMorph removeSele ctor: #handleEntered!HaloMorph removeSelector: #handleLeft!HaloMorph removeSelector: #isMagicHalo!HaloMorph removeSelector: #isMagicHalo:!HaloMorph removeSelector: #mouseDown:!HaloMorph removeSelector: #openViewerForTarget:with:!HaloMorph removeSelector: #popUpMagicallyFor:hand:!HaloMorph removeSelector: #tearOffTileForTarget:with:!SimpleHaloMorph removeSelector: #isMagicHalo!SimpleHaloMorph removeSelector: #popUpMagicallyFor:hand:!!IconicButton reorganize!('events' mouseEnter: mouseLeave:)('initialization' borderNormal borderThick buttonSetup defaultBorderWidth initialize initializeWithThumbnail:withLabel:andColor:andSend:to: initializeWithThumbnail:withLabel:andSend:to: setDefaultLabel stationarySetup)('menu' addLabelItemsTo:hand:)('button' doButtonAction)('compatibility' dim undim)('ui' darken darkenedForm restoreImage shedSelvedge)('label' labelFromString: labelGraphic: labelMorph)('*MorphicExtras-initialization' initializeToShow:withLabel:andSend:to:)!SimpleButtonMorph removeS elector: #adaptToWorld:!!ServerDirectory class reorganize!('available servers' addLocalProjectDirectory: addServer:named: localProjectDirectories nameForServer: projectServers removeServerNamed: removeServerNamed:ifAbsent: resetLocalProjectDirectories resetServers serverForURL: serverNamed: serverNamed:ifAbsent: serverNames servers)('class initialization' cleanUp: initialize)('misc' defaultStemUrl newFrom: on: parseFTPEntry: secondsForDay:month:yearOrTime:thisMonth:thisYear:)('school support' projectDefaultDirectory)('server prefs' determineLocalServerDirectory: fetchExternalSettingsIn: parseServerEntryFrom: releaseExternalSettings serverConfDirectoryName storeCurrentServersIn: transferServerDefinitionsToExternal)('*UpdateStream-server groups' convertGroupNames groupNames serverInGroupNamed: serversInGroupNamed:)!Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl keepAlive encodingName'
classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers' poolDictionaries: '' category: 'Network-RemoteDirectory'!SelectionMorph removeSelector: #couldMakeSibling!SelectionMorph removeSelector: #preferredDuplicationHandleSelector!ScrollableField removeSelector: #cursorWrapped:!ScrollableField removeSelector: #getAllButFirstCharacter!ScrollableField removeSelector: #getNumericValue!ScrollableField removeSelector: #insertCharacters:!ScrollableField removeSelector: #insertContentsOf:!ScrollableField removeSelector: #setNumericValue:!!ScreeningMorph reorganize!('accessing' passElseBlock: passingColor:)('drawing' fullDrawOn:)('halos and balloon help' wantsRecolorHandle)('geometry testing' containsPoint:)('initialization' initialize)('layout' layoutChanged)('menu' addCustomMenuItems:hand: chooseBlockingColor choosePassingColor exchange showScreenOnly showScreenOverSource showScreened showSourceOnly)('private' removedMorph: screenFor m screenMorph sourceMorph)('submorphs - add/remove' addMorph:)!ScreenController removeSelector: #standardGraphicsLibrary!ReleaseBuilder class removeSelector: #beautifyEtoys!FlapTab removeSelector: #makeNewDrawing:!FlapTab removeSelector: #startOrFinishDrawing:!FlapTab removeSelector: #thicknessString!Quadrangle class removeSelector: #exampleInViewer!!ProjectSorterMorph reorganize!('initialization' addControls defaultBorderWidth defaultColor initialize navigator:listOfPages:)('event handling' clickFromSorterEvent:morph:)('controls' insertNewProject:)('private' morphsForMyContentsFrom:sizedTo: sorterMorphForProjectNamed:)!ProjectNavigationMorph removeSelector: #buttonPaint!ProjectNavigationMorph removeSelector: #doNewPainting!ProjectNavigationMorph removeSelector: #editProjectInfo!ProjectNavigationMorph removeSelector: #makeTheSimpleButtons!!ProjectLoading class reorganize!('accessing' projectStreamFromArchive: thumbnailFromUrl:)('loading' installRemoteNamed:from:named:in: openFromDirectory:andFileName: openFromFile:fromDirectory:withProjectView: openName:stream:fromDirectory:withProjectView: openName:stream:fromDirectory:withProjectView:clearOriginFlag: openOn:)('utilities' bestAccessToFileName:andDirectory: useTempChangeSet)('loading - support' checkSecurity:preStream:projStream: fileInName:archive:morphOrList: loadImageSegment:fromDirectory:withProjectView:numberOfFontSubstitutes:substituteFont:mgr: makeExistingView:project:projectsToBeDeleted: morphOrList:stream:fromDirectory:archive: parseManifest:)!ProjectLauncher removeSelector: #cancelLogin!ProjectLauncher removeSelector: #doEtoyLogin!ProjectLauncher removeSelector: #loginAs:!ProjectLauncher removeSelector: #prepareForLogin!ProjectLauncher removeSelector: #proceedWithLogin!ProjectLauncher removeSelector: #startUpAfterLogin!AbstractLauncher subclass: #ProjectLauncher instanceVariableNames: 'showSplash splashURL whichFlaps' classVariableNames: 'SplashMorph' poolDictionaries: ''
category: 'System-Download'!!ProjectLauncher reorganize!('initialization' initialize setupFlaps setupFromParameters)('running' hideSplashMorph installProjectFrom: showSplashMorph startUp)('private' showSplash)!Project class removeSelector: #publishInSexp!!Project class reorganize!('class initialization' cleanUp: cleanUpProjectPreferences initialize localeChanged rebuildAllProjects)('constants' current uiManager uiProcess)('squeaklet on server' enterIfThereOrFind: fromUrl: isBadNameForStoring: loaderUrl mostRecent:onServer: namedUrl: parseProjectFileName: projectExtension serverDirectoryFromURL: serverFileFromURL: squeakletDirectory sweep:)('utilities' addingProject: advanceToNextProject allNames allNamesAndProjects allProjects allProjectsOrdered canWeLoadAProjectNow chooseNaturalLanguage deletingProject: enter: flattenProjectHierarchy forget: hierarchyOfNamesAndProjects jumpToProject jumpToSelection: maybeForkInterrupt named: named:in: namedWithDepth: ofWorld: projectHierarch y releaseProjectReferences: removeAll: removeAllButCurrent returnToParentProject returnToPreviousProject storeAllInSegments topProject versionForFileName:)('*Morphic-Support' allMorphicProjects)('error recovery' tryEmergencyEvaluatorForRecovery: tryOtherProjectForRecovery:)('shrinking' removeProjectsFromSystem)('snapshots' shutDown: startUp:)('*ST80-Support' allMVCProjects)('preferences')('*60Deprecated-error recovery' handlePrimitiveError:)('*61Deprecated-utilities' resumeProcess:)!MorphicProject removeSelector: #exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction:!MorphicProject removeSelector: #initMorphic!MorphicProject removeSelector: #myPlayerClasses!MorphicProject removeSelector: #setFlaps!!MorphicProject reorganize!('display' displayScaleChangedFrom:to: invalidate noDisplayDuring: previewImageForm restore viewLocFor:)('initialize' initialize installPasteUpAsWorld: openProject: setWorldBackground:)('testing' isMorphic)('menu messages' assureNavigatorPresenceMatchesPreference makeThumbnail)('utilities' addItem:toMenu:selection:color:thumbnail: composeDisplayTextIntoForm: createViewIfAppropriate do:withProgressInfoOn:label: findAFolderForProject:label: findProjectView: jumpToProject launchSystemFiles:event: offerMenu:from:shifted: pointerMoved setAsBackground: showImage:named: textWindows)('docking bars support' assureMainDockingBarPresenceMatchesPreference createOrUpdateMainDockingBar dockingBar dockingBar: removeMainDockingBar showWorldMainDockingBar showWorldMainDockingBar: showWorldMainDockingBarString toggleShowWorldMainDockingBar)('file in/out' acceptProjectDetails: armsLengthCommand:withDescription: compressFilesIn:to:in: compressFilesIn:to:in:resources: exportSegmentWithChangeSet:fileName:directory: exportSegmentWithChangeSet:fileName:directory:withoutInteraction: loadFromServer: noteManifestDetailsIn: storeSegment storeSegmentNoFile)('enter' clearGlobalState enterAsActiveSubprojectWithin: finalEnter Actions: finalExitActions: initializeMenus isIncompletelyLoaded resumeEventRecorder: scheduleProcessForEnter startUpActions suspendProcessForDebug terminateProcessForLeave wakeUpTopWindow)('squeaklet on server' enterIfThereOrFind: openBlankProjectNamed:)('release' deletingProject: prepareForDelete)('language' chooseNaturalLanguage updateLocaleDependents)('editors' bitEdit: bitEdit:at:scale: editCharacter:ofFont: formEdit: formViewClass openImage:name:saveResource:)('futures' future:do:at:args: future:send:at:args:)('active process' spawnNewProcess spawnNewProcessAndTerminateOld: spawnNewProcessIfThisIsUI: uiProcess uiProcess:)('transcripter' displayTranscripter: initializeParagraphForTranscripter:)('subprojects' addProject: subProjects)('accessing' color topMorphicProject)('updating' applyUserInterfaceTheme canApplyUserInterfaceTheme)('scheduling & debugging' addDeferredUIMessage: fatalDrawingError: interruptCleanUpFor: lastDeferredUIMessage openDebuggerWindow: recursiveError: restore Display resumeProcessSafely: suspendProcessSafely:)('flaps support' assureFlapIntegrity cleanseDisabledGlobalFlapIDsList enableDisableGlobalFlap: flapsSuppressed: globalFlapEnabledString: globalFlapWithIDEnabledString: isFlapEnabled: isFlapIDEnabled: suppressFlapsString toggleFlapsSuppressed)('protocols' currentVocabulary)!Project removeSelector: #restoreReferences!!Project reorganize!('accessing' changeSet color displayDepth displayDepth: explicitName explicitName: findProjectView: forgetExistingURL labelString lastDirectory: lastSavedAtSeconds name nameAdjustedForDepth nextProject nilParentError previousProject projectChangeSet renameTo: storeNewPrimaryURL: thumbnail thumbnail: topProject transcript uiManager urlList viewSize viewSize: world)('active process' depth spawnNewProcessIfThisIsUI: uiProcess)('displaying' displayDepthChanged displayScaleChangedFrom:to: displaySizeChanged displayZoom: imageForm imageFormOfSize:depth: invalidate noDisplayDuring: previewImageForm restore restoreDisplay showZoom shrinkDisplay viewLocFor:)('file in/out' armsLengthCommand:withDescription: assureIntegerVersion bumpVersion: couldBeSwappedOut currentVersionNumber decideAboutCreatingBlank: doArmsLengthCommand: downloadUrl ensureChangeSetNameUnique exportSegmentFileName:directory: exportSegmentFileName:directory:withoutInteraction: exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction: exportSegmentWithCatagories:classes:fileName:directory: exportSegmentWithChangeSet:fileName:directory: findAFolderToLoadProjectFrom findAFolderToStoreProjectIn fromMyServerLoad: hasBadNameForStoring htmlPagePrototype loadFromServer loadFromServer: objectForDataStream: primaryServer primaryServerIfNil: projectExtension revert saveAs saveForRevert serverList squeakletDirectory storeAttributeKey:value:on: storeAttributesOn: storeDataOn: storeHtmlPageIn: storeManifestFileIn: storeOnServer storeOnServerAssumingNameValid storeOnServerInnards storeOnServerShowProgressOn:forge tURL: storeOnServerWithProgressInfo storeOnServerWithProgressInfoOn: storeSegment storeSegmentNoFile storeSomeSegment storeToMakeRoom tryToFindAServerWithMe url urlForLoading versionForFileName versionFrom: versionedFileName writeFileNamed:fromDirectory:toServer: writeStackText:in:registerIn:)('flaps support' flapsSuppressed flapsSuppressed: showSharedFlaps)('initialization' initialExtent initialProject initialize installNewDisplay:depth: openProject: resetTranscript setChangeSet: setServer windowActiveOnFirstClick windowReqNewLabel:)('language' chooseNaturalLanguage localeChanged localeID naturalLanguage updateLocaleDependents)('menu messages' assureNavigatorPresenceMatchesPreference doWeWantToRename exit fileOut installProjectPreferences makeThumbnail saveProjectPreferences validateProjectNameIfOK:)('printing' addSubProjectNamesTo:indentation: printOn:)('project parameters' initializeProjectParameters initializeProjectPreferences noteThatParameter:justChangedTo: parameterAt: parameterAt:ifAbsent: projectParameterAt: projectParameterAt:ifAbsent: projectParameterAt:ifAbsentPut: projectParameterAt:put: projectParameters projectPreferenceAt: projectPreferenceAt:ifAbsent: projectPreferenceFlagDictionary rawParameters removeParameter:)('release' addDependent: canDiscardEdits close delete deletingProject: forget okToChange prepareForDelete release removeChangeSetIfPossible windowIsClosing)('resources' abortResourceLoading resourceDirectoryName resourceManager resourceManager: resourceUrl startResourceLoading storeResourceList:in:)('SuperSwiki' tellAFriend tellAFriend:)('*sound' beep)('enter' enter enter: enter:revert:saveForRevert: finalEnterActions: finalExitActions: loadState saveState scheduleProcessForEnter shutDownActions startUpActions terminateProcessForLeave wakeUpTopWindow)('utilities' addItem:toMenu:selection:color:thumbnail: buildJumpToMenu: composeDisplayTextIntoForm: do:withProgressInfoOn:label: findAFolderForProject:label: jumpToProject jumpToSelection: offerMenu:from:shifted: pointerMoved setAsBackground: showImage:named: textWindows)('squeaklet on server' enterIfThereOrFind: openBlankProjectNamed:)('futures' future:do:at:args: future:send:at:args:)('editors' bitEdit: bitEdit:at:scale: editCharacter:ofFont: formEdit: formViewClass openImage:name:saveResource:)('transcripter' displayTranscripter: initializeParagraphForTranscripter:)('sub-projects & hierarchy' addProject: beTopProject children isTopProject liftSubProjects parent setParent: subProjects withChildrenDo:)('enter - recovery' enterForEmergencyRecovery suspendProcessForDebug)('testing' isCurrentProject isIncompletelyLoaded isMorphic)('shrinking' removeAllOtherProjects)('*ST80-Testing' isMVC)('*60Deprecated-accessing' setThumbnail: setViewSize:)('scheduling & debugging' addDeferredUIMessage: debugProcess:inDialog: debugProcess:inWindow: guardRecursiveError:during: interruptCleanUpFor: interruptName: interruptName:message: interruptName:message:preemptedProcess: interruptName:preemptedProcess: lastDeferredUIMessage openDebuggerWindow: prepareProcessForDebugger: primitiveError: recursiveError: resumeProcessSafely: suspendProcessSafely:)('*MorphicExtras-accessing' useOwnChangeSetWithCurrentName useParentChangeSetButSetProjectName:)('protocols' currentVocabulary)!Preferences class removeSelector: #annotationEditingWindow!Preferences class removeSelector: #automaticViewerPlacement!Preferences class removeSelector: #batchPenTrails!Preferences class removeSelector: #capitalizedReferences!Preferences class removeSelector: #cautionBeforeClosing!Preferences class removeSelector: #chooseEToysFont!Preferences class removeSelector: #chooseEToysTitleFont!Preferences class removeSelector: #classicTilesSettingToggled!Preferences class removeSelector: #compactViewerFlaps!Preferences class removeSelector: #debugMenuItemsInvokableFromScripts!Preferences class removeSelector: #defaultPaintingExtent!Preferences cl ass removeSelector: #dropProducesWatcher!Preferences class removeSelector: #eToyFriendly!Preferences class removeSelector: #eToyFriendlyChanged!Preferences class removeSelector: #eToyLoginEnabled!Preferences class removeSelector: #editAnnotations!Preferences class removeSelector: #enableLocalSave!Preferences class removeSelector: #expandedPublishing!Preferences class removeSelector: #fenceEnabled!Preferences class removeSelector: #fenceSoundEnabled!Preferences class removeSelector: #fenceSoundEnabled:!Preferences class removeSelector: #haloTransitions!Preferences class removeSelector: #includeSoundControlInNavigator!Preferences class removeSelector: #keepTickingWhilePainting!Preferences class removeSelector: #largeTilesSettingToggled!Preferences class removeSelector: #magicHalos!Preferences class removeSelector: #menuColorFromWorld!Preferences class removeSelector: #menuColorString!Preferences class removeSelector: #messengersInViewers!Preferences class removeSelector: #mouseOverHalos!Preferences class removeSelector: #mouseOverHalosChanged!Preferences class removeSelector: #mvcProjectsAllowed!Preferences class removeSelector: #navigatorOnLeftEdge!Preferences class removeSelector: #noviceMode!Preferences class removeSelector: #noviceModeSettingChanged!Preferences class removeSelector: #okToReinitializeFlaps!Preferences class removeSelector: #oliveHandleForScriptedObjects!Preferences class removeSelector: #propertySheetFromHalo!Preferences class removeSelector: #selectiveHalos!Preferences class removeSelector: #setEToysFontTo:!Preferences class removeSelector: #setEToysTitleFontTo:!Preferences class removeSelector: #showAdvancedNavigatorButtons!Preferences class removeSelector: #showFlapsWhenPublishing!Preferences class removeSelector: #simpleMenus!Preferences class removeSelector: #standardEToysFont!Preferences class removeSelector: #standardEToysTitleFont!Preferences class removeSelector: #tabAmongFields!Preferences class removeSelector: #tileTranslucentDrag!Preferences class removeSelector: #typeCheckingInTileScripting!Preferences class removeSelector: #uniTilesClassic!Preferences class removeSelector: #universalTiles!Preferences class removeSelector: #universalTilesSettingToggled!Preferences class removeSelector: #unlimitedPaintArea!Preferences class removeSelector: #useCategoryListsInViewers!Preferences class removeSelector: #useVectorVocabulary!Preferences class removeSelector: #vectorVocabularySettingChanged!Preferences class removeSelector: #viewersInFlaps!!Preferences class reorganize!('accessing' allPreferences atomicUpdatePreferences: dictionaryOfPreferences pragmaIdFor:getter: pragmaPreferenceFor:getter: preferenceAt: preferenceAt:ifAbsent:)('class initialization' initialize unload)('get/set' doesNotUnderstand: setPreference:toValue: setPreference:toValue:during: valueOfPreference: valueOfPreference:ifAbsent:)('initialization' chooseInitialSettings cleanUp: cleanUpPragmaPreferences initializeDictionaryOfPreferences registerForEvents removeObsolete resetDefaultValues setPreferencesFrom:)('parameters' expungeParameter: initializeParameters inspectParameters parameterAt: parameterAt:ifAbsentPut: parameterAt:ifAbsent: parameters setParameter:to:)('reacting to change' isChangeSelector:)('standard queries' alphabeticalProjectMenu alternateHandlesLook alternativeBrowseIt alternativeWindowBoxesLook alwaysHideHScrollbar alwaysShowHScrollbar alwaysShowVScrollbar annotationPanes areaFillsAreTolerant areaFillsAreVeryTolerant autoIndent automaticFlapLayout automaticKeyGeneration balloonHelpEnabled balloonHelpInMessageLists biggerHandles caseSensitiveFinds changeSetVersionNumbers checkForSlips checkForUnsavedProjects classicNavigatorEnabled cmdDotEnabled cmdGesturesEnabled collapseWindowsInPlace confirmFirstUseOfStyle conversionMethodsAtFileOut debugHaloHandle debugLogTimestamp debugPrintSpaceLog debugShowDamage decorateBrowserButtons diffsInChangeList diffsWithPrett yPrint dismissAllOnOptionClose easySelection extraDebuggerButtons fastDragWindowForMorphic fullScreenLeavesDeskMargins generalizedYellowButtonMenu haloEnclosesFullBounds higherPerformance honorDesktopCmdKeys infiniteUndo logDebuggerStackToFile maintainHalos menuAppearance3d menuKeyboardControl menuWithIcons modalColorPickers mouseOverForKeyboardFocus optionalButtons passwordsOnPublish personalizedWorldMenu postscriptStoredAsEPS projectsSentToDisk projectViewsInWindows projectZoom purgeUndoOnQuit readDocumentAtStartup readDocumentAtStartup: restartAlsoProceeds reverseWindowStagger scrollBarsNarrow scrollBarsOnRight securityChecksEnabled serverMode showBoundsInHalo showDirectionForSketches showDirectionHandles showProjectNavigator showSecurityStatus showSharedFlaps showSplitterHandles signProjectFiles smartUpdating standaloneSecurityChecksEnabled startInUntrustedDirectory swapMouseButtons systemWindowEmbedOK timeStampsInMenuTitles tinyDisplay traceMessages turnOffPowerManager twentyFourHourFileStamps uniqueNamesInHalos useButtonPropertiesToFire useUndo visualExplorer warnAboutInsecureContent warnIfNoChangesFile warnIfNoSourcesFile wordStyleCursorMovement)('themes' outOfTheBox personal)('*PreferenceBrowser' addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:viewRegistry:)('private' compileAccessorForPreference: compileAccessorForPreferenceNamed:value: preference:category:description:type: preference:categoryList:description:type:)('prefs - fonts' aaFontsColormapDepth chooseBalloonHelpFont chooseCodeFont chooseFixedFont chooseFlapsFont chooseFontWithPrompt:andSendTo:withSelector:highlightSelector: chooseHaloLabelFont chooseListFont chooseMenuFont chooseStandardButtonFont chooseSystemFont chooseWindowTitleFont decreaseFontSize fontConfigurationMenu fontConfigurationMenu: increaseFontSize printStandardSystemFonts refreshFontSettings restoreDefaultFonts restoreDefaultFontsForJapanese restoreFontsAfter: setBalloonHel pFontTo: setButtonFontTo: setCodeFontTo: setDemoFonts setFixedFontTo: setFlapFontTo: setFlapsFontTo: setHaloLabelFontTo: setListFontTo: setMenuFontTo: setPaintBoxButtonFontTo: setSystemFontTo: setWindowTitleFontTo: standardBalloonHelpFont standardButtonFont standardCodeFont standardDefaultTextFont standardFixedFont standardFlapFont standardHaloLabelFont standardListFont standardMenuFont standardPaintBoxButtonFont standardSystemFont standardWindowTitleFont subPixelRenderColorFonts subPixelRenderFonts windowTitleFont windowTitleStyle)('support - misc' acceptAnnotationsFrom: addModelItemsToWindowMenu: automaticFlapLayoutString initialExtent inspectPreferences letUserPersonalizeMenu navigatorShowingString personalizeUserMenu: setArrowheads staggerPolicyString wantsChangeSetLogging)('add/remove - specific' addBooleanPreference:categories:default:balloonHelp: addBooleanPreference:category:default:balloonHelp: addColorPreference:categories:default:balloonHelp: addColorPreference:category:default:balloonHelp: addFontPreference:categories:default:balloonHelp: addFontPreference:category:default:balloonHelp: addNumericPreference:categories:default:balloonHelp: addNumericPreference:category:default:balloonHelp: addTextPreference:categories:default:balloonHelp: addTextPreference:category:default:balloonHelp:)('add/remove' addPragmaPreference: addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:type: removeAllPreferencesSuchThat: removePreference:)('add/remove - convenience' addPreference:categories:default:balloonHelp: addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: addPreference:category:default: addPreference:category:default:balloonHelp: addPreference:default:)('prefs - annotations' annotationInfo defaultAnnotationInfo defaultAnnotationRequests defaultAnnotationRequests:)('updating - system' annotationPanesChanged displaySizeChanged infiniteUndoChanged optionalButtonsChanged roundedWindowCornersChanged sharedFlapsSettingChanged showProjectNavigatorChanged smartUpdatingChanged)('prefs - misc' balloonHelpDelayTime borderColorWhenRunning cmdKeysInText defaultAuthorName defaultWorldColor desktopColor desktopColor: desktopMenuTitle enableProjectNavigator maxBalloonHelpLineLength maxBalloonHelpLineLength: metaMenuDisabled preserveCommandExcursions scrollBarColor scrollBarWidth suppressWindowTitlesInInstanceBrowsers useFormsInPaintBox:)('themes - tools' browseThemes installTheme: offerThemesMenu themeChoiceButtonOfColor:font:)('support' categoryList categoryListOfPreference: giveHelpWithPreferences okayToChangeProjectLocalnessOf: preferencesInCategory: typeForValue:)('prefs - halos' classicHaloSpecs classicHalosInForce customHaloSpecs customHalosInForce editCustomHalos haloSpecifications haloSpecificationsForWorld haloTheme iconicHaloSpecifications iconicHalosInForce installClassicHaloSpecs installCustomHaloSpecs installHaloSpecsFromArray: installHaloTheme: installIconicHaloSpecs installSimpleHaloSpecs resetHaloSpecifications showChooseGraphicHaloHandle simpleFullHaloSpecifications simpleHalosInForce)('defaults' defaultValueTableForCurrentRelease unclassifiedCategory)('get/set - flags' disable: enable: setFlag:toValue: setFlag:toValue:during: toggle: valueOfFlag: valueOfFlag:ifAbsent:)('initialization - misc' disableProgrammerFacilities enableProgrammerFacilities setDefaultAnnotationInfo setNotificationParametersForStandardPreferences)('support - file list services' fileReaderServicesForFile:suffix: serviceLoadPreferencesFromDisk services)('initialization - save/load' loadPreferencesFrom: restorePersonalPreferences restorePreferencesFromDisk restorePreferencesFromDisk: savePersonalPreferences storePreferencesIn: storePreferencesToDisk)('updating' localeChanged prefEvent:)('*60Deprecated-menu colors' menuBorderColor menuBorderWidth menuColor menuLineColor menuSelectionColor menuTitleBorderColor menuTitleBorderWidth menuTitleColor)('*morphicextras' rotationAndScaleHandlesInPaintBox)('*60Deprecated-prefs-text' chooseInsertionPointColor chooseKeyboardFocusColor chooseTextHighlightColor initializeTextHighlightingParameters insertionPointColor insertionPointColor: keyboardFocusColor keyboardFocusColor: textHighlightColor textHighlightColor:)('*60Deprecated-Etoys-Squeakland-window colors' windowColorHelp windowSpecificationPanel)('*60Deprecated-parameters' parameterAt:default:)!!PolygonMorph reorganize!('access' isClosed isCurve isOpen makeOpenOrClosed midVertices openOrClosePhrase smoothOrSegmentedPhrase vertices)('accessing' borderColor: borderDashSpec borderStyle: borderWidth: couldHaveRoundedCorners)('caching' loadCachedState releaseCachedState)('dashes' borderDashOffset dashedBorder dashedBorder: removeVertex: vertexAt:)('debug and other' installModelIn: rotateTestFlip:)('drawing' areasRemainingToFill: drawArrowOn:at:from: drawArrowsOn: drawBorde rOn: drawBorderOn:usingEnds: drawClippedBorderOn:usingEnds: drawDashedBorderOn: drawDashedBorderOn:usingEnds: drawOnFormCanvas: drawOn:)('editing' addHandles clickVertex:event:fromHandle: deleteVertexAt: dragVertex:event:fromHandle: dragVertex:fromHandle:vertIndex: dropVertex:event:fromHandle: dropVertex:fromHandle:vertIndex: handleColorAt: insertVertexAt:put: newVertex:event:fromHandle: newVertex:fromHandle:afterVert: updateHandles verticesAt:put:)('event handling' handlesMouseDown: mouseDown:)('geometry' arrowsContainPoint: bounds: closestPointTo: closestSegmentTo: extent: flipHAroundX: flipVAroundY: intersectionsWith: intersectionWithLineSegmentFromCenterTo: intersects: isBordered lineBorderColor lineBorderColor: lineBorderWidth lineBorderWidth: lineColor lineColor: lineWidth lineWidth: mergeDropThird:in:from: merge: nextDuplicateVertexIndex reduceVertices straighten transformedBy:)('geometry testing' containsPoint:)('initialization' beSmoothCurve beStraightSegments defaultBord erColor defaultColor initialize vertices:color:borderWidth:borderColor:)('menu' addCustomMenuItems:hand: addPolyArrowMenuItems:hand: addPolyLIneCurveMenuItems:hand: addPolyShapingMenuItems:hand: arrowLength: arrowSpec: arrows customizeArrows: handlesShowingPhrase makeBackArrow makeBothArrows makeClosed makeForwardArrow makeNoArrows makeOpen quickFill: removeHandles setRotationCenterFrom: showingHandles showOrHideHandles specifyDashedLine standardArrows toggleHandles toggleSmoothing unrotatedLength unrotatedLength: unrotatedWidth unrotatedWidth:)('objects from disk' convertToCurrentVersion:refStream:)('rotate scale and flex' addFlexShellIfNecessary heading heading: referencePosition rotationCenter rotationCenter: rotationDegrees rotationDegrees:)('smoothing' coefficients computeNextToEndPoints derivs:first:second:third: lineSegmentsDo: nextToFirstPoint nextToLastPoint slopes: straightLineSegmentsDo:)('stepping' step stepTime wantsSteps)('testing' hasArrows isCurvier isCurvy isLineMorph)('visual properties' canHaveFillStyles fillStyle fillStyle:)('*MorphicExtras-geometry eToy' scale:)('private' arrowBoundsAt:from: arrowForms borderForm computeArrowFormAt:from: computeBounds curveBounds filledForm getVertices includesHandle: lineSegments privateMoveBy: setVertices: transformVerticesFrom:to:)('shaping' diamondOval rectOval)('attachments' defaultAttachmentPointSpecs endShapeColor: endShapeWidth: firstVertex lastVertex midpoint nudgeForLabel: totalLength)('rounding' cornerStyle:)('*MorphicExtras-Postscript Canvases' drawPostscriptOn:)!PluggableTextMorph removeSelector: #tileForIt!PasteUpMorphTest removeSelector: #testCursorWrapped!PasteUpMorphTest removeSelector: #testCursorWrappedWithFraction!PasteUpMorphTest removeSelector: #testGridToGradient!PasteUpMorph initialize!PasteUpMorph class removeSelector: #supplementaryPartsDescriptions!!PasteUpMorph class reorganize!('printing' defaultNameStemForInstances)('project' newWorldForProject:)('scripting' authoringPrototype)('preferences' globalCommandKeysEnabled globalCommandKeysEnabled:)('recompilation' postRecompileAction)('*MorphicExtras-class initialization' initialize registerInFlapsRegistry unload)('*MorphicExtras-project' newWorldTesting)('*MorphicExtras-parts bin')('parts bin' descriptionForPartsBin)!PartsBin removeSelector: #morphToDropFrom:!PasteUpMorph removeSelector: #abandonCostumeHistory!PasteUpMorph removeSelector: #abandonVocabularyPreference!PasteUpMorph removeSelector: #adaptedToWorld:!PasteUpMorph removeSelector: #addPenMenuItems:hand:!PasteUpMorph removeSelector: #addPenTrailsMenuItemsTo:!PasteUpMorph removeSelector: #addPlayfieldMenuItems:hand:!PasteUpMorph removeSelector: #addStackMenuItems:hand:!PasteUpMorph removeSelector: #allScriptEditors!PasteUpMorph removeSelector: #allScriptors!PasteUpMorph removeSelector: #allTileScriptingElements!PasteUpMorph removeSelector: #assureNotPaintingEvent:!PasteUpMorph removeSelector: #automaticPhraseExpansion!PasteUpM orph removeSelector: #automaticViewing!PasteUpMorph removeSelector: #behaveLikeHolder!PasteUpMorph removeSelector: #behaveLikeHolder:!PasteUpMorph removeSelector: #behavingLikeAHolder!PasteUpMorph removeSelector: #browseAllScriptsTextually!PasteUpMorph removeSelector: #buildDebugMenu:!PasteUpMorph removeSelector: #closedViewerFlapTabs!PasteUpMorph removeSelector: #couldMakeSibling!PasteUpMorph removeSelector: #cursor!PasteUpMorph removeSelector: #cursor:!PasteUpMorph removeSelector: #cursorWrapped:!PasteUpMorph removeSelector: #detachableScriptingSpace!PasteUpMorph removeSelector: #drawOn:!PasteUpMorph removeSelector: #dumpPresenter!PasteUpMorph removeSelector: #hideViewerFlaps!PasteUpMorph removeSelector: #hideViewerFlapsOtherThanFor:!PasteUpMorph removeSelector: #indicateCursor!PasteUpMorph removeSelector: #indicateCursor:!PasteUpMorph removeSelector: #indicateCursorString!PasteUpMorph removeSelector: #installVectorVocabulary!PasteUpMorph removeSelector: #isPlayfieldLike!PasteUp Morph removeSelector: #makeNewDrawing:!PasteUpMorph removeSelector: #makeNewDrawing:at:!PasteUpMorph removeSelector: #makeNewDrawingWithin!PasteUpMorph removeSelector: #makeVectorUseConformToPreference!PasteUpMorph removeSelector: #mouseOverHalosString!PasteUpMorph removeSelector: #newDrawingFromMenu:!PasteUpMorph removeSelector: #numberAtCursor!PasteUpMorph removeSelector: #openScrapsBook:!PasteUpMorph removeSelector: #paintArea!PasteUpMorph removeSelector: #paintAreaFor:!PasteUpMorph removeSelector: #paintingBoundsAround:!PasteUpMorph removeSelector: #paintingFlapTab!PasteUpMorph removeSelector: #prepareToBeSaved!PasteUpMorph removeSelector: #prepareToPaint!PasteUpMorph removeSelector: #prepareToPaint:!PasteUpMorph removeSelector: #presentCardAndStackMenu!PasteUpMorph removeSelector: #presentPlayfieldMenu!PasteUpMorph removeSelector: #presenter!PasteUpMorph removeSelector: #printScriptSummary!PasteUpMorph removeSelector: #putUpPenTrailsSubmenu!PasteUpMorph removeSelector: #reasonablePaintingExtent!PasteUpMorph removeSelector: #rectifyCursor!PasteUpMorph removeSelector: #referencePlayfield!PasteUpMorph removeSelector: #referencePool!PasteUpMorph removeSelector: #releaseViewers!PasteUpMorph removeSelector: #removeAllViewers!PasteUpMorph removeSelector: #restoreBoundsOfSubmorphs!PasteUpMorph removeSelector: #resumeScriptsPausedByPainting!PasteUpMorph removeSelector: #roundUpStrays!PasteUpMorph removeSelector: #saveBoundsOfSubmorphs!PasteUpMorph removeSelector: #selectedRect!PasteUpMorph removeSelector: #sendTextContentsBackToDonor!PasteUpMorph removeSelector: #showStatusOfAllScripts!PasteUpMorph removeSelector: #showingListView!PasteUpMorph removeSelector: #sortSubmorphsBy:!PasteUpMorph removeSelector: #standardPlayerHit!PasteUpMorph removeSelector: #startRunningAll!PasteUpMorph removeSelector: #stepAll!PasteUpMorph removeSelector: #stopRunningAll!PasteUpMorph removeSelector: #toggleAutoLineLayout!PasteUpMorph removeSelector: #toggleClassicNavigatorIfAppropriate!PasteUpMorph removeSelector: #toggleMouseOverHalos!PasteUpMorph removeSelector: #triggerClosingScripts!PasteUpMorph removeSelector: #triggerOpeningScripts!PasteUpMorph removeSelector: #updateStatusForAllScriptEditors!PasteUpMorph removeSelector: #valueAtCursor!PasteUpMorph removeSelector: #valueAtCursor:!PasteUpMorph removeSelector: #viewingNormally!PasteUpMorph removeSelector: #wantsHaloFor:!PasteUpMorph removeSelector: #wantsMouseOverHalos!PasteUpMorph removeSelector: #wantsMouseOverHalos:!BorderedMorph subclass: #PasteUpMorph instanceVariableNames: 'model padding isPartsBin worldState' classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler' poolDictionaries: '' category: 'Morphic-Worlds'!!PasteUpMorph reorganize!('accessing' assureFlapWidth: flapTab lastKeystroke lastKeystroke: modelOrNil useRoundedCorners)('alarms-scheduler' addAlarm:withArguments:for:at: removeAlarm:for:)('caching' releaseCachedState)('change rep orting' invalidRect:from:)('classification' isWorldMorph)('copying' veryDeepCopyWith:)('display' gradientFillColor: setGradientColor:)('dropping/grabbing' acceptDroppingMorph:event: dropEnabled hasTransferMorphConverter justDroppedInto:event: morphToDropForTransferMorph: morphToDropFrom: originAtCenter positionNear:forExtent:adjustmentSuggestion: repelsMorph:event: resetTransferMorphConverter transferMorphConverter transferMorphConverter: wantsDroppedMorph:event: wantsDroppedTransferMorph:)('event handling' dropExplorerField:from:event: dropFiles:event: dropInspectorField:event: dropSourceCode:event: handleDroppedItem:event: handlesKeyboard: handlesMouseDown: keyStroke: morphToGrab: mouseDown: mouseUp: wantsEasySelection wantsKeyboardFocusFor: wantsWindowEvent: windowEvent: windowEventHandler windowEventHandler:)('events-processing' filterEvent:for: processEvent:using: tryInvokeHalo: tryInvokeKeyboardShortcut: tryInvokeMetaMenu:)('geometry' bringTopmostsToFront extent: position:)('ge ometry testing' fullContainsPoint:)('halos and balloon help' defersHaloOnClickTo: wantsDirectionHandles wantsHaloFromClick)('initialization' addKeyboardShortcuts addMouseShortcuts becomeActiveDuring: defaultBorderColor defaultBorderWidth defaultColor initialize initializeKeyboardShortcuts initializeMouseShortcuts newResourceLoaded removeKeyboardShortcuts)('interaction loop' doOneCycleNow)('layout' addCenteredAtBottom:offset: convertAlignment laySubpartsOutInOneRow layoutChanged)('menu & halo' addCustomMenuItems:hand: addScalingMenuItems:hand: addWorldHaloMenuItemsTo:hand: addWorldToggleItemsToHaloMenu: autoLineLayoutString currentlyUsingVectorVocabulary defineApplicationView defineFactoryView deleteBalloonTarget: isPartsBinString originAtCenterString reformulateUpdatingMenus showApplicationView showExpandedView showFactoryView showFullView showReducedView showThumbnailString showWorldMainDockingBarString toggleShowWorldMainDockingBar transformToShow:)('misc' alwaysShowThumbnail cachedOrNewThumbnailFrom: cartesianOrigin heightForThumbnails hideFlapsOtherThan:ifClingingTo: innocuousName maxHeightToAvoidThumbnailing maximumThumbnailWidth mouseX mouseY nameForCopyIfAlreadyNamed: padding: smallThumbnailForPageSorter thumbnailForPageSorter unhideHiddenObjects)('model' createCustomModel model setModel:)('name' unusedMorphNameLike:)('objects from disk' convertToCurrentVersion:refStream: fixUponLoad:seg: saveOnFile)('options' autoLineLayout autoLineLayout: isPartsBin: replaceTallSubmorphsByThumbnails resizeToFit resizeToFitString setPartsBinStatusTo: toggleIsPartsBin toggleResizeToFit)('parts bin' initializeToStandAlone isPartsBin residesInPartsBin)('printing' printOn:)('project' project releaseSqueakPages storeProjectsAsSegments)('project state' canvas canvas: firstHand hands handsDo: handsReverseDo: isStepping: isStepping:selector: listOfSteppingMorphs stepListSize stepListSummary steppingMorphsNotInWorld viewBox viewBox:)('stepping' cleanseStepList runLocalStepMethods runStepMethods startStepping: startStepping:at:selector:arguments:stepTime: step stepTime stopStepping: stopStepping:selector:)('structure' primaryHand world)('testing' isEasySelecting)('undo' clearCommandHistory commandHistory onceAgainDismiss: reintroduceIntoWorld:)('update cycle' startBackgroundProcess)('user interface' modelWakeUp)('naming' defaultNameStemForInstances)('visual properties' canHaveFillStyles fillStyle: setAsBackground:)('WiW support' addMorphInLayer: installAsActiveSubprojectIn:at:titled: installAsActiveSubprojectIn:titled: restartWorldCycleWithEvent: shouldGetStepsFrom: validateMouseEvent:)('world menu' activateObjectsTool addUndoItemsTo: bringWindowsFullOnscreen buildWorldMenu: closeUnchangedWindows collapseAll collapseNonWindows commandKeySelectors connectRemoteUser connectRemoteUserWithName:picture:andIPAddress: delayedInvokeWorldMenu: deleteNonWindows disconnectAllRemoteUsers disconnectRemoteUser dispatchCommandKeyInWorld:event: drawingClass expandAll extractScreenRegion:andPutSketchInHand: findAChangeSorter: findAFileList: findAMessageNamesWindow: findAPreferencesPanel: findATranscript: findAWindowSatisfying:orMakeOneUsing: findDirtyBrowsers: findDirtyWindows: findWindow: getWorldMenu: grabDrawingFromScreen: grabFloodFromScreen: grabLassoFromScreen: grabRubberBandFromScreen: initializeDesktopCommandKeySelectors invokeWorldMenu: keyboardNavigationHandler keyboardNavigationHandler: keystrokeInWorld: putUpNewMorphMenu putUpWorldMenu: putUpWorldMenuFromEscapeKey reportLocalAddress respondToCommand:bySending:to: undoOrRedoCommand yellowButtonClickOnDesktopWithEvent:)('world state' abandonAllHalos addHand: addMorph:centeredNear: addMorphsAndModel: allNonFlapRelatedSubmorphs allNonWindows assureNotPaintingElse: assuredCanvas beWorldForProject: checkCurrentHandForObjectToPaste checkCurrentHandForObjectToPaste2 chooseClickTarget colorAt:belowMorph: deEmphasizeViewMVC: deleteAllHalos displayWorld displayWorldAsTwoTone displayWorldNonIncrementally displayWorldSafely doOneCycle doOneCycleInBackground doOneSubCycle dragThroughOnDesktop: embeddedProjectDisplayMode endDrawing: exit flashRects:color: fullRepaintNeeded goBack haloMorphs initForProject: install installFlaps jumpToProject nextPage noDisplayDuring: optimumExtentFromAuthor paintBox paintBoxOrNil patchAt:without:andNothingAbove: pauseEventRecorder previousPage privateOuterDisplayWorld removeHand: repairEmbeddedWorlds repositionFlapsAfterScreenSizeChange restoreFlapsDisplay restoreMainDockingBarDisplay restoreMorphicDisplay saveAsWorld sketchEditorOrNil sleep someHalo specialNameInModelFor: startSteppingSubmorphsOf:)('*Tools' defaultDesktopCommandKeyTriplets findAMonticelloBrowser)('private' privateFullMoveBy: privateMoveBy:)('thumbnail' icon)('polymorph' modalLockTo: modalUnlockFrom:)('recompilation' updateStatePostRecompile)('submorphs - add/remove' addAllMorphs: addMorphFront:)('submorphs - accessing' allMorphs Do: morphsInFrontOf:overlapping:do:)('flaps' accommodateFlap: addGlobalFlaps assureFlapTabsFitOnScreen correspondingFlapTab deleteGlobalFlapArtifacts enableGlobalFlaps flapTabs localFlapTabs offsetForAccommodating:onEdge: removeAccommodationForFlap:)('Nebraska' addRemoteClient: convertRemoteClientToBuffered: hasRemoteServer releaseRemoteServer remoteServer remoteServer: removeRemoteClient: transferRemoteServerFrom:)('*60Deprecated-menu & halo' isOpenForDragNDropString)('*services-base' focusedRequestor openWorldMenu requestor worldMenu)('*60Deprecated-accessing' modalWindow: removeModalWindow)('*MorphicExtras-flaps' deleteAllFlapArtifacts)('*ST80-Support' standardSystemController)('*Protocols' currentVocabulary)!ParagraphEditor class removeSelector: #yellowButtonExpertMenu!ParagraphEditor class removeSelector: #yellowButtonNoviceMenu!PackageDependencyTest removeSelector: #testEtoys!ObjectlandMorph removeSelector: #createEtoysProject!ObjectExplorer removeSelector: #viewerForValue!NativeImageSegment removeSelector: #findRogueRootsAllMorphs:!NativeImageSegment removeSelector: #rootsIncludingPlayers!NativeImageSegment removeSelector: #savePlayerReferences:!MorphicModel removeSelector: #addModelYellowButtonMenuItemsTo:forMorph:hand:!!MorphicModel reorganize!('accessing' model modelOrNil slotName wantsSlot)('caching' releaseCachedState)('classification' isMorphicModel)('compilation' addPartNameLike:withValue: compileAccessForSlot: compilePropagationMethods nameFor: propagate:as: removeAll slotSelectorFor: use:orMakeModelSelectorFor:in:)('debug and other' installModelIn:)('drag and drop' allowSubmorphExtraction isOpen)('geometry' charactersOccluded newBounds: recomputeBounds)('initialization' defaultBorderColor defaultBounds defaultColor duplicate:from: initialize model: model:slotName:)('menu' addCustomMenuItems:hand: closeToEdits openToEdits)('naming' choosePartName)('printing' initString)('submorphs - accessing' allKnownNames)('submorphs - add/remove' delete)('*MorphicExtras-compilation' compileInitMethods)!MorphExtension removeSelector: #player!MorphExtension removeSelector: #player:!Object subclass: #MorphExtension instanceVariableNames: 'locked visible sticky balloonText balloonTextSelector externalName isPartsDonor actorState eventHandler otherProperties' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Kernel'!!MorphExtension reorganize!('accessing' actorState actorState: balloonText balloonTextSelector balloonTextSelector: balloonText: eventHandler eventHandler: externalName: locked locked: sticky sticky: visible visible:)('accessing - layout properties' layoutFrame layoutFrame: layoutPolicy layoutPolicy: layoutProperties layoutProperties:)('accessing - other properties' assureOtherProperties hasOtherProperties hasProperty: initializeOtherProperties otherProperties privateOtherProperties: removeOtherProperties removeProperty: setProperty:toValue: sortedPropertyNames valueOfProper ty: valueOfProperty:ifAbsentPut: valueOfProperty:ifAbsent:)('connectors-copying' copyWeakly propertyNamesNotCopied veryDeepFixupWith: veryDeepInner:)('initialization' initialize)('objects from disk' comeFullyUpOnReload:)('other' isDefault)('printing' printOn:)('viewer' externalName)('*MorphicExtras-copying' updateReferencesUsing:)('*MorphicExtras-Undo' removeUndoCommands)('parts bin' isPartsDonor isPartsDonor:)('*60Deprecated-other' inspectElement)!ImageMorph class removeSelector: #descriptionForPartsBin!!ImageMorph class reorganize!('accessing' defaultForm)('class initialization' initialize registerInFlapsRegistry unload)('instance creation' fromString: fromString:font:)('scripting' authoringPrototype)!Morph class removeSelector: #selectionBackground!!Morph class reorganize!('class initialization' initialize)('fileIn/Out' fileReaderServicesForFile:suffix: fromFileName: serviceLoadMorphFromFile services)('initialize-release' unload)('instance creation' initializedInstance newBoun ds: newBounds:color: newSticky)('misc' morphsUnknownToTheirOwners)('new-morph participation' includeInNewMorphMenu newStandAlone partName:categories:documentation: partName:categories:documentation:sampleImageForm:)('scripting' authoringPrototype)('testing' allSketchMorphClasses allSketchMorphForms isSketchMorphClass)('preferences' haloForAll haloForAll: indicateKeyboardFocus indicateKeyboardFocus: metaMenuForAll metaMenuForAll: preferredCornerRadius preferredCornerRadius: themeProperties useSoftDropShadow useSoftDropShadow:)('*Tools-icons' toolIcon)('defaults')('layer names' backmostLayer balloonLayer defaultLayer dialogLayer frontmostLayer haloLayer menuLayer navigatorLayer progressLayer windowLayer)('*MorphicExtras-arrow head size' defaultArrowheadSize obtainArrowheadFor:defaultValue:)('*MorphicExtras-parts bin' supplementaryPartsDescriptions)('*MorphicExtras-new-morph participation' addPartsDescriptorQuadsTo:if:)!MenuMorph removeSelector: #allWordings!MenuMorph removeSelector : #allWordingsNotInSubMenus:!MenuMorph removeSelector: #undoGrabCommand!!MenuMorph reorganize!('accessing' addBlankIconsIfNecessary: commandKeyHandler commandKeyHandler: defaultTarget hasItems hasSubMenu: itemWithWording: items lastItem lastSelection matchString matchString: popUpOwner popUpOwner: rootMenu stayUp stayUp:)('construction' add:action: add:help:action: add:icon:help:subMenu: add:icon:subMenu: add:selector:argument: add:subMenu: add:subMenu:target:selector:argumentList: add:target:action: add:target:selector: add:target:selector:argument: add:target:selector:argumentList: addAllFrom: addItem: addLine addList: addMenuItem: addService:for: addServices2:for:extraLines: addServices:for:extraLines: addStayUpIcons addStayUpItem addStayUpItemSpecial addTitle: addTitle:icon: addTitle:icon:updatingSelector:updateTarget: addTitle:updatingSelector:updateTarget: addTranslatedList: addUpdating:action: addUpdating:enablement:action: addUpdating:enablementSelector:target:selector:argumentList: addUpdating:target:action: addUpdating:target:selector:argumentList: addUpdatingItem: addWithLabel:enablement:action: addWithLabel:enablementSelector:target:selector:argumentList: balloonTextForLastItem: defaultTarget: labels:lines:selections: title:)('control' activeSubmenu: deleteIfPopUp deleteIfPopUp: popUpAdjacentTo:forHand:from: popUpAt:forHand:in: popUpAt:forHand:in:allowKeyboard: popUpEvent:in: popUpForHand:in: popUpInWorld popUpInWorld: popUpNoKeyboard selectItem:event: updateColor wantsToBeDroppedInto:)('copying' veryDeepFixupWith: veryDeepInner:)('dropping/grabbing' justDroppedInto:event:)('events' activate: deactivate: handlesMouseDown: handlesMouseOver: mouseDown: mouseLeave: mouseMove: mouseUp: processFocusEvent:using: wantsEveryMouseMove)('initialization' delete initialize setDefaultParameters setTitleParameters setTitleParametersFor:)('keyboard control' displayFiltered: handlesKeyboard: keyStroke: matchString:event: moveSelectionDown:event: removeMatchString removeMatchString: selectCurrentItem: selectMoreItem:)('menu' addCustomMenuItems:hand: addItem addTitle detachSubMenu: doButtonAction removeStayUpBox removeStayUpItems setInvokingView: setTarget: target: toggleStayUp: toggleStayUpIgnore:evt: updateItemsWithTarget:orWithHand:)('modal control' informUserAt:during: invokeAt:in:allowKeyboard: invokeModal invokeModal: invokeModalAt:in: invokeModalAt:in:allowKeyboard: isModalInvokationDone isModalInvokationDone: modalSelection modalSelection:)('private' invokeMetaMenu: positionAt:relativeTo:inWorld: selectedItem)('update' applyUserInterfaceTheme updateMenu)('keystroke helpers' handleCRStroke: handleCommandKeyPress: handleDelStroke: handleDownStroke: handleEscStroke: handleFiltering: handleLeftStroke: handlePageDownStroke: handlePageUpStroke: handleRightStroke: handleUpStroke: hideKeyboardHelp keyStrokeHandlers noteRootMenuHasUsedKeyboard showKeyboardHelp stepIntoSubmenu:)('rounding' wantsRoundedCorners)('testing' indicateKeyboardFocus)('*ToolBuilder-Morphic-opening' openAsTool)('*MorphicExtras-accessing')('*60Deprecated-keyboard control' filterListWith: unfilterOrEscape:)!MenuItemMorph removeSelector: #adaptToWorld:!MenuItemMorph removeSelector: #allWordingsNotInSubMenus:!!MenuItemMorph reorganize!('accessing' action: addSubMenu: addUpdatingSubMenu: arguments arguments: colorToUse contentString contentString: contents: contents:withMarkers: contents:withMarkers:inverse: hasIcon hasIconOrMarker hasMarker hasSubMenu hasSubMenu: help: icon icon: isEnabled isEnabled: isStayUpItem itemWithWording: selector selector: subMenu subMenu: subMenuUpdater:selector: subMenuUpdater:selector:arguments: target target:)('copying' veryDeepFixupWith: veryDeepInner:)('drawing' drawBackgroundOn: drawIconOn: drawLabelOn: drawOn: drawSubMenuMarkerOn:)('events' activateOwnerMenu: activateSubmenu: doButtonAction handleMouseUp: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: invokeWithEvent: mouseDown: mouseEnter: mouseEnterDragging: mouseUp:)('grabbing' aboutToBeGrabbedBy: duplicateMorph:)('initialization' defaultBounds deleteIfPopUp: initialize)('layout' doLayoutIn: minHeight minWidth stringMargin)('selecting' adjacentTo deselect: isSelected isSelected: select:)('private' bottomArrow createSubmenu createUpdatingSubmenu deselectItem iconForm leftArrow offImage onImage rightArrow selectionFillStyle subMenuMarker upArrow updateLayoutInDockingBar)('browse' browseImplementationOfActionSelector buildDebugMenu: debugAction effectiveActionSelector effectiveActionTarget)('testing' isMenuItemMorph)('updating' applyUserInterfaceTheme)!!LassoPatchMorph reorganize!('dropping' justDroppedInto:event: wantsToBeDroppedInto:)('initialization' initialize initializeToStandAlone)!!GrabPatchMorph reorganize!('dropping' justDroppedInto:event: wantsToBeDroppedInto:)('initialization' initialize initializeToStandAlone)!!ImageM orph reorganize!('accessing' borderStyle: borderWidth: color: form image image: isOpaque isOpaque: preferredExtent setNewImageFrom: wantsRecolorHandle withSnapshotBorder)('caching' releaseCachedState)('drawing' drawOn:)('geometry' extent:)('initialization' initialize)('menu' changeOpacity opacityString)('menu commands' grabFromScreen readFromFile)('menus' addCustomMenuItems:hand:)('other' newForm:)('parts bin' initializeToStandAlone)('testing' isImageMorph)('*MorphicExtras-Postscript Canvases' drawPostscriptOn:)!HandMorph removeSelector: #removePendingHaloFor:!HandMorph removeSelector: #spawnMagicHaloFor:!HandMorph removeSelector: #triggerHaloFor:after:!!HandMorph reorganize!('accessing' anyButtonPressed colorForInsets lastEvent mouseOverHandler noButtonPressed targetOffset targetPoint userInitials userPicture userPicture:)('balloon help' addBalloonHelp: balloonHelpList deleteBalloonTarget: removePendingBalloonFor: resetBalloonHelp: spawnBalloonFor: triggerBalloonFor:after:)('cach ing' releaseCachedState)('change reporting' invalidRect:from:)('classification' isHandMorph)('copying' veryDeepCopyWith:)('cursor' cursorBounds showTemporaryCursor: showTemporaryCursor:hotSpotOffset: temporaryCursor)('double click support' resetClickState waitForClicksOrDrag:event: waitForClicksOrDrag:event:selectors:threshold:)('drawing' drawOn: fullDrawOn: hasChanged hasUserInformation needsToBeDrawn nonCachingFullDrawOn: restoreSavedPatchOn: savePatchFrom: shadowForm showHardwareCursor: updateCacheCanvas: visible:)('drop shadows' shadowOffset)('event handling' cursorPoint flushEvents noticeMouseOver:event: processEvents)('events-processing' handleEvent: isCapturingGesturePoints sendFilterEventCaptureAgain:for:)('focus handling' keyboardFocus keyboardFocus: mouseFocus mouseFocus: newKeyboardFocus: newMouseFocus: newMouseFocus:event: releaseAllFoci releaseKeyboardFocus releaseKeyboardFocus: releaseMouseFocus releaseMouseFocus:)('genie-stubs' autoFocusRectangleBoundsFor: disableGe nieFocus enableGenie focusStartEvent genieGestureProcessor isGenieAvailable isGenieEnabled isGenieFocused)('geometry' position position: userInitials:andPicture:)('grabbing/dropping' attachMorph: dropMorphs dropMorphs: dropMorph:event: grabMorph:from: targetOffset:)('halo handling' halo: obtainHalo: releaseHalo: removeHalo removeHaloFromClick:on:)('halos and balloon help' halo)('initialization' becomeActiveDuring: initForEvents initialize interrupted resourceJustLoaded)('layout' fullBounds)('meta-actions' copyToPasteBuffer: grabMorph:)('multilingual' clearKeyboardInterpreter keyboardInterpreter)('objects from disk' objectForDataStream:)('paste buffer' objectToPaste pasteBuffer pasteBuffer: pasteMorph)('updating' applyUserInterfaceTheme changed)('private events' generateDropFilesEvent: generateKeyboardEvent: generateMouseEvent: generateMouseWheelEvent: generateMouseWheelEvent:direction: generateWindowEvent: mouseDragTrailFrom: mouseTrailFrom: moveToEvent: sendEvent:focus: sendEvent:focus:clear: sendFocusEvent:to:clear: sendKeyboardEvent: sendListenEvent:to: sendListenEvents: sendMouseEvent:)('selected object' selectedObject)('*MorphicExtras-event handling' pauseEventRecorderIn:)('gridded cursor' gridPointRaw gridTo:origin: griddedPoint: griddingOn turnOffGridding turnOnGridding)('events-listening' addEventListener: addKeyboardListener: addListener:to: addMouseListener: eventListeners eventListeners: keyboardListeners keyboardListeners: mouseListeners mouseListeners: removeEventListener: removeKeyboardListener: removeListener:from: removeMouseListener:)('events-filtering-bubbling' eventBubbleFilters keyboardBubbleFilters mouseBubbleFilters)('events-filtering-capturing' eventCaptureFilters eventCaptureFilters: keyboardCaptureFilters keyboardCaptureFilters: mouseCaptureFilters mouseCaptureFilters:)('events-debugging' logEvent: showEvent:)('events-filtering' filterEvent:for: ignoreEvent:)('Multilingual-ImmPlugin' compositionWindowManager)('initialize-release' cleanUp:)!!GraphMorph reorganize!('accessing' color: cursor cursor: cursorAtEnd cursorColor cursorColor: cursorColorAtZeroCrossing cursorColorAtZeroCrossings: cursorWrapped: data data: dataColor dataColor: interpolatedValueAtCursor lastValue lastValue: startIndex startIndex: valueAtCursor valueAtCursor:)('commands' appendValue: centerCursor clear loadSineWave loadSound: loadSoundData: playOnce reverse)('drawing' drawOn:)('event handling' handlesMouseDown: mouseMove:)('initialization' defaultColor initialize)('layout' layoutChanged)('objects from disk' convertToCurrentVersion:refStream:)('stepping' step)('private' asNumber: drawCursorOn: drawDataOn: flushCachedForm keepIndexInView:)('sound' addCustomMenuItems:hand: openWaveEditor readDataFromFile)!DockingBarMorph removeSelector: #isSticky!DockingBarMorph removeSelector: #resistsRemoval!BookMorph removeSelector: #goToPage:transitionSpec:runTransitionScripts:!BookMorph removeSelecto r: #goToPageMorph:runTransitionScripts:!BookMorph removeSelector: #goToPageMorph:transitionSpec:runTransitionScripts:!BookMorph removeSelector: #goto:!BookMorph removeSelector: #keepTogether!BooklikeMorph removeSelector: #currentPlayerDo:!!BooklikeMorph reorganize!('menu commands' clearNewPagePrototype firstPage insertPage sortPages)('menus' addCustomMenuItems:hand:)('misc' addBookMenuItemsTo:hand: move pageSize pageSize: playPageFlipSound: showingFullScreenString showingPageControlsString)('page controls' addPageControlMorph: fewerPageControls fullControlSpecs hidePageControls indexForPageControls makeDescriptionViewer makePageControlsFrom: makePageNumberItem setEventHandlerForPageControls: shortControlSpecs showPageControls showPageControls:)!!BookPageSorterMorph reorganize!('copying' veryDeepFixupWith: veryDeepInner:)('dropping/grabbing' wantsToBeDroppedInto:)('initialization' addControls book:morphsToSort: defaultBorderWidth defaultColor initialize)('buttons' acceptSort getPartsBinStatus togglePartsBinStatus)('private' changeExtent: closeButtonOnly columnWith: rowWith: wrapperFor:)('accessing' pageHolder)!!AlignmentMorph reorganize!('classification' isAlignmentMorph)('event handling' wantsKeyboardFocusFor:)('geometry' addTransparentSpacerOfSize:)('initialization' defaultBorderWidth defaultColor initialize openInWindowLabeled:inWorld:)('object fileIn' convertOldAlignmentsNov2000:using:)('objects from disk' convertToCurrentVersion:refStream:)('visual properties' canHaveFillStyles)('*MorphicExtras-initialization' basicInitialize)!!BorderedMorph reorganize!('accessing' borderColor: borderStyle: borderWidth: hasTranslucentColor useRoundedCorners useSquareCorners)('drawing' areasRemainingToFill:)('geometry' acquireBorderWidth: closestPointTo: intersectionWithLineSegmentFromCenterTo:)('initialization' borderInitialize borderInset borderRaised borderSimple defaultBorderColor defaultBorderStyle defaultBorderWidth initialize)('menu' addBorderStyleMenuItems:hand: changeBorderColor: changeBorderWidth:)('resize handling' addCellGapToLayoutFrames addCornerGrips addEdgeGrips addGrips addMorph:fullFrame: addPaneHSplitterAtBottomOfRow: addPaneHSplitters addPaneSplitters addPaneVSplitterAtRightOfColumn: addPaneVSplitters changeCellGapOfLayoutFrames: cornerGrips doFastWindowReframe: edgeGrips fastFramingOn grips linkSubmorphsToSplitters paneMorphs removeCellGapFromLayoutFrames removeCornerGrips removeEdgeGrips removeGrips removePaneSplitters splitters wantsGrips wantsGrips: wantsPaneSplitters wantsPaneSplitters:)('printing' fullPrintOn:)('layout properties' cellGap:)('display scale' displayScaleChangedBy: handlesDisplayScaleChangedBy:)('*MorphicExtras-initialization' basicInitialize)('*60Deprecated-private' setBorderWidth:borderColor: setColor:borderWidth:borderColor:)('*60Deprecated-accessing' doesBevels)!Morph removeSelector: #adaptToWorld:!Morph removeSelector: #addMagicHaloFor:!Morph removeSelector: #addMorphNearBack:!Morph removeSelector: #addPaintingItemsTo:hand:!Morph removeSelector: #allMenuWordings!Morph removeSelector: #allMorphsAndBookPagesInto:!Morph removeSelector: #allMorphsWithPlayersDo:!Morph removeSelector: #applyStatusToAllSiblings:!Morph removeSelector: #asNumber:!Morph removeSelector: #automaticViewing!Morph removeSelector: #bringAllSiblingsToMe:!Morph removeSelector: #chooseNewGraphic!Morph removeSelector: #chooseNewGraphicCoexisting:!Morph removeSelector: #chooseNewGraphicFromHalo!Morph removeSelector: #couldMakeSibling!Morph removeSelector: #currentPlayerDo:!Morph removeSelector: #cursor!Morph removeSelector: #cursor:!Morph removeSelector: #decimalPlacesForGetter:!Morph removeSelector: #defaultValueOrNil!Morph removeSelector: #demandsBoolean!Morph removeSelector: #demandsThumbnailing!Morph removeSelector: #doMenuItem:!Morph removeSelector: #embedInWindow!Morph removeSelector: #embeddedInMorphicWindowLabeled:!Morph removeSelector: #getNumericValue!Morph removeSelector: #gridFormOrigin:grid:background:line:!Morph removeSelector: #handUserASibling!Morph removeSelector: #indicateAllSiblings!Morph removeSelector: #inspectArgumentsPlayerInMorphic:!Morph removeSelector: #isAViewer!Morph removeSelector: #isCompoundTileMorph!Morph removeSelector: #isKedamaMorph!Morph removeSelector: #isLikelyRecipientForMouseOverHalos!Morph removeSelector: #isModalShell!Morph removeSelector: #isNumericReadoutTile!Morph removeSelector: #isPhraseTileMorph!Morph removeSelector: #isPlayfieldLike!Morph removeSelector: #isSoundTile!Morph removeSelector: #isStandardViewer!Morph removeSelector: #isStickySketchMorph!Morph removeSelector: #isSyntaxMorph!Morph removeSelector: #isTileEditor!Morph removeSelector: #isTileMorph!Morph removeSelector: #isTilePadMorph!Morph removeSelector: #isViewer!Morph removeSelector: #makeGraphPaper!Morph removeSelector: #makeGraphPaperGrid:background:line:!Morph removeSelector: #makeMultipleSiblings:!Morph removeSelector: #makeNascentScript!Morph removeSelector: #makeNewPlayerInstance:!Morph removeSelector: #makeSiblings:!Morph removeSelector: #makeSiblingsLookLikeMe:!Morph removeSelector: #menuItemAfter:!Morph removeSelector: #menuItemBefore:!Morph removeSelector: #methodCommentAsBalloonHelp!Morph removeSelector: #mustBeBackmost!Morph removeSelector: #noteDecimalPlaces:forGetter:!Morph removeSelector: #objectViewed!Morph removeSelector: #offerCostumeViewerMenu:!Morph removeSelector: #openAPropertySheet!Morph removeSelector: #openViewerForArgument!Morph removeSelector: #overlapsShadowForm:bounds:!Morph removeSelector: #pasteUpMorphHandlingTabAmongFields!Morph removeSelector: #player!Morph removeSelector: #player:!Morph removeSelector: #playerRepresented!Morph removeSelector: #preferredDuplicationHandleSelector!Morph removeSelector: #presenter!Morph removeSelector: #readoutForField:!Morph removeSelector: #referencePlayfield!Morph removeSelector: #renameInternal:!Morph removeSelector: #rotationStyle!Morph removeSelector: #rotationStyle:!Morph removeSelector: #roundUpStrays!Morph removeSelector: #saveDocPane!Morph removeSelector: #screenLocation!Morph removeSelector: #screenRectangle!Morph removeSelector: #setAsActionInButtonProperties:!Morph removeSelector: #setNumericValue:!Morph removeSelector: #setStandardTexture!Morph removeSelector: #shouldRememberCostumes!Morph removeSelector: #shuffleSubmorphs!Morph removeSelector: #standardPalette!Morph removeSelector: #tabAmongFields!Morph removeSelector: #textureParameters!Morph removeSelector: #unlockOneSubpart!Morph removeSelector: #updateAllScriptingElements!Morph removeSelector: #usableSiblingInstance!Morph removeSelector: #viewMorphDirectly!Morph removeSelector: #wantsHalo!Morph removeSelector: #wantsHaloFor:!Morph removeSelector: #wantsScriptorHaloHandle!Morph removeSelector: #wouldAcceptKeyboardFocusUponTab!Morph removeSelector: #wrappedInWindow:!Morph removeSelector: #wrappedInWindowWithTitle:!!Morph reorganize!('accessing' actorState: actorStateOrNil adoptPaneColor: balloonText balloonText: balloonTextSelector balloonTextSelector: beFlap: beSticky beTransparent beUnsticky borderColor borderColor: borderStyle borderStyle: borderStyleForSymbol: borderWidth borderWidth: borderWidthForRounding clearArea color color: colorForInsets couldHaveRoundedCorners defaultNameStemForInstances eventHandler eventHandler: hasTranslucentColor highlight highlightColor highlightColor: insetColor isFlap isLocked isShared isSticky lock lock: modelOrNil raisedColor regularColor regularColor: rememberedColor rememberedColor: resistsRemoval resistsRemoval: scaleFactor setBorderStyle: sqkPage sticky: toggleLocked toggleResistsRemoval toggleStickiness unHighlight unlock unlockContents url userString viewBox visibleClearArea wantsToBeCachedByHand)('accessing - extension' assureExtension extension hasExtension initializeExtension privateExtension: resetExtension)('accessing - properties' hasProperty: otherProperties removeProperty: setProperties: setProperty:toValue: valueOfProperty: valueOfProperty:ifAbsent: valueOfProperty:ifAbsentPut: valueOfProperty:ifPresentDo:)('caching' fullLoadCachedState fullReleaseCachedState loadCachedState releaseCachedState)('change reporting' addedMorph: colorChangedForSubmorph: invalidRect: invalidRect:from: privateInvalidateMorph: userSelectedColor:)('classification' isAlignmentMorph isBalloonHelp isButton isFlapOrTab isFlapTab isFlexMorph isHandMorph isRenderer isTextMorph isWorldMorph isWorldOrHandMorph)('connectors-scripting' wantsConnectorVocabulary)('converting' asSnapshotThumbnail)('copying' copy deepCopy duplicate duplicateMorphCollection: okayToDuplicate updateReferencesUsing: veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:)('creation' asMorph)('debug and other' addDebuggingItemsTo:hand: addMouseActionIndicatorsWidth:color: addMouseUpAction addMouseUpActionWith: addViewingItemsTo: allStringsAfter: allStringsAfter:do: altSpecial Cursor0 altSpecialCursor1 altSpecialCursor2 altSpecialCursor3 altSpecialCursor3: buildDebugMenu: defineTempCommand deleteAnyMouseActionIndicators hasStrings inspectOwnerChain installModelIn: mouseUpCodeOrNil ownerChain programmedMouseDown:for: programmedMouseEnter:for: programmedMouseLeave:for: programmedMouseUp:for: removeMouseUpAction resumeAfterDrawError resumeAfterLayoutError resumeAfterStepError tempCommand)('dispatching' disableSubmorphFocusForHand:)('drawing' areasRemainingToFill: boundingBoxOfSubmorphs boundsWithinCorners changeClipSubmorphs clipLayoutCells clipLayoutCells: clipSubmorphs clipSubmorphs: clippingBounds doesOwnRotation drawDropHighlightOn: drawDropShadowOn: drawErrorOn: drawKeyboardFocusIndicationOn: drawMouseDownHighlightOn: drawOn: drawOverlayOn: drawRolloverBorderOn: drawSubmorphsOn: expandFullBoundsForDropShadow: expandFullBoundsForRolloverBorder: flashBounds fullDrawOn: hasClipSubmorphsString hide highlightedForMouseDown highlightedForMouseDown: imageForm imageForm:backgroundColor:forRectangle: imageForm:forRectangle: imageFormDepth: imageFormForRectangle: imageFormWithout:andStopThere: keyboardFocusColor keyboardFocusWidth refreshWorld shadowForm show updateDropShadowCache visible visible:)('drop shadows' addDropShadow addDropShadowMenuItems:hand: changeShadowColor hasDropShadow hasDropShadow: hasDropShadowString hasRolloverBorder hasRolloverBorder: removeDropShadow setShadowOffset: shadowColor shadowColor: shadowOffset shadowOffset: shadowPoint: toggleDropShadow useSoftDropShadow useSoftDropShadow:)('dropping/grabbing' aboutToBeGrabbedBy: acceptDroppingMorph:event: disableDragNDrop dragEnabled dragEnabled: dragNDropEnabled dragSelectionColor dropEnabled dropEnabled: dropHighlightColor dropSuccessColor enableDrag: enableDragNDrop enableDragNDrop: enableDrop: formerOwner formerOwner: formerPosition formerPosition: grabTransform handledOwnDraggingBy:on: highlightForDrop highlightForDrop: highlightedForDrop justDroppedInto:event : justGrabbedFrom: morphToDropInPasteUp: nameForUndoWording rejectDropMorphEvent: repelsMorph:event: resetHighlightForDrop separateDragAndDrop slideBackToFormerSituation: slideToTrash: startDrag:with: transportedMorph undoGrabCommand vanishAfterSlidingTo:event: wantsDroppedMorph:event: wantsToBeDroppedInto: wantsToBeOpenedInWorld willingToBeDiscarded)('event handling' click click: cursorPoint doubleClick: doubleClickTimeout: firstClickTimedOut: handlerForMouseDown: handlerForYellowButtonDown: handlesKeyboard: handlesKeyboardOnlyOnFocus handlesKeyboardOnlyOnFocus: handlesMouseDown: handlesMouseMove: handlesMouseOver: handlesMouseOverDragging: handlesMouseStillDown: handlesMouseWheel: hasFocus hasKeyboardFocus hasKeyboardFocus: hasMouseFocus hasMouseFocus: keyDown: keyStroke: keyUp: keyboardFocusChange: keyboardFocusDelegate mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: mouseMove: mouseStillDown: mouseStillDownThreshold mouseUp: mouseWheel: moveOrResizeFromKeystroke: on:send:to: on:send:to:withValue: removeLink: restoreSuspendedEventHandler startDrag: suspendEventHandler transformFrom: transformFromOutermostWorld transformFromWorld wantsEveryMouseMove wantsKeyboardFocus wantsKeyboardFocusFor: wantsWindowEvents: windowEvent: wouldAcceptKeyboardFocus yellowButtonActivity:)('events-accessing' actionMap updateableActionMap)('events-alarms' addAlarm:after: addAlarm:at: addAlarm:with:after: addAlarm:with:at: addAlarm:with:with:after: addAlarm:with:with:at: addAlarm:withArguments:after: addAlarm:withArguments:at: alarmScheduler removeAlarm: removeAlarm:at:)('events-processing' containsPoint:event: defaultEventDispatcher handleDropMorph: handleEvent: handleFocusEvent: handleKeyDown: handleKeyUp: handleKeystroke: handleListenEvent: handleMouseDown: handleMouseEnter: handleMouseLeave: handleMouseMove: handleMouseOver: handleMouseStillDown: handleMouseUp: handleMouseWheel: handleUnknownEvent: handleWindowEvent: mouseDownPr iority mouseDownPriority: processEvent: processEvent:using: processFocusEvent: processFocusEvent:using: rejectDropEvent: rejectsEvent: sendFilterEvent:for:to: sendFilterEventBubble:for: sendFilterEventBubbleAgain:for: sendFilterEventCapture:for: sendFilterEventCaptureAgain:for: transformedFrom:)('events-removing' releaseActionMap)('fileIn/out' attachToResource prepareToBeSaved reserveUrl: saveAsResource saveOnFile saveOnURL saveOnURL: saveOnURLbasic updateAllFromResources updateFromResource)('filter streaming' drawOnCanvas:)('geometry' bottom bottom: bottomCenter bottomLeft bottomLeft: bottomRight bottomRight: bounds bounds: center center: extent extent: height height: left left: leftCenter pointAtFraction: position position: right right: rightCenter top top: topCenter topLeft topLeft: topRight topRight: width width:)('geometry testing' containsPoint: fullContainsPoint: obtrudesBeyondContainer)('halos and balloon help' addHalo addHalo: addHandlesTo:box: addOptionalHandlesTo:box: addSimpleHandlesTo:box: addWorldHandlesTo:box: balloonColor balloonColor: balloonFont balloonFont: balloonHelpAligner balloonHelpDelayTime balloonHelpTextForHandle: balloonMorphClass boundsForBalloon comeToFrontAndAddHalo createHalo defaultBalloonColor defaultBalloonFont defaultHaloDispatcher defersHaloOnClickTo: deleteBalloon editBalloonHelpContent: editBalloonHelpText halo haloClass haloDelayTime hasHalo hasHalo: mouseDownOnHelpHandle: noHelpString okayToAddDismissHandle okayToAddGrabHandle okayToBrownDragEasily okayToExtractEasily okayToResizeEasily okayToRotateEasily removeHalo setBalloonText: setBalloonText:maxLineLength: setCenteredBalloonText: showBalloon showBalloon: showBalloon:at: showBalloon:hand: transferHalo: transferHalo:using: wantsBalloon wantsDirectionHandles wantsDirectionHandles: wantsHaloFromClick wantsHaloFromClick: wantsHaloHandleWithSelector:inHalo: wantsRecolorHandle wantsSimpleSketchMorphHandles)('initialization' basicInitialize defaultBounds defaultC olor inAScrollPane initialize openCenteredInWorld openInHand openInWindow openInWindowLabeled: openInWindowLabeled:inWorld: openInWorld openInWorld: openNear: openNear:in: openNearMorph: resourceJustLoaded)('layout' adjustLayoutBounds checkCellSpacingProperty: checkListSpacingProperty: checkResizingProperty: doLayout doLayoutIn: doLayoutSafely fullBounds layoutChanged layoutComputed layoutInBounds: layoutInBounds:positioning: layoutProportionallyIn: layoutProportionallyInBounds:positioning: minExtent minExtent: minHeight minHeight: minWidth minWidth: ownerChanged ownerChangedHandler ownerChangedHandler: privateFullBounds privateFullBoundsForRedraw setExtentFromLayout: setLayoutBoundsFromLayout: setPositionFromLayout: submorphBounds submorphBoundsForShrinkWrap)('layout-menu' addCellLayoutMenuItems:hand: addLayoutMenuItems:hand: addTableLayoutMenuItems:hand: cellPositioningString: cellSpacingString: changeCellGap: changeCellInset: changeClipLayoutCells changeDisableTableLayout changeHeightForWidth changeLayoutInset: changeListDirection: changeMaxCellSize: changeMinCellSize: changeNoLayout changeProportionalLayout changeReverseCells changeRubberBandCells changeTableLayout changeWidthForHeight changesHeightForWidth changesWidthForHeight hResizingString: hasClipLayoutCellsString hasDisableTableLayoutString hasNoLayoutString hasProportionalLayoutString hasReverseCellsString hasRubberBandCellsString hasTableLayoutString layoutMenuPropertyString:from: listCenteringString: listDirectionString: listSpacingString: vResizingString: wrapCenteringString: wrapDirectionString:)('macpal' flash)('menu' addBorderStyleMenuItems:hand: addGestureMenuItems:hand: addGraphModelYellowButtonItemsTo:event: addModelYellowButtonItemsTo:event: addMyYellowButtonMenuItemsToSubmorphMenus addNestedYellowButtonItemsTo:event: addTitleForHaloMenu: addYellowButtonMenuItemsTo:event: buildYellowButtonMenu: hasYellowButtonMenu outermostOwnerWithYellowButtonMenu startWiring wantsMetaMenu wantsMetaMenu: wantsYellowButtonMenu wantsYellowButtonMenu:)('menus' absorbStateFromRenderer: addAddHandMenuItemsForHalo:hand: addCopyItemsTo: addCustomHaloMenuItems:hand: addCustomMenuItems:hand: addExportMenuItems:hand: addFillStyleMenuItems:hand: addHaloActionsTo: addMiscExtrasTo: addStandardHaloMenuItemsTo:hand: addToggleItemsToHaloMenu: addWorldTargetSightingItems:hand: adhereToEdge adhereToEdge: adjustedCenter adjustedCenter: changeColor changeDirectionHandles changeDrag changeDragAndDrop changeDrop collapse defaultArrowheadSize exploreInMorphic exploreInMorphic: exportAsBMP exportAsBMPNamed: exportAsGIF exportAsGIFNamed: exportAsJPEG exportAsJPEGNamed: exportAsPNG exportAsPNGNamed: hasDirectionHandlesString hasDragAndDropEnabledString hasDragEnabledString hasDropEnabledString helpButton inspectInMorphic inspectInMorphic: lockUnlockMorph lockedString maybeAddCollapseItemTo: model presentHelp reasonableBitmapFillForms reasonableForms resetForwardDirection resistsRemovalS tring setArrowheads setRotationCenter setRotationCenterFrom: setToAdhereToEdge: snapToEdgeIfAppropriate stickinessString transferStateToRenderer: uncollapseSketch)('meta-actions' addEmbeddingMenuItemsTo:hand: beThisWorldsModel buildHandleMenu: buildMetaMenu: changeColorTarget:selector:originalColor:hand: copyToPasteBuffer: dismissMorph dismissMorph: duplicateMorph: duplicateMorphImage: embedInto: grabMorph: inspectAt:event: invokeMetaMenu: invokeMetaMenuAt:event: maybeDuplicateMorph maybeDuplicateMorph: openATextPropertySheet potentialEmbeddingTargets potentialTargets potentialTargetsAt: resizeFromMenu resizeMorph: saveAsPrototype showActions showHiders sightTargets: sightWorldTargets: subclassMorph targetFromMenu: targetWith:)('miscellaneous' setExtentFromHalo: setFlexExtentFromHalo:)('naming' assureExternalName downshiftedNameOfObjectRepresented externalName innocuousName knownName name: nameForFindWindowFeature nameInModel nameOfObjectRepresented renameTo: setNamePropertyTo: set NameTo: specialNameInModel tryToRenameTo:)('objects from disk' objectForDataStream: storeDataOn:)('other events' menuButtonMouseEnter: menuButtonMouseLeave:)('parts bin' inPartsBin initializeToStandAlone isPartsBin isPartsDonor isPartsDonor: markAsPartsDonor partRepresented residesInPartsBin)('printing' clipText colorString: constructorString fullPrintOn: initString morphReport morphReportFor: morphReportFor:on:indent: pagesHandledAutomatically printConstructorOn:indent: printConstructorOn:indent:nodeDict: printOn: printSpecs printSpecs: printStructureOn:indent: reportableSize structureString textToPaste)('rotate scale and flex' addFlexShell addFlexShellIfNecessary assureFlexShell forwardDirection forwardDirection: heading heading: keepsTransform newTransformationMorph referencePosition referencePosition: referencePositionInWorld referencePositionInWorld: removeFlexShell rotationCenter rotationCenter: rotationDegrees rotationDegrees: setDirectionFrom:)('rounding' cornerRadius cornerR adius: cornerStyle cornerStyle: roundedCorners roundedCornersString toggleCornerRounding wantsRoundedCorners)('stepping' arrangeToStartStepping arrangeToStartSteppingIn: isStepping isSteppingSelector: start startStepping startStepping:at:arguments:stepTime: startSteppingIn: startSteppingSelector: step stepAt: stepTime stop stopStepping stopSteppingSelector: stopSteppingSelfAndSubmorphs wantsSteps)('structure' activeHand allOwners allOwnersDo: containingWindow firstOwnerSuchThat: hasOwner: isInDockingBar isInSystemWindow isInWorld morphPreceding: nearestOwnerThat: orOwnerSuchThat: outermostMorphThat: outermostWorldMorph owner ownerThatIsA: ownerThatIsA:orA: pasteUpMorph primaryHand renderedMorph root rootAt: topPasteUp topRendererOrSelf withAllOwners withAllOwnersDo: world)('testing' canDrawAtHigherResolution canDrawBorder: completeModificationHash indicateKeyboardFocus isDockingBar isFlexed isFullOnScreen isImageMorph isLineMorph isMenuItemMorph isMorph isSafeToServe isSelectionMorp h isSketchMorph isTransferMorph modificationHash shouldDropOnMouseUp)('text-anchor' addTextAnchorMenuItems:hand: asTextAnchor textAnchorProperties)('thumbnail' icon iconOrThumbnail iconOrThumbnailOfSize: morphRepresented permitsThumbnailing representativeNoTallerThan:norWiderThan:thumbnailHeight: thumbnail updateThumbnailUrl updateThumbnailUrlInBook:)('undo' commandHistory undoMove:redo:owner:bounds:predecessor:)('updating' applyUserInterfaceTheme changed)('user interface' defaultLabelForInspector doCancel initialExtent playSoundNamed:)('visual properties' canApplyUserInterfaceTheme canHaveFillStyles defaultBitmapFillForm fillStyle fillStyle: fillWithRamp:oriented: useBitmapFill useDefaultFill useGradientFill useSolidFill)('WiW support' eToyRejectDropMorph:event: randomBoundsFor: shouldGetStepsFrom:)('private' canBeEncroached privateAddAllMorphs:atIndex: privateAddMorph:atIndex: privateBounds: privateColor: privateDeleteWithAbsolutelyNoSideEffects privateFullBounds: privateFull MoveBy: privateMoveBy: privateOwner: privateRemove: privateRemoveMorphWithAbsolutelyNoSideEffects: privateSubmorphs privateSubmorphs:)('accessing-backstop' target:)('geniestubs' allowsGestureStart: isGestureStart: mouseStillDownStepRate redButtonGestureDictionaryOrName: yellowButtonGestureDictionaryOrName:)('*morphic-Postscript Canvases' asPostscript clipPostscript drawPostscriptOn: fullDrawPostscriptOn: printPSToFile)('button' doButtonAction)('model access' models)('other' removeAllButFirstSubmorph)('selected object' selectedObject)('polymorph' modalLockTo: modalUnlockFrom: openModal:)('*Morphic-Sound-piano rolls' addMorphsTo:pianoRoll:eventTime:betweenTime:and: encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: justDroppedIntoPianoRoll:event: pauseFrom: resetFrom: resumeFrom: triggerActionFromPianoRoll)('events-filtering-bubbling' addEventBubbleFilter: addKeyboardBubbleFilter: addMouseBubbleFilter: eventBubbleFilters eventBubbleFilters: keyboardBubbleFilters keyboardBubbleFilters: mouseBubbleFilters mouseBubbleFilters: removeEventBubbleFilter: removeKeyboardBubbleFilter: removeMouseBubbleFilter:)('events-filtering-capturing' addEventCaptureFilter: addKeyboardCaptureFilter: addMouseCaptureFilter: eventCaptureFilters eventCaptureFilters: keyboardCaptureFilters keyboardCaptureFilters: mouseCaptureFilters mouseCaptureFilters: removeEventCaptureFilter: removeKeyboardCaptureFilter: removeMouseCaptureFilter:)('events-filtering' addFilter:to: eventFilterDocumentation removeFilter:from:)('*ToolBuilder-Morphic-opening' buildWith: openAsTool)('geometry - misc' align:with: positionSubmorphs setConstrainedPosition:hangOut: shiftSubmorphsOtherThan:by: transformedBy: worldBounds worldBoundsForHalo)('geometry - local/global' bounds:from: bounds:in: boundsIn: boundsInWorld fullBoundsInWorld globalPointToLocal: intersects: localPointToGlobal: point:from: point:in: pointFromWorld: pointInWorld: positionInWorld)('geometry - layout' innerBounds inner Bounds: innerExtent innerExtent: innerPosition innerPosition: layoutBounds layoutBounds: layoutExtent layoutExtent: layoutPosition layoutPosition: minimumExtent minimumExtent: minimumHeight minimumHeight: minimumWidth minimumWidth: outerBounds outerBounds: outerExtent outerExtent: outerPosition outerPosition:)('Multilingual-ImmPlugin' preferredKeyboardBounds preferredKeyboardPosition)('*ToolBuilder-Morphic' inspectorClass)('submorphs - add/remove' abandon addAllMorphs: addAllMorphs:after: addAllMorphs:behind: addAllMorphs:inFrontOf: addAllMorphsBack: addAllMorphsFront: addMorph: addMorph:after: addMorph:asElementNumber: addMorph:atIndex: addMorph:behind: addMorph:inFrontOf: addMorphBack: addMorphFront: comeToFront delete goBehind privateDelete removeAllMorphs removeAllMorphsIn: removeMorph:)('submorphs - misc' actWhen actWhen: addMorph:fullFrame: addMorphCentered: addMorphFront:fromWorldPosition: addMorphFrontFromWorldPosition: allNonSubmorphMorphs copyWithoutSubmorph: deleteDockingB ars deleteSubmorphsWithProperty: deleteUnlessHasFocus dismissViaHalo dockingBars findA: findDeepSubmorphThat:ifAbsent: findDeeplyA: findSubmorphBinary: hasSubmorphWithProperty: indexOfMorphAbove: mainDockingBars morphsAt:behind:unlocked: morphsInFrontOf:overlapping:do: morphsInFrontOverlapping: morphsInFrontOverlapping:do: replaceSubmorph:by: rootMorphsAt: rootMorphsAtGlobal: submorphAfter submorphBefore submorphOfClass: submorphWithProperty:)('submorphs - layers' addAllMorphsBackInLayers: addAllMorphsFrontInLayers: addAllMorphsInLayers: addMorphBackInLayer: addMorphFrontInLayer: addMorphInLayer: morphicLayerNumber morphicLayerNumber: reorderSubmorphsInLayers wantsToBeTopmost)('submorphs - accessing' allKnownNames allMorphs firstSubmorph lastSubmorph morphsAt: morphsAt:unlocked: morphsAt:unlocked:useFullBounds: submorphCount submorphIndexOf: submorphNamed: submorphNamed:ifNone: submorphThat:ifNone: submorphs submorphsSatisfying:)('submorphs - enumerating' allMorphsBreadthFirstDo: allMorphsBreadthFirstDo:sorted: allMorphsDepthFirstDo: allMorphsDo: allSubmorphNamesDo: morphsAt:unlocked:do: morphsAt:unlocked:useFullBounds:do: submorphsBehind:do: submorphsDo: submorphsInFrontOf:do: submorphsReverseDo:)('layout properties' assureGridLayoutProperties assureLayoutProperties assureTableLayoutProperties copyLayoutProperties disableLayout disableLayout: disableTableLayout disableTableLayout: hResizing hResizing: layoutInset layoutInset: layoutPolicy layoutPolicy: layoutProperties layoutProperties: vResizeToFit: vResizing vResizing:)('layout properties - table' cellGap cellGap: cellInset cellInset: cellPositioning cellPositioning: cellSpacing cellSpacing: listCentering listCentering: listDirection listDirection: listSpacing listSpacing: maxCellSize maxCellSize: minCellSize minCellSize: reverseTableCells reverseTableCells: rubberBandCells rubberBandCells: spaceFillWeight spaceFillWeight: wrapCentering wrapCentering: wrapDirection wrapDirection:)('layout propertie s - grid' gridModulus gridModulus: gridOrigin gridOrigin:)('submorphs - testing' hasSubmorphs)('submorphs - callbacks' intoWorld: noteNewOwner: outOfWorld: removedMorph:)('layout properties - proportional' layoutFrame layoutFrame:)('halo notification' aboutToBeDraggedViaHalo aboutToBeGrownViaHalo aboutToBeRotatedViaHalo aboutToBeScaledViaHalo changedViaHalo:)('display scale' displayScaleChangedBy: handlesDisplayScaleChangedBy:)('*60Deprecated-events-processing' handleDropFiles:)('*MorphicExtras-menus' dismissButton printPSToFileNamed:)('*60Deprecated-rotate scale and flex' degreesOfFlex)('*60Deprecated-text-anchor' changeDocumentAnchor changeInlineAnchor changeParagraphAnchor hasDocumentAnchorString hasInlineAnchorString hasParagraphAnchorString relativeTextAnchorPosition relativeTextAnchorPosition: textAnchorType textAnchorType:)('*MorphicExtras' nextOwnerPage previousOwnerPage)('*60Deprecated-event handling' dropFiles: wantsDropFiles:)('*60Deprecated-geometry' gridPoint: griddedPoint:)('*services-base' requestor)('*60Deprecated-accessing' doesBevels)('*60Deprecated-meta-actions' blueButtonDown: blueButtonUp: handlerForBlueButtonDown: handlerForMetaMenu:)('*60Deprecated-user-interface' becomeModal)('*MorphicExtras-books' updateCachedThumbnail)('*60Deprecated-initialization' inATwoWayScrollPane)('*MorphicExtras-geometry' shiftSubmorphsBy:)('*60Deprecated-dropping/grabbing' toggleDragNDrop)('*60Deprecated-copying' fullCopy)('*MorphicExtras-postscript' asEPS asPostscriptPrintJob exportAsEPS exportAsEPSNamed:)('*60Deprecated-WiW support' addMorphInFrontOfLayer: morphicLayerNumberWithin:)('*60Deprecated-MorphicExtras-accessing' highlightOnlySubmorph:)('*61Deprecated-drawing' highlightForMouseDown highlightForMouseDown:)!InstanceBrowser removeSelector: #viewViewee!!Lexicon reorganize!('basic operation' annotation displaySelector: messageListIndex:)('category list' categoriesPane categoryDefiningSelector: categoryList categoryListIndex categoryListIn dex: categoryListKey:from: categoryListMenu:shifted: categoryListMenuTitle categoryWithNameSpecifiedBy: chooseCategory: mainCategoryListMenu: newCategoryPane reformulateCategoryList selectCategoryAll selectWithinCurrentCategoryIfPossible: selectedCategoryName selectorsReferringToClassVar showCategoriesPane)('contents' contents)('control buttons' customButtonSpecs)('history' navigateToNextMethod navigateToPreviousMethod navigateToRecentMethod removeFromSelectorsVisited removeFromSelectorsVisited: selectorsVisited updateSelectorsVisitedfrom:to:)('initialization' customButtonsFrame: initListFrom:highlighting: listFrame:fromLeft:width:)('limit class' chooseLimitClass initialLimitClass limitClass limitClass: limitClassString setLimitClass:)('menu commands' offerMenu removeMessage showCategory showHomeCategory showMainCategory)('message category functions' canShowMultipleMessageCategories)('message list menu' messageListKey:from:)('model glue' doItReceiver okayToAccept targetObject)('ne w-window queries' browseVariableAssignments browseVariableReferences)('search' hasSearchPane lastSearchString lastSearchString: lastSendersSearchSelector methodListFromSearchString: obtainNewSearchString selectorsMatching setMethodListFromSearchString showSearchPane toggleSearch)('selection' categoryOfSelector: selectImplementedMessageAndEvaluate: selectSelectorItsNaturalCategory: selectWithinCurrentCategory: selectedClassOrMetaClass selectedMessage setToShowSelector:selectCategory:)('senders' navigateToASender selectorsSendingSelectedSelector setSendersSearch)('transition' maybeReselectClass:selector: noteAcceptanceOfCodeFor: preserveSelectorIfPossibleSurrounding: reformulateList reformulateListNoting: retainMethodSelectionWhileSwitchingToCategory:)('vocabulary' chooseVocabulary switchToVocabulary: useVocabulary:)('window title' addModelItemsToWindowMenu: adjustWindowTitle startingWindowTitle)('within-tool queries' currentQueryParameter methodsWithInitials methodsWithInitials: queryCharacterization seeAlso seeAlso: selectorsChanged selectorsDefiningInstVar selectorsReferringToInstVar selectorsRetrieved setLocalClassVarRefs setLocalInstVarDefs setLocalInstVarRefs showMethodsInCurrentChangeSet showMethodsWithInitials showMethodsWithInitials: showQueryResultsCategory)('toolbuilder' addSpecialButtonsTo:with: buildCategoryListWith: buildCustomButtonsWith: buildWith: openOnClass:inWorld:showingSelector: openOnClass:showingSelector: wantsAnnotationPane)('morphic' representsSameBrowseeAs: targetClass)('message list' formattedLabel:forSelector:inClass: messageHelpAt: messageIconAt:)('user interface' defaultWindowColor)('private' contents:notifying: contents:oldSelector:in:classified:notifying: targetForContents:)!Object subclass: #MenuIcons instanceVariableNames: '' classVariableNames: 'Icons ScriptingIcons TranslatedIcons TranslationLocale' poolDictionaries: '' category: 'Morphic-Menus'!Inspector removeSelector: #addEtoysItemsTo:!!Inspector reorganize!('accessing' context context: customFields doItContext doItReceiver fields object object: selectionIndex selectionIndex:)('private' allInstVarsTranslated)('toolbuilder' buildCodePaneWith: buildExploreButtonWith: buildFieldListWith: buildValuePaneWith: buildWith: replaceInspectorWithExplorer)('*Protocols-Tools' browseFullProtocol spawnFullProtocol spawnProtocol)('*60Deprecated-selecting' selectedSlotName)('user interface - styling' aboutToStyle:requestor: fieldListStyler typeValue: updateStyler: updateStyler:requestor:)('menu - construction' addClassItemsTo: addCollectionItemsTo: addFieldItemsTo: addInstVarItemsTo: addObjectItemsTo:)('fields - custom' addCustomField addCustomField: hasCustomFields newCustomField removeCustomField: requestCustomFieldOrCancel:)('user interface' applyUserInterfaceTheme defaultIntegerBase fieldList getContents representsSameBrowseeAs: textColorForError valuePane)('menu - commands' browseClass browseClassHierarchy browseVariableAssignmen ts browseVariableReferences chaseSelectionPointers copyExpression copyName exploreSelection exploreSelectionPointers inspectOne inspectOneOf: inspectOneOfFrom:to: inspectSelection inspectSelectionBasic objectReferencesToSelection removeSelection)('selection - convenience' classOfSelection selectedClass selectedInstVarName selectionIsReadOnly selectionOrObject typeOfSelection)('accessing - contents' contents:notifying: contentsTyped contentsTyped: expression expression:)('fields - error handling' contentsForErrorDoing: emphasizeError: streamError:on: streamErrorDoing:on:)('fields - truncation' contentsForTruncationOf: streamOn:truncate:collectFields: streamOn:truncate:collectFields:ellipsisFrom: truncationLimit truncationTail)('fields - drag and drop' dragFromFieldList: dragTypeInFieldListAt: dropOnFieldList:at:shouldCopy:)('selection' ensureSelectedField hasSelection noteSelectionIndex:for: replaceSelectionValue: selectField: selectFieldNamed: selectFieldSuchThat: selectedField selectedFieldName selection)('fields' expressionForField: fieldAllInstVars fieldSelf newFieldForType: newFieldForType:key:)('initialization' fieldClass initialExtent initialize inspect: resetContents resetFields setContents: setContentsTyped: setExpression:)('menu' fieldListMenu: fieldListMenu:shifted: inspectorKey:from: mainFieldListMenu: metaFieldListMenu:)('user interface - window' labelString objectOkToClose okToClose okToDiscardCustomFields)('updating - steps' modelWakeUpIn: stepAt:in: stepTimeIn: updateListsAndCodeIn: wantsStepsIn:)('fields - streaming' streamBaseFieldsOn: streamCustomFieldsOn: streamFieldsOn: streamIndexedVariablesOn: streamInstanceVariablesOn: streamVariableFieldsOn:)('updating' update update: update:with: updateContentsSafely updateFieldList updateFields)('*60Deprecated-menu' classHierarchy)('*60Deprecated-toolbuilder' exploreObject)('copying' veryDeepInner:)('private - collections' elementAt: elementGetterAt:)('user edits' okToRevertChanges:)!!Image Segment reorganize!('access' allObjectsDo: arrayOfRoots arrayOfRoots:)('read/write segment' install loadSegmentFrom:outPointers: localName readFromFile)('error checking' checkAndReportLoadError)('fileIn' comeFullyUpOnReload: declare: declareAndPossiblyRename: dependentsCancel: dependentsRestore: fixCapitalizationOfSymbols processRoots rehashDictionaries: reshapeClasses:refStream: restoreEndianness:)('fileIn/Out' acceptSingleMethodSource: endianness restoreEndianness scanFrom: scanFrom:environment:)('testing' errorWrongState forFile:outPointers:)('private' forgetDoItsInClass: segmentFormatFrom:)!Form removeSelector: #graphicForViewerTab!!Form reorganize!('accessing' bits bitsSize bits: defaultCanvasClass depth depth: extent form getCanvas hasBeenModified hasBeenModified: nativeDepth offset offset: size)('analyzing' cgForPixelValue:orNot: colorsUsed dominantColor innerPixelRectFor:orNot: pixelCompare:with:at: primCountBits rectangleEnclosingPixelsNotOfColor: tallyPixelValues tallyPixelValuesInRect:into: xTallyPixelValue:orNot: yTallyPixelValue:orNot:)('bordering' borderFormOfWidth:sharpCorners: borderWidth: borderWidth:color: borderWidth:fillColor: border:width:rule:fillColor: shapeBorder:width: shapeBorder:width:interiorPoint:sharpCorners:internal:)('color mapping' balancedPatternFor: bitPatternFor: colormapFromARGB colormapIfNeededForDepth: colormapIfNeededFor: colormapToARGB makeBWForm: mapColors:to: mapColor:to: maskingMap newColorMap pixelValueFor: pixelWordFor: reducedPaletteOfSize: rgbaBitMasks)('converting' adjustBrightness: adjustSaturation: as8BitColorForm asCursorForm asFormOfDepth: asGrayScale asSourceForm asTextAnchor blendColor: collectColors: collectPixels: colorReduced copyWithColorsReducedTo: darker dimmed dyed: flipVertically lighter orderedDither32To16)('copying' blankCopyOf:scaledBy: contentsOfArea: contentsOfArea:into: copyBits:at:translucent: copyBits:from:at:clippingBox:rule:fillColor: copyBits:from:at:clippingBox:rule:fillColor:map: copyBits:from:at:colorMap: copy: copy:from:in:rule: copy:from:to:rule: deepCopy postCopy veryDeepCopyWith:)('display box access' boundingBox center computeBoundingBox height width)('displaying' displayInterpolatedIn:on: displayInterpolatedOn: displayOnPort:at: displayOn:at:clippingBox:rule:fillColor: displayOn:transformation:clippingBox:align:with:rule:fillColor: displayResourceFormOn: displayScaledOn: drawLine:from:to:clippingBox:rule:fillColor: paintBits:at:translucent:)('editing' bitEdit bitEditAt:scale: edit)('fileIn/Out' comeFullyUpOnReload: hibernate objectForDataStream: printOn: readAttributesFrom: readBitsFrom: readFromOldFormat: readFrom: replaceByResource: storeBitsOn:base: storeOn: storeOn:base: unhibernate writeAttributesOn: writeBitsOn: writeBMPfileNamed: writeJPEGfileNamed: writeJPEGfileNamed:progressive: writeOnMovie: writeOn: writePNGfileNamed: writeUncompressedOn:)('filling' anyShapeFill bitPatternForDepth: convexShapeFill: eraseShape: fillFromXColorBlock: fillFromXYColorBlock: fillFromYColorBlock: fill:rule:fillColor: findShapeAroundSeedBlock: floodFill2:at: floodFillMapFrom:to:mappingColorsWithin:to: floodFill:at: floodFill:at:tolerance: shapeFill:interiorPoint: shapeFill:seedBlock:)('image manipulation' replaceColor:withColor: smear:distance: trimBordersOfColor:)('initialize-release' allocateForm: finish flush fromDisplay: shutDown swapEndianness)('other' fillAlpha: fixAlpha formForColorCount: preMultiplyAlpha primPrintHScale:vScale:landscape: relativeTextAnchorPosition setAsBackground)('pixel access' colorAt: colorAt:put: isTransparentAt: pixelValueAt: pixelValueAt:put: primPixelValueAtX:y: primPixelValueAtX:y:put:)('postscript generation' bitsPerComponent bytesPerRow decodeArray numComponents paddedWidth printPostscript:operator: rowPadding setColorspaceOn: store15To24HexBitsOn: store32To24HexBitsOn: storeBits:to:on: storeHexBitsOn: storePostscriptHexOn:)('resources' readNativeResourceFrom: readResourceFrom: resourceTag storeResourceOn:)('scaling, rotation' clippedToSize: flipBy:centerAt: magnifyBy: magnify:by: magnify:by:smoothing: rotateBy: rotateBy:centerAt: rotateBy:magnify:smoothing: rotateBy:smoothing: scaledToHeight: scaledToSize: scaledToSize:smoothing: scaledToWidth: shrink:by:)('testing' hasNonStandardPalette isAllWhite isBigEndian isDisplayScreen isForm isGrayScale isLittleEndian isStatic isTranslucent isVirtualScreen shouldPreserveContents)('transitions' fadeImageCoarse:at: fadeImageFine:at: fadeImageHorFine:at: fadeImageHor:at: fadeImageSquares:at: fadeImageVert:at: fadeImage:at:indexAndMaskDo: pageImage:at:corner: pageWarp:at:forward: slideImage:at:delta: wipeImage:at:clippingBox:rectForIndex: wipeImage:at:delta: wipeImage:at:delta:clippingBox: zoomInTo:at: zoomIn:orOutTo:at:vanishingPoint: zoomOutTo:at:)('*MorphicExtras-postscript generation' encodePostscriptOn:)('*nebraska-encoding' addDeltasFrom: deltaFrom: deltaFrom:at: encodeForRemoteCanvas)('private' hackBits: initFromArray: privateFloodFillValue: setExtent:depth: setExtent:depth:bits: setResourceBits:)('*Morphic' asMorph blankCopyOf: iconOrThumbnailOfSize: scaledIntoFormOfSize: scaledIntoFormOfSize:smoothing:)('*Morphic-Support-image manipulation' stencil)('processing' approxGaussianBlur at:bias: dither: edgeDetect emboss processUsingKernel: processUsingKernel:factor:bias: sharpen)('*System-icon scaling' scaleIconToDisplay)('*Morphic-Text Support' textAnchorProperties)('*Tools-Inspector' inspectorClass)('*TrueType-displaying' advanceWidth)!Flaps class removeSelector: #addAndEnableEToyFlaps!Flaps class removeSelector: #defaultsQuadsDefiningPlugInSuppliesFlap!Flaps class removeSelector: #defaultsQuadsDefiningScriptingFlap!Flaps class removeSelector: #enableEToyFlaps!Flaps class removeSelector: #newLoneSuppliesFlap!Flaps class removeSelector: #newPaintingFlap!Flaps class removeSelector: #paintFlapButton!Flaps class removeSelector: #possiblyReplaceEToyFlaps!Flaps class removeSelector: #setUpSuppliesFlapOnly!!Flaps class reorganize!('class initialization' initialize)('construction support' addMorph:asElementNumber:inGlobalFlapSatisfying: addMorph:asElementNumber:inGlobalFlapWithID: addToSuppliesFlap:asElementNumber: deleteMorphsSatisfying:fromGlobalFlapSatisfying:)('flap mechanics' clobberFlapTabList freshFlapsStart reinstateDefaultFlaps removeFlapTab:keepInList:)('flaps registry' defaultsQuadsDefiningStackToolsFlap defaultsQuadsDefiningSuppliesFlap defaultsQuadsDefiningToolsFlap defaultsQuadsDefiningWidgetsFlap initializeFlapsQuads registeredFlapsQuads registeredFlapsQuadsAt: registerQuad:forFlapNamed: unregisterQuadsWithReceiver: unregisterQuadsWithReceiver:fromFlapNamed: unregisterQuad:forFlapNamed:)('menu commands' disableGlobalFlaps disableGlobalFlaps: disableGlobalFlapWithID: enableDisableGlobalFlapWithID: enableGlobalFlapWithID: explainFlaps explainFlapsText)('menu support' addIndividualGlobalFlap ItemsTo: enableGlobalFlaps globalFlapWithIDEnabledString: showSharedFlaps suppressFlapsString)('miscellaneous' automaticFlapLayoutChanged doAutomaticLayoutOfFlapsIfAppropriate enableClassicNavigatorChanged fileOutChanges makeNavigatorFlapResembleGoldenBar orientationForEdge: removeFromGlobalFlapTabList:)('new flap' addLocalFlap addLocalFlap: addLocalFlap:titled:onEdge: askForEdgeOfNewFlap defaultColorForFlapBackgrounds newFlapTitled:onEdge: newFlapTitled:onEdge:inPasteUp:)('predefined flaps' addNewDefaultSharedFlaps addStandardFlaps initializeStandardFlaps newNavigatorFlap newObjectsFlap newSqueakFlap newStackToolsFlap newSuppliesFlap newSuppliesFlapFromQuads:positioning: newToolsFlap newWidgetsFlap quadsDefiningPlugInSuppliesFlap quadsDefiningStackToolsFlap quadsDefiningSuppliesFlap quadsDefiningToolsFlap quadsDefiningWidgetsFlap quadsDeiningScriptingFlap twiddleSuppliesButtonsIn:)('replacement' replaceGlobalFlapwithID: replacePartSatisfying:inGlobalFlapSatisfying:with: replacePartSatisfying:inGlobalFlapWithID:with: replaceToolsFlap)('shared flaps' addGlobalFlap: enableOnlyGlobalFlapsWithIDs: globalFlapTabOrDummy: globalFlapTabs globalFlapTabsIfAny globalFlapTabsWithID: globalFlapTabWithID: globalFlapTab: positionNavigatorAndOtherFlapsAccordingToPreference positionVisibleFlapsRightToLeftOnEdge:butPlaceAtLeftFlapsWithIDs: removeDuplicateFlapTabs sharedFlapsAllowed sharedFlapsAlongBottom)('testing' anyFlapsVisibleIn:)!EventHandler removeSelector: #adaptToWorld:!DeepCopier removeSelector: #mapUniClasses!DeepCopier removeSelector: #newUniClasses!DeepCopier removeSelector: #newUniClasses:!DeepCopier removeSelector: #uniClasses!Object subclass: #DeepCopier instanceVariableNames: 'references' classVariableNames: '' poolDictionaries: '' category: 'System-Object Storage'!!DeepCopier reorganize!('like fullCopy' checkBasicClasses checkClass: checkDeep checkVariables fixDependents initialize initialize: objInMemory: references warnIverNotCopiedIn:sel:)!ChangeList removeSelector: #buildMorphicCodePaneWith:!CodeHolder removeSelector: #installTextualCodingPane!CodeHolder removeSelector: #restoreTextualCodingPane!!CodeHolder reorganize!('annotation' addPriorVersionsCountForSelector:ofClass:to: annotation annotation: annotationForClassCommentFor: annotationForClassDefinitionFor: annotationForHierarchyFor: annotationForSelector:ofClass: annotationPaneMenu:shifted: annotationRequests annotationSeparator)('categories' categoryFromUserWithPrompt:for: categoryOfCurrentMethod changeCategory letUserReclassify:in: methodCategoryChanged selectedMessageCategoryName selectedSystemCategoryName)('categories & search pane' listPaneWithSelector: newSearchPane searchTextMorph)('commands' adoptMessageInCurrentChangeset browseImplementors browseSenders copyUpOrCopyDown offerMenu offerShiftedClassListMenu offerUnshiftedClassListMenu shiftedYellowButtonActivity spawn: spawnToClass: spawnToCollidingClass: unshiftedYellowButtonActivity)('construction' buildClassBrowserEditString: buildMessageBrowserEditString: buildMessageCategoryBrowserForCategory:class:selector:editString: buildMorphicCodePaneWith:)('contents' commentContents contents contentsChanged contentsSymbol contentsSymbol: editContents editContentsWithDefault: isModeStyleable)('controls' codePaneProvenanceString contentsSymbolQuints decorateButtons optionalButtonPairs sourceAndDiffsQuintsOnly)('diffs' defaultDiffsSymbol diffFromPriorSourceFor: showDiffs showDiffs: showPrettyDiffs: showRegularDiffs: showingAnyKindOfDiffs showingPrettyDiffs showingPrettyDiffsString showingRegularDiffs showingRegularDiffsString toggleDiffing togglePlainSource togglePrettyDiffing togglePrettyPrint toggleRegularDiffing wantsDiffFeedback)('message category functions' canShowMultipleMessageCategories removeMessageCategory)('message list' decompiledSourceIntoContents decompiledSourceIntoContentsWithTempNames: formattedLabel: formattedLabel:forSelector:inClass: messageHelpForMethod: messageHelpTruncated: selectedBytecodes selectedMessage sourceStringPrettifiedAndDiffed validateMessageSource:forSelector:inClass:)('message list menu' messageListKey:from: messageListMenuMore: shiftedMessageListMore:)('misc' addModelItemsToWindowMenu: getSelectorAndSendQuery:to: getSelectorAndSendQuery:to:with: informPossiblyCorruptSource isThereAnOverride isThisAnOverride modelWakeUpIn: okayToAccept priorSourceOrNil refreshAnnotation refusesToAcceptCode releaseCachedState sampleInstanceOfSelectedClass sendQuery:to: sendQuery:to:with: setClassAndSelectorIn: suggestCategoryToSpawnedBrowser: useSelector:orGetSelectorAndSendQuery:to:)('self-updating' didCodeChangeElsewhere stepIn: updateCodePaneIfNeeded updateListsAndCodeIn: wantsStepsIn:)('toolbuilder' annotationFrame annotationPaneHeight browseButtonEnabled buildAnnotationPaneWith: buildCodePaneWith: buildCodeProvenanceButtonWith: buildOptionalButtonsWith: buttonHeight hierarchyButtonEnabled inheritanceButtonColor inheritanceButtonEnabled optionalButtonsFrame receiverClass textFrame variablesButtonEnabled versionsButtonEnabled)('traits' makeSampleInstance showUnreferencedClassVars showUnreferencedInstVars spawnHierarchy)('what to show' offerWhatToShowMenu prettyPrintString setContentsToForceRefetch showByteCodes: showDecompile: showDocumentation: showingByteCodes showingByteCodesString showingDecompile showingDecompileString showingDocumentation showingDocumentationString showingEditContentsOption showingPlainSource showingPlainSourceString showingPrettyPrint showingSource toggleDecompile toggleShowDocumentation toggleShowingByteCodes wantsCodeProvenanceButton)('*services-base' messageListMenuServices: requestor)('*Protocols-Tools' spawnFullProtocol spawnProtocol)('multi-window support' multiWindowState multiWindowState:)('message functions' exploreMethod inspectMethod removeMessage)('*SUnitTools-running' testAskToCreateNewTest: testBinarySelectorNames testBrowseClassNamed:possibleMessageNamed: testFindTest testFindTested testRunSuite: testSelectorFrom:)('*SUnitTools-message list functions' testDebugTest testRunTest)('*SUnitTools-menus' testsMessageListMenu: testsTestFindingMenu:)('breakpoints' isBreakOnEntry toggleBreakOnEntry)('code pane' aboutToStyle: compileMessage:notifying:)('accessing' contents:notifying: doItReceiver metaClassIndicated selectedClass selectedClassOrMetaClass selectedMessageName systemOrganizer)('initialize-release' defaultBrowserTitle labelString setClass:selector:)('*monticello-revisions' classListMenuMonticello: messageListMenuMonticello:)('class functions' removeClass)('system category functions' removeSystemCategory)('*60Deprecated-annotation' defaultAnnotationPaneHeight defaultButtonPaneHeight)('*60Deprecated-categories & search pane' searchPane)!Object removeSelector: #adaptedToWorld:!Object removeSelector: #beViewed!Object removeSelector: #belongsToUniClass!Object removeSelector: #costumes!Object removeSelector: #defaultFloatPrecisionFor:!Object removeSelector: #evaluateUnloggedForSelf:!Object removeSelector: #isPlayer!Object removeSelector: #isPrimitiveCostume!Object removeSelector: #isScriptEditorMorph!Object removeSelector: #isUniversalTiles!Object removeSelector: #methodInterfacesForCategory:inVocabulary:limitClass:!Object removeSelector: #methodInterfacesForInstanceVariablesCategoryIn:!Object removeSelector: #methodInterfacesForScriptsCategoryIn:!Object removeSelector: #presenter!Object removeSelector: #renameInternal:!Object removeSelector: #scriptPerformer!Object removeSelector: #selfWrittenAsIll!Object removeSelector: #selfWrittenAsIm!Object removeSelector: #selfWrittenAsMe!Object removeSelector: #selfWrittenAsMy!Object removeSelector: #selfWrittenAsThis!Object removeSelector: #slotInfo!Object removeSelector: #veryDeepCopySibling!!Object reorganize!('accessing' at: at:modify: at:put: basicAt: basicAt:put: basicSize bindWithTemp : enclosedSetElement in: readFromString: size yourself)('associating' ->)('binding' bindingOf:)('casing' caseOf: caseOf:otherwise:)('class membership' class inheritsFromAnyIn: isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass)('comparing' = closeTo: hash identityHashPrintString literalEqual: ~=)('converting' adaptToFloat:andCompare: adaptToFloat:andSend: adaptToFraction:andCompare: adaptToFraction:andSend: adaptToInteger:andCompare: adaptToInteger:andSend: adaptToScaledDecimal:andCompare: adaptToScaledDecimal:andSend: as: asOrderedCollection asSetElement asString asStringOrText changeClassTo: complexContents mustBeBoolean mustBeBooleanIn: printDirectlyToDisplay withoutListWrapper)('copying' copy copyAddedStateFrom: copyFrom: copySameFrom: copyTwoLevel deepCopy initialDeepCopierSize postCopy shallowCopy veryDeepCopy veryDeepCopyUsing: veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:)('debugging' evaluate:wheneverChangeIn: haltIf: haltOnceIf: meetsHaltCondition: needsWork)('debugging-haltOnce' checkHaltCountExpired clearHaltOnce decrementAndCheckHaltCount decrementHaltCount doExpiredHaltCount doExpiredHaltCount: doExpiredInspectCount halt:onCount: haltIfNil haltOnCount: haltOnce haltOnce: haltOnceEnabled hasHaltCount inspectOnCount: inspectOnce inspectUntilCount: removeHaltCount setHaltCountTo: setHaltOnce toggleHaltOnce)('dependents access' addDependent: breakDependents canDiscardEdits dependents hasUnacceptedEdits myDependents myDependents: release removeDependent:)('drag and drop' acceptDroppingMorph:event:inMorph: dragPassengerFor:inMorph: dragStartedFor:transferMorph: dragTransferTypeForMorph: wantsDroppedMorph:event:inMorph:)('error handling' assert: assert:description: assert:descriptionBlock: backwardCompatibilityOnly: caseError deprecated deprecated: deprecated:block: doesNotUnderstand: dpsTrace: dpsTrace:levels: dpsTrace:levels:withContext: error error: halt halt: handles: notify: notify:at: primitiveFailed primitiveFailed: shouldBeImplemented shouldNotImplement subclassResponsibility traitConflict)('evaluating' value valueWithArguments:)('filter streaming' byteEncode: drawOnCanvas: elementSeparator encodePostscriptOn: flattenOnStream: fullDrawPostscriptOn: putOn: writeOnFilterStream:)('flagging' isThisEverCalled isThisEverCalled: logEntry logExecution logExit)('graph model' addModelYellowButtonMenuItemsTo:forMorph:hand: hasModelYellowButtonMenuItems)('macpal' codeStrippedOut: contentsChanged flash instanceVariableValues objectRepresented refusesToAcceptCode)('message handling' executeMethod: perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:with:with:with:with: perform:with:with:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: perform:withEnoughArguments: with:executeMethod: with:with:executeMethod: with:with:with:executeMethod: with:with:with:with:executeMethod: withArgs:executeMethod:)('objects from disk' comeFullyUpOnReload: convertToCurrentVersion:refStream: fixUponLoad:seg: objectForDataStream: readDataFrom:size: saveOnFile saveOnFileNamed: storeDataOn:)('printing' fullPrintString isLiteral longPrintOn: longPrintOn:limitedTo:indent: longPrintString longPrintStringLimitedTo: nominallyUnsent: printOn: printString printStringLimitedTo: printWithClosureAnalysisOn: reportableSize storeOn: storeString stringForReadout stringRepresentation)('system primitives' asOop become: becomeForward: becomeForward:copyHash: className creationStamp instVarAt: instVarAt:put: instVarNamed: instVarNamed:put: oopString primitiveChangeClassTo: rootStubInImageSegment: someObject)('testing' isArray isBehavior isBlock isBoolean isCharacter isClassReference isClosure isCodeReference isCollection isColor isColorForm isCompiledCode isCompiledCodeClass isCompiledMethod isComplex isContext isDictionary isFloat isForm isFraction isHeap isInteger isInterval isMessageSend isMethodContext isMethodProperties isMethodReference isMor ph isMorphicEvent isMorphicModel isNumber isPoint isPromise isRectangle isScaledDecimal isSketchMorph isStream isString isSymbol isSystemWindow isText isTextView isTrait isTransparent isVariableBinding isWebBrowser isWindowForModel: knownName name nameForViewer renameTo: shouldBePrintedAsLiteral shouldBePrintedAsLiteralVisiting: showDiffs stepAt:in: stepIn: stepTime stepTimeIn: vocabularyDemanded wantsDiffFeedback wantsSteps wantsStepsIn:)('updating' changed changed: changed:with: handledListVerification noteSelectionIndex:for: okToChange okToClose update: update:with: updateListsAndCodeIn: windowIsClosing)('user interface' addModelItemsToWindowMenu: addModelMenuItemsTo:forMorph:hand: asExplorerString defaultLabelForInspector launchPartVia: launchPartVia:label: launchTileToRefer modelSleep modelWakeUp modelWakeUpIn: mouseUpBalk: notYetImplemented windowActiveOnFirstClick windowReqNewLabel:)('*monticello' isConflict)('*system-support' isPrimitiveError systemNavigation)('*Tools-Ex plorer' explore exploreWithLabel:)('*tools-browser' browseHierarchy)('private' errorImproperStore errorNonIntegerIndex errorNotIndexable errorSubscriptBounds: setPinned: species storeAt:inTempFrame:)('thumbnail' iconOrThumbnailOfSize:)('*Morphic-Explorer' explorerContents hasContentsInExplorer)('futures' future future: futureDo:at:args: futureSend:at:args:)('*Tools-MessageSets' browseAllCallsOn: browseAllCallsOn:requestor: browseAllImplementorsOf: browseAllImplementorsOf:requestor:)('*Tools-multi-window support' canHaveUnacceptedEdits)('*morphic' asMorph asStringMorph asTextMorph isPluggableListMorph openAsMorph)('tracing' inboundPointers inboundPointersExcluding: outboundPointers outboundPointersDo:)('*Tools-Debugger' canonicalArgumentName chasePointers explorePointers shouldFollowOutboundPointers)('*System-Object Events-accessing' actionForEvent: actionForEvent:ifAbsent: actionMap actionSequenceForEvent: actionsDo: createActionMap hasActionForEvent: setActionSequence:forEvent: updateableActionMap)('*System-Change Notification-events' actionsWithReceiver:forEvent: renameActionsWithReceiver:forEvent:toEvent:)('*System-Change Notification-converting' asActionSequence asActionSequenceTrappingErrors)('*System-Tools-breakpoint' break)('*ToolBuilder-Kernel-error handling' confirm: confirm:orCancel:)('*ToolBuilder-Kernel-user interface' inform:)('*System-Support-user interface' initialExtent)('*System-Localization-locales' localeChanged localeChangedGently translatedNoop)('*System-Object Events-accessing-removing' releaseActionMap removeAction:forEvent: removeActionsForEvent: removeActionsSatisfying: removeActionsSatisfying:forEvent: removeActionsWithReceiver: removeActionsWithReceiver:forEvent:)('*System-Object Events-accessing-triggering' triggerEvent: triggerEvent:ifNotHandled: triggerEvent:with: triggerEvent:with:ifNotHandled: triggerEvent:withArguments: triggerEvent:withArguments:ifNotHandled:)('*System-Object Events-accessing-registering' when:evalua te: when:send:to: when:send:to:with: when:send:to:withArguments:)('*Traits' explicitRequirement requirement)('*Graphics-KernelExtensions' fullScreenSize)('*System-Finalization' actAsExecutor executor finalizationRegistry finalize hasMultipleExecutors retryWithGC:until: toFinalizeSend:to:with:)('*collections' asLink compareSafely:)('*Tools-Browsing' browse)('*System-Recovery-error handling' primitiveError:)('*SUnit-testing' isTestClass)('*Morphic-Events-Filtering' filterEvent:for:)('*System-Preferences' applyUserInterfaceTheme canApplyUserInterfaceTheme userInterfaceTheme)('*Tools' environment)('pinning' isPinned pin unpin)('literals' allLiteralsDo: hasLiteral: hasLiteralSuchThat:)('write barrier' attemptToAssign:withIndex: beReadOnlyObject beWritableObject isReadOnlyObject setIsReadOnlyObject:)('*Tools-Inspector' basicInspect inspect inspectWithLabel: inspectorClass)('*Morphic-Kernel-accessing' currentEvent currentHand currentWorld)('*Monticello-Patching-testing' isMCPatchOperation)('*JSON' asJsonString)('*60Deprecated-accessing' ifNil:ifNotNilDo: ifNotNilDo: ifNotNilDo:ifNil:)('*MorphicExtras-Undo' capturedState commandHistory purgeAllCommands redoFromCapturedState: refineRedoTarget:selector:arguments:in: refineUndoTarget:selector:arguments:in: rememberCommand: rememberUndoableAction:named: undoFromCapturedState:)('*Protocols' currentVocabulary haveFullProtocolBrowsed haveFullProtocolBrowsedShowingSelector:)('*services-base' requestor)('*60Deprecated-copying' clone)('*60Deprecated-Tools' exploreAndYourself notifyWithLabel:)('*MorphicExtras-PartsBin' descriptionForPartsBin)!| currentChanges |currentChanges := ChangeSet current.Smalltalk globals removeKey: #References.Smalltalk globals removeKey: #CustomEventsRegistry.Smalltalk globals removeKey: #ScriptingSystem.ChangeSet newChanges: (ChangeSet new name: 'unload-etoys-more').(Smalltalk classNamed: #StandardScriptingSystem) removeFromSystem.(Smalltalk classNamed: #Presenter) removeFromSystem.(Smalltalk classNamed: #MethodHolder) removeFromSystem.(Smalltalk classNamed: #PaintInvokingMorph) removeFromSystem.(Smalltalk classNamed: #ViewerFlapTab) removeFromSystem.(Smalltalk classNamed: #AcceptableCleanTextMorph) removeFromSystem.(Smalltalk classNamed: #BrowserCommentTextMorph) removeFromSystem.(Smalltalk classNamed: #BorderedSubpaneDividerMorph) removeFromSystem.(Smalltalk classNamed: #TextFieldMorph) removeFromSystem.(Smalltalk classNamed: #KeyboardBuffer) removeFromSystem.(Smalltalk classNamed: #PluggableTabButtonMorph) removeFromSystem.(Smalltalk classNamed: #MorphWithSubmorphsWrapper) removeFromSystem.(Smalltalk classNamed: #TwoWayScrollPane) removeFromSystem.Preferences removePreference: #noviceMode.Preferences removePreference: #eToyFriendly.Preferences removePreference: #universalTiles.Preferences removePreference: #uniTilesClassic.Preferences removePreference: #tileTranslucentDrag.Preferences removePreference: #typeCheckingInTileScripting.Preferences removePreference: #compactViewerFlaps.Preferences removePreference: #viewersInFlaps.Preferences removePreference: #batchPenTrails.Preferences removePreference: #keepTickingWhilePainting.Preferences removePreference: #unlimitedPaintArea.Preferences removePreference: #mvcProjectsAllowed.Preferences removePreference: #eToyLoginEnabled.Preferences removePreference: #oliveHandleForScriptedObjects.Preferences removePreference: #dropProducesWatcher.Preferences removePreference: #automaticViewerPlacement.Preferences removePreference: #capitalizedReferences.Preferences removePreference: #fenceEnabled.Preferences removePreference: #fenceSoundEnabled.Preferences removePreference: #haloTransitions.Preferences removePreference: #selectiveHalos.Preferences removePreference: #useVectorVocabulary.Preferences removePreference: #simpleMenus.Preferences removePreference: #propertySheetFromHalo.Preferences removePreference: #menuColorFromWorld.Preferences removePreference: #enableVirtualOLPCDisplay.Preferences removePreference: #enablePortraitMode.Preferences removePreference: #magicHalos.Preferences removePreference: #tabAmongFields.Preferences removePreference: #sugarAutoSave.Preferences removePreference: #showAdvancedNavigatorButtons.FileServices removeObsolete.ChangeSet newChanges: currentChanges.ChangeSet newChanges: (ChangeSet new name: 'clean-up-categories').SystemChangeNotifier uniqueInstance doSilently: [Smalltalk allClassesDo: [:cls | cls organization renameCategory: 'stepping and presenter' toBe: 'stepping']].Smalltalk removeEmptyMessageCategories.ChangeSet newChanges: currentChanges.Preferences resetHaloSpecifications.TheWorldMainDockingBar updateInstances.Flaps initializeFlapsQuads; initializeStandardFlaps.Vocabulary initializeStandardVocabularies.UserInterfaceTheme cleanUpAndReset."Next: Remove Etoys package from update map."!
Hi Dave, hi Marcel, hi all,
first, thank you a lot for working on this important refactoring!
I have finally found some time to take a briefly look at these changes (dtl's commits from 2023-11-25f.) and are confused by many of them. Maybe you can help me understand the overall goal? :-) These changes move many methods from other packages into the Trunk despite they are still used in these other packages. I have made a non-exhaustive list that fills about three workspaces, I will just briefly sketch two categorizes:
1. Logic that IMHO belongs into a base package indeed: Morphic halo invocation (#wantsHalo, #triggerHaloFor:after:, #removePendingHaloFor:), Morphic halo's duplicate handles, Morph>>#addMorphNearBack:, Morphic undo (MenuMorph>>#undoGrabCommand), annotation setup (docking bar > extras), ProjectLauncher startUp (afaik currently responsible for running changesets provided via command line). I am unsure about uniclasses: Should they belong into the trunk? I like to use a quick #newSubclass in different scripting/testing situations. 2. Logic that does belong to Etoys but is still intertwined with the original package. If we unload the Etoys package today, this will lead to DNUs in the trunk. Many of them might require better hooks (e.g., pragmas or registries) in the base packages. This is probably expected at the current state of making Etoys optional, but I'm listing them here for later reference anyway: Menu items in inspector/explorer (use menu pragmas consistently, introduce pragmas for keyboard shortcuts), CodeHolder>>#restoreTextualCodingPane, DeepCopier>>#mapUniClasses (generic global fixup hook*), NativeImageSegment>>#rootsIncludingPlayers, several preferences (haloTransitions, captializedReferences, ...), ReleaseBuilder ebautifyEtoys, ObjectlandMorph etoysProject 2b. Logic that belongs to Etoys but abuses an unused internal hook of a base package class: MorphicModel>>#addModelYellowButtonMenuItemsTo:forMorph:hand:, PasteUpMorph>>#drawOn: - this will conflict once we decide that these classes want to use these hooks themselves, so they also would require an explicit hook in the long term.
Again, thank you a lot, and I am looking forward to talk about these questions again, in particular about the first category. :-)
Best, Christoph
* see also: veryDeepCopy, ImageSegments, and actionMaps (https://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfoun...)
--- Sent from Squeak Inbox Talk
On 2023-11-11T01:47:19+00:00, christoph.thiede@student.hpi.uni-potsdam.de wrote:
Thanks a lot! :-)
Best,
Christoph
Von: Taeumel, Marcel via Squeak-dev <squeak-dev(a)lists.squeakfoundation.org> Gesendet: Montag, 6. November 2023 08:05:19 An: The general-purpose Squeak developers list Cc: Taeumel, Marcel Betreff: [squeak-dev] Re: Let's discuss the future of Etoys in Squeak 6.1 (and beyond)
Hi Dave! 😊
Thank you for the effort!
Best, Marcel
From: lewis(a)mail.msen.com <lewis(a)mail.msen.com> Sent: Sunday, November 5, 2023 5:29:46 PM To: The general-purpose Squeak developers list <squeak-dev(a)lists.squeakfoundation.org> Subject: [squeak-dev] Re: Let's discuss the future of Etoys in Squeak 6.1 (and beyond)
I have pushed a number of updates to trunk with class and method recategorization for Etoys. I am attaching for reference an updated RecategorizeForEtoys.st that includes scripts that I have been using to make the changes.
So for, the changes do two things:
- Clean up category names, based the cleanups in Marcel's Etoys removal
script. 2) Move classes an methods from Etoys to base packages if they are used outside of Etoys.
I have also made, but not committed, a bunch of updates that move methods into Etoys if they are used only by Etoys. These changes should be safe for trunk, but I want to spend some more time reviewing them before committing them for real.
Meanwhile any feedback is appreciated :-)
Dave
On 2023-10-03 15:24, David T. Lewis wrote:
On Tue, Aug 29, 2023 at 03:47:19PM +0200, Marcel Taeumel via Squeak-dev wrote:
Hi all --
Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later).
Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set.
I have been working with Marcel's excellent Etoys removal script and trying to figure out if it might be possible to maintain images with and without Etoys over time. I have been using Monticello with a local disk based repository to look at the differences between trunk images with and without the Etoys removal.
Just for the record, and in case anyone else is playing around with similar ideas, I am attaching RecategorizeExtensionsForEtoys.st which I have been using to move methods that are different into a separate 'Extensions' package. This separates out the methods that are necessarily different between images with and without Etoys. I don't (yet?) see how this helps with maintainability but it does give a view of the methods that could potentially be refactored in better ways. Basically I think the idea would be to make the 'Extensions' package be as small a possible (right now it is rather large).
I was hoping to find that moving these conflicting methods into a separate package would leave the rest of the packages reasonable similar between the full trunk image and the no-Etoys trunk image. But of course it is not quite that simple.
One encouraging thing is that, after moving the conflicting methods (Etoys image versus no-Etoys) I find a large number of methods in other packages that are referenced only by Etoys, even though that would not be obvious just from looking at those methods in the full image. I think that there is a lot of stuff that could be safely moved to the 'EToys' package without impacting the base image.
Just a few observations that may be of interest, hopefully more to follow.
Dave
!!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system.
Here is what would still work through the package MorphicExtras:
- Games
- Sketches and PaintBox
- Flaps
- CalendarMorph
- SpectrumAnalyzerMorph
Here is what would still "work" through the package System:
- Object storage (ImageSegment etc.)
- ProjectLoading
Here is what would still work through the package Protocols:
- Lexicon tool
- Vocabulary framework
Here is what would be gone:
- Tiles, viewers, and scripts
- Players and costumes
- Pen trails, Turtles, ...
- References, CustomEventsRegistry, ScriptingSystem
- Siblings for (Player-only) uni-classes
- DeepCopier support for (Player-only) uni-classes
- Preferences #noviceMode, #eToyFriendly, and more
Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-)
So...should we remove Etoys from Trunk at this point?
Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself.
Best, Marcel ???'From Squeak6.1alpha of 26 July 2023 [latest update: #22682] on 29 August 2023 at 3:33:41 pm'!| currentChanges |currentChanges := ChangeSet current.MenuIcons addClassVarName: #ScriptingIcons.MenuIcons classPool at: #ScriptingIcons put: ((Smalltalk globals at: #ScriptingSystem) formDictionary associationsSelect: [:assoc | true "keep all for now" "(assoc key beginsWith: 'Halo-') or: [assoc key beginsWith: 'Debugger']"]).ChangeSet newChanges: (ChangeSet new name: 'move-etoys-games-to-morphicextras').#( "Keep the games as standalone example applications"'Etoys-Squeakland-Morphic-Games' 'MorphicExtras-Games''Etoys-Squeakland-Morphic-Games-Chess' 'MorphicExtras-Games-Chess''Etoys-Squeakland-Morphic-Games-Chess960' 'MorphicExtras-Games-Chess960''Etoys-Squeakland-Morphic-Demo' 'MorphicExtras-Demo') pairsDo: [:oldCat :newCat | (SystemOrganization listAtCategoryNamed: oldCat) do: [:className | (self environment classNamed: className) category: newCat]]."Rescue more examples from Etoys over to MorphicExtras"(Smalltalk classNamed: #CalendarMorph) category: 'MorphicExtras-Demo'.(Smalltalk classNamed: #SpectrumAnalyzerMorph) category: 'MorphicExtras-SoundInterface'.ChangeSet newChanges: currentChanges.(MCPackage named: #EToys) unload.!Object subclass: #DeepCopier instanceVariableNames: 'references uniClasses newUniClasses ' classVariableNames: '' poolDictionaries: '' category: 'System-Object Storage'!!DeepCopier commentStamp: 'mt 8/28/2023 15:05' prior: 0!DeepCopier does a veryDeepCopy.It is a complete tree copy using a dictionary. Any object that is 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. See Object|veryDeepCopy which calls (self veryDeepCopyWith: aDeepCopier).When a tree of morphs points at a morph outside of itself, that morph should not be copied. Use our own kind of weak pointers for the 'potentially outside' morphs. Default is that any new class will have all of its fields deeply copied. If a field needs to be weakly copied, define veryDeepInner: and veryDeepFixupWith:. veryDeepInner: has the loop that actually copies the fields. If a class defines its own copy of veryDeepInner: (to leave some fields out), then veryDeepFixupWith: will be called on that object at the end. veryDeepInner: can compute an alternate object to put in a field. (Object veryDeepCopyWith: discovers which superclasses did not define veryDeepInner:, and very deeply copies the variables defined in those classes). To decide if a class needs veryDeepInner: and veryDeepFixupWith:, ask this about an instance: If I duplicate this object, does that mean that I also want to make duplicates of the things it holds onto? If yes, (i.e. a Paragraph does want a new copy of its Text) then do nothing. If no, (i.e. an undo command does not want to copy the objects it acts upon), then define veryDeepInner: and veryDeepFixupWith:. Here is an analysis for the specific case of a morph being held by another morph. Does field X contain a morph? If not, no action needed.Is the morph in field X already a submorph of the object? Is it down lower in the submorph tree? If so, no action needed.Could the morph in field X every appear on the screen (be a submorph of some other morph)? If not, no action needed. If it could, you must write the methods veryDeepFixupWith: and veryDeepInner:, and in them, refrain from sending veryDeepCopyWith: to the contents of field X.----- Things Ted is still considering -----Rule: If object A has object C in a field, and A says (^ C) for the copy, but object B has A in a normal field and it gets deepCopied, and A in encountered first, then there will be two copies of C. (just be aware of it)Dependents are now fixed up. Suppose a model has a dependent view. In the DependentFields dictionary, model -> (view ...). If only the model is copied, no dependents are created (no one knows about the new model). If only the view is copied, it is inserted into DependentFields on the right side. model -> (view copiedView ...). If both are copied, the new model has the new view as its dependent. If additional things depend on a model that is copied, the caller must add them to its dependents.August 2023: There is no support for uni-classes at this time!!!Model subclass: #FancyMailComposition instanceVariableNames: 'messageText theLinkToInclude to subject' classVariableNames: '' poolDictionaries: '' category: 'Nebraska-Network-Mail'!Object subclass: #MenuIcons instanceVariableNames: '' classVariableNames: 'Icons TranslatedIcons TranslationLocale ScriptingIcons ' poolDictionaries: '' category: 'Morphic-Menus'!Object subclass: #MorphExtension instanceVariableNames: 'locked visible sticky balloonText balloonTextSelector externalName isPartsDonor actorState player eventHandler otherProperties ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Kernel'!BorderedMorph subclass: #PasteUpMorph instanceVariableNames: 'presenter model cursor padding turtleTrailsForm turtlePen lastTurtlePositions isPartsBin indicateCursor wantsMouseOverHalos worldState ' classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler ' poolDictionaries: '' category: 'Morphic-Worlds'!AbstractLauncher subclass: #ProjectLauncher instanceVariableNames: 'showSplash splashURL whichFlaps eToyAuthentificationServer ' classVariableNames: 'SplashMorph ' poolDictionaries: '' category: 'System-Download'!Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl eToyUserListUrl eToyUserList keepAlive encodingName ' classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers ' poolDictionaries: '' category: 'Network-RemoteDirectory'!!SmartRefStream commentStamp: 'mt 8/28/2023 15:44' prior: 0!Ordinary ReferenceStreams assume that the names and order of instance variables is exactly the same when an object file is written and read. SmartRefStream allows object files to be read even after instance variables have changed or the entire class has been renamed.When an object file is written, no one knows how the classes will change in the future. Therefore, all conversion must be done when the file is read. The key is to store enough information in the file about the names of the instance variables of all outgoing classes. SmartRefStream works best with only one tree of objects per file. You can nextPut: more than once, but each object tree gets its own class structure description, which is big. Conversion of old objects is done by a method in each class called (convertToCurrentVersion: varDict refStream: smartRefStrm). At fileOut time, ChangeSet>>checkForConversionMethods creates a prototype of this method (if Preference #conversionMethodsAtFileOut is true). The programmer must edit this method to (1) test if the incoming object needs conversion, (2) put non-nil values into any new inst vars that need them, and (3) save the data of any inst vars that are being deleted. Determining which old version is represented by the incoming object can be done in several ways: - noticing that a current inst var is nil when it should have data, - noticing that there is an older inst var name in the variable dictionary (varDict), - checking kinds of objects in one or more inst vars, or - retrieving the classVersion of the incoming object from the ref stream. If a class is renamed, a method goes into SmartRefStream telling the new name. The conversion method of the new class must be prepared to accept instances of the old class also. If no inst var names have changed, the conversion method does nothing.An example: Suppose we change the representation of class Rectangle from ('origin' 'corner') to ('origin' 'extent'). Suppose lots of Rectangle instances are already out on files (in .pr project files, especially). The programmer changes the class definition, modifies all the methods, and filesOut. A series of dialogs appear, asking if instances Rectangle might be in an object file, if 'extent' needs to be non-nil (yes), and if the info in 'corner' needs to be preserved (yes). This method appears:Rectangle >> convertToCurrentVersion: varDict refStream: smartRefStrm "These variables are automatically stored into the new instance: #('origin'). Test for this particular conversion. Get values using expressions like (varDict at: 'foo')." "New variables: #('extent'). If a non-nil value is needed, please assign it." "These are going away #('corner'). Possibly store their info in some other variable?" "Move your code above the ^ super... Delete extra comments." ^ super convertToCurrentVersion: varDict refStream: smartRefStrmThe programmer modifies it to be:Rectangle >> convertToCurrentVersion: varDict refStream: smartRefStrm(varDict includesKey: 'extent') ifFalse: ["old version!!" "Create the new extent, and preserve the info from the old corner" extent := (varDict at: 'corner') - origin. ].^ super convertToCurrentVersion: varDict refStream: smartRefStrm This conversion method stays in the system and is ready to convert the old format of Rectangle whenever one is encountered in an object file. Note that the subclasses of Rectangle, (B3DViewport, CharacterBlock, and Quadrangle) do not need conversion methods. Their instances will be converted by the code in Rectangle. Files written by SmartRefStream are in standard fileout format. You can mix raw objects with code to be filed in. The file starts out in the normal fileOut format. Definitions of new classes on the front.structures Dictionary of (#Rectangle -> #(<classVersionInteger> 'origin' 'corner')). Inst var names are strings.steady Set of Classes who have the same structure now as on the incoming file. Includes classes with same inst vars except for new ones added on the end.reshaped Dictionary of Classes who have a different structure now from the incoming file. Includes those with same inst vars but new version number. (old class name -> method selector to fill in data for version to version)renamed Dictionary of Classes who have a different name. Make an instance of the new class, and send it the conversion call. (old class name symbol -> new class name). renamedConv Dictionary of conversion selector for Classes who have a different name. (old class name symbol -> conversion selector). topCall Tells if next or nextPut: are working on the top object in the tree. nil if outside, the top object if deep inside.See DataStream.typeIDFor: for where the tangle of objects is clipped, so the whole system will not be written on the file.No object that is written on the file is ever a class. All class definitions are filed in. A class may be stored inside an ImageSegment that itself is stored in a SmartRefStream.UniClasses are classes for the instance specific behavior of just one instance. See #newSubclass. When a UniClass is read in, and a class of the same name already exists, the incoming one is renamed. ObjectScanner converts the filed-in code.Values in instance variables of UniClasses are stored in the array that tells the class structure. It is the fourth of the four top level objects. #(version (class-structure) the-object ((#Player25 scripts slotInfo costumeDictionary) (#Player26 scripts slotInfo costumeDictionary))).There is a separate subclass for doing veryDeepCopy (in memory). Currently, any object for which objectToStoreOnDataStream return an object other than self, does this: The new object (a DiskProxy) is traced. When it comes time to go through the fields of the old object, they are not found as keys in references (DiskProxies are there instead). So the old field value is left in the new object. That is OK for StrikeFont, Class, MetaClass, DisplayScreen. But the DiskProxies are evaluated, which takes a lot of time.Some metaclasses are put into the structures table. This is for when a block has a receiver that is a class. See checkFatalReshape:.ImageSegments: A ReferenceStream is used to enumerate objects to put inside an ImageSegment. If an instance of a UniClass is seen, the class is put in also. A SmartRefStream is used to store the ImageSegment. Roots are nil, and the segment is a wordArray. We are encoding the outPointers. Structures contains all classes from both places. Must filter out UniClasses for some things, and do include them for putting source code at end of file. Do not write any class inst vars in file.--Ted Kaehler and Bob Arning.How are the selectors in the '*Morphic-conversion' protocol ending with something like ttfclpomsswfpp0constructed and what does it mean?Answer:It is the initials of all instance variables followed by the class version integer. The initials allow to detect most changes to the instance variables, but if this is not sufficient (perhaps because the new var had the same initial, or the vars did not change in name at all) we still have the class version.Most classes are still at version 0, but if you check implementers of classVersion you can find a few that were incremented to force a conversion on load.!!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:05'!veryDeepCopy "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." | copier new | copier := DeepCopier new: self initialDeepCopierSize. new := self veryDeepCopyWith: copier. copier references associationsDo: [:assoc | assoc value veryDeepFixupWith: copier]. copier fixDependents. ^ new! !!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:05'!veryDeepCopyUsing: copier "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. Same as veryDeepCopy except copier (with dictionary) is supplied. ** do not delete this method, even if it has no callers **" | new refs | new := self veryDeepCopyWith: copier. copier references associationsDo: [:assoc | assoc value veryDeepFixupWith: copier]. "Fix dependents" refs := copier references. DependentsFields associationsDo: [:pair | pair value do: [:dep | | newDep newModel | (newDep := refs at: dep ifAbsent: [nil]) ifNotNil: [ newModel := refs at: pair key ifAbsent: [pair key]. newModel addDependent: newDep]]]. ^ new! !!Object methodsFor: 'copying' stamp: 'mt 8/28/2023 15:07'!veryDeepCopyWith: deepCopier "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." | class index sub subAss new sup has mine | deepCopier references at: self ifPresent: [:newer | ^ newer]. "already did him" class := self class. class isMeta ifTrue: [^ self]. "a class" new := self shallowCopy. deepCopier references at: self put: new. "remember" (class isVariable and: [class isPointers]) ifTrue: [index := self basicSize. [index > 0] whileTrue: [sub := self basicAt: index. (subAss := deepCopier references associationAt: sub ifAbsent: [nil]) ifNil: [new basicAt: index put: (sub veryDeepCopyWith: deepCopier)] ifNotNil: [new basicAt: index put: subAss value]. index := index - 1]]. "Ask each superclass if it wants to share (weak copy) any inst vars" new veryDeepInner: deepCopier. "does super a lot" "other superclasses want all inst vars deep copied" sup := class. index := class instSize. [has := sup compiledMethodAt: #veryDeepInner: ifAbsent: [nil]. has := has ifNil: [class isSystemDefined not "is a uniClass"] ifNotNil: [true]. mine := sup instVarNames. has ifTrue: [index := index - mine size] "skip inst vars" ifFalse: [1 to: mine size do: [:xx | sub := self instVarAt: index. (subAss := deepCopier references associationAt: sub ifAbsent: [nil]) "use association, not value, so nil is an exceptional value" ifNil: [new instVarAt: index put: (sub veryDeepCopyWith: deepCopier)] ifNotNil: [new instVarAt: index put: subAss value]. index := index - 1]]. (sup := sup superclass) == nil] whileFalse. new rehash. "force Sets and Dictionaries to rehash" ^ new! !!Object methodsFor: 'testing' stamp: 'mt 3/8/2023 10:43'!knownName ^ nil! !!Class methodsFor: 'testing' stamp: 'mt 8/28/2023 14:56'!officialClass "I am not a UniClass. (See MorphicModel officialClass). Return the class you use to make new subclasses." ^ self! !!Class methodsFor: 'fileIn/Out' stamp: 'mt 8/28/2023 14:56'!objectForDataStream: refStrm "I am about to be written on an object file. Write a reference to a class in Smalltalk instead." refStrm insideASegment ifFalse: ["Normal use" ^ DiskProxy global: self theNonMetaClass name selector: #withClassVersion: args: {self classVersion}] ifTrue: ["recording objects to go into an ImageSegment" self isSystemDefined ifFalse: [^ self]. "do trace uni-classes" (refStrm rootObject includes: self) ifTrue: [^ self]. "is in roots, intensionally write out, ^ self" "A normal class. remove it from references. Do not trace." refStrm references removeKey: self ifAbsent: []. "already there" ^ nil]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!toggleDiffing "Toggle whether diffs should be shown in the code pane. If any kind of diffs were being shown, stop showing diffs. If no kind of diffs were being shown, start showing whatever kind of diffs are called for by default." | wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingAnyKindOfDiffs. self showDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!togglePlainSource "Toggle whether plain source shown in the code pane" | wasShowingPlainSource | self okToChange ifTrue: [wasShowingPlainSource := self showingPlainSource. wasShowingPlainSource ifTrue: [self showDocumentation: true] ifFalse: [contentsSymbol := #source]. self setContentsToForceRefetch. self changed: #contents]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!togglePrettyDiffing "Toggle whether pretty-diffing should be shown in the code pane" | wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingPrettyDiffs. self showPrettyDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!togglePrettyPrint "Toggle whether pretty-print is in effectin the code pane" self okToChange ifTrue: [self showingPrettyPrint ifTrue: [contentsSymbol := #source] ifFalse: [contentsSymbol := #prettyPrint]. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'diffs' stamp: 'mt 3/23/2023 11:25'!toggleRegularDiffing "Toggle whether regular-diffing should be shown in the code pane" | wasShowingDiffs | self okToChange ifTrue: [wasShowingDiffs := self showingRegularDiffs. self showRegularDiffs: wasShowingDiffs not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'misc' stamp: 'mt 3/23/2023 11:24'!refusesToAcceptCode "Answer whether receiver, given its current contentsSymbol, could accept code happily if asked to" ^ (#(byteCodes documentation) includes: self contentsSymbol)! !!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'!toggleDecompile "Toggle the setting of the showingDecompile flag, unless there are unsubmitted edits that the user declines to discard" | wasShowing | self okToChange ifTrue: [wasShowing := self showingDecompile. self showDecompile: wasShowing not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'!toggleShowDocumentation "Toggle the setting of the showingDocumentation flag, unless there are unsubmitted edits that the user declines to discard" | wasShowing | self okToChange ifTrue: [wasShowing := self showingDocumentation. self showDocumentation: wasShowing not. self setContentsToForceRefetch. self contentsChanged]! !!CodeHolder methodsFor: 'what to show' stamp: 'mt 3/23/2023 11:25'!toggleShowingByteCodes "Toggle whether the receiver is showing bytecodes" self showByteCodes: self showingByteCodes not. self setContentsToForceRefetch. self contentsChanged! !!Command class methodsFor: 'dog simple ui' stamp: 'mt 7/31/2023 11:10'!undoRedoButtons "Answer a morph that offers undo and redo buttons" | wrapper | "self currentHand attachMorph: Command undoRedoButtons" wrapper := AlignmentMorph newColumn. wrapper color: Color veryVeryLightGray lighter; borderWidth: 0; layoutInset: 0; vResizing: #shrinkWrap; hResizing: #shrinkWrap. #((CrudeUndo undoLastCommand 'undo last command done' undoEnabled CrudeUndoDisabled CrudeUndoDisabled) (CrudeRedo redoNextCommand 'redo last undone command' redoEnabled CrudeRedoDisabled CrudeRedoDisabled)) do: [:tuple | | aButton | wrapper addTransparentSpacerOfSize: (8(a)0). aButton := UpdatingThreePhaseButtonMorph new. aButton onImage: (MenuIcons formAtKey: tuple first); offImage: (MenuIcons formAtKey: tuple fifth); pressedImage: (MenuIcons formAtKey: tuple sixth); getSelector: tuple fourth; color: Color transparent; target: self; actionSelector: tuple second; setNameTo: tuple second; setBalloonText: tuple third; extent: aButton onImage extent. wrapper addMorphBack: aButton. wrapper addTransparentSpacerOfSize: (8(a)0)]. ^ wrapper! !!Debugger methodsFor: 'toolbuilder' stamp: 'mt 3/10/2023 11:26'!buildNotifierWith: builder label: label message: messageString | windowSpec listSpec textSpec panelSpec quads | windowSpec := builder pluggableWindowSpec new model: self; extent: self initialExtentForNotifier; label: label asString; children: OrderedCollection new. panelSpec := builder pluggablePanelSpec new. panelSpec children: OrderedCollection new. quads := self preDebugButtonQuads. (self interruptedContext selector == #doesNotUnderstand:) ifTrue: [ quads := quads copyWith: { 'Create'. #createMethod. #magenta. 'create the missing method' } ]. (#(#notYetImplemented #shouldBeImplemented #requirement) includes: self interruptedContext selector) ifTrue: [ quads := quads copyWith: { 'Create'. #createImplementingMethod. #magenta. 'implement the marked method' } ]. (self interruptedContext selector == #subclassResponsibility) ifTrue: [ quads := quads copyWith: { 'Create'. #createOverridingMethod. #magenta. 'create the missing overriding method' } ]. quads do:[:spec| | buttonSpec | buttonSpec := builder pluggableButtonSpec new. buttonSpec model: self. buttonSpec label: spec first. buttonSpec action: spec second. buttonSpec help: spec fourth. spec size >= 5 ifTrue: [buttonSpec enabled: spec fifth]. panelSpec children add: buttonSpec. ]. panelSpec layout: #horizontal. "buttons" panelSpec frame: self preDebugButtonQuadFrame. windowSpec children add: panelSpec. messageString notNil ifFalse:[ listSpec := builder pluggableListSpec new. listSpec model: self; list: #contextStackList; getIndex: #contextStackIndex; setIndex: #debugAt:; icon: #messageIconAt:; helpItem: #messageHelpAt:; frame: self contextStackFrame. windowSpec children add: listSpec. ] ifTrue:[ message := messageString. textSpec := builder pluggableTextSpec new. textSpec model: self; getText: #preDebugMessageString; setText: nil; selection: nil; menu: #debugProceedMenu:; frame: self contextStackFrame. windowSpec children add: textSpec. ]. ^windowSpec! !!Debugger methodsFor: 'initialize' stamp: 'mt 3/10/2023 11:26'!preDebugButtonQuads ^{ {'Proceed' translated. #proceed. #blue. 'continue execution' translated. #interruptedProcessShouldResume}. self class showTerminateButton ifTrue: [ {'Terminate' translated. #terminateProcess. #black. 'terminate this execution and close this window' translated}]. self class showAbandonButton ifTrue: [ {'Abandon' translated. #abandon. #black. 'terminate this execution aggressively and close this window' translated}]. {'Debug' translated. #debug. #red. 'bring up a debugger' translated}} reject: [:quad | quad isNil]! !!DeepCopier methodsFor: 'like fullCopy' stamp: 'mt 3/10/2023 15:37'!checkBasicClasses "Check that no indexes of instance vars have changed in certain classes. If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated. The idea is to catch a change while it is still in the system of the programmer who made it. DeepCopier new checkVariables " | str objCls morphCls | str := '|veryDeepCopyWith: or veryDeepInner: is out of date.'. (objCls := self objInMemory: #Object) ifNotNil: [ objCls instSize = 0 ifFalse: [self error: 'Many implementers of veryDeepCopyWith: are out of date']]. (morphCls := self objInMemory: #Morph) ifNotNil: [ morphCls superclass == Object ifFalse: [self error: 'Morph', str]. (morphCls instVarNames copyFrom: 1 to: 6) = #('bounds' 'owner' 'submorphs' 'fullBounds' 'color' 'extension') ifFalse: [self error: 'Morph', str]]. "added ones are OK"! !!DeepCopier methodsFor: 'like fullCopy' stamp: 'mt 8/28/2023 15:08'!initialize: size references := IdentityDictionary new: size.! !!ExtendedClipboardUnixInterface methodsFor: 'general-api-read' stamp: 'mt 8/11/2023 15:20'!readHTMLClipboardData | bytes source | "Answer a HTMLDocument object" bytes := self readClipboardData: 'text/html'. (bytes beginsWith: '<!!DOCTYPE' asByteArray) ifTrue: ["BAD HACK for Abiword" source := bytes asString convertFromWithConverter: UTF8TextConverter new] ifFalse: ["BAD HACK for mozilla" source := bytes asString convertFromWithConverter: (UTF16TextConverter new useLittleEndian: SmalltalkImage current isLittleEndian)]. ^ source asTextFromHtml! !!FileList2 methodsFor: 'volume list and pattern' stamp: 'mt 8/16/2023 15:54'!listForPattern: pat "Make the list be those file names which match the pattern." | sizePad newList entries | directory ifNil: [^#()]. entries := directory entries. (fileSelectionBlock isKindOf: MessageSend) ifTrue: [ fileSelectionBlock arguments: {entries}. newList := fileSelectionBlock value. fileSelectionBlock arguments: #(). ] ifFalse: [ newList := entries select: [:entry | fileSelectionBlock value: entry value: pat]. ]. newList := newList asArray sort: self sortBlock. sizePad := (newList inject: 0 into: [:mx :entry | mx max: entry fileSize]) asStringWithCommas size - 1. ^newList collect: [ :e | self fileNameFormattedFrom: e sizePad: sizePad ]! !!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'!morphicViewGeneralLoaderInWorld: aWorld"FileList2 morphicViewGeneralLoaderInWorld: self currentWorld" | window aFileList buttons treePane textColor1 fileListPane pane2a pane2b fileTypeInfo fileTypeButtons fileTypeRow actionRow | fileTypeInfo := self endingSpecs. window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new directory: FileDirectory default. aFileList fileSelectionBlock: self projectOnlySelectionBlock; modalView: window. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1 px; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners. fileTypeButtons := fileTypeInfo collect: [ :each | (self blueButtonText: each first textColor: Color gray inWindow: window) setProperty: #enabled toValue: true; hResizing: #shrinkWrap; useSquareCorners ]. buttons := {{'OK'. Color lightGreen}. {'Cancel'. Color lightRed}} collect: [ :each | self blueButtonText: each first textColor: textColor1 color: each second inWindow: window ]. treePane := aFileList morphicDirectoryTreePane extent: 250 px @ 300 px; retractable: false; borderWidth: 0. fileListPane := aFileList morphicFileListPane extent: 350 px @ 300 px; retractable: false; borderWidth: 0. window addARow: {window fancyText: 'Find...' translated font: Preferences standardWindowTitleFont color: textColor1}. fileTypeRow := window addARowCentered: fileTypeButtons cellInset: 2 px. actionRow := window addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second } cellInset: 2 px. window addARow: { (window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2a fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). pane2b fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35)." buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]." fileTypeButtons do: [ :each | each on: #mouseUp send: #value:value: to: [ :evt :morph | self update: actionRow in: window fileTypeRow: fileTypeRow morphUp: morph. ] ]. buttons first on: #mouseUp send: #okHit to: aFileList. buttons second on: #mouseUp send: #cancelHit to: aFileList. aFileList postOpen. window position: aWorld topLeft + (aWorld extent - window extent // 2). aFileList directoryChangeBlock: [ :newDir | self update: actionRow in: window fileTypeRow: fileTypeRow morphUp: nil. self enableTypeButtons: fileTypeButtons info: fileTypeInfo forDir: newDir. ]. aFileList directory: aFileList directory. window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window openInWorld: aWorld.! !!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'!morphicViewProjectLoader2InWorld: aWorld reallyLoad: aBoolean dirFilterType: aSymbol | window aFileList buttons treePane textColor1 fileListPane pane2a pane2b treeExtent filesExtent | window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new. aFileList optionalButtonSpecs: aFileList servicesForProjectLoader; fileSelectionBlock: ( aSymbol == #limitedSuperSwikiDirectoryList ifTrue: [ MessageSend receiver: Project current selector: #latestProjectVersionsFromFileEntries: ] ifFalse: [ self projectOnlySelectionBlock ] ); "dirSelectionBlock: self hideSqueakletDirectoryBlock;" modalView: window. aFileList directory: FileDirectory default. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1 px; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners. buttons := {{'OK'. Color lightGreen}. {'Cancel'. Color lightRed}} collect: [ :each | self blueButtonText: each first textColor: textColor1 color: each second inWindow: window ]. aWorld width < 800 px ifTrue: [ treeExtent := 150 px @ 300 px. filesExtent := 350 px @ 300 px. ] ifFalse: [ treeExtent := 350 px @ 500 px. filesExtent := 550 px @500 px. ]. (treePane := aFileList morphicDirectoryTreePaneFiltered: aSymbol) extent: treeExtent; retractable: false; borderWidth: 0. fileListPane := aFileList morphicFileListPane extent: filesExtent; retractable: false; borderWidth: 0. window addARow: { window fancyText: 'Load A Project' translated font: Preferences standardWindowTitleFont color: textColor1 }; addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second }; addARow: { window fancyText: 'Please select a project' translated font: Preferences standardButtonFont color: textColor1 }; addARow: { (window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) }) layoutInset: 10 px. }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2a fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35). pane2b fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35)." buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]." buttons first on: #mouseUp send: (aBoolean ifTrue: [#okHitForProjectLoader] ifFalse: [#okHit]) to: aFileList. buttons second on: #mouseUp send: #cancelHit to: aFileList. aFileList postOpen. window position: aWorld topLeft + (aWorld extent - window extent // 2). window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window openInWorld: aWorld.! !!FileList2 class methodsFor: 'blue ui' stamp: 'mt 8/11/2023 14:00'!morphicViewProjectSaverFor: aProject"(FileList2 morphicViewProjectSaverFor: Project current) openInWorld" | window aFileList buttons treePane pane2 textColor1 option treeExtent buttonData buttonRow | textColor1 := Color r: 0.742 g: 0.839 b: 1.0. aFileList := self new directory: ServerDirectory projectDefaultDirectory. aFileList dirSelectionBlock: self hideSqueakletDirectoryBlock. window := AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. aFileList modalView: window. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 1; borderColor: (Color r: 0.9 g: 0.801 b: 0.2); useRoundedCorners. buttonData := Preferences enableLocalSave ifTrue: [{ {'Save'. #okHit. 'Save in the place specified below, and in the Squeaklets folder on your local disk'. Color lightGreen}. {'Save on local disk only'. #saveLocalOnlyHit. 'saves in the Squeaklets folder'. Color lightGreen}. {'Cancel'. #cancelHit. 'return without saving'. Color lightRed} }] ifFalse: [{ {'Save'. #okHit. 'Save in the place specified below, and in the Squeaklets folder on your local disk'. Color lightGreen}. {'Cancel'. #cancelHit. 'return without saving'. Color lightRed} }]. buttons := buttonData collect: [ :each | (self blueButtonText: each first textColor: textColor1 color: each fourth inWindow: window) setBalloonText: each third translated; hResizing: #shrinkWrap; on: #mouseUp send: each second to: aFileList ]. option := aProject world valueOfProperty: #SuperSwikiPublishOptions ifAbsent: [#initialDirectoryList]. aProject world removeProperty: #SuperSwikiPublishOptions. treeExtent := Project current world height < 500 px ifTrue: [ 350 px @ 150 px ] ifFalse: [ 350 px @ 300 px ]. (treePane := aFileList morphicDirectoryTreePaneFiltered: option) extent: treeExtent; retractable: false; borderWidth: 0. window addARowCentered: { window fancyText: 'Publish This Project' translated font: Preferences standardWindowTitleFont color: textColor1 }. buttonRow := OrderedCollection new. buttons do: [:button | buttonRow add: button] separatedBy: [buttonRow add: ((Morph new extent: 30 px @ 5 px) color: Color transparent)]." addARowCentered: { buttons first. (Morph new extent: 30 px @ 5 px) color: Color transparent. buttons second. (Morph new extent: 30 px@ 5 px) color: Color transparent. buttons third };" window addARowCentered: buttonRow; addARowCentered: { (window inAColumn: {(ProjectViewMorph on: aProject) lock}) layoutInset: 4 px}; addARowCentered: { window fancyText: 'Please select a folder' translated font: Preferences standardButtonFont color: textColor1 }; addARow: { ( window inAColumn: { (pane2 := window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 0; borderWidth: 1 px; borderColor: (Color r: 0.6 g: 0.7 b: 1) } ) layoutInset: 10 px }. window fullBounds. window fillWithRamp: (Color r: 1 g: 0.85 b: 0.975) oriented: 0.65. pane2 fillWithRamp: (Color r: 0.85 g: 0.9 b: 1) oriented: (0.7 @ 0.35)." buttons do: [ :each | each fillWithRamp: ColorTheme current dialogButtonsRampOrColor oriented: (0.75 @ 0). ]." window morphicLayerNumber: window class dialogLayer. aFileList postOpen. window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window ! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:52'!defaultsQuadsDefiningStackToolsFlap "Answer a structure defining the items on the default system Stack Tools flap. previously in quadsDefiningStackToolsFlap" ^ { {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}. {#StackMorph. #stackHelpWindow. 'Stack Help' translatedNoop. 'Some hints about how to use Stacks' translatedNoop}. {#TextMorph . #authoringPrototype. 'Simple Text' translatedNoop. 'Text that you can edit into anything you wish' translatedNoop}. {#TextMorph . #fancyPrototype. 'Fancy Text' translatedNoop. 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop}. {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}. {#StackMorph. #previousCardButton. 'Previous Card' translatedNoop. 'A button that takes the user to the previous card in the stack' translatedNoop}. {#StackMorph. #nextCardButton. 'Next Card' translatedNoop. 'A button that takes the user to the next card in the stack' translatedNoop} } asOrderedCollection! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:52'!defaultsQuadsDefiningSuppliesFlap "Answer a list of quads which define the objects to appear in the default Supplies flap. previously in quadsDefiningSuppliesFlap" ^ { {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}. {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}. {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}. {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}. {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}. {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}. {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}. {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}. {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}. {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}. {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}. {#TabbedPalette. #authoringPrototype. 'TabbedPalette' translatedNoop. 'A structure with tabs' translatedNoop}. {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}. {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}. {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}. {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}} asOrderedCollection! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 14:38'!defaultsQuadsDefiningToolsFlap "Answer a structure defining the default Tools flap. previously in quadsDefiningToolsFlap" ^ OrderedCollection new addAll: #( (Browser prototypicalToolWindow 'Browser' 'A Browser is a tool that allows you to view all the code of all the classes in the system') (TranscriptStream openMorphicTranscript 'Transcript' 'A Transcript is a window usable for logging and debugging; browse references to #Transcript for examples of how to write to it.') (Workspace prototypicalToolWindow 'Workspace' 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.')); add: { FileList2 . #prototypicalToolWindow. 'File List'. 'A File List is a tool for browsing folders and files on disks and FTP servers.' }; addAll: #( (DualChangeSorter prototypicalToolWindow 'Change Sorter' 'Shows two change sets side by side') (SelectorBrowser prototypicalToolWindow 'Method Finder' 'A tool for discovering methods by providing sample values for arguments and results') (MessageNames prototypicalToolWindow 'Message Names' 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.') (PreferencesBrowser prototypicalToolWindow 'Preferences' 'Allows you to control numerous options') (Utilities recentSubmissionsWindow 'Recent' 'A message browser that tracks the most recently-submitted methods') (ProcessBrowser prototypicalToolWindow 'Processes' 'A Process Browser shows you all the running processes') (PackagePaneBrowser prototypicalToolWindow 'Packages' 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"') (ChangeSorter prototypicalToolWindow 'Change Set' 'A tool that allows you to view and manipulate all the code changes in a single change set')); yourself! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:53'!defaultsQuadsDefiningWidgetsFlap "Answer a structure defining the default Widgets flap. previously in quadsDefiningWidgetsFlap" ^ #( (TrashCanMorph new 'Trash' 'A tool for discarding objects') (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there') (GeeMailMorph new 'Gee-Mail' 'A place to present annotated content') (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.') (FrameRateMorph authoringPrototype 'FrameRate' 'An indicator of how fast your system is running') (MagnifierMorph newRound 'Magnifier' 'A magnifying glass') (ObjectsTool newStandAlone 'ObjectCatalog' 'A tool that lets you browse the catalog of objects') ) asOrderedCollection! !!Flaps class methodsFor: 'flaps registry' stamp: 'mt 8/4/2023 13:50'!initializeFlapsQuads "initialize the list of dynamic flaps quads. self initializeFlapsQuads" FlapsQuads := nil. self registeredFlapsQuads at: 'Stack Tools' put: self defaultsQuadsDefiningStackToolsFlap; at: 'Supplies' put: self defaultsQuadsDefiningSuppliesFlap; at: 'Tools' put: self defaultsQuadsDefiningToolsFlap; at: 'Widgets' put: self defaultsQuadsDefiningWidgetsFlap. ^ self registeredFlapsQuads! !!Flaps class methodsFor: 'new flap' stamp: 'mt 8/4/2023 14:02'!addLocalFlap: anEvent titled: title onEdge: edge | flapTab menu world | flapTab := self newFlapTitled: title onEdge: edge. (world := anEvent hand world) addMorphFront: flapTab. menu := flapTab buildHandleMenu: anEvent hand. flapTab addTitleForHaloMenu: menu. flapTab computeEdgeFraction. menu popUpEvent: anEvent in: world.! !!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 8/10/2023 11:29'!addStandardFlaps "Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed. " SharedFlapTabs ifNil: [SharedFlapTabs := OrderedCollection new]. SharedFlapTabs add: self newSqueakFlap. SharedFlapTabs add: self newSuppliesFlap. SharedFlapTabs add: self newToolsFlap. SharedFlapTabs add: self newWidgetsFlap. SharedFlapTabs add: self newStackToolsFlap. Preferences showProjectNavigator ifTrue:[SharedFlapTabs add: self newNavigatorFlap]. SharedFlapTabs add: self newObjectsFlap. self disableGlobalFlapWithID: 'Stack Tools' translated. Preferences showProjectNavigator ifTrue:[self disableGlobalFlapWithID: 'Navigator' translated]. ^ SharedFlapTabs! !!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 7/31/2023 11:11'!newSqueakFlap "Answer a new default 'Squeak' flap for the left edge of the screen" | aFlap aFlapTab aButton aClock buttonColor anOffset bb aFont | aFlap := PasteUpMorph newSticky borderWidth: 0. aFlapTab := FlapTab new referent: aFlap. aFlapTab setName: 'Squeak' translated edge: #left color: Color brown lighter lighter. aFlapTab position: (0 @ ((Display height - aFlapTab height) // 2)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. aFlap cellInset: 14(a)14. aFlap beFlap: true. aFlap color: (Color brown muchLighter lighter "alpha: 0.3"). aFlap extent: 150 @ self currentWorld height. aFlap layoutPolicy: TableLayout new. aFlap wrapCentering: #topLeft. aFlap layoutInset: 2. aFlap listDirection: #topToBottom. aFlap wrapDirection: #leftToRight. "self addProjectNavigationButtonsTo: aFlap." anOffset := 16. aClock := ClockMorph newSticky. aClock color: Color red. aClock showSeconds: false. aClock font: (TextStyle default fontAt: 3). aClock step. aClock setBalloonText: 'The time of day. If you prefer to see seconds, check out my menu.' translated. aFlap addCenteredAtBottom: aClock offset: anOffset. buttonColor := Color cyan muchLighter. bb := SimpleButtonMorph new target: Smalltalk. bb color: buttonColor. aButton := bb copy. aButton actionSelector: #saveSession. aButton setBalloonText: 'Make a complete snapshot of the current state of the image onto disk.' translated. aButton label: 'save' translated font: (aFont := Preferences standardButtonFont). aFlap addCenteredAtBottom: aButton offset: anOffset. aButton := bb copy target: MCMcmUpdater. aButton actionSelector: #updateFromServer. aButton label: 'load code updates' translated font: aFont. aButton color: buttonColor. aButton setBalloonText: 'Check the Squeak server for any new code updates, and load any that are found.' translated. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton := SimpleButtonMorph new target: Smalltalk; actionSelector: #aboutThisSystem; label: 'about this system' translated font: aFont. aButton color: buttonColor. aButton setBalloonText: 'click here to find out version information' translated. aFlap addCenteredAtBottom: aButton offset: anOffset. aFlap addCenteredAtBottom: (Preferences themeChoiceButtonOfColor: buttonColor font: aFont) offset: anOffset. aButton := TrashCanMorph newSticky. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton startStepping. ^ aFlapTab"Flaps replaceGlobalFlapwithID: 'Squeak' translated "! !!Flaps class methodsFor: 'predefined flaps' stamp: 'mt 8/28/2023 14:29'!newSuppliesFlapFromQuads: quads positioning: positionSymbol "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen. Use #center as the positionSymbol to have it centered at the bottom of the screen, or #right to have it placed off near the right edge." | aFlapTab aStrip hPosition | aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: quads. "self twiddleSuppliesButtonsIn: aStrip." aFlapTab := FlapTab new referent: aStrip beSticky. aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter. hPosition := positionSymbol == #center ifTrue: [(Display width // 2) - (aFlapTab width // 2)] ifFalse: [Display width - (aFlapTab width + 22)]. aFlapTab position: (hPosition @ (self currentWorld height - aFlapTab height)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. aStrip extent: self currentWorld width @ 136. aStrip beFlap: true. aStrip autoLineLayout: true. ^ aFlapTab"Flaps replaceGlobalFlapwithID: 'Supplies' translated"! !!Flaps class methodsFor: 'replacement' stamp: 'mt 8/4/2023 15:19'!replaceGlobalFlapwithID: flapID "If there is a global flap with flapID, replace it with an updated one." | replacement tabs | (tabs := self globalFlapTabsWithID: flapID) size = 0 ifTrue: [^ self]. tabs do: [:tab | self removeFlapTab: tab keepInList: false]. flapID = 'Stack Tools' translated ifTrue: [replacement := self newStackToolsFlap]. flapID = 'Supplies' translated ifTrue: [replacement := self newSuppliesFlap]. flapID = 'Tools' translated ifTrue: [replacement := self newToolsFlap]. flapID = 'Widgets' translated ifTrue: [replacement := self newWidgetsFlap]. flapID = 'Navigator' translated ifTrue: [replacement := self newNavigatorFlap]. flapID = 'Squeak' translated ifTrue: [replacement := self newSqueakFlap]. replacement ifNil: [^ self]. self addGlobalFlap: replacement. self currentWorld ifNotNil: [self currentWorld addGlobalFlaps]"Flaps replaceFlapwithID: 'Widgets' translated "! !!FontSubstitutionDuringLoading methodsFor: 'accessing' stamp: 'mt 8/11/2023 13:59'!defaultAction familyName ifNil: [ familyName := 'NoName' ]. pixelSize ifNil: [ pixelSize := 12 ]. ^((familyName beginsWith: 'Comic') ifTrue: [ TextStyle named: (Preferences standardDefaultTextFont familyName) ] ifFalse: [ TextStyle default ]) fontOfSize: pixelSize.! !!Form methodsFor: 'converting' stamp: 'mt 8/16/2023 16:54'!blendColor: aTranslucentColor | form canvas | form := self deepCopy asFormOfDepth: 32. canvas := form getCanvas. canvas stencil: form at: 0 @ 0 sourceRect: (0 @ 0 extent: form extent) color: aTranslucentColor. ^ canvas form! !!Form methodsFor: 'scaling, rotation' stamp: 'sw 4/16/2008 00:13'!scaledToHeight: newHeight "Answer the receiver, scaled such that it has the desired height." newHeight = self height ifTrue: [^ self]. ^self magnify: self boundingBox by: (newHeight / self height) smoothing: 2.! !!Form methodsFor: 'scaling, rotation' stamp: 'ct 9/17/2019 18:50'!scaledToWidth: newWidth "Answer the receiver, scaled such that it has the desired width." newWidth = self width ifTrue: [^ self]. ^self magnify: self boundingBox by: (newWidth / self width) smoothing: 2.! !!Form class methodsFor: '*MorphicExtras-examples' stamp: 'mt 8/14/2023 16:21'!gridFormExample "Original was in Morph
#setStandardTexture and #textureParameters and #makeGraphPaperGrid:... Morph new color: Form gridFormExample; extent: 500(a)500; openInHand " ^ self gridFormOrigin: 0(a)0 grid: 16 px background: Color black line: Color lightGreen lighter lighter ! !!Form class methodsFor: '*MorphicExtras-sprites' stamp: 'mt 8/14/2023 16:20'!gridFormOrigin: origin grid: smallGrid background: backColor line: lineColor | bigGrid gridForm gridOrigin | gridOrigin := origin \ smallGrid. bigGrid := (smallGrid asPoint x) @ (smallGrid asPoint y). gridForm := Form extent: bigGrid depth: Display depth. backColor ifNotNil: [gridForm fillWithColor: backColor]. gridOrigin x to: gridForm width by: smallGrid asPoint x do: [:x | gridForm fill: (x(a)0 extent: 1(a)gridForm height) fillColor: lineColor]. gridOrigin y to: gridForm height by: smallGrid asPoint y do: [:y | gridForm fill: (0(a)y extent: gridForm width(a)1) fillColor: lineC
olor]. ^ InfiniteForm with: gridForm! !!GetTextExporter class methodsFor: 'utilities' stamp: 'mt 8/4/2023 13:49'!listAllHelp "self listAllHelp" | spec specs oCatalog flap flapSelectors allKeys oCatalogHelp flapHelp | oCatalog := Dictionary new. Morph withAllSubclasses do: [:aClass | (aClass class includesSelector: #descriptionForPartsBin) ifTrue: [spec := aClass descriptionForPartsBin. oCatalog at: spec formalName put: spec documentation]]. Morph withAllSubclasses do: [:aClass | (aClass class includesSelector: #supplementaryPartsDescriptions) ifTrue: [specs := aClass supplementaryPartsDescriptions. specs do: [:each | oCatalog at: each formalName put: each documentation]]]. flap := Dictionary new. flapSelectors := #( #defaultsQuadsDefiningStackToolsFlap #defaultsQuadsDefiningSuppliesFlap #defaultsQuadsDefiningToolsFlap #defaultsQuadsDefiningWidgetsFlap ). flapSelectors do: [:selector | specs := Flaps perform: selector. specs do: [:each | flap at: each third put: each fourth]]. allKeys := oCatalog keys intersection: flap keys. allKeys asArray sort do: [:each | oCatalogHelp := oCatalog at: each ifAbsent: ['']. flapHelp := flap at: each ifAbsent: ['']. oCatalogHelp = flapHelp ifFalse: [Transcript cr; show: 'Name: ' , each. Transcript cr; show: 'O: ' , oCatalogHelp. Transcript cr; show: 'F: ' , flapHelp. Transcript cr.]]! !!ImageSegment methodsFor: 'fileIn' stamp: 'mt 8/16/2023 16:51'!declareAndPossiblyRename: classThatIsARoot | existing catInstaller | "The class just arrived in this segment. How fit it into the Smalltalk dictionary? If it had an association, that was ins talled with associationDeclareAt:." catInstaller := [ classThatIsARoot category: Object categoryForUniclasses. ]. classThatIsARoot superclass addSubclass: classThatIsARoot. (Smalltalk includesKey: classThatIsARoot name) ifFalse: [ "Class entry in Smalltalk not referred to in Segment, install anyway." catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. existing := Smalltalk at: classThatIsARoot name. existing xxxClass == ImageSegmentRootStub ifTrue: [ "We are that segment!! Must ask it carefully!!" catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. existing == false | (existing == nil) ifTrue: [ "association is in outPointers, just installed" catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. "Conflict with existing global or copy of the class" (existing isKindOf: Class) ifTrue: [ classThat IsARoot isSystemDefined not ifTrue: [ "UniClass. give it a new name" classThatIsARoot setName: MorphicModel chooseUniqueClassName. catInstaller value. "must be after new name" ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. "Take the incoming one" self inform: 'Using newly arrived version of ', classThatIsARoot name. classThatIsARoot superclass removeSubclass: classThatIsARoot. "just in case" (Smalltalk at: classThatIsARoot name) becomeForward: classThatIsARoot. catInstaller value. ^ classThatIsARoot superclass addSubclass: classThatIsARoot]. self error: 'Name already in use by a non-class: ', classThatIsARoot name.! !!ImageSegment class methodsFor: 'fileIn/Out' stamp: 'mt 8/28/2023 15:10'!copyFromRootsLocalFileFor: rootArray sizeHint: segSize ^ NativeImageSegment new copyFromRootsLocalFileFor: rootArray sizeHint: segSize! !!Inspector methodsFor: 'menu' stamp: 'mt 8/28/202 3 14:33'!inspectorKey: aChar from: view "Respond to a Command key issued while the cursor is over my field list" ^ aChar caseOf: { [$x] -> [self removeSelection]. [$i] -> [self inspectSelection]. [$I] -> [self exploreSelection]. [$b] -> [self browseClass]. [$h] -> [self browseClassHierarchy]. [$p] -> [self browseFullProtocol]. [$r] -> [self browseVariableReferences]. [$a] -> [self browseVariableAssignments]. [$N] -> [self browseClassRefs]. [$c] -> [self copyName] } otherwise: [self arrowKey: aChar from: view]! !!Inspector methodsFor: 'menu' stamp: 'mt 3/10/2023 15:12'!mainFieldListMenu: aMenu "Arm the supplied menu with items for the field-list of the receiver" <fieldListMenu> aMenu addStayUpItemSpecial. self addObjectItemsTo: aMenu. (#(self ellipsis element nil) includes: self typeOfSelection) ifTrue: [self addCollectionItemsTo: aMenu]. self typeOfSelection = #instVar ifTrue: [self addInstVarItemsTo: aMenu]. self addFieldItemsTo: aMenu. self addClassItemsTo: aMenu. ^ aMenu! !!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 7/31/2023 10:45'!formAtKey: aString "Answer the form saved under the given key" ^(Symbol lookup: aString) ifNotNil: [ :aKey | ScriptingIcons at: aKey ifAbsent: [ self blankIcon ] ] ifNil: [ self blankIcon ]! !!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:08'!formPressedAtKey: aSymbol "Answer the form for pressed button. It is automatically generated if unavailable." "(ScriptingSystem formPressedAtKey: #TryIt) asMorph openInHand" | pressedName pressedImage | pressedName := (aSymbol , 'Pressed') asSymbol. ((ScriptingIcons includesKey: aSymbol) and: [(ScriptingIcons includesKey: pressedName) not])
ifTrue: [pressedImage := ((self formAtKey: aSymbol) blendColor: (Color black alpha: 0.3)) colorReduced. ScriptingIcons at: pressedName put: pressedImage]. ^ self formAtKey: pressedName! !!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:11'!saveForm: aForm atKey: aKey ScriptingIcons at: aKey asSymbol put: aForm! !!MenuIcons class methodsFor: 'scripting icons' stamp: 'mt 3/15/2023 14:05'!scriptingIcons ^ ScriptingIcons ifNil: [ScriptingIcons := IdentityDictionary new]! !!MessageSet methodsFor: 'filtering' stamp: 'mt 8/28/2023 15:11'!filterMessageList "Allow the user to refine the list of messages." | builder menuSpec | builder := ToolBuilder default. menuSpec := builder pluggableMenuSpec new model: self; yourself. menuSpec addList: #( ('unsent messages' filterToUnsentMessages 'filter to show only messages that have no senders') - ('messages that send...' filterToSendersOf 'filter to show only messages that send a selector I specify') ('messages that do not send...' filterToNotSendersOf 'filter to show only messages that do not send a selector I specify') - ('messages whose selector is...' filterToImplementorsOf 'filter to show only messages with a given selector I specify') ('messages whose selector is NOT...' filterToNotImplementorsOf 'filter to show only messages whose selector is NOT a seletor I specify') - ('messages in current change set' filterToCurrentChangeSet 'filter to show only messages that are in the current change set') ('messages not in current change set' filterToNotCurrentChangeSet 'filter to show only messages that are not in the current change set') - ('messages in any change set' filterToAnyChangeSet 'filter to show only messages that occur in at least one change set') ('messages not in any change set' filterToNotAnyChangeSet 'filter to show only messages that do not occur in any change set in the system') - ('messages authored by me' filterToCurrentAuthor 'filter to show only messages whose authoring stamp has my initials') ('messages not authored by me' filterToNotCurrentAuthor 'filter to show only messages whose authoring stamp does not have my initials') - ('messages logged in .changes file' filterToMessagesInChangesFile 'filter to show only messages whose latest source code is logged in the .changes file') ('messages only in .sources file' filterToMessagesInSourcesFile 'filter to show only messages whose latest source code is logged in the .sources file') - ('messages with prior versions' filterToMessagesWithPriorVersions 'filter to show only messages that have at least one prior version') ('messages without prior versions' filterToMessagesWithoutPriorVersions 'filter to show only messages that have no prior versions') - ('uncom mented messages' filterToUncommentedMethods 'filter to show only messages that do not have comments at the beginning') ('commented messages' filterToCommentedMethods 'filter to show only messages that have comments at the beginning') - ('messages in hardened classes' filterToMessagesWithHardenedClasses 'filter to show only messages of established classes (as opposed to Uniclasses such as MorphicModel23)') - ('methods in classes with matching names' filterToMatchingClassesNames 'filter to show only methods of classes with names that match the given criteria (wildcards are allowed)') ('methods in package...' filterToPackage 'filter to show only methods of a given package') ('methods not in package...' filterToNotPackage 'filter to show only methods not of a given package') - ('messages that...' filterToMessagesThat 'let me type in a block taking a class and a selector, which will specify yea or nay concerning which element s should remain in the list')). builder runModal: (builder open: menuSpec).! !!Lexicon methodsFor: 'toolbuilder' stamp: 'mt 7/31/2023 11:13'!addSpecialButtonsTo: buttonPanelSpec with: builder | homeCatBtnSpec menuBtnSpec mostGenericBtnSpec | homeCatBtnSpec := builder pluggableButtonSpec new model: self; action: #showHomeCategory; label: MenuIcons smallHomeIcon scaleIconToDisplay; help: 'show this method''s home category'; yourself. menuBtnSpec := builder pluggableButtonSpec new model: self; action: #offerMenu; label: (MenuIcons formAtKey: #TinyMenu) asMorph; help: 'click here to get a menu with further options'; yourself. mostGenericBtnSpec :=builder pluggableButtonSpec new model: self; action: #chooseLimitClass; label: #limitClassString; help: 'Governs which classes'' methods should be shown. If this is the same as the viewed class, then only methods implemented in that c lass will be shown. If it is ProtoObject, then methods of all classes in the vocabulary will be shown.'. buttonPanelSpec children add: homeCatBtnSpec; addFirst: mostGenericBtnSpec; addFirst: menuBtnSpec.! !!InstanceBrowser methodsFor: 'menu commands' stamp: 'mt 8/16/2023 16:52'!offerMenu "Offer a menu to the user, in response to the hitting of the menu button on the tool pane" | aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu title: ('Messages of {1}' translated format: {objectViewed nameForViewer}). aMenu addStayUpItem. aMenu addTranslatedList: #( ('vocabulary...' chooseVocabulary) ('what to show...' offerWhatToShowMenu) - ('inst var refs (here)' setLocalInstVarRefs) ('inst var defs (here)' setLocalInstVarDefs) ('class var refs (here)' setLocalClassVarRefs) - ('navigate to a sender...' navigateToASender) ('recent...'
navigateToRecentMethod) ('show methods in current change set' showMethodsInCurrentChangeSet) ('show methods with initials...' showMethodsWithInitials) - "('toggle search pane' toggleSearch)" - - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' browseClassHierarchy) ('browse protocol (p)' browseFullProtocol) - ('fileOut' fileOutMessage) ('printOut' printOutMessage) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('versions (v)' browseVersions) ('inheritance (i)' methodHierarchy) - ('references... (r)' browseVariableReferences) ('assignments... (a)'
browseVariableAssignments) - ('inspector on me' inspectViewee) - ('more...' shiftedYellowButtonActivity)). ^ aMenu popUpInWorld: self currentWorld! !!MethodCall methodsFor: 'initialization' stamp: 'mt 8/28/2023 14:54'!receiver: aReceiver methodInterface: aMethodInterface "Initialize me to have the given receiver and methodInterface" receiver := aReceiver. selector := aMethodInterface selector. methodInterface := aMethodInterface. arguments := aMethodInterface defaultArguments. lastValue := nil.! !!MethodFinder methodsFor: 'initialize' stamp: 'mt 3/10/2023 15:58'!initialize "The methods we are allowed to use. (MethodFinder new initialize) " Approved := Set new. AddAndRemove := Set new. Blocks := Set new. "These modify an argument and are not used by the MethodFinder: longPrintOn: printOn: storeOn: sentTo: storeOn:base: printOn:base: absPrintExactlyOn:base: absPrintOn:base: absPrintOn:base:digitCount: writeOn: writeScanOn: possibleVariablesFor:continuedFrom: printOn:format:""Object" #("in class, instance creation" categoryForUniclasses chooseUniqueClassName initialInstance isSystemDefined newFrom: officialClass readCarefullyFrom:"accessing" at: basicAt: basicSize bindWithTemp: in: size yourself "testing" basicType ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: isColor isFloat isFraction isInMemory isInteger isMorph isNil isNumber isPoint isText isTransparent isWebBrowser knownName notNil pointsTo: wantsSteps "comparing" = == closeTo: hash identityHash identityHashPrintString ~= ~~ "copying" copy shallowCopy "dependents access" canDiscardEdits dependents hasUnacceptedEdits "updating" changed changed: okToChange update: windowIsClosing "printing" fullPrintString isLiteral longPrintString printString storeString stringForReadout stringRepresentation "class membership" class isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass "error han dling" "user interface" addModelMenuItemsTo:forMorph:hand: defaultLabelForInspector fullScreenSize initialExtent modelWakeUp mouseUpBalk: newTileMorphRepresentative windowActiveOnFirstClick windowReqNewLabel: "system primitives" asOop instVarAt: instVarNamed: "private" "associating" -> "converting" as: asOrderedCollection asString "casing" caseOf: caseOf:otherwise: "binding" bindingOf: "macpal" contentsChanged currentEvent currentHand currentWorld flash instanceVariableValues "flagging" flag: "translation support" "objects from disk" "finalization" ) do: [:sel | Approved add: sel]. #(at:add: at:modify: at:put: basicAt:put: "NOT instVar:at:""message handling" perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: ) do: [:sel | AddAndRemove add: sel]."Boolean, True, False, UndefinedObject" #("logical operations" & eqv: not xor: |"controlling" and: ifFalse: ifFalse:ifTrue: ifTrue: ifTrue:ifF alse: or:"copying" "testing" isEmptyOrNil) do: [:sel | Approved add: sel]."Behavior" #("initialize-release""accessing" compilerClass decompilerClass evaluatorClass format methodDict parserClass sourceCodeTemplate subclassDefinerClass"testing" instSize instSpec isBits isBytes isFixed isPointers isVariable isWeak isWords"copying""printing" printHierarchy"creating class hierarchy""creating method dictionary""instance creation" basicNew basicNew: new new:"accessing class hierarchy" allSubclasses allSubclassesWithLevelDo:startingLevel: allSuperclasses subclasses superclass withAllSubclasses withAllSuperclasses"accessing method dictionary" allSelectors changeRecordsAt: compiledMethodAt: compiledMethodAt:ifAbsent: firstCommentAt: lookupSelector: selectors selectorsDo: selectorsWithArgs: "slow but useful ->" sourceCodeAt: sourceCodeAt:ifAbsent: sourceMethodAt: sourceMethodAt:ifAbsent:"accessing instances and variables" allClassVarNames allInstVarNames allSharedPools classVarNames instV arNames instanceCount sharedPools someInstance subclassInstVarNames"testing class hierarchy" inheritsFrom: kindOfSubclass"testing method dictionary" canUnderstand: classThatUnderstands: hasMethods includesSelector: whichClassIncludesSelector: whichSelectorsAccess: whichSelectorsReferTo: whichSelectorsReferTo:special:byte: whichMethodsStoreInto:"enumerating""user interface") do: [:sel | Approved add: sel]."ClassDescription" #("initialize-release" "accessing" classVersion isMeta name theNonMetaClass"copying" "printing" classVariablesString instanceVariablesString sharedPoolsString"instance variables" checkForInstVarsOK: "method dictionary" "organization" category organization whichCategoryIncludesSelector:"compiling" acceptsLoggingOfCompilation wantsChangeSetLogging"fileIn/Out" definition"private" ) do: [:sel | Approved add: sel]."Class" #("initialize-release" "accessing" classPool"testing""copying" "class name" "instance variables" "class variables" classVarAt: classVariableAssociationAt:"pool variables" "compiling" "subclass creation" "fileIn/Out" ) do: [:sel | Approved add: sel]. "Metaclass" #("initialize-release" "accessing" isSystemDefined soleInstance"copying" "instance creation" "instance variables" "pool variables" "class hierarchy" "compiling""fileIn/Out" nonTrivial ) do: [:sel | Approved add: sel]."Context, BlockContext" #(receiver client method receiver tempAt: "debugger access" pc selector sender shortStack sourceCode tempNames tempsAndValues"controlling" "printing" "system simulation" "initialize-release" "accessing" hasMethodReturn home numArgs"evaluating" value value:ifError: value:value: value:value:value: value:value:value:value: valueWithArguments:"controlling" "scheduling" "instruction decoding" "printing" "private" "system simulation" ) do: [:sel | Approved add: sel]. #(value: "<- Association has it as a store" ) do: [:sel | AddAndRemove add: sel]."Message" #("inclass, instance creation" select or: selector:argument: selector:arguments:"accessing" argument argument: arguments sends:"printing" "sending" ) do: [:sel | Approved add: sel]. #("private" setSelector:arguments:) do: [:sel | AddAndRemove add: sel]."Magnitude" #("comparing" < <= > >= between:and:"testing" max: min: min:max: ) do: [:sel | Approved add: sel]."Date, Time" #("in class, instance creation" fromDays: fromSeconds: fromString: newDay:month:year: newDay:year: today "in class, general inquiries" dateAndTimeNow dayOfWeek: daysInMonth:forYear: daysInYear: firstWeekdayOfMonth:year: indexOfMonth: leapYear: nameOfDay: nameOfMonth:"accessing" day leap monthIndex monthName weekday year"arithmetic" addDays: subtractDate: subtractDays:"comparing""inquiries" dayOfMonth daysInMonth daysInYear daysLeftInYear firstDayOfMonth previous:"converting" asSeconds"printing" mmddyyyy printFormat: "private" weekdayIndex "in class, instance creation" fromSeconds: now "in class, general inquiries" dateAndTimeFromSeconds: dateAndTimeNow millisecondClockValue millisecondsToRun: totalSeconds"accessing" hours minutes seconds"arithmetic" addTime: subtractTime:"comparing""printing" intervalString print24 "converting") do: [:sel | Approved add: sel]. #("private" ) do: [:sel | AddAndRemove add: sel]."Number" #("in class" readFrom:base: "arithmetic" * + - / // \ abs negated quo: reciprocal rem:"mathematical functions" arcCos arcSin arcTan arcTan: cos exp floorLog: ln log log: raisedTo: raisedToInteger: sin sqrt squared tan"truncation and round off" ceiling detentBy:atMultiplesOf:snap: floor roundTo: roundUpTo: rounded truncateTo: truncated"comparing""testing" even isDivisibleBy: isInfinite isNaN isZero negative odd positive sign strictlyPositive"converting" @ asInteger asNumber asPoint asSmallAngleDegrees degreesToRadians radiansToDegrees"intervals" to: to:by: "printing" printStringBase: storeStringBase: ) do: [:sel | Approved add: sel]."Integer" #("in class" primesUpTo:"testing" isPowerOfTwo"arithmetic" alignedTo:"comparing""truncation and round off" atRandom normalize"enumerating" timesRepeat:"mathematical functions" degreeCos degreeSin factorial gcd: lcm: take:"bit manipulation" << >> allMask: anyMask: bitAnd: bitClear: bitInvert bitInvert32 bitOr: bitShift: bitXor: lowBit noMask:"converting" asCharacter asColorOfDepth: asFloat asFraction asHexDigit"printing" asStringWithCommas hex hex8 radix:"system primitives" lastDigit replaceFrom:to:with:startingAt:"private" "benchmarks" ) do: [:sel | Approved add: sel]."SmallInteger, LargeNegativeInteger, LargePositiveInteger" #("arithmetic" "bit manipulation" highBit "testing" "comparing" "copying" "converting" "printing" "system primitives" digitAt: digitLength "private" fromString:radix: ) do: [:sel | Approved add: sel]. #(digitAt:put: ) do: [:sel | AddAndRemove add: sel]."Float" #("arithmetic""mathematical functions" reciprocalLogBase2 timesTwoPower:"comparing" "testing""trunc ation and round off" exponent fractionPart integerPart significand significandAsInteger"converting" asApproximateFraction asIEEE32BitWord asTrueFraction"copying") do: [:sel | Approved add: sel]."Fraction, Random" #(denominator numerator reduced next nextValue) do: [:sel | Approved add: sel]. #(setNumerator:denominator:) do: [:sel | AddAndRemove add: sel]."Collection" #("accessing" anyOne"testing" includes: includesAllOf: includesAnyOf: includesSubstringAnywhere: isEmpty isSequenceable occurrencesOf:"enumerating" collect: collect:thenSelect: count: detect: detect:ifNone: detectMax: detectMin: detectSum: inject:into: reject: select: select:thenCollect: intersection:"converting" asBag asCharacterSet asSet asSortedArray asSortedCollection asSortedCollection:"printing""private" maxSize"arithmetic""math functions" average max median min range sum) do: [:sel | Approved add: sel]. #("adding" add: addAll: addIfNotPresent:"removing" remove: remove:ifAbsent: removeAll: removeAllFo undIn: removeAllSuchThat: remove:ifAbsent:) do: [:sel | AddAndRemove add: sel]."SequenceableCollection" #("comparing" hasEqualElements:"accessing" allButFirst allButLast at:ifAbsent: atAll: atPin: atRandom: atWrap: fifth first fourth identityIndexOf: identityIndexOf:ifAbsent: indexOf: indexOf:ifAbsent: indexOf:startingAt:ifAbsent: indexOfSubCollection:startingAt: indexOfSubCollection:startingAt:ifAbsent: last second sixth third"removing""copying" , copyAfterLast: copyAt:put: copyFrom:to: copyReplaceAll:with: copyReplaceFrom:to:with: copyUpTo: copyUpToLast: copyWith: copyWithout: copyWithoutAll: forceTo:paddingWith: shuffled sorted:"enumerating" withIndexCollect: findFirst: findLast: pairsCollect: with:collect: withIndexCollect: polynomialEval:"converting" asArray asDictionary asFloat32Array asFloat64Array asIntegerArray asStringWithCr asWordArray reversed"private" copyReplaceAll:with:asTokens: ) do: [:sel | Approved add: sel]. #( swap:with:) do: [:sel | AddAndRemove add: sel]."ArrayedCollection, Bag" #("private" defaultElement "sorting" isSorted"accessing" cumulativeCounts sortedCounts sortedElements "testing" "adding" add:withOccurrences: "removing" "enumerating" ) do: [:sel | Approved add: sel]. #( mergeSortFrom:to:by: sort sort: add: add:withOccurrences:"private" setDictionary ) do: [:sel | AddAndRemove add: sel]."Other messages that modify the receiver" #(atAll:put: atAll:putAll: atAllPut: atWrap:put: replaceAll:with: replaceFrom:to:with: removeFirst removeLast) do: [:sel | AddAndRemove add: sel]. self initialize2."MethodFinder new initialize.MethodFinder new organizationFiltered: Set"! !!MissingFont methodsFor: 'handling' stamp: 'mt 3/7/2023 15:07'!defaultAction familyName ifNil: [ familyName := 'NoName' ]. pixelSize ifNil: [ pixelSize := 12 ]. ^((familyName beginsWith: 'Comic') ifTrue: [ TextStyle named: (Preferences standardButtonFont familyName) ] ifFalse: [ TextStyle default ]) fontOfSize: pixe lSize.! !!Morph methodsFor: 'accessing' stamp: 'mt 8/11/2023 16:29'!balloonText "Answer balloon help text or nil, if no help is available." "NB: subclasses may override such that they programatically construct the text, for economy's sake, such as model phrases in a Viewer." | balloonSelector | extension ifNil: [^ nil]. extension balloonText ifNotNil: [:balloonText | ^ balloonText]. balloonSelector := extension balloonTextSelector ifNil: [^ nil]. balloonSelector isUnary ifTrue: [ (self respondsTo: balloonSelector) ifTrue: [^ self perform: balloonSelector]. (self model respondsTo: balloonSelector) ifTrue: [^ self model perform: balloonSelector]]. ^ nil! !!Morph methodsFor: 'copying' stamp: 'mt 3/10/2023 14:51'!duplicate "Make and return a duplicate of the receiver" | newMorph aName w topRend | ((topRend := self topRendererOrSelf) ~~ self) ifTrue: [^ topRend duplicate]. self okayToDuplicate ifFalse: [^ self]. aName := (w := self world) ifNotNil: [w nameForCopyIfAlreadyNamed: self]. newMorph := self veryDeepCopy. aName ifNotNil: [newMorph setNameTo: aName]. newMorph arrangeToStartStepping. newMorph privateOwner: nil. "no longer in world" newMorph isPartsDonor: false. "no longer parts donor" ^ newMorph! !!Morph methodsFor: 'debug and other' stamp: 'mt 3/10/2023 15:09'!buildDebugMenu: aHand "Answer a debugging menu for the receiver. The hand argument is seemingly historical and plays no role presently" | aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu addStayUpItem. (self hasProperty: #errorOnDraw) ifTrue: [aMenu add: 'start drawing again' translated action: #resumeAfterDrawError. aMenu addLine]. (self hasProperty: #errorOnStep) ifTrue: [aMenu add: 'start stepping again' translated action: #resumeAfterStepError. aMenu addLine]. (self hasProperty: #errorOnLayout) ifTrue: [aMenu add: 'start layouting again' translated action: #resumeAfterLayoutError. aMenu addLine]. aMenu add: 'inspect morph' translated action: #inspectInMorphic:. aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain. Smalltalk isMorphic ifFalse: [aMenu add: 'inspect morph (in MVC)' translated action: #inspect]. self isMorphicModel ifTrue: [aMenu add: 'inspect model' translated target: self model action: #inspect; add: 'explore model' translated target: self model action: #explore]. aMenu add: 'explore morph' translated target: self selector: #exploreInMorphic:. aMenu addLine. aMenu add: 'browse morph class' translated target: self selector: #browseHierarchy. (self isMorphicModel) ifTrue: [aMenu add: 'browse model class' target: self model selector: #browseHierarchy]. aMenu addLine. self addViewingItemsTo: aMenu. aMenu add: 'make own subclass' translated action: #subclassMorph; add: 'save morph in file' translated action: #saveOnFile; addLine; add: 'call #tempCommand' translated action: #tempCommand; add: 'define #tempCommand' translated action: #defineTempCommand; addLine; add: 'control-menu...' translated target: self selector: #invokeMetaMenu:; add: 'edit balloon help' translated action: #editBalloonHelpText. ^ aMenu! !!Morph methodsFor: 'debug and other' stamp: 'mt 8/16/2023 17:11'!deleteAnyMouseActionIndicators self changed. (self valueOfProperty: #mouseActionIndicatorMorphs ifAbsent: [#()]) do: [ :each | each delete "one is probably enough, but be safe" ]. self removeProperty: #mouseActionIndicatorMorphs. self hasRolloverBorder: false. self removeProperty: #rolloverWidth. self removeProperty: #rolloverColor. self layoutChanged. self changed.! !!Morph methodsFor: 'dropping/grabbing' stamp: 'mt 8/4/2023 14:49'!justDroppedInto: aMorph event: anEvent "This message is sent to a dropped morph after it has been dropped on -- and been accepted by -- a drop-sensitive morph" | partsBinCase cmd | (self formerOwner notNil and: [self formerOwner ~~ aMorph]) ifTrue: [self removeHalo]. self formerOwner: nil. self formerPosition: nil. cmd := self valueOfProperty: #undoGrabCommand. cmd ifNotNil:[aMorph rememberCommand: cmd. self removeProperty: #undoGrabCommand]. (partsBinCase := aMorph isPartsBin) ifFalse: [self isPartsDonor: false]. (self isInWorld and: [partsBinCase not]) ifTrue: [self world startSteppingSubmorphsOf: self]. "Note an unhappy inefficiency here: the startStepping... call will often have already been called in the sequence leading up to entry to this method, but unfortunately the isPartsDonor: call often will not have already happened, with the result that the startStepping... call will not have resulted in the startage of the steppage."! !!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:54'!handleMouseDown: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseDown: and #mouseDown: in your custom morphs. See #handlerForMouseDown: and #mouseDownPriority." anEvent wasHandled ifTrue:[^self]. "not interested" anEvent hand removePendingBalloonFor: self. anEvent wasHandled: true. "Make me modal during mouse transitions" anEvent hand newMouseFocus: self event: anEvent. "this mouse down could be the start of a gesture, or the end of a gesture focus" (self isGestureStart: anEvent) ifTrue: [^ self gestureStart: anEvent]. self mouseDown: anEvent. (self handlesMouseStillDown: anEvent) ifTrue:[ self startStepping: #handleMouseStillDown: at: Time millisecondClockValue + self mouseStillDownThreshold arguments: {anEvent copy resetHandlerFields} stepTime: self mouseStillDownStepRate ].! !!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:54'!handleMouseEnter: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseOver: and #mouseEnter: in your custom morphs. Also see/use #handlesMouseOverDragging: and #mouseEnterDragging:." (anEvent isDraggingEvent) ifTrue:[ (self handlesMouseOverDragging: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseEnterDragging: anEvent]. ^self]. self wantsBalloon ifTrue:[anEvent hand triggerBalloonFor: self after: self balloonHelpDelayTime]. (self handlesMouseOver: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseEnter: anEvent. ].! !!Morph methodsFor: 'events-processing' stamp: 'mt 8/11/2023 15:55'!handleMouseLeave: anEvent "System level event handling. AVOID OVERRIDE if possible. Instead, please use #handlesMouseOver: and #mouseLeave: in your custom morphs. Also see/ use #handlesMouseOverDragging: and #mouseLeaveDragging:." anEvent hand removePendingBalloonFor: self. anEvent isDraggingEvent ifTrue:[ (self handlesMouseOverDragging: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseLeaveDragging: anEvent]. ^self]. (self handlesMouseOver: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseLeave: anEvent. ].! !!Morph methodsFor: 'halos and balloon help' stamp: 'mt 8/14/2023 15:59'!addHandlesTo: aHaloMorph box: box "Add halo handles to the halo. Apply the halo filter if appropriate." aHaloMorph haloBox: box. Preferences haloSpecifications do: [:aSpec | (self wantsHaloHandleWithSelector: aSpec addHandleSelector inHalo: aHaloMorph) ifTrue: [aHaloMorph perform: aSpec addHandleSelector with: aSpec]]. aHaloMorph innerTarget addOptionalHandlesTo: aHaloMorph box: box! !!Morph methodsFor: 'halos and balloon help' stamp: 'mt 8/11/2023 16:50'!balloonHelpTextForHandle: aHandle "Answer a string providing balloon help for the given halo handle" | itsSelector | itsSelector := aHandle eventHandler firstMouseSelector. itsSelector == #doRecolor:with: ifTrue: [^ 'Change color']. itsSelector == #mouseDownInDimissHandle:with: ifTrue: [^ TrashCanMorph preserveTrash ifTrue: ['Move to trash'] ifFalse: ['Remove from screen']]. #(#(#addFullHandles 'More halo handles') #(#addSimpleHandles 'Fewer halo handles') #(#chooseEmphasisOrAlignment 'Emphasis & alignment') #(#chooseFont 'Change font') #(#chooseStyle 'Change style') #(#dismiss 'Remove') #(#doDebug:with: 'Debug') #(#doDirection:with: 'Choose forward direction') #(#doDup:with: 'Duplicate') #(#doMenu:with: 'Menu') #(#doGrab:with: 'Pick up') #(#editButtonsScript 'See the script for this button') #(#editDrawing 'Repaint') #(#mouseDownInCollapseHandle:with: 'Collapse') #(#mouseDownOnHelpHandle: 'Help') #(#paintBackground 'Paint background') #(#prepareToTrackCenterOfRotation:with: 'Move object or set center of rotation') #(#presentViewMenu 'Present the Viewing menu') #(#startDrag:with: 'Move') #(#startGrow:with: 'Change size (Ctrl + drag blue button)') #(#startRot:with: 'Rotate') #(#startScale:with: 'Change scale') #(#tearOffTile 'Make a tile representing this object') #(#trackCenterOfRotation:with: 'Set center of rotation') ) do: [:pair | itsSelector == pair first ifTrue: [^ pair last]]. ^ 'unknown halo handle'translated! !!Morph methodsFor: 'menu' stamp: 'mt 8/11/2023 14:44'!addYellowButtonMenuItemsTo: aMenu event: evt "Populate aMenu with appropriate menu items for a yellow-button (context menu) click." aMenu defaultTarget: self. "" aMenu addStayUpItem. "" self addModelYellowButtonItemsTo: aMenu event: evt. "" Preferences generalizedYellowButtonMenu ifFalse: [^ self]. "" aMenu addLine. aMenu add: 'insp ect' translated action: #inspect. "" aMenu addLine. self world selectedObject == self ifTrue: [aMenu add: 'deselect' translated action: #removeHalo] ifFalse: [aMenu add: 'select' translated action: #addHalo]. "" self isWorldMorph ifFalse: ["" aMenu addLine. aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: evt hand]. "" self isWorldMorph ifFalse: ["" Smalltalk at: #NCAAConnectorMorph ifPresent: [:connectorClass | aMenu addLine. aMenu add: 'connect to' translated action: #startWiring. aMenu addLine]. "" self isFullOnScreen ifFalse: [aMenu add: 'move onscreen' translated action: #goHome]]. "" self addLayoutMenuItems: aMenu hand: evt hand. (owner notNil and: [owner isTextMorph]) i fTrue: [self addTextAnchorMenuItems: aMenu hand: evt hand]. "" self isWorldMorph ifFalse: ["" aMenu addLine. self addToggleItemsToHaloMenu: aMenu]. "" aMenu addLine. self isWorldMorph ifFalse: [aMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:]. self hasStrings ifTrue: [ aMenu add: 'copy text' translated action: #clipText]. "" self addExportMenuItems: aMenu hand: evt hand. "" self isWorldMorph not ifTrue: ["" aMenu addLine. aMenu add: 'adhere to edge...' translated action: #adhereToEdge]. "" self addCustomMenuItems: aMenu hand: evt hand! !!Morph methodsFor: 'menu' stamp: 'mt 3/10/2023 16:07'!wantsYellowButtonMenu "Answer true if the receiver wants a yellow button menu" self valueOfProperty: #wantsYellowButtonMenu ifPresentDo: [:value | ^ value]. "" self isInSystemWindow ifTrue: [^ false]."" ^ Preferences generalizedYellowButtonMenu! !!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:59'!absorbStateFromRenderer: aRenderer "Transfer knownName, actorState, visible over from aRenderer, which was formerly imposed above me as a transformation shell but is now going away." | current | (current := aRenderer actorStateOrNil) ifNotNil: [self actorState: current. aRenderer actorState: nil]. (current := aRenderer knownName) ifNotNil: [self setNameTo: current. aRenderer setNameTo: nil]. self visible: aRenderer visible! !!Morph methodsFor: 'menus' stamp: 'mt 3/10/2023 14:25'!addHaloActionsTo: aMenu "Add items to aMenu representing actions requestable via halo" | subMenu | subMenu := MenuMorph new defaultTarget: self. subMenu addTitle: self externalName. subMenu addStayUpItemSpecial. subMenu addLine. subMenu add: 'delete' translated action: #dismissViaHalo. subMenu balloonTextForLastItem: 'Delete this object -- warning -- can be destructive!!' translated. self maybeAddCollapseItemTo: subMenu. subMenu add: 'grab' translated action: #openInHand. subMenu balloonTextForLastItem: 'Pick this object up -- warning, since this removes it from its container, it can have adverse effects.' translated. subMenu addLine. subMenu add: 'resize' translated action: #resizeFromMenu. subMenu balloonTextForLastItem: 'Change the size of this object' translated. subMenu add: 'duplicate' translated action: #maybeDuplicateMorph. subMenu balloonTextForLastItem: 'Hand me a copy of this object' translated. "Note that this allows access to the non-instancing duplicate even when this is a uniclass instance" subMenu addLine. subMenu add: 'set color' translated target: self renderedMorph action: #changeColor. subMenu balloonTextForLastItem: 'Change the color of this object' translated. subMenu addLine. subMenu add: 'inspect' translated target: self action: #inspect. subMenu balloonTextForLastItem: 'Open an Inspector on this object' translated. aMenu add: 'halo actions...' translated subMenu: subMenu! !!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:47'!addMiscExtrasTo: aMenu "Add a submenu of miscellaneous extra items to the menu." | realOwner realMorph subMenu | subMenu := MenuMorph new defaultTarget: self. self isWorldMorph ifFalse: [subMenu add: 'adhere to edge...' translated action: #adhereToEdge. subMenu addLine]. realOwner := (realMorph := self topRendererOrSelf) owner. (realOwner isKindOf: TextPlusPasteUpMorph) ifTrue: [subMenu add: 'GeeMail stuff...' translated subMenu: (realOwner textPlusMenuFor: realMorph)]. subMenu add: 'add mouse up action' translated action: #addMouseUpAction; add: 'remove mouse up action' translated action: #removeMouseUpAction; add: 'hand me tiles to fire this button' translated action: #handMeTilesToFire. subMenu addLine. subMe nu add: 'arrowheads on pen trails...' translated action: #setArrowheads. subMenu addLine. subMenu defaultTarget: self topRendererOrSelf. subMenu add: 'draw new path' translated action: #definePath. subMenu add: 'follow existing path' translated action: #followPath. subMenu add: 'delete existing path' translated action: #deletePath. subMenu addLine. self addGestureMenuItems: subMenu hand: self currentHand. aMenu add: 'extras...' translated subMenu: subMenu! !!Morph methodsFor: 'menus' stamp: 'mt 8/16/2023 15:58'!addStandardHaloMenuItemsTo: aMenu hand: aHandMorph "Add standard halo items to the menu" | unlockables | self isWorldMorph ifTrue: [^ self addWorldHaloMenuItemsTo: aMenu hand: aHandMorph]. aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: aHandMorph. aMenu addLine. self addFillStyleMenuItems: aMenu hand: aHandMorph. self addBorderStyleMenuItems: aMenu hand: aHandMorph. self addDropShadowMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph. self addHaloActionsTo: aMenu. owner isTextMorph ifTrue:[self addTextAnchorMenuItems: aMenu hand: aHandMorph]. aMenu addLine. self addToggleItemsToHaloMenu: aMenu. aMenu addLine. self addCopyItemsTo: aMenu. self addExportMenuItems: aMenu hand: aHandMorph. self addMiscExtrasTo: aMenu. self addDebuggingItemsTo: aMenu hand: aHandMorph. aMenu addLine. aMenu defaultTarget: self. aMenu addLine. unlockables := self submorphs select: [:m | m isLocked]. unlockables size = 1 ifTrue: [aMenu add: ('unlock "{1}"' translated format: unlockables first externalName) action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' translated action: #unlockContents]. aMenu defaultTarget: aHandMorph.! !!Morp h methodsFor: 'menus' stamp: 'mt 3/10/2023 16:06'!addToggleItemsToHaloMenu: aMenu "Add standard true/false-checkbox items to the memu" #( (resistsRemovalString toggleResistsRemoval 'whether I should be reistant to easy deletion via the pink X handle') (stickinessString toggleStickiness 'whether I should be resistant to a drag done by mousing down on me') (lockedString lockUnlockMorph 'when "locked", I am inert to all user interactions') (hasClipSubmorphsString changeClipSubmorphs 'whether the parts of objects within me that are outside my bounds should be masked.') (hasDirectionHandlesString changeDirectionHandles 'whether direction handles are shown with the halo') (hasDragEnabledString changeDrag 'whether I am open to having objects dragged out of me') (hasDropEnabledString changeDrop 'whether I am open to having objects dropped into me') ) do: [:each | aMenu addUpdating: each first action: eac h second. aMenu balloonTextForLastItem: each third translated]. self couldHaveRoundedCorners ifTrue: [aMenu addUpdating: #roundedCornersString action: #toggleCornerRounding. aMenu balloonTextForLastItem: 'whether my corners should be rounded' translated]! !!Morph methodsFor: 'menus' stamp: 'mt 8/11/2023 15:59'!transferStateToRenderer: aRenderer "Transfer knownName, actorState, visible over to aRenderer, which is being imposed above me as a transformation shell" | current | (current := self actorStateOrNil) ifNotNil: [aRenderer actorState: current. self actorState: nil]. (current := self knownName) ifNotNil: [aRenderer setNameTo: current. self setNameTo: nil]. aRenderer simplySetVisible: self visible ! !!Morph methodsFor: 'meta-actions' stamp: 'mt 3/10/2023 16:06'!buildHandleMenu: aHand "Build the morph menu for the given morph's halo's menu handle. This menu has two sections. The first section con tains commands that are interpreted by the hand; the second contains commands provided by the target morph. This method allows the morph to decide which items should be included in the hand's section of the menu." | menu | menu := MenuMorph new defaultTarget: self. menu addStayUpItem. menu addLine. self addStandardHaloMenuItemsTo: menu hand: aHand. menu defaultTarget: aHand. self addAddHandMenuItemsForHalo: menu hand: aHand. menu defaultTarget: self. self addCustomHaloMenuItems: menu hand: aHand. menu defaultTarget: aHand. ^ menu! !!Morph methodsFor: 'naming' stamp: 'mt 3/8/2023 10:49'!renameTo: aName self knownName = aName ifTrue: [^ aName]. self topRendererOrSelf setNameTo: aName. ^ aName! !!Morph methodsFor: 'stepping' stamp: 'mt 8/28/2023 15:14'!step "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message."! !!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:53'!stepAt: millisecondClockValue "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message. The millisecondClockValue parameter gives the value of the millisecond clock at the moment of dispatch. Default is to dispatch to the parameterless step method for the morph, but this protocol makes it possible for some morphs to do differing things depending on the clock value" self step! !!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:53'!stepTime "Answer the desired time between steps in milliseconds. This default implementation requests that the 'step' method be called once every second." ^ 1000! !!Morph methodsFor: 'stepping' stamp: 'mt 3/10/2023 14:57'!wantsSteps "Return true if the receiver overrides the default Morph step method." "Details: Find first cla ss in superclass chain that implements #step and return true if it isn't class Morph." | c | self isPartsDonor ifTrue: [^ false]. c := self class. [c includesSelector: #step] whileFalse: [c := c superclass]. ^ c ~= Morph! !!Morph methodsFor: 'thumbnail' stamp: 'mt 8/14/2023 17:40'!representativeNoTallerThan: maxHeight norWiderThan: maxWidth thumbnailHeight: thumbnailHeight "Return a morph representing the receiver but which is no taller than aHeight. If the receiver is already small enough, just return it, else return a MorphThumbnail companioned to the receiver, enforcing the maxWidth. If the receiver personally *demands* thumbnailing, do it even if there is no size-related reason to do it." self permitsThumbnailing ifFalse: [^ self]. (self fullBounds height <= maxHeight and: [self fullBounds width <= maxWidth]) ifTrue: [^ self]. ^ MorphThumbnail new extent: maxWidth @ (thumbnailHeight min: self fullBounds height); morphRepresented: self! !!Morph metho dsFor: 'WiW support' stamp: 'mt 3/7/2023 15:07'!eToyRejectDropMorph: morphToDrop event: evt | tm am | tm := TextMorph new beAllFont: ((TextStyle named: Preferences standardButtonFont familyName) fontOfSize: 24); contents: 'GOT IT!!'. (am := AlignmentMorph new) color: Color yellow; layoutInset: 10; useRoundedCorners; vResizing: #shrinkWrap; hResizing: #shrinkWrap; addMorph: tm; fullBounds; position: (self bounds center - (am extent // 2)); openInWorld: self world. SoundService default playSoundNamed: 'yum' ifAbsentReadFrom: 'yum.aif'. morphToDrop rejectDropMorphEvent: evt. "send it back where it came from" am delete! !!Morph methodsFor: 'private' stamp: 'mt 3/10/2023 14:53'!privateMoveBy: delta "Private!! Use 'position:' instead." | fill | bounds := bounds translateBy: delta. fullBounds ifNotNil: [fullBounds := fullBounds translateBy: delta]. fill := self fillStyle. fill isOrientedFill ifTrue: [fill origin: fill origin + delta]! !!Morph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/10/2023 14:50'!delete "Remove the receiver as a submorph of its owner and make its new owner be nil." | oldWorld | self removeHalo. (oldWorld := self world) ifNotNil: [ self disableSubmorphFocusForHand: self activeHand. self activeHand releaseKeyboardFocus: self; releaseMouseFocus: self]. owner ifNotNil: [ self privateDelete. "remove from world"].! !!Morph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/10/2023 14:27'!goBehind "Move the receiver to bottom z-order." | topRend | topRend := self topRendererOrSelf. topRend owner ifNotNil: [:own | own addMorphBack: topRend]! !!Morph methodsFor: 'submorphs - layers' stamp: 'dgd 8/31/2004 16:21'!wantsToBeTopmost "Answer if the receiver want to be one of the topmost objects in its owner" ^ self isFlapOrTab! !!BorderedMorph method sFor: 'menu' stamp: 'mt 4/11/2018 08:30'!changeBorderWidth: evt | handle origin aHand newWidth oldWidth | aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand]. origin := aHand position. oldWidth := self borderWidth. (handle := HandleMorph new) forEachPointDo: [:newPoint | handle removeAllMorphs. handle addMorph: (LineMorph from: origin to: newPoint color: Color black width: 1). newWidth := (newPoint - origin) r asInteger // 5. self borderWidth: newWidth] lastPointDo: [:newPoint | handle deleteBalloon. self halo ifNotNil: [:halo | halo addHandles]. self rememberCommand: (Command new cmdWording: 'border change' translated; undoTarget: self selector: #borderWidth: argument: oldWidth; redoTarget: self selector: #borderWidth: argument: newWidth)]. aHand attachMorph: handle. handle setProperty: #helpAtCe nter toValue: true. handle showBalloon:'Move cursor farther fromthis point to increase border width.Click when done.' translated hand: evt hand. handle startStepping! !!AlignmentMorph methodsFor: 'geometry' stamp: 'mt 3/7/2023 14:37'!addTransparentSpacerOfSize: aPoint "Required for several MorphicExtras and other non-Etoys stuff." self addMorphBack: ((Morph new extent: aPoint asPoint) color: Color transparent)! !!BookPageSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'!addControls "Add the control bar at the top of the tool." | bb r str aCheckbox aWrapper | r := AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0. r wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5(a)5. bb := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated font: Preferences standardButtonFont ; actionSelector: #acceptSort)). bb setBalloonText: 'Accept the changes made here as the new page-order for this book' translated. r addTransparentSpacerOfSize: 12. bb := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #delete)). bb setBalloonText: 'Forgot any changes made here, and dismiss this sorter' translated. "eliminate the parts-bin button on the book-page sorters... r addTransparentSpacerOfSize: 24 @ 0. aCheckbox := UpdatingThreePhaseButtonMorph checkBox. aCheckbox target: self; actionSelector: #togglePartsBinStatus; arguments: #(); getSelector: #getPartsBinStatus. str := StringMorph contents: 'Parts bin' translated font: Preferences standardButtonFont. aWrapper := AlignmentMorph newRow beTransparent. aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0. aWrapper
addMorphBack: (self wrapperFor: aCheckbox); addMorphBack: (self wrapperFor: str lock). r addMorphBack: aWrapper." self addMorphFront: r! !!BookPageSorterMorph methodsFor: 'initialization' stamp: 'mt 8/16/2023 13:52'!initialize "initialize the state of the receiver" super initialize. "" self extent: Display extent - 100; listDirection: #topToBottom; wrapCentering: #topLeft; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 3. pageHolder := PasteUpMorph new. pageHolder vResizeToFit: true; autoLineLayout: true. pageHolder extent: self extent - self borderWidth. pageHolder hResizing: #shrinkWrap. "pageHolder cursor: 0." "causes a walkback as of 5/25/2000" self addControls. self addMorphBack: pageHolder! !!BooklikeMorph methodsFor: 'misc' stamp: 'mt 8/4/2023 13:41'!playPageFlipSound: soundName PageFlipSoundOn "mechanism to suppress sounds at init time" ifTrue: [self playSoundNamed: soundName].! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:39'!addBookMenuItemsTo: aMenu hand: aHandMorph | controlsShowing subMenu | subMenu := MenuMorph new defaultTarget: self. subMenu add: 'previous page' translated action: #previousPage. subMenu add: 'next page' translated action: #nextPage. subMenu add: 'goto page' translated action: #goToPage. subMenu add: 'insert a page' translated action: #insertPage. subMenu add: 'delete this page' translated action: #deletePage. controlsShowing := self hasSubmorphWithProperty: #pageControl. controlsShowing ifTrue: [subMenu add: 'hide page controls' translated action: #hidePageControls. subMenu add: 'fewer page controls' translated action: #fewerPageControls] ifFalse: [subMenu add: 'show page controls' translated action: #showPageControls]. self isInFullScreenMode ifTrue: [ subMenu add: 'exit full screen' translated action: #exitFullScreen. ] ifFalse: [ subMenu add: 'show full screen' translated action: #goFullScreen. ]. subMenu addLine. subMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:. subMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:. subMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:. subMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:. subMenu addLine. subMenu add: 'sort pages' translated action: #sortPages:. subMenu add: 'uncache page sorter' translated action: #uncachePageSorter. (self hasProperty: #dontWrapAtEnd) ifTrue: [subMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true] ifFalse: [subMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false]. subMenu addLine. subMenu add: 'search for text' translated action: #textSearch. (aHandMorph pasteBuffer class isKindOf: PasteUpMorph class) ifTrue: [subMenu add: 'paste book page' translated action: #pasteBookPage]. subMenu add: 'send all pages to server' translated action: #savePagesOnURL. subMenu add: 'send this page to server' translated action: #saveOneOnURL. subMenu add: 'reload all from server' translated action: #reload. subMenu add: 'copy page url to clipboard' translated action: #copyUrl. subMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype. newPagePrototype ifNotNil: [subMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype]. aMenu add: 'book...' translated subMenu: subMenu! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/11/2023 14:44'!invokeBookMenu "Invoke the book's control panel menu." | aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'Book' translated. aMenu addStayUpItem. aMenu add: 'find...' translated action: #textSearch. aMenu add: 'go to page...' translated action: #goToPage. aMenu addLine. aMenu addList: { {'sort pages' translated. #sortPages}. {'uncache page sorter' translated. #uncachePageSorter}}. (self hasProperty: #dontWrapAtEnd) ifTrue: [aMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true] ifFalse: [aMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false]. aMenu addList: { {'make bookmark' translated. #bookmarkForThisPage}. {'make thumbnail' translated. #thumbnailForThisPage}}. aMenu addUpdating: #showingPageControlsString action: #toggleShowingOfPageControls. aMenu addUpdating: #showingFullScreenString action: #toggleFullScreen. aMenu addLine. aMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:. aMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:. aMen u add: 'visual effect for all pages' translated action: #menuPageVisualForAll:. aMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:. aMenu addLine. (self primaryHand pasteBuffer class isKindOf: PasteUpMorph class) ifTrue: [aMenu add: 'paste book page' translated action: #pasteBookPage]. aMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype. newPagePrototype ifNotNil: [ aMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype]. aMenu add: (self dragNDropEnabled ifTrue: ['close dragNdrop'] ifFalse: ['open dragNdrop']) translated action: #changeDragAndDrop. aMenu add: 'make all pages this size' translated action: #makeUniformPageSize. aMenu addUpdating: #keepingUniformPageSizeString target: self action: #toggleMaintainUniformPageSize. aMenu addLine. aMenu add: 'send all pages to server' translated action: #savePagesOnURL . aMenu add: 'send this page to server' translated action: #saveOneOnURL. aMenu add: 'reload all from server' translated action: #reload. aMenu add: 'copy page url to clipboard' translated action: #copyUrl. aMenu addLine. aMenu add: 'load PPT images from slide #1' translated action: #loadImagesIntoBook. aMenu add: 'background color for all pages...' translated action: #setPageColor. aMenu add: 'make a thread of projects in this book' translated action: #buildThreadOfProjects. aMenu popUpEvent: self world activeHand lastEvent in: self world! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:38'!saveAsNumberedURLs "Write out all pages in this book that are not showing, onto a server. The local disk could be the server. For any page that does not have a SqueakPage and a url already, name that page file by its page number. Any pages that are already totally out will stay that way." | stem list firstTime | firstTime := (self valueOfProperty: #url ) isNil. stem := self getStemUrl. "user must approve" stem isEmpty ifTrue: [^self]. firstTime ifTrue: [self setProperty: #futureUrl toValue: stem , '.bo']. self reserveUrlsIfNeeded. pages withIndexDo: [:aPage :ind | "does write the current page too" aPage isInMemory ifTrue: ["not out now" aPage saveOnURL: stem , ind printString , '.sp']]. list := pages collect: [:aPage | aPage sqkPage prePurge]. "knows not to purge the current page" list := (list select: [:each | each notNil]) asArray. "do bulk become:" (list collect: [:each | each contentsMorph]) elementsExchangeIdentityWith: (list collect: [:spg | MorphObjectOut new xxxSetUrl: spg url page: spg]). self saveIndexOnURL. firstTime ifTrue: ["Put a thumbnail into the hand" URLMorph grabForBook: self. self setProperty: #futureUrl toValue: nil " clean up"]! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:39'!saveOnUrlPage: pageMorph "Write out this single page in this book onto a server. See savePagesOnURL. (Don't compute the texts, only this page's is written.)" | stem ind response rand newPlace dir | "Don't give the chance to put in a different place. Assume named by number" ((self valueOfProperty: #url) isNil and: [pages first url notNil]) ifTrue: [response := Project uiManager chooseOptionFrom: {'Old book' translated. 'New book sharing old pages' translated} title: 'Modify the old book, or make a new book sharing its pages?' translated. response = 2 ifTrue: ["Make up new url for .bo file and confirm with user." "Mark as shared" [rand := String new: 4. 1 to: rand size do: [:ii | rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)]. (newPlace := self get StemUrl) ifEmpty: [^ self]. newPlace := (newPlace copyUpToLast: $/), '/BK', rand, '.bo'. dir := ServerFile new fullPath: newPlace. (dir includesKey: dir fileName)] whileTrue. "keep doing until a new file" self setProperty: #url toValue: newPlace]. response = 0 ifTrue: [^ self]]. stem := self getStemUrl. "user must approve" stem ifEmpty: [^ self]. ind := pages identityIndexOf: pageMorph ifAbsent: [self error: 'where is the page?' translated]. pageMorph isInMemory ifTrue: "not out now" [pageMorph saveOnURL: stem,(ind printString),'.sp']. self saveIndexOfOnly: pageMorph.! !!BookMorph methodsFor: 'menu' stamp: 'mt 8/4/2023 13:40'!savePagesOnURL "Write out all pages in this book onto a server. For any page that does not have a SqueakPage and a url already, ask the user for one. Give the option of naming all page files by page number. Any pages that are not in memory will stay that way. The local disk coul d be the server." | response list firstTime newPlace rand dir bookUrl | self getAllText. "stored with index later" response := Project uiManager chooseOptionFrom: {'Use page numbers' translated. 'Type in file names' translated. 'Save in a new place (using page numbers)' translated. 'Save in a new place (typing names)' translated. 'Save new book sharing old pages' translated. } title: 'Each page will be a file on the server. Do you want to page numbers be the names of the files? or name each one yourself?' translated. response = 1 ifTrue: [self saveAsNumberedURLs. ^ self]. response = 3 ifTrue: [self forgetURLs; saveAsNumberedURLs. ^ self]. response = 4 ifTrue: [self forgetURLs]. response = 5 ifTrue: ["Make up new url for .bo file and confirm with user." "Mark as shared" [rand := String new: 4. 1 to: rand size do: [:ii | rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)]. (newPlace := self getStemUrl) isEmpty ifTrue: [^ self]. newPlace := (newPlace copyUpToLast: $/), '/BK', rand, '.bo'. dir := ServerFile new fullPath: newPlace. (dir includesKey: dir fileName)] whileTrue. "keep doing until a new file" self setProperty: #url toValue: newPlace. self saveAsNumberedURLs. bookUrl := self valueOfProperty: #url. (SqueakPage stemUrl: bookUrl) = (SqueakPage stemUrl: currentPage url) ifTrue: [bookUrl := true]. "not a shared book" (URLMorph grabURL: currentPage url) book: bookUrl. ^ self]. response = 0 ifTrue: [^ self]. "self reserveUrlsIfNeeded. Need two passes here -- name on one, write on second" pages do: [:aPage | "does write the current page too" aPage isInMemory ifTrue: "not out now" [aPage saveOnURLbasic]]. "ask user if no url" list := pages collect: [:aPage | aPage sqkPage prePurge]. "knows not to purge the current page" list := (list select: [:each | each notNil]) asArray. "do bulk become:" (list collect: [:each | each contentsMorph]) elementsExchangeIdentityWith: (list collect: [:spg | MorphObjectOut new xxxSetUrl: spg url page: spg]). firstTime := (self valueOfProperty: #url) isNil. self saveIndexOnURL. firstTime ifTrue: "Put a thumbnail into the hand" [URLMorph grabForBook: self. self setProperty: #futureUrl toValue: nil]. "clean up"! !!BookMorph methodsFor: 'navigation' stamp: 'mt 8/4/2023 13:34'!goToPageMorph: aMorph "Set the given morph as the current page; run closing and opening scripts as appropriate" self goToPage: (pages identityIndexOf: aMorph ifAbsent: [^ self "abort"]) transitionSpec: nil! !!BookMorph methodsFor: 'navigation' stamp: 'mt 8/4/2023 13:30'!goToPageMorph: newPage transitionSpec: transitionSpec "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly. Apply the transitionSpec provided." | pageIndex aWorld oldPageIndex ascending tSpec readIn | pages isEmpty ifTrue: [^self]. self setProperty: #searchContainer toValue: nil. "forget previous search" self setProperty: #searchOffset toValue: nil. self setProperty: #searchKey toValue: nil. pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"]. readIn := newPage isInMemory not. oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil]. ascending := (oldPageIndex isNil or: [newPage == currentPage]) ifTrue: [nil] ifFalse: [oldPageIndex < pageIndex]. tSpec := transitionSpec ifNil: ["If transition not specified by requestor..." newPage valueOfProperty: #transitionSpec
ifAbsent: [" ... then consult new page" self transitionSpecFor: self " ... otherwise this is the default"]]. self flag: #arNote. "Probably unnecessary" (aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus]. currentPage ifNotNil: [currentPage updateCachedThumbnail]. self currentPage notNil ifTrue: [(((pages at: pageIndex) owner isKindOf: TransitionMorph) and: [(pages at: pageIndex) isInWorld]) ifTrue: [^self "In the process of a prior pageTurn"]. ascending ifNotNil: ["Show appropriate page transition and start new page when done" currentPage stopStepping. (pages at: pageIndex) position: currentPage position. ^(TransitionMorph effect: tSpec second direction: tSpec third inve rse: (ascending or: [transitionSpec notNil]) not) showTransitionFrom: currentPage to: (pages at: pageIndex) in: self whenStart: [self playPageFlipSound: tSpec first] whenDone: [currentPage delete; fullReleaseCachedState. self insertPageMorphInCorrectSpot: (pages at: pageIndex). self adjustCurrentPageForFullScreen. self snapToEdgeIfAppropriate. aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. aWorld := self world. readIn ifTrue: [currentPage updateThumbnailUrlInBook: self url. currentPage sqkPage computeThumbnail "just store it"]]]. "No transition, but at least decommission current page" currentPage delete; fullReleaseCachedState]. self insertPageMorphInCorrectSpot: (pages at: pageIndex). "sets currentPage" self adjustCurrentPageForFullScreen. self snapToEdgeIfAppropriate. aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. aWorld := self world. readIn ifTrue: [currentPage updateThumbnailUrl. currentPage sqkPage computeThumbnail "just store it"].! !!DockingBarMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 16:05'!wantsYellowButtonMenu "Answer true if the receiver wants a yellow button menu" ^ true! !!EventRecorderMorph methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:52'!makeStatusLightIn: aPoint ^statusLight := EllipseMorph new extent: aPoint; color: Color green ; borderWidth: 0! !!GraphMorph methodsFor: 'accessing'!valueAtCursor: aPointOrNumber data isEmpty ifTrue: [^ 0]. data at: ((cursor truncated max: 1) min: data size) put: (self asNumber: aPointOrNumber). self flushCachedForm.! !!GraphMorph methodsFor: 'commands'!appendValue: aPointOrNumber | newVal | (data isKindOf: OrderedCollection) ifFalse: [data := data asOrderedCollection]. newVal := self asNumber: aPointOrNumber. data addLast: newVal. newVal < minVal ifTrue: [minVal := newVal]. newVal > maxVal ifTrue: [maxVal := newVal]. self cursor: data size. self flushCachedForm.! !!GraphMorph methodsFor: 'private' stamp: 'mt 8/14/2023 16:25'!asNumber: aPointOrNumber ^ aPointOrNumber isPoint ifTrue: [aPointOrNumber r] ifFalse: [aPointOrNumber]! !!GraphicalDictionaryMenu methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'!initializeFor: aTarget fromDictionary: aDictionary "Initialize me for a target and a dictionary ." | anIndex aButton | self baseDictionary: aDictionary. target := aTarget. coexistWithOriginal := true. self extent: 210 @ 210. self clipSubmorphs: true. self layoutPolicy: ProportionalLayout new. aButton := (IconicButton new) borderWidth: 0; labelGraphic: (MenuIcons formAtKey: 'TinyMenu'); color: Color transparent; actWhen: #buttonDown; actionSelector: #showMenu; target: self; setBalloonText: 'menu'. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (-50 @ 6 extent: aButton extent)). aButton := (SimpleButtonMorph new) target: self; borderColor: Color black; label: 'Prev'; actionSelector: #downArrowHit; actWhen: #whilePressed; setBalloonText: 'show previous picture'; yourself. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (-24 @ 4 extent: aButton extent)). aButton := (SimpleButtonMorph new) target: self; borderColor: Color black; label: 'Next'; actionSelector: #upArrowHit; actWhen: #whilePressed; setBalloonText: 'show next pictutre'. self addMorph: aButton fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) offsets: (24 @ 4 extent: aButton extent)). self addMorph: ((UpdatingStringMorph new) contents: ' '; target: self; putSelector: #renameGraphicTo:; getSelector: #truncatedNameOfGraphic; useStringFormat; setBalloonText: 'The name of the current graphic'; yourself) fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ 0) offsets: (10 @ 40 corner: -10 @ 60)). self addMorph: ((Morph new) extent: 100 @ 4; color: Color black) fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ 0) offsets: (0 @ 60 corner: 0 @ 64)). formDisplayMorph := (Thumbnail new) extent: 100 @ 100; useInterpolation: true; maxWidth: 300 minHeight: 100; yourself. formDisplayMorph layoutFrame: (LayoutFrame fractions: (0 @ 0 extent: 0(a)0) offsets: (8 @ 72 corner: 108 @ 172)). self addMorph: formDisplayMorph. self minimumExtent: 116(a)180. target ifNotNil: [(anIndex := formChoices indexOf: target form ifAbsent: []) ifNotNil: [currentIndex := anIndex]]. self updateThumbnail! !!GraphicalDictionaryMenu methodsFor: 'menu commands' stamp: 'mt 8/16/2023 13:50'!repaintEntry "Let the user enter into painting mode to repaint the item and save it back." | aWorld bn ds sketchEditor aPaintBox formToEdit | (aWorld := self world) assureNotPaintingElse: [^ self]. formToEdit := formChoices at: currentIndex. bnds := (submorphs second boundsInWorld origin extent: formToEdit extent) intersect: aWorld bounds. bnds := bnds expandBy: 60(a)60. sketchEditor := SketchEditorMorph new. aWorld addMorphFront: sketchEditor. sketchEditor initializeFor: ((aWorld drawingClass withForm: formToEdit) position: submorphs second positionInWorld) inBounds: bnds pasteUpMorph: aWorld paintBoxPosition: bnds topRight. sketchEditor afterNewPicDo: [:aForm :aRect | formChoices at: currentIndex put: aForm. baseDictionary at: (entryNames at: currentIndex) put: aForm. self updateThumbnail. (aPaintBox := aWorld paintBoxOrNil) ifNotNil: [aPaintBox delete]] ifNoBits: [(aPaintBox := aWorld paintBoxOrNil) ifNotNil: [aPaintBox delete]]. ! !!HandMorph methodsFor: 'paste buffer' stamp: ' mt 3/10/2023 14:49'!pasteMorph | aPastee | PasteBuffer ifNil: [^ self inform: 'Nothing to paste.' translated]. self attachMorph: (aPastee := self objectToPaste). aPastee align: aPastee center with: self position.! !!HandMorphForReplay methodsFor: 'event handling' stamp: 'mt 8/28/2023 14:05'!processEvents "Play back the next event" | evt hadMouse hadAny tracker | suspended == true ifTrue: [^ self]. hadMouse := hadAny := false. tracker := recorder objectTrackingEvents. [(evt := recorder nextEventToPlay) isNil] whileFalse: [ ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self]. tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp]. evt type == #EOF ifTrue: [recorder pauseIn: self currentWorld. ^ self]. evt type == #startSound ifTrue: [evt argument play. re corder synchronize. ^ self]. evt isMouse ifTrue: [hadMouse := true]. (evt isMouse or: [evt isKeyboard]) ifTrue: [self handleEvent: (evt setHand: self) resetHandlerFields. hadAny := true]]. (mouseClickState notNil and: [hadMouse not]) ifTrue: ["No mouse events during this cycle. Make sure click states time out accordingly" mouseClickState handleEvent: lastMouseEvent asMouseMove from: self]. hadAny ifFalse: ["No pending events. Make sure z-order is up to date" self mouseOverHandler processMouseOver: lastMouseEvent]! !!ImageMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:15'!setNewImageFrom: formOrNil "Change the receiver's image to be one derived from the supplied form. If nil is supplied, clobber any existing image in the receiver, and in its place put a default graphic, either the one known to the receiver as it s default value" formOrNil ifNotNil: [^ self image: formOrNil]. self image: (Form extent: 16(a)16 depth: 32)! !!GrabPatchMorph methodsFor: 'dropping' stamp: 'mt 8/14/2023 17:31'!wantsToBeDroppedInto: aMorph "Only into PasteUps that are not part bins" ^ aMorph isWorldMorph! !!GrabPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:11'!initialize "Initialize the receiver. Emblazon the GrabPatch icon on its face" super initialize. self image: (MenuIcons formAtKey: 'GrabPatch'). self setProperty: #ignorePartsBinDrop toValue: true! !!GrabPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:11'!initializeToStandAlone "Initialize the receiver. Emblazon the GrabPatch icon on its face" super initializeToStandAlone. self image: (MenuIcons formAtKey: 'GrabPatch')! !!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'mt 8/23/2023 13:48'!insertNewProject [MorphicProject openViewOn: nil] on: ProjectViewOpenNotifica tion do: [ :ex | ex resume: false].! !!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'mt 8/11/2023 14:44'!moreCommands "Put up a menu of options" | allThreads aMenu others target | allThreads := self class knownThreads. aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'navigation' translated. self flag: #deferred. "Probably don't want that stay-up item, not least because the navigation-keystroke stuff is not dynamically handled" aMenu addStayUpItem. others := (allThreads keys reject: [ :each | each = threadName]) asArray sort. others do: [ :each | aMenu add: ('switch to <{1}>' translated format:{each}) selector: #switchToThread: argument: each ]. aMenu addList: { {'switch to recent projects' translated. #getRecentThread}. #-. {'create a new thread' translated. #threadOfNoProjects}. {'edit this thread' translated. #editThisThread}. {'create thread of all projects' transl ated. #threadOfAllProjects}. #-. {'First project in thread' translated. #firstPage}. {'Last project in thread' translated. #lastPage} }. (target := self currentIndex + 2) > listOfPages size ifFalse: [ aMenu add: ('skip over next project ({1})' translated format:{(listOfPages at: target - 1) first}) action: #skipOverNext ]. aMenu addList: { {'jump within this thread' translated. #jumpWithinThread}. {'insert new project' translated. #insertNewProject}. #-. {'simply close this navigator' translated. #delete}. {'destroy this thread' translated. #destroyThread}. #- }. (self currentWorld keyboardNavigationHandler == self) ifFalse:[ aMenu add: 'start keyboard navigation with this thread' translated action: #startKeyboardNavigation ] ifTrue: [ aMenu add: 'stop keyboard navigation with this thread' translated action: #stopKeyboardNavigation ]. aMenu popUpInWorld.! !!LassoPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'!initialize "Initialize the receiver. Sets its image to the lasso picture" super initialize. self image: (MenuIcons formAtKey: 'Lasso')! !!LassoPatchMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:13'!initializeToStandAlone "Initialize the receiver such that it can live on its own. Sets its image to the lasso picture" super initializeToStandAlone. self image: (MenuIcons formAtKey: 'Lasso')! !!Morph class methodsFor: 'fileIn/Out' stamp: 'mt 3/8/2023 09:07'!fromFileName: fullName "Reconstitute a Morph from the file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world" | aFileStream morphOrList | aFileStream := (MultiByteBinaryOrTextStream with: ((FileStream readOnlyFileNamed: fullName) binary contentsOfEntireFile)) binary reset. morphOrList := aFileStream fileInObjectAndCode. P roject current world addMorphsAndModel: morphOrList.! !!Morph class methodsFor: '*MorphicExtras-parts bin' stamp: 'mt 8/4/2023 14:43'!supplementaryPartsDescriptions "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol" ^ {DescriptionForPartsBin formalName: 'NextPage' translatedNoop categoryList: {'Multimedia' translatedNoop} documentation: 'A button which, when clicked, takes the reader to the next page of a book' translatedNoop globalReceiverSymbol: #BookMorph nativitySelector: #nextPageButton. DescriptionForPartsBin formalName: 'PreviousPage' translatedNoop categoryList: {'Multimedia'} documentation: 'A button which, when clicked, takes the reader to the previous page of a book' translatedNoop globalReceiverSymbol: #BookMorph
nativitySelector: #previousPageButton.}! !!GraphicalDictionaryMenu class methodsFor: 'example' stamp: 'mt 7/31/2023 11:13'!example "GraphicalDictionaryMenu example" | aDict | aDict := Dictionary new. #('ColorTilesOff' 'ColorTilesOn' 'Controls') do: [:aString | aDict at: aString put: (MenuIcons formAtKey: aString)]. self openOn: aDict withLabel: 'Testing One Two Three'! !!ImageMorph class methodsFor: 'scripting' stamp: 'mt 3/15/2023 14:10'!authoringPrototype | aMorph aForm | aMorph := super authoringPrototype. aForm := MenuIcons formAtKey: 'Image'. aForm ifNil: [aForm := aMorph image rotateBy: 90]. aMorph image: aForm. ^ aMorph! !!GrabPatchMorph class methodsFor: 'instance creation' stamp: 'mt 7/31/2023 11:11'!authoringPrototype "Answer a prototype for use in a parts bin" ^ self new image: (MenuIcons formAtKey: 'GrabPatch'); markAsPartsDonor; setBalloonText: 'Use this to grab a rectangular patch from the screen'; yourself! !!LassoPatchMorph class methodsFor: 'instance creation' stamp: 'mt 7/31/2023 11:13'!authoringPrototype "Answer a prototype for use in a parts bin" ^ self new image: (MenuIcons formAtKey: 'Lasso'); markAsPartsDonor; setBalloonText: 'Drop this on the desktop and you can then grab a patch from the screen with a lasso.'; yourself! !!MorphExtension methodsFor: 'accessing - other properties' stamp: 'mt 3/10/2023 14:57'!sortedPropertyNames "answer the receiver's property names in a sorted way" | props | props := WriteStream on: (Array new: 10). locked == true ifTrue: [props nextPut: #locked]. visible == false ifTrue: [props nextPut: #visible]. sticky == true ifTrue: [props nextPut: #sticky]. balloonText isNil ifFalse: [props nextPut: #balloonText]. balloonTextSelector isNil ifFalse: [props nextPut: #balloonTextSelector]. externalName isNil ifFalse: [props nextPut: #externalName]. isPartsDonor == true ifTrue: [props nextPut: #isPartsDonor]. act orState isNil ifFalse: [props nextPut: #actorState]. eventHandler isNil ifFalse: [props nextPut: #eventHandler]. otherProperties ifNotNil: [otherProperties associationsDo: [:a | props nextPut: a key]]. ^props contents sort: [:s1 :s2 | s1 <= s2]! !!MorphExtension methodsFor: 'connectors-copying' stamp: 'mt 3/10/2023 16:11'!veryDeepInner: deepCopier "Copy all of my instance variables. Some otherProperties need to be not copied at all, but shared. Their names are given by copyWeakly. Some otherProperties should not be copied or shared. Their names are given by propertyNamesNotCopied. This is special code for the dictionary. See DeepCopier, and veryDeepFixupWith:." | namesOfWeaklyCopiedProperties weaklyCopiedValues | super veryDeepInner: deepCopier. locked := locked veryDeepCopyWith: deepCopier. visible := visible veryDeepCopyWith: deepCopier. sticky := sticky veryDeepCopyWith: deepCopier. balloonText := balloonText veryDeepCopyWith: deepCopier.
balloonTextSelector := balloonTextSelector veryDeepCopyWith: deepCopier. externalName := externalName veryDeepCopyWith: deepCopier. isPartsDonor := isPartsDonor veryDeepCopyWith: deepCopier. actorState := actorState veryDeepCopyWith: deepCopier. eventHandler := eventHandler veryDeepCopyWith: deepCopier. "has its own restrictions" otherProperties ifNil: [ ^self ]. otherProperties := otherProperties copy. self propertyNamesNotCopied do: [ :propName | otherProperties removeKey: propName ifAbsent: [] ]. namesOfWeaklyCopiedProperties := self copyWeakly. weaklyCopiedValues := namesOfWeaklyCopiedProperties collect: [ :propName | otherProperties removeKey: propName ifAbsent: [] ]. "Now copy all the others." otherProperties := otherProperties veryDeepCopyWith: deepCopier. "And replace the weak ones." namesOfWeaklyCopiedProperties with: weaklyCopiedValues do: [ :name :value | value ifNotNil: [ otherProperties at: name put: value ]].! !!MorphE xtension methodsFor: 'other' stamp: 'mt 3/10/2023 16:11'!isDefault "Return true if the receiver is a default and can be omitted" locked == true ifTrue: [^ false]. visible == false ifTrue: [^ false]. sticky == true ifTrue: [^ false]. balloonText isNil ifFalse: [^ false]. balloonTextSelector isNil ifFalse: [^ false]. externalName isNil ifFalse: [^ false]. isPartsDonor == true ifTrue: [^ false]. actorState isNil ifFalse: [^ false]. eventHandler isNil ifFalse: [^ false]. otherProperties ifNotNil: [otherProperties isEmpty ifFalse: [^ false]]. ^ true! !!MorphExtension methodsFor: 'printing' stamp: 'mt 3/10/2023 16:11'!printOn: aStream "Append to the argument, aStream, a sequence of characters that identifies the receiver." super printOn: aStream. aStream nextPutAll: ' ' , self identityHashPrintString. locked == true ifTrue: [aStream nextPutAll: ' [locked] ']. visibl e == false ifTrue: [aStream nextPutAll: '[not visible] ']. sticky == true ifTrue: [aStream nextPutAll: ' [sticky] ']. balloonText ifNotNil: [aStream nextPutAll: ' [balloonText] ']. balloonTextSelector ifNotNil: [aStream nextPutAll: ' [balloonTextSelector: ' , balloonTextSelector printString , '] ']. externalName ifNotNil: [aStream nextPutAll: ' [externalName = ' , externalName , ' ] ']. isPartsDonor == true ifTrue: [aStream nextPutAll: ' [isPartsDonor] ']. eventHandler ifNotNil: [aStream nextPutAll: ' [eventHandler = ' , eventHandler printString , '] ']. (otherProperties isNil or: [otherProperties isEmpty ]) ifTrue: [^ self]. aStream nextPutAll: ' [other: '. self otherProperties keysDo: [:aKey | aStream nextPutAll: ' (' , aKey , ' -> ' , (self otherProperties at: aKey) printString , ')']. aStream nextPut: $]! !!MorphHierarchy class methodsFor: 'opening' stamp: 'mt 8/4/2023 14:46'!openOrDelete | oldMorph | oldMorph := Project current world submorphs detect: [:each | each hasProperty: #morphHierarchy] ifNone: [| newMorph | newMorph := self new asMorph. newMorph bottomLeft: self currentHand position. newMorph openInWorld. ^ self]. "" oldMorph delete! !!MorphListItemWrapper methodsFor: 'accessing' stamp: 'mt 3/10/2023 16:07'!contents "Answer the receiver's contents" | tentative submorphs | tentative := item submorphs collect: [:each | each renderedMorph]. submorphs := tentative reject: [:each | each isKindOf: HaloMorph]. ^ submorphs collect: [:each | self class with: each]! !!MorphicModel methodsFor: 'submorphs - accessing' stamp: 'mt 3/10/2023 14:52'!allKnownNames "Return a list of all known names based on the scope of the receiver. If the receiver is a member of a uniclass, incorporate the original 1997 logic that queries the known names of the values of all the instance variables." | superNames | superNames := super allKnownNames. "gather them from submorph tree" ^self class isUniClass ifTrue: [superNames , (self instanceVariableValues select: [:e | e notNil and: [e knownName notNil]] thenCollect: [:e | e knownName])] ifFalse: [superNames]! !!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 3/8/2023 11:01'!copyFromRootsForExport: rootArray "When possible, use copySmartRootsExport:. This way may not copy a complete tree of objects. Add to roots: all of the methods pointed to from the outside by blocks." | newRoots segSize symbolHolder | arrayOfRoots := rootArray. "self halt." symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers, so they will be in outPointers" "Creation of the segment happens here" self copyFromRoots: arrayOfRoots sizeHint: 0. segSize := segment size. [(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize]. "with methods pointed at from outside" [(newRoots := self rootsIncludingBlocks) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize]. "with methods, blocks from outPointers" "Zap sender of a homeContext. Can't send live stacks out." "Why not? eem 7/3/2017 15:31" 1 to: outPointers size do: [:ii | | outPointer | outPointer := outPointers at: ii. (outPointer isBlock or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil]]. symbolHolder size "Keep reference to symbolHolder until the last"! !!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/28/2023 15:10'!copyFromRootsLocalFileFor: rootArray sizeHint: segSize arrayOfRoots := rootArr ay. self copyFromRoots: arrayOfRoots sizeHint: segSize.! !!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/28/2023 15:40'!copySmartRootsExport: rootArray "Use SmartRefStream to find the object. Make them all roots. Create the segment in memory. Project should be in first five objects in rootArray." | newRoots segSize symbolHolder replacements naughtyBlocks allClasses sizeHint proj dummy world | world := Project current world. symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers, so they will be in outPointers" dummy := ReferenceStream on: (DummyStream on: nil). "Write to a fake Stream, not a file" "Collect all objects" dummy insideASegment: true. "So Uniclasses will be traced" dummy rootObject: rootArray. "inform him about the root" dummy nextPut: rootArray. (proj :=dummy project) ifNotNil: [self dependentsSave: dummy]. allClasses := SmartRefStream new uniClassInstVarsRefs: dummy. " catalog the extra objects in UniClass inst vars. Put into dummy" allClasses do: [:cls | dummy references at: cls class put: false. "put MorphicModel5 class in roots" dummy blockers removeKey: cls class ifAbsent: []]. "refs := dummy references." arrayOfRoots := self smartFillRoots: dummy. "guaranteed none repeat" replacements := dummy blockers. dummy project "recompute it" ifNil: [self error: 'lost the project!!']. dummy project class == DiskProxy ifTrue: [self error: 'saving the wrong project']. dummy := nil. "Allow dummy to be GC'ed below (bytesLeft)." naughtyBlocks := arrayOfRoots select: [ :each | each isContext and: [each hasInstVarRef]]. "since the caller switched ActiveWorld, put the real one back temporarily" naughtyBlocks isEmpty ifFalse: [world becomeActiveDuring: [world firstHand becomeActiveDuring: [ | goodToGo | goodToGo := (Project uiM anager chooseOptionFrom: #('keep going' 'stop and take a look') title: 'Some block(s) which reference instance variables are included in this segment. These may fail when the segment is loaded if the class has been reshaped. What would you like to do?') = 1. goodToGo ifFalse: [naughtyBlocks inspect. self error: 'Here are the bad blocks']]]]. "Creation of the segment happens here" "try using one-quarter of memory min: four megs to publish (will get bumped up later if needed)" sizeHint := (Smalltalk bytesLeft // 4 // 4) min: 1024*1024. self copyFromRoots: arrayOfRoots sizeHint: sizeHint areUnique: true. segSize := segment size. [(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true]. "with methods pointed at from outsi de" [(newRoots := self rootsIncludingBlocks) == nil] whileFalse: [arrayOfRoots := newRoots. self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true]. "with methods, blocks from outPointers" 1 to: outPointers size do: [:ii | | outPointer | outPointer := outPointers at: ii. (outPointer isBlock or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil]. "substitute new object in outPointers" (replacements includesKey: outPointer) ifTrue: [outPointers at: ii put: (replacements at: outPointer)]]. proj ifNotNil: [self dependentsCancel: proj]. symbolHolder. "hold onto symbolHolder until the last."! !!NativeImageSegment methodsFor: 'read/write segment' stamp: 'mt 8/16/2023 16:58'!smartFillRoots: dummy | refs known ours ww blockers | "Put all traced objects into my arrayOfRoots. Remove somethat want to be in outPointers. Return blockers, anIdentityDictionary of objects to r eplace in outPointers." blockers := dummy blockers. known := (refs := dummy references) size. refs keys do: [:obj | "copy keys to be OK with removing items" (obj isSymbol) ifTrue: [refs removeKey: obj. known := known-1]. (obj class == PasteUpMorph) ifTrue: [ obj isWorldMorph & (obj owner == nil) ifTrue: [ (dummy project ~~ nil and: [obj == dummy project world]) ifFalse: [ refs removeKey: obj. known := known-1. blockers at: obj put: (StringMorph contents: 'The worldMorph of a different world')]]]. "Make a ProjectViewMorph here" "obj class == Project ifTrue: [Transcript show: obj; cr]." (blockers includesKey: obj) ifTrue: [ refs removeKey: obj ifAbsent: [known := known+1]. known := known-1]. ]. ours := (dummy project ifNil: [Project current]) world. refs keysDo: [:obj | obj isMorph ifTrue: [ ww := obj world. (ww == ours) | (ww == nil) ifFalse: [ refs removeKey: obj. known := known-1. blockers at: obj put: (StringMorph contents: obj printString, ' from another world')]]]. "keep original roots on the front of the list" dummy rootObject do: [:rr | refs removeKey: rr ifAbsent: []]. ^dummy rootObject, refs keys asArray! !!NativeImageSegment methodsFor: 'testing' stamp: 'mt 3/8/2023 11:01'!findRogueRootsImSeg: rootArray "This is a tool to track down unwanted pointers into the segment. If we don't deal with these pointers, the segment turns out much smaller than it should. These pointers keep a subtree of objects out of the segment.1) Break all owner pointers in submorphs and all scripts.2) Create the segment and look at outPointers.3) Remove those we expect.4) Remember to quit without saving -- the owner pointers are smashed."| suspects bag1 bag2 |arrayOfRoots := rootArray.self findRogueRootsPrep. "and free that context!!"Smalltalk garbageCollect.self copyFromRoots: arrayOfRoots sizeHint: 0.suspects := outPointers select: [:oo | oo isMorph].suspects size > 0 ifTrue: [suspects inspect].bag1 := Bag new. bag2 := Bag new.outPointers do: [:key | (key isKindOf: Class) ifTrue: [bag2 add: key class name] ifFalse: [(#(Symbol Point Rectangle True False String Float Color Form ColorForm StrikeFont Metaclass UndefinedObject TranslucentColor) includes: key class name) ifTrue: [bag2 add: key class name] ifFalse: [bag1 add: key class name]]]."(bag sortedCounts) is the SortedCollection"(StringHolder new contents: bag1 sortedCounts printString, '', bag2 sortedCounts printString) openLabel: 'Objects pointed at by the outside'.self halt: 'Examine local variables pointIn and inSeg'."Use this in inspectors: outPointers select: [:oo | oo class == <a Class>]. "! !!NativeImageSegment methodsFor: 'testing' stamp: 'm t 3/10/2023 15:12'!findRogueRootsPrep "Part of the tool to track down unwanted pointers into the segment. Break all owner pointers in submorphs, scripts, and viewers in flaps."| wld morphs |wld := arrayOfRoots detect: [:obj | obj isMorph ifTrue: [obj isWorldMorph] ifFalse: [false]] ifNone: [nil].wld ifNil: [wld := arrayOfRoots detect: [:obj | obj isMorph] ifNone: [^ self error: 'can''t find a root morph']].morphs := IdentitySet new: 400.wld allMorphsDo: [:m | morphs add: m].morphs do: [:mm | "break the back pointers" mm isInMemory ifTrue: [ (mm respondsTo: #target) ifTrue: [ mm nearestOwnerThat: [:ow | ow == mm target ifTrue: [mm target: nil. true] ifFalse: [false]]]. (mm respondsTo: #arguments) ifTrue: [ mm arguments do: [:arg | arg ifNotNil: [ mm nearestOwnerThat: [:ow | ow == arg ifTrue: [mm arguments at: (mm arguments indexOf: arg) put: nil. true] ifFalse: [fal se]]]]]. mm eventHandler ifNotNil: ["recipients point back up" (morphs includesAllOf: (mm eventHandler allRecipients)) ifTrue: [ mm eventHandler: nil]]. "temporary, until using Model for PartsBin" (mm isMorphicModel) ifTrue: [ (mm model isMorphicModel) ifTrue: [ mm model breakDependents]]. (mm isTextMorph) ifTrue: [mm setContainer: nil]]].(Smalltalk includesKey: #Owners) ifTrue: [Smalltalk at: #Owners put: nil]. "in case findOwnerMap: is commented out""self findOwnerMap: morphs."morphs do: [:mm | "break the back pointers" mm isInMemory ifTrue: [mm privateOwner: nil]]."more in extensions?"! !!NebraskaCommunicatorMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/11/2023 13:59'!textEntryFieldNamed: aSymbol with: aString help: helpString | f col | f := (StringMorph new contents: aString; font: Preferences standardDefaultTextFont; yourself) setBalloonText: helpString; on: #mouseUp send: #editEvent:for: to: sel f. self field: aSymbol is: f. col := (self inAColumn: {f}) color: Color white; hResizing: #shrinkWrap. ^col! !!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:52'!acceptTo: someText forMorph: aMorph | betterText | betterText := self improveText: someText forMorph: aMorph. self transmitStreamedObject: (SmartRefStream streamedRepresentationOf: betterText) to: self ipAddress. aMorph setText: '' asText. self appendMessage: self startOfMessageFromMe, ' - ', betterText, String cr. ^true! !!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:56'!appendMessage: aText receivingPane setText: (receivingPane text append: aText).! !!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:54'!improveText: someText forMorph: aMorph | betterText conversions fontForAll | fontForAll := TextStyle default. betterText := someText veryDeepCopy. conversions := OrderedCollection new. betterText runs withStartStopAndValueDo: [:start :stop :attributes | attributes do: [:att | (att isMemberOf: TextFontChange) ifTrue: [ conversions add: {att. start. stop} ] ] ]. conversions do: [ :old | | newAttr | betterText removeAttribute: old first from: old second to: old third. newAttr := TextFontReference toFont: (fontForAll fontAt: old first fontNumber). newAttr fontNumber: old first fontNumber. betterText addAttribute: newAttr from: old second to: old third. ]. ^betterText! !!NebraskaChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:57'!reportError: aString receivingPane setText: (receivingPane text append: (aString asText addAttribute: TextColor red), String cr).! !!NebraskaFridgeMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:52'!acceptDroppingMorph: morphToDrop event: evt | outData | (morphToDrop i sKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt ]. self eToyRejectDropMorph: morphToDrop event: evt. "we will keep a copy" (morphToDrop isKindOf: NebraskaSenderMorph) ifTrue: [ self class addRecipient: morphToDrop. ^self rebuild ]. self stopFlashing. "7 mar 2001 - remove #veryDeepCopy" outData := SmartRefStream streamedRepresentationOf: morphToDrop. self resetIndicator: #working. self class fridgeRecipients do: [ :each | self transmitStreamedObject: outData to: each ipAddress ].! !!NebraskaMorphsWelcomeMorph methodsFor: 'initialization' stamp: 'mt 8/11/2023 13:59'!initialize "initialize the state of the receiver" | earMorph | super initialize. "" self layoutInset: 8 @ 8. "earMorph := (EToyListenerMorph makeListeningToggle: true) asMorph." earMorph := TextMorph new contents: 'Morphswelcomehere'; fontName: Preferences standardDefaultTextFont familyName size: 18; centered; lock. self addARow: {earMorph}. self setBalloonText: 'My presence in this world means received morphs may appear automatically' translated! !!NebraskaMultiChatMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:52'!acceptTo: someText forMorph: aMorph | streamedMessage betterText | betterText := self improveText: someText forMorph: aMorph. streamedMessage := SmartRefStream streamedRepresentationOf: {targetIPAddresses. betterText}. targetIPAddresses do: [ :each | self transmitStreamedObject: streamedMessage to: each. ]. aMorph setText: '' asText. self appendMessage: self startOfMessageFromMe, ' - ', betterText, String cr. ^true! !!NebraskaSenderMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:53'!acceptDroppingMorph: morphToDrop event: evt | myCopy outData | (morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it" "7 mar 2001 - remove #veryDeepCopy" myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position. self stopFlashing. outData := SmartRefStream streamedRepresentationOf: myCopy. self resetIndicator: #working. self transmitStreamedObject: outData to: self ipAddress.! !!NebraskaSenderMorph methodsFor: 'as yet unclassified' stamp: 'mt 8/16/2023 15:53'!sendStatusReply | null | null := String with: 0 asCharacter. NebraskaPeerToPeer new sendSomeData: { NebraskaIncomingMessage typeStatusReply,null. Preferences defaultAuthorName,null. (SmartRefStream streamedRepresentationOf: (NebraskaGateKeeperMorph acceptableTypesFor: self ipAddress)). } to: self ipAddress for: self.! !!NebraskaServerMorph methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:54'!rebuild | myServer toggle closeBox font | font := StrikeFont familyName: #Palatino size: 14. self removeAllMorphs. self setColorsAndBorder. self updateCurrentStatusString. toggle := SimpleHierarchicalListMorph new perform: ( fullDisplay ifTrue: [#expandedForm] ifFalse: [#notExpandedForm] ). closeBox := SimpleButtonMorph new borderWidth: 0; label: 'X' font: Preferences standardButtonFont; color: Color transparent; actionSelector: #delete; target: self; extent: 14(a)14; setBalloonText: 'End Nebraska session' translated. self addARow: { self inAColumn: {closeBox}. self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentStatusString; contents: sel f currentStatusString; stepTime: 2000; lock. }. self inAColumn: { toggle asMorph on: #mouseUp send: #toggleFull to: self; setBalloonText: 'Show more or less of Nebraska Status' translated }. }. myServer := self server. (myServer isNil or: [fullDisplay not]) ifTrue: [ ^self world startSteppingSubmorphsOf: self ]. "--- the expanded display ---" self addARow: { self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentBacklogString; contents: self currentBacklogString; stepTime: 2000; lock. }. }. self addARow: { self inAColumn: { (StringMorph contents: '--clients--' translated) lock; font: font. }. }. myServer clients do: [ :each | self addARow: {
UpdatingStringMorph new useStringFormat; target: each; font: font; getSelector: #currentStatusString; contents: each currentStatusString; stepTime: 2000; lock. } ]. self world startSteppingSubmorphsOf: self.! !!NebraskaServerMorph methodsFor: 'initialization' stamp: 'mt 8/23/2023 13:26'!setColorsAndBorder self color: (Color r: 0.9 g: 0.9 b: 0.9). self borderStyle: (BorderStyle raised width: 1). self useRoundedCorners! !!NetworkTerminalMorph methodsFor: 'events-processing' stamp: 'mt 8/14/2023 11:29'!handleMouseDown: anEvent anEvent wasHandled ifTrue:[^self]. anEvent hand removePendingBalloonFor: self. anEvent wasHandled: true. anEvent hand newMouseFocus: self event: anEvent. anEvent hand removeHaloFromClick: anEvent on: self. self sendEventAsIs: anEvent.! !!NetworkTerminalMorph methodsFor: 'layout' stamp: 'mt 8/16/2023 15:53'!acceptDroppingMorph: morphToDrop event: evt | myCopy outData null | (morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it" "7 mar 2001 - remove #veryDeepCopy" myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position. outData := SmartRefStream streamedRepresentationOf: myCopy. null := String with: 0 asCharacter. NebraskaPeerToPeer new sendSomeData: { NebraskaIncomingMessage typeMorph,null. Preferences defaultAuthorName,null. outData } to: connection remoteSocketAddress hostNumber for: self.! !!NewHandleMorph methodsFor: 'initialization' stamp: 'mt 3/10/2023 16:07'!initialize"initialize the state of the receiver" super initialize.""
waitingForClickInside := true.! !!ObjectExplorer methodsFor: 'menus' stamp: 'mt 8/28/2023 14:40'!explorerKey: aChar from: view event: event event anyModifierKeyPressed ifFalse: [^ false]. self object ifNotNil: [ aChar == $i ifTrue: [self inspectSelection. ^ true]. aChar == $I ifTrue: [self exploreSelection. ^ true]. aChar == $b ifTrue: [self browseFull. ^ true]. aChar == $h ifTrue: [self browseClassHierarchy. ^ true]. aChar == $c ifTrue: [self copyName. ^ true]. aChar == $p ifTrue: [self browseFullProtocol. ^ true]. aChar == $N ifTrue: [self browseClassRefs. ^ true]]. ^ false! !!ObjectlandMorph methodsFor: 'projects' stamp: 'mt 8/11/2023 15:16'!fillObjectlandProject ^ self fillObjectlandProjectWith: { self createGamesProject. self createGraphicsProject. self createToolsProject. self createSoundsProject }! !!ObjectsTool methodsFor: 'search' stamp: 'mt 8/11/2023 13:59'!newSearchPan e "Answer a type-in pane for searches" | aTextMorph | aTextMorph := TextMorph new setProperty: #defaultContents toValue: ('' asText allBold addAttribute: (TextFontChange font3)); setTextStyle: (TextStyle fontArray: { Preferences standardDefaultTextFont }); setDefaultContentsIfNil; on: #keyStroke send: #searchPaneCharacter: to: self; setNameTo: 'SearchPane'; setBalloonText: 'Type here and all entries that match will be shown.' translated; vResizing: #shrinkWrap; hResizing: #spaceFill; margins: 4 px @ 6 px; backgroundColor: Color white. ^ aTextMorph! !!PackageDependencyTest methodsFor: 'tests' stamp: 'mt 3/15/2023 14:59'!testMorphic self testPackage: #Morphic dependsExactlyOn: #( Balloon #'Chronology-Core' Collections Compiler Compression Files Graphics 'Installer-Core' "Because of TheWorldMainDockingBar's install feature ..." Kernel
MonticelloConfigurations MorphicExtras Multilingual Network Sound System SystemReporter #'ToolBuilder-Kernel' #'ToolBuilder-Morphic' Tools TrueType ).! !!PackageDependencyTest methodsFor: 'failures' stamp: 'mt 3/15/2023 14:58'!expectedFailures ^ #(testSystem testTools)! !!PaintBoxMorph methodsFor: 'actions' stamp: 'mt 8/10/2023 15:31'!currentColor: aColor currentColor := aColor.! !!PaintBoxMorph methodsFor: 'initialization' stamp: 'mt 8/28/2023 14:39'!addLabels self addGraphicLabels ifFalse: [self addTextualLabels].! !!PaintBoxMorph methodsFor: 'initialization' stamp: 'mt 8/10/2023 15:30'!beSupersized "Not supported."! !!PaintBoxMorph methodsFor: 'other' stamp: 'mt 8/28/2023 14:39'!offsetFromMaxBounds "location of normal PaintBox within maxBounds." | left | left := self left. self flag: #useBiggerPaintingBox. left := left - (( self width * 1.5)- self width). ^ left - colorM emory left @ 0! !!PaintBoxMorph class methodsFor: 'instance creation' stamp: 'mt 8/28/2023 15:42'!new | pb | pb := self prototype veryDeepCopy. pb stampHolder normalize. "Get the stamps to show" "Get my own copies of the brushes so I can modify them" #(brush1: brush2: brush3: brush4: brush5: brush6:) do: [:sel | | dualUse button | button := pb submorphNamed: sel. button offImage: button offImage deepCopy. dualUse := button onImage == button pressedImage. "sometimes shared" button onImage: button onImage deepCopy. dualUse ifTrue: [button pressedImage: button onImage] ifFalse: [button pressedImage: button pressedImage deepCopy]. ]. pb showColor. pb fixUpRecentColors. pb addLabels. ^ pb! !!ParagraphEditor methodsFor: 'editing keys' stamp: 'mt 8/11/2023 14:44'!changeEmphasis: characterStream "Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change. Keeps typeahead." | keyCode attribute oldAttributes index thisSel colors extras | "control 0..9 -> 0..9" keyCode := ('0123456789' indexOf: sensor keyboard ifAbsent: [1]) - 1. oldAttributes := paragraph text attributesAt: self pointIndex forStyle: paragraph textStyle. thisSel := self selection. "Decipher keyCodes for Command 0-9..." "(keyCode between: 1 and: 5) ifTrue: [ attribute := TextFontChange fontNumber: keyCode ]." keyCode = 5 ifTrue: [ | labels lines | colors := #(#black #magenta #red #yellow #green #blue #cyan #white ). extras := #('Link to comment of class' 'Link to definition of class' 'Link to hierarchy of class' 'Link to method' ). labels := colors , #('choose color...' 'Do it' 'Print it' ) , extras , #('be a web URL link' 'Edit hidden info' 'Copy hidden info' ). lines := Array with: colors size + 1. "index := (PopUpMenu labelArra y: labels lines: lines) startUp. " index := UIManager default chooseFrom: labels lines: lines. index = 0 ifTrue: [ ^ true]. index <= colors size ifTrue: [ attribute := TextColor color: (Color perform: (colors at: index)) ] ifFalse: [ index := index - colors size - 1. "Re-number!!!!!!" index = 0 ifTrue: [ attribute := self chooseColor ]. index = 1 ifTrue: [ attribute := TextDoIt new. thisSel := attribute analyze: self selection asString ]. index = 2 ifTrue: [ attribute := TextPrintIt new. thisSel := attribute analyze: self selection asString ]. extras size = 0 & (index > 2) ifTrue: [ index := index + 4 "skip those" ]. index = 3 ifTrue: [ attribute := TextLink new. thisSel := attribute a nalyze: self selection asString with: 'Comment' ]. index = 4 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Definition' ]. index = 5 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString with: 'Hierarchy' ]. index = 6 ifTrue: [ attribute := TextLink new. thisSel := attribute analyze: self selection asString ]. index = 7 ifTrue: [ attribute := TextURL new. thisSel := attribute analyze: self selection asString ]. index = 8 ifTrue: [ "Edit hidden info" thisSel := self hiddenInfo. "includes selection" attribute := TextEmphasis normal ]. index = 9 ifTrue: [ "Copy hidden info"
self copyHiddenInfo. ^ true ]. "no other action" thisSel ifNil: [ ^ true ] ] ]. (keyCode between: 6 and: 9) ifTrue: [ sensor leftShiftDown ifTrue: [ keyCode = 6 ifTrue: [ attribute := TextKern kern: -1 ]. keyCode = 7 ifTrue: [ attribute := TextKern kern: 1 ] ] ifFalse: [ "And remember this: nine is fine for underline, obliter-eight it as you see fit, seven has been bold for ever'n, which leaves six as the obivous fix to emphasize your poetics." attribute := TextEmphasis perform: (#(italic bold struckOut underlined) at: keyCode - 5). oldAttributes do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]] ] ]. keyCode = 0 ifTrue: [attribute := TextEmphasis normal]. attribute ifNil: [^ true]. beginTypeInBlock ~ ~ nil ifTrue: [ "only change emphasisHere while typing" self insertTypeAhead: characterStream. emphasisHere := Text addAttribute: attribute toArray: oldAttributes. ^ true ]. self replaceSelectionWith: (thisSel asText addAttribute: attribute). ^ true! !!ParagraphEditor class methodsFor: 'class initialization' stamp: 'mt 8/11/2023 14:47'!yellowButtonMenu ^ SelectionMenu fromArray: StringHolder yellowButtonMenuItems! !!ParagraphEditor class methodsFor: 'keyboard shortcut tables' stamp: 'mt 8/11/2023 14:45'!initializeCmdKeyShortcuts "Initialize the (unshifted) command-key (or alt-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "ParagraphEditor initialize" | cmdMap | cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash" cmdMap at: 1 + 1 put: #cursorHome:. "home key" cmdMap at: 4 + 1 put: #cursorEnd:. "end key" cmdM ap at: 8
- 1 put: #backspace:. "ctrl-H or delete key" cmdMap at: 11 + 1 put: #cursorPageUp:. "page up key" cmdMap at: 12 + 1 put: #cursorPageDown:. "page down key" cmdMap at: 13 + 1 put: #crWithIndent:. "cmd-Return" cmdMap at: 27 + 1 put: #offerMenuFromEsc:. "escape key" cmdMap at: 28 + 1 put: #cursorLeft:. "left arrow key" cmdMap at: 29 + 1 put: #cursorRight:. "right arrow key" cmdMap at: 30 + 1 put: #cursorUp:. "up arrow key" cmdMap at: 31 + 1 put: #cursorDown:. "down arrow key" cmdMap at: 32 + 1 put: #selectWord:. "space bar key" cmdMap at: 127 + 1 put: #forwardDelete:. "del key" '0123456789' do: [:char | cmdMap at: char asciiValue + 1 put: #changeEmphasis:]. "triplet = {character. comment selector. novice appropiated}" #( ($a #selectAll: ) ($b #browseIt: ) ($c #copySel
ection: ) ($d #doIt: ) ($e #exchange: ) ($f #find: ) ($g #findAgain: ) ($h #setSearchString: ) ($i #inspectIt: ) ($j #doAgainOnce: ) ($k #offerFontMenu: ) ($l #cancel: ) ($m #implementorsOfIt: ) ($n #sendersOfIt: ) ($o #spawnIt: ) ($p #printIt: ) ($q #querySymbol: ) ($s #save: ) ($t #tempCommand: ) ($u #align: ) ($v #paste: ) ($w #backWord: ) ($x #cut: ) ($y #swapChars: ) ($z #undo: ) ) do:[:triplet | cmdMap at: triplet first asciiV alue + 1 put: triplet second]. CmdActions := cmdMap.! !!ParagraphEditor class methodsFor: 'keyboard shortcut tables' stamp: 'mt 8/11/2023 14:46'!initializeShiftCmdKeyShortcuts "Initialize the shift-command-key (or control-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the capitalized versions of the letters. TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values." | cmdMap | "shift-command and control shortcuts" cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash" cmdMap at: ( 1 + 1) put: #cursorHome:. "home key" cmdMap at: ( 4 + 1) put: #cursorEnd:. "end key" cmdMap at: ( 8 + 1) put: #forwardDelete:. "ctrl-H or delete key" cmdMap at: (11 + 1) put: #cursorPageUp:. "page up key" cmdMap at: (12 + 1) put: #cursorPageDown:. "page down key" cmdMap at: (13 + 1) put: #crWithIndent:. "ctrl-Return" cmdMap at: (27 + 1) put: #offerMenuFromEsc:. "escape key" cmdMap at: (28 + 1) put: #cursorLeft:. "left arrow key" cmdMap at: (29 + 1) put: #cursorRight:. "right arrow key" cmdMap at: (30 + 1) put: #cursorUp:. "up arrow key" cmdMap at: (31 + 1) put: #cursorDown:. "down arrow key" cmdMap at: (32 + 1) put: #selectWord:. "space bar key" cmdMap at: (45 + 1) put: #changeEmphasis:. "cmd-sh-minus" cmdMap at: (61 + 1) put: #changeEmphasis:. "cmd-sh-plus" cmdMap at: (127 + 1) put: #forwardDelete:. "del key" "triplet = {character. comment selector. novice appropiated}" #( ($a argAdvance: ) ($b browseItHere: ) ($c compareToClipboard: ) ($d debugIt:
) ($e methodStringsContainingIt:) ($f displayIfFalse: ) ($g fileItIn: ) ($h cursorTopHome: ) ($i exploreIt: ) ($j doAgainMany: ) ($k changeStyle: ) ($m selectCurrentTypeIn: ) ($n referencesToIt: ) ($p makeProjectLink: ) ($s search: ) ($t displayIfTrue: ) ($u changeLfToCr: ) ($v pasteInitials: ) ($w methodNamesContainingIt:) ($x makeLowercase: ) ($y makeUppercase: ) ($z makeCapitalized: ) ) do:[:triplet | cmdMap at: (triplet first asciiValue + 1) put: tr iplet second. "plain keys" cmdMap at: (triplet first asciiValue - 32 + 1) put: triplet second. "shifted keys" cmdMap at: (triplet first asciiValue - 96 + 1) put: triplet second. "ctrl keys" ]. ShiftCmdActions := cmdMap! !!PasteUpMorph methodsFor: 'accessing' stamp: 'mt 8/11/2023 16:19'!flapTab "Answer the tab affilitated with the receiver. Normally every flap tab is expected to have a PasteUpMorph which serves as its 'referent.'" self isFlap ifFalse: [^ nil]. ^ self flapTabs detect: [:any| any referent == self] ifNone: [nil]! !!PasteUpMorph methodsFor: 'caching' stamp: 'mt 3/10/2023 15:07'!releaseCachedState super releaseCachedState. self isWorldMorph ifTrue:[self cleanseStepList].! !!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'mt 8/14/2023 17:42'!acceptDroppingMorph: dropped event: evt "The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitatin g event is supplied" | aMorph | (self isWorldMorph and: [dropped isTransferMorph] and: [self hasTransferMorphConverter not]) ifTrue: [ dropped dragTransferType = #filesAndDirectories ifTrue: [^ self dropFiles: dropped passenger event: evt]. dropped dragTransferType = #sourceCode ifTrue: [^ self dropSourceCode: dropped passenger event: evt]. dropped dragTransferType = #inspectorField "See Tools-Inspector" ifTrue: [^ self dropInspectorField: dropped passenger event: evt]. dropped dragTransferType = #explorerField "See Tools-Explorer" ifTrue: [^ self dropExplorerField: dropped passenger from: dropped source model event: evt]]. aMorph := self morphToDropFrom: dropped. self isWorldMorph ifFalse: [super acceptDroppingMorph: aMorph event: evt] ifTrue: ["Add the given morph to this world and start s tepping it if it wants to be." aMorph isInWorld ifFalse: [aMorph position: evt position]. self addMorphFront: aMorph. (aMorph fullBounds intersects: self viewBox) ifFalse: [Beeper beep. aMorph position: self bounds center]]. aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]]. self isPartsBin ifTrue: [aMorph isPartsDonor: true. aMorph stopSteppingSelfAndSubmorphs. aMorph suspendEventHandler] ifFalse: [self world startSteppingSubmorphsOf: aMorph]. self bringTopmostsToFront.! !!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'mt 8/14/2023 17:41'!morphToDropFrom: aMorph "Given a morph being carried by the hand which the hand is about to drop, answer the actual morph to be deposited. Normally this would be just the morph itself, but several unusual cases arise, which this method is designed to service." | aNail rep resentee handy posBlock | handy := self isWorldMorph ifTrue: [self primaryHand] ifFalse: [self currentHand]. posBlock := [:z | | tempPos | tempPos := handy position - ((handy targetOffset - aMorph formerPosition) * (z extent / aMorph extent)) rounded. self pointFromWorld: tempPos]. self alwaysShowThumbnail ifTrue: [aNail := aMorph representativeNoTallerThan: self maxHeightToAvoidThumbnailing norWiderThan: self maximumThumbnailWidth thumbnailHeight: self heightForThumbnails. aNail == aMorph ifFalse: [aMorph formerPosition: aMorph position. aNail position: (posBlock value: aNail)]. ^aNail]. ((aMorph isKindOf: MorphThumbnail) and: [(representee := aMorph morphRepresented) owner isNil]) ifT rue: [representee position: (posBlock value: representee). ^representee]. ^aMorph morphToDropInPasteUp: self! !!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/15/2023 13:45'!handlesKeyboard: evt ^self isWorldMorph! !!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/15/2023 13:45'!keyStroke: anEvent "A keystroke has been made. Service event handlers and, if it's a keystroke presented to the world, dispatch it to #unfocusedKeystroke:" | selected | super keyStroke: anEvent. "Give event handlers a chance" selected := self selectedObject. selected isNil ifFalse:[ selected moveOrResizeFromKeystroke: anEvent ]. self isWorldMorph ifTrue: [self keystrokeInWorld: anEvent]! !!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 16:08'!mouseDown: evt "Handle a mouse down event." | grabbedMorph handHadHalos | (Preferences generalizedYellowButtonMenu and: [evt yellowButtonPressed])
ifTrue: [^ self yellowButtonActivity: evt shiftPressed]. grabbedMorph := self morphToGrab: evt. grabbedMorph ifNotNil:[ grabbedMorph isSticky ifTrue:[^self]. self isPartsBin ifFalse:[^evt hand grabMorph: grabbedMorph]. grabbedMorph := grabbedMorph partRepresented duplicate. grabbedMorph restoreSuspendedEventHandler. (grabbedMorph fullBounds containsPoint: evt position) ifFalse:[grabbedMorph position: evt position]. "Note: grabbedMorph is ownerless after duplicate so use #grabMorph:from: instead" ^ evt hand grabMorph: grabbedMorph from: self]. (super handlesMouseDown: evt) ifTrue:[^super mouseDown: evt]. handHadHalos := evt hand halo notNil. evt hand removeHalo. "shake off halos" evt hand releaseKeyboardFocus. "shake of keyboard foci" self submorphs select:[:each | each hasProperty: #morphHierarchy] thenDo:[:each | each delete]. (evt shiftPressed not and:[ self isWorldMorph not and:[ self wantsEasySelection not ]]) ifTrue:[ "explicitly ignore the event if we're not the world and we'll not select, so that we could be picked up if need be" evt wasHandled: false. ^ self. ]. ( evt shiftPressed or: [ self wantsEasySelection ] ) ifTrue:[ "We'll select on drag, let's decide what to do on click" | clickSelector | clickSelector := nil. evt shiftPressed ifTrue:[ clickSelector := #findWindow:. ] ifFalse:[ self isWorldMorph ifTrue:[ clickSelector := handHadHalos ifTrue: [ #delayedInvokeWorldMenu: ] ifFalse: [ #invokeWorldMenu: ] ] ]. evt hand waitForClicksOrDrag: self event: evt selectors: { clickSelector. nil. nil. #dragThroughOnDesktop: } threshold: Hand Morph dragThreshold. ] ifFalse:[ "We wont select, just bring world menu if I'm the world" self isWorldMorph ifTrue:[ handHadHalos ifTrue: [ self delayedInvokeWorldMenu: evt ] ifFalse: [ self invokeWorldMenu: evt ] ] ].! !!PasteUpMorph methodsFor: 'event handling' stamp: 'mt 3/7/2023 18:18'!windowEvent: anEvent self windowEventHandler ifNotNil: [^self windowEventHandler windowEvent: anEvent]. anEvent type caseOf: { [#windowClose] -> [TheWorldMenu basicNew quitSession]. [#windowDeactivated] -> [ "The host window has been deactivated. Until it regains the focus, honor the fact that we will not receive keyboard events again by changing the current keyboard focus morph. windowHostFocusMorph represents the host system which now holds the keyboard focus instead of the previousFocus." (self valueOfProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | "There is currently no exact-once guarantee for this event type from the VM. Mark any older host focus morph as inactive, it will be held as the previousFocus of the next host focus morph." hostFocus active: false]. self setProperty: #windowHostFocusMorph toValue: (WindowHostFocusMorph new in: [:hostFocus | hostFocus previousFocus: anEvent hand keyboardFocus. anEvent hand newKeyboardFocus: hostFocus.]; yourself)]. [#windowActivated] -> [ "Alright, the spook is over!! We have back control over the keyboard focus, delete the windowHostFocusMorph and restore the previous focus holder." (self removeProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | hostFocus active: false. (anEvent hand keyboardFocus == hostFocus and: [hostFocus previousF ocus notNil]) ifTrue: [anEvent hand newKeyboardFocus: hostFocus previousFocus]]]. } otherwise: []! !!PasteUpMorph methodsFor: 'events-processing' stamp: 'mt 3/10/2023 16:09'!tryInvokeHalo: aUserInputEvent Morph haloForAll ifFalse: [ ^ self ]. (self transferHalo: aUserInputEvent) ifTrue: "The event was handled, don't let it cause any further side-effects." [ aUserInputEvent ignore ].! !!PasteUpMorph methodsFor: 'events-processing' stamp: 'mt 3/10/2023 11:27'!tryInvokeMetaMenu: anEvent | innerMost target | Morph metaMenuForAll ifFalse: [^ self]. innerMost := (self morphsAt: anEvent position unlocked: true) first. "Traverse the owner chain if some morph does not want to show its meta menu." target := innerMost. [target isNil or: [target wantsMetaMenu]] whileFalse: [target := target owner]. target ifNil: [^ self]. target invokeMetaMenu: anEvent. anEvent ignore.! !!PasteUpMorph methodsFor: 'ha los and balloon help' stamp: 'mt 3/7/2023 17:39'!wantsHaloFromClick (owner isSystemWindow) ifTrue: [^ false]. ^ true.! !!PasteUpMorph methodsFor: 'initialization' stamp: 'mt 3/10/2023 15:29'!initialize"initialize the state of the receiver" super initialize."" padding := 3. self enableDragNDrop. self clipSubmorphs: true. self initializeKeyboardShortcuts. self initializeMouseShortcuts.! !!PasteUpMorph methodsFor: 'menu & halo' stamp: 'mt 8/11/2023 16:18'!addCustomMenuItems: menu hand: aHandMorph "Add morph-specific menu itemns to the menu for the hand" super addCustomMenuItems: menu hand: aHandMorph. self isWorldMorph ifTrue: [ | twm | menu addLine. menu addUpdating: #showWorldMainDockingBarString action: #toggleShowWorldMainDockingBar. menu addLine. Flaps sharedFlapsAllowed ifTrue: [ menu addUpdating: #suppressFlapsString
target: Project current action: #toggleFlapsSuppressed. ]. twm := TheWorldMenu new. twm world: self project: Project current hand: aHandMorph. menu add: 'old desktop menu... (W)' translated subMenu: twm buildWorldMenu. ].! !!PasteUpMorph methodsFor: 'menu & halo' stamp: 'mt 8/16/2023 16:02'!addWorldHaloMenuItemsTo: aMenu hand: aHandMorph "Add standard halo items to the menu, given that the receiver is a World" | unlockables | self addFillStyleMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph. aMenu addLine. self addWorldToggleItemsToHaloMenu: aMenu. aMenu addLine. self addCopyItemsTo: aMenu. self addExportMenuItems: aMenu hand: aHandMorph. self addMiscExtrasTo: aMenu. self addDebuggingItemsTo: aMenu hand: aHandMorph. aMenu addLine. aMenu defaultTarget: self. aMenu addLine. unlockables := self submorphs select: [:m | m isLo cked]. unlockables size = 1 ifTrue: [aMenu add: ('unlock "{1}"' translated format:{unlockables first externalName})action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' translated action: #unlockContents]. aMenu defaultTarget: aHandMorph.! !!PasteUpMorph methodsFor: 'options' stamp: 'mt 8/4/2023 14:08'!autoLineLayout: aBoolean "Make the receiver be viewed with auto-line-layout, which means that its submorphs will be laid out left-to-right and then top-to-bottom in the manner of a word processor, or (if aBoolean is false,) cease applying auto-line-layout" aBoolean ifTrue:[ self layoutPolicy: TableLayout new. self layoutInset: 8; cellGap: 4. self listDirection: #leftToRight; wrapDirection: #topToBottom. ] ifFalse:[ self layoutPolicy: nil. self layoutInset: 0; cellGap: 0. ].! !!PasteUpMorph methodsFor: 'undo' stamp: 'fbs 12/31/2013 12:08'!onceAgainDismiss: aMorph "Occasioned by a r edo of a dismiss-via-halo" aMorph dismissMorph. TrashCanMorph preserveTrash ifTrue: [TrashCanMorph slideDismissalsToTrash ifTrue:[aMorph slideToTrash: nil] ifFalse:[TrashCanMorph moveToTrash: aMorph]]! !!PasteUpMorph methodsFor: 'undo' stamp: 'mt 8/4/2023 14:45'!reintroduceIntoWorld: aMorph "The given morph is being raised from the dead. Bring it back to life." (aMorph valueOfProperty: #lastPosition) ifNotNil: [:pos | aMorph position: pos]. aMorph openInWorld ! !!PasteUpMorph methodsFor: 'WiW support' stamp: 'raa 11/14/2017 07:47'!installAsActiveSubprojectIn: enclosingWorld at: newBounds titled: aString | window howToOpen tm boundsForWorld | howToOpen := self embeddedProjectDisplayMode. "#scaled may be the only one that works at the moment" submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." boundsForWorld := howToOpen == #naked ifTrue : [newBounds] ifFalse: [bounds]. worldState canvas: nil. worldState viewBox: boundsForWorld. self bounds: boundsForWorld. "self viewBox: Display boundingBox." "worldState handsDo: [:h | h initForEvents]." self installFlaps. "SystemWindow noteTopWindowIn: self." "self displayWorldSafely." howToOpen == #naked ifTrue: [enclosingWorld addMorphFront: self]. howToOpen == #window ifTrue: [window := (SystemWindow labelled: aString) model: self. window addMorph: self frame: (0 @ 0 extent: 1.0 @ 1.0). window openInWorld: enclosingWorld]. howToOpen == #frame ifTrue: [window := (AlignmentMorphBob1 new) minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color green; bounds: newBounds. window addMorph: self. window openInWorld: enclosingWorld]. howToOp en == #scaled ifTrue: [self position: 0 @ 0. window := (EmbeddedWorldBorderMorph new) minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color green; bounds: newBounds. tm := BOBTransformationMorph new. window addMorph: tm. tm addMorph: self. window openInWorld: enclosingWorld. tm changeWorldBoundsToShow: bounds. self arrangeToStartSteppingIn: enclosingWorld "tm scale: (tm width / self width min: tm height / self height) asFloat."]! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 8/14/2023 17:32'!findWindow: evt "Present a menu names of windows and naked morphs, and activate the one that gets chosen. Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo." | menu expanded collapsed nakedMorphs | menu := MenuMorph new. expanded := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed not]. collapsed := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed]. nakedMorphs := self submorphsSatisfying: [:m | m isSystemWindow not and: [(m isFlapTab) not]]. (expanded isEmpty & (collapsed isEmpty & nakedMorphs isEmpty)) ifTrue: [^ Beeper beep]. (expanded sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: (w label contractTo: 80) target: w action: #beKeyWindow. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. (expanded isEmpty | (collapsed isEmpty & nakedMorphs isEmpty)) ifFalse: [menu addLine]. (collapsed sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: (w labe l contractTo: 80) target: w action: #collapseOrExpand. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. nakedMorphs isEmpty ifFalse: [menu addLine]. (nakedMorphs sort: [:w1 :w2 | w1 nameForFindWindowFeature caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) do: [:w | menu add: (w nameForFindWindowFeature contractTo: 80) target: w action: #comeToFrontAndAddHalo]. menu addTitle: 'find window' translated. menu popUpEvent: evt in: self.! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 11:27'!invokeWorldMenu: evt "Put up the world menu, triggered by the passed-in event." self putUpWorldMenu: evt.! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 11:27'!keystrokeInWorld: evt "A keystroke was hit when no keyboard focus was set, so it is sent here to the world instead." | aChar isCmd ascii | aChar := evt keyCharacter. (ascii := aChar asciiValue) = Character escape asciiValue ifTrue: [evt commandKeyPressed ifFalse: [^ self putUpWorldMenuFromEscapeKey]]. (evt controlKeyPressed not and: [(#(1 4 8 28 29 30 31 32) includes: ascii) "home, end, backspace, arrow keys, space" and: [self keyboardNavigationHandler notNil]]) ifTrue: [self keyboardNavigationHandler navigateFromKeystroke: aChar]. isCmd := evt commandKeyPressed and: [Preferences cmdKeysInText]. (isCmd and: [Preferences honorDesktopCmdKeys]) ifTrue: [^ self dispatchCommandKeyInWorld: aChar event: evt]. "It was unhandled. Remember the keystroke." self lastKeystroke: evt keyString. self triggerEvent: #keyStroke! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/8/2023 10:36'!putUpNewMorphMenu "Put up the New Morph menu in the world" TheWorldMenu new world: self project: Project current hand: self currentHand; newMorph! !!PasteUpMorph methodsFor: 'world menu' stamp: 'mt 3/10/2023 16:08'!putUpWorldMenuFromEscapeKey
self putUpWorldMenu: self currentEvent.! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/10/2023 13:57'!allNonWindows "Answer all non-window submorphs" ^submorphs select: [:m | (m isSystemWindow) not and: [m wantsToBeTopmost not]]! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/10/2023 15:29'!beWorldForProject: aProject self privateOwner: nil. worldState := WorldState new. self addHand: HandMorph new. self setProperty: #optimumExtentFromAuthor toValue: Display extent. self startSteppingSubmorphsOf: self! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 3/15/2023 13:18'!initForProject: aWorldState worldState := aWorldState. self viewBox: Display boundingBox. self color: Preferences defaultWorldColor. self addHand: HandMorph new. self setProperty: #optimumExtentFromAuthor toValue: Display extent. self borderWidth: 0. model := nil.! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 8/11/2023 16:20'!install owner := nil. "since we may have been inside another world previously" submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." self viewBox: Display boundingBox. EventSensor default flushEvents. worldState handsDo: [:h | h initForEvents]. self installFlaps. self borderWidth: 0. "default" (Preferences showSecurityStatus and: [SecurityManager default isInRestrictedMode]) ifTrue: [self borderWidth: 2; borderColor: Color red]. SystemWindow noteTopWindowIn: self.! !!PasteUpMorph methodsFor: 'world state' stamp: 'mt 8/10/2023 15:27'!paintBox "Return the painting controls widget (PaintBoxMorph) to be used for painting in this world. If there is not already a PaintBox morph, or if it has been deleted from this world, create a new one." | newPaintBox refPoint | self allMorphsDo: [:m | (m isKindOf: PaintB oxMorph) ifTrue: [^ m]]. refPoint := self topRight. newPaintBox := PaintBoxMorph new. newPaintBox position: (refPoint - (newPaintBox width @ 0)). self addMorph: newPaintBox. ^ newPaintBox! !!PasteUpMorph methodsFor: 'world state' stamp: 'sw 9/2/1999 12:01'!paintBoxOrNil "Return the painting controls widget (PaintBoxMorph) to be used for painting in this world. If there is not already a PaintBox morph return nil" self allMorphsDo: [:m | (m isKindOf: PaintBoxMorph) ifTrue: [^ m]]. ^ nil! !!PasteUpMorph methodsFor: '*Tools' stamp: 'mt 3/10/2023 16:08'!defaultDesktopCommandKeyTriplets "Answer a list of triplets of the form <key> <receiver> <selector> [+ optional fourth element, a <description> for use in desktop-command-key-help] that will provide the default desktop command key handlers. If the selector takes an argument, that argument will be the command-key event" "World initializeDesktopCommandKeySelectors" | noviceKeys expertKeys | no viceKeys := { {$r. self. #restoreMorphicDisplay. 'Redraw the screen' translated}. {$M. self. #toggleShowWorldMainDockingBar. 'Show/Hide the Main Docking Bar' translated}. {$]. Smalltalk. #saveSession. 'Save the image.' translated}. }. expertKeys := { {$b. SystemBrowser. #defaultOpenBrowser. 'Open a new System Browser' translated}. {$k. Workspace. #open. 'Open a new Workspace' translated}. {$m. self. #putUpNewMorphMenu. 'Put up the "New Morph" menu' translated}. {$O. self. #findAMonticelloBrowser. 'Bring a Monticello window into focus.' translated}. {$t. self. #findATranscript:. 'Make a System Transcript visible' translated}. {$w. SystemWindow. #closeTopWindow. 'Close the topmost window' translated}. {Character escape. SystemWindow. #closeTopWindow. 'Close the topmost window' translated}. {$C. self. #findAChangeSorter:. 'Make a Change Sorter visible' translated}. {$L. self. #findAFileList:. 'Make a File List visible' translated}. {$P. self. #findAPreferencesPanel:. 'Activate the Preferences tool' translated}. {$R. Utilities. #browseRecentSubmissions. 'Make a Recent Submissions browser visible' translated}. {$W. self. #findAMessageNamesWindow:. 'Make a MessageNames tool visible' translated}. {$Z. ChangeList. #browseRecentLog. 'Browse recently-logged changes' translated}. {$. SystemWindow. #sendTopWindowToBack. 'Send the top window to the back' translated}. {$_. Smalltalk. #quitPrimitive. 'Quit the image immediately.' translated}. {$-. Preferences. #decreaseFontSize. 'Decrease all font sizes' translated}. {$+. Preferences. #increaseFontSize. 'Increase all font sizes' translated}. }. ^ noviceKeys, expertKeys! !!PasteUpMorph methodsFor: 'flaps' stamp: 'mt 8/4/2023 14:02'!addGlobalFlaps "Must make global flaps adapt to world. Do this even if not shown, so the old world will not be pointed at by the flaps." | use thisWorld | use := Flaps sharedFlapsAllowed. Project current flapsSuppressed ifTrue: [use := false]. "Smalltalk isMorphic ifFalse: [use := false]." thisWorld := use ifTrue: [self] ifFalse: [PasteUpMorph new initForProject: "fake to be flap owner" WorldState new; bounds: (0(a)0 extent: 4000(a)4000); viewBox: (0(a)0 extent: 4000(a)4000)]. Flaps globalFlapTabsIfAny do: [:aFlapTab | (Project current isFlapEnabled: aFlapTab) ifTrue: [(aFlapTab world == thisWorld) ifFalse: [thisWorld addMorphFront: aFlapTab]. "always do" use ifTrue: [aFlapTab spanWorld. aFlapTab adjustPositionAfterHidingFlap. aFlapTab flapShowing ifTrue: [aFlapTab showFlap]]]]! !!PasteUpMorph methodsFor: 'flaps' stamp: 'nice 12/27/2009 20:14'!localFlapTabs "Answer a list of local fla p tabs in the current project" | globalList aList | globalList := Flaps globalFlapTabsIfAny. aList := OrderedCollection new. submorphs do: [:m | | aFlapTab | ((m isFlapTab) and: [(globalList includes: m) not]) ifTrue: [aList add: m] ifFalse: [((m isFlap) and: [(aFlapTab := m submorphs detect: [:n | n isFlapTab] ifNone: [nil]) notNil]) ifTrue: [aList add: aFlapTab]]]. ^ aList! !!PasteUpMorph methodsFor: '*services-base' stamp: 'mt 8/4/2023 14:03'!openWorldMenu | menu | menu := (TheWorldMenu new world: self project: nil hand: self primaryHand) buildWorldMenu. menu addTitle: Preferences desktopMenuTitle translated. menu openInHand! !!PasteUpMorph methodsFor: '*services-base' stamp: 'mt 8/28/2023 14:42'!worldMenu ^ TheWorldMenu new world: self project: nil hand: self primaryHand! !!PasteUpMorph class methodsFor: 'scripting' stamp: 'mt 3/15/2023 13:30'!authoringPrototype "Answer an instance of the receiver suitable for placing in a parts bin for authors" | proto | proto := self new markAsPartsDonor. proto color: Color green muchLighter; extent: 100 @ 80; borderColor: (Color r: 0.645 g: 0.935 b: 0.161). proto extent: 300 @ 240. proto beSticky. ^ proto! !!PasteUpMorph class methodsFor: '*MorphicExtras-class initialization' stamp: 'mt 7/31/2023 11:14'!initialize "Initialize the class" self registerInFlapsRegistry.! !!PolygonMorph methodsFor: 'stepping' stamp: 'mt 3/10/2023 15:01'!stepTime "Answer the desired time between steps in milliseconds." ^ 100! !!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:59'!printStandardSystemFonts "self printStandardSystemFonts" | string | string := String streamContents: [ :s | #(standardDefaultTextFont standardListFont standardFlapFont standardMenuFont windowTitleFont standardBalloonHelpFont standardCodeFont standardButtonFont) do: [:selector | | font | font := Preferences perform: selector. s nextPutAll: selector; space; nextPutAll: font familyName; space; nextPutAll: (AbstractFont emphasisStringFor: font emphasis); nextPutAll: ' points: '; print: font pointSize; nextPutAll: ' height: '; print: font height; cr ]]. (StringHolder new) contents: string; openLabel: 'Current system font settings' translated.! !!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:58'!refreshFontSettings "Try to update all the current font settings to make things consistent." UserInterfaceTheme current applyAfter: [ self setFlapsFontTo: (self standardFlapFont); setWindowTitleFontTo: (self windowTitleFont); setListFontTo: (self standardListFont); setMenuFontTo: (self standardMenuFont);
setSystemFontTo: (TextStyle defaultFont); setCodeFontTo: (self standardCodeFont); setBalloonHelpFontTo: (BalloonMorph balloonFont)]. SystemWindow allSubInstancesDo: [ :s | | rawLabel | rawLabel := s getRawLabel. rawLabel owner vResizing: #spaceFill. rawLabel font: rawLabel font. s setLabel: s label. s replaceBoxes ].! !!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 8/11/2023 13:59'!restoreFontsAfter: aBlock "Restore the currently chosen set of standard fonts after evaluating aBlock. Used for tests that modify the default fonts." | standardDefaultTextFont standardListFont standardMenuFont windowTitleFont standardBalloonHelpFont standardCodeFont standardButtonFont | standardDefaultTextFont := Preferences standardDefaultTextFont. standardListFont := Preferences standardListFont. standardMenuFont := Preferences standardMenuFont. windowTitleFont := Preferences windowTitleFont. standardBalloonHelpFont := Preferences standardBalloonHelpFont. standardCodeFont := Preferences standardCodeFont. standardButtonFont := Preferences standardButtonFont. ^ UserInterfaceTheme current applyAfter: [ aBlock ensure: [ Preferences setSystemFontTo: standardDefaultTextFont. Preferences setListFontTo: standardListFont. Preferences setMenuFontTo: standardMenuFont. Preferences setWindowTitleFontTo: windowTitleFont. Preferences setBalloonHelpFontTo: standardBalloonHelpFont. Preferences setCodeFontTo: standardCodeFont. Preferences setButtonFontTo: standardButtonFont]].! !!Preferences class methodsFor: 'support - misc' stamp: 'mt 3/7/2023 15:42'!personalizeUserMenu: aMenu "The user has clicked on the morphic desktop with the yellow mouse button (option+click on the Mac); a menu is being constructed to present to the user in response; its default target is the current world. In th is method, you are invited to add items to the menu as per personal preferences. The default implementation, for illustrative purposes, sets the menu title to 'personal', and adds items for go-to-previous-project, show/hide flaps, and load code updates" aMenu addTitle: 'personal' translated. "Remove or modify this as per personal choice" aMenu addStayUpItem. aMenu add: 'previous project' translated action: #goBack. aMenu add: 'load latest code updates' translated target: MCMcmUpdater action: #updateFromServer. aMenu add: 'about this system...' translated target: Smalltalk action: #aboutThisSystem.! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'!classicHaloSpecs "Non-iconic halos with traditional placements" "Preferences installClassicHaloSpecs" "Preferences resetHaloSpecifications" " <- will result in the standard default halos being reinstalled" "NB: listed below in clockwise order" ^ #( " selecto r horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addMenuHandle: left top (red) none) (addDismissHandle: leftCenter top (red muchLighter) 'Halo-Dismiss') (addGrabHandle: center top (black) none) (addDragHandle: rightCenter top (brown) none) (addDupHandle: right top (green) none) (addDebugHandle: right topCenter (blue veryMuchLighter) none) (addGrowHandle: right bottom (yellow) none) (addScaleHandle: right bottom (lightOrang e) none) (addFontEmphHandle: rightCenter bottom (lightBrown darker) none) (addFontStyleHandle: center bottom (lightRed) none) (addFontSizeHandle: leftCenter bottom (lightGreen) none) (addRecolorHandle: right bottomCenter (magenta darker) none) (addRotateHandle: left bottom (blue) none))! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/8/2023 11:41'!customHaloSpecs "Intended for you to modify to suit your personal preference. What is implemented in the default here is just a skeleton; in comment at the bottom of this method are some useful lines you may wish to paste in to the main body here, possibly modifying positions, colors, etc.. Note that in this example, we include: Dismiss handle, at top-left M enu handle, at top-right Resize handle, at bottom-right Rotate handle, at bottom-left Drag handle, at top-center Recolor handle, at left-center. (this one is NOT part of the standard formulary -- it is included here to illustrate how to add non-standard halos) Note that the optional handles for specialized morphs, such as Sketch, Text, PasteUp, are also included" ^ #( (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addMenuHandle: right top (red) 'Halo-Menu') (addDragHandle: center top (brown) 'Halo-Drag') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bot tom (lightOrange) 'Halo-Scale') (addRecolorHandle: left center (green muchLighter lighter) 'Halo-Recolor') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') ) " Other useful handles... selector horiz vert color info icon key --------- ------ ----------- ------------------------------- --------------- (addTileHandle: left bottomCenter (lightBrown) 'Halo-Tile') (addViewHandle: left center (cyan) 'Halo-View') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addFewerHandlesHandle: left topCenter (paleBuff) 'Halo-FewerHandles') (addPaintBgdHandle: right center (lightGray) 'Halo-Paint') (addRepaintHandle: right center (lightGray) 'Halo-Paint ') "! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/8/2023 11:30'!haloSpecificationsForWorld | desired | "Answer a list of HaloSpecs that describe which halos are to be used on a world halo, what they should look like, and where they should be situated" "Preferences resetHaloSpecifications" desired := #(addDebugHandle: addMenuHandle: addHelpHandle: addRecolorHandle:). ^ self haloSpecifications select: [:spec | desired includes: spec addHandleSelector]! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'!iconicHaloSpecifications "Answer an array that characterizes the locations, colors, icons, and selectors of the halo handles that may be used in the iconic halo scheme" "Preferences resetHaloSpecifications" ^ #( " selector horiz vert color info icon key --------- ------ ----------- -------------------------------
---------------" (addCollapseHandle: left topCenter (tan) 'Halo-Collapse') (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addMenuHandle: leftCenter top (red) 'Halo-Menu') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue)
'Halo-Help') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor') ) ! !!Preferences class methodsFor: 'prefs - halos' stamp: 'mt 3/10/2023 14:21'!simpleFullHaloSpecifications "This method gives the specs for the 'full' handles variant when simple halos are in effect" "Preferences resetHaloSpecifications" ^ #( " selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addRotateHandle: left bottom (blue) 'Halo-Rot') (addMenuHandle: leftCenter top (red) 'Halo-Menu') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale') (addFewerHandlesHandle: left topCenter (paleBuff) 'Halo-FewerHandles') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor') ) ! !!Preferences class methodsFor: 'defaults' stamp: 'mt 8/29/2023 15:25'!defaultValueTableForCurrentRelease "Answer a table defining default values for all the prefere nces in the release. Returns a list of (pref-symbol, boolean-symbol) pairs" ^ #( (alternativeBrowseIt false) (annotationPanes false) (areaFillsAreTolerant false) (areaFillsAreVeryTolerant false) (automaticKeyGeneration false) (balloonHelpEnabled true) (balloonHelpInMessageLists false) (caseSensitiveFinds false) (changeSetVersionNumbers true) (checkForSlips true) (checkForUnsavedProjects true) (cmdDotEnabled true) (collapseWindowsInPlace false) (confirmFirstUseOfStyle true) (conversionMethodsAtFileOut false) (debugHaloHandle true) (debugPrintSpaceLog false) (debugShowDamage false) (decorateBrowserButtons true) (diffsInChangeList true) (diffsWithPrettyPrint false) (dismissAllOnOptionClose false) (fastDragWindowForMorphic true) (fullScreenLeavesDeskMargins true) (higherPerformance false) (honorDesktopCm dKeys true) (logDebuggerStackToFile true) (menuKeyboardControl false) (modalColorPickers true) (mouseOverForKeyboardFocus false) (navigatorOnLeftEdge true) (optionalButtons true) (passwordsOnPublish false) (personalizedWorldMenu true) (postscriptStoredAsEPS false) (projectViewsInWindows true) (projectZoom true) (projectsSentToDisk false) (readDocumentAtStartup true) (restartAlsoProceeds false) (reverseWindowStagger true) (roundedMenuCorners true) (scrollBarsNarrow false) (scrollBarsOnRight true) (securityChecksEnabled false) (showBoundsInHalo false) (showDirectionForSketches false) (showDirectionHandles false) (showProjectNavigator false) (showSecurityStatus true) (signProjectFiles true) (smartUpdating true) (startInUntrustedDirectory false) (systemWindowEmbedOK false) (timeStampsInMenuTitles true) (turnOffPowerManager false) (twentyFourHourFileStamps true) (uniqueNamesInHalos false) (useButtonPropertiesToFire false) (warnAboutInsecureContent true) (warnIfNoChangesFile true) (warnIfNoSourcesFile true))"Preferences defaultValueTableForCurrentRelease do: [:pair | (Preferences preferenceAt: pair first ifAbsent: [nil]) ifNotNilDo: [:pref | pref defaultValue: (pair last == true)]].Preferences chooseInitialSettings."! !!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/10/2023 16:09'!disableProgrammerFacilities "Warning: do not call this lightly!! It disables all access to menus, debuggers, halos. There is no guaranteed return from this, which is to say, you cannot necessarily reenable these things once they are disabled -- you can only use whatever the UI of the current project affords, and you cannot even snapshot -- you can only quit. You can completely r everse the work of this method by calling the dual Preferences method enableProgrammerFacilities, provided you have left yourself leeway to bring about a call to that method. To set up a system that will come up in such a state, you have to request the snapshot in the same breath as you disable the programmer facilities. To do this, put the following line into the 'do' menu and then evaluate it from that 'do' menu: Preferences disableProgrammerFacilities.You will be prompted for a new image name under which to save the resulting image." Beeper beep. (self confirm: 'CAUTION!!!!This is a drastic step!!Do you really want to do this?') ifFalse: [Beeper beep. ^self inform: 'whew!!']. self disable: #cmdDotEnabled. "No user-interrupt-into-debugger" self compileAccessorForPreferenceNamed: #cmdGesturesEnabled value: false. "No halos, etc." self compileAccessorForPreferenceNamed: #cmdKeysInText value: false. "No user commands invokable via cmd-key combos in text editor" self disable: #warnIfNoSourcesFile. self disable: #warnIfNoChangesFile. Smalltalk saveAs! !!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/10/2023 16:09'!enableProgrammerFacilities "Meant as a one-touch recovery from a #disableProgrammerFacilities call." "Preferences enableProgrammerFacilities" self enable: #cmdDotEnabled. self compileAccessorForPreferenceNamed: #cmdGesturesEnabled value: true. self compileAccessorForPreferenceNamed: #cmdKeysInText value: true. self enable: #warnIfNoSourcesFile. self enable: #warnIfNoChangesFile.! !!Preferences class methodsFor: 'initialization - misc' stamp: 'mt 3/15/2023 13:50'!setNotificationParametersForStandardPreferences "Set up the notification parameters for the standard preferences that require need them. When adding new Preferences that require use of the notification mechanism, users declare the notifcation info as part of the call that adds the preference, or afterwards -- the two relevant methods for doing that are: Preferences.addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: and Preference changeInformee:changeSelector:" "Preferences setNotificationParametersForStandardPreferences" #( (annotationPanes annotationPanesChanged) (optionalButtons optionalButtonsChanged) (smartUpdating smartUpdatingChanged) ) do: [:pair | | aPreference | aPreference := self preferenceAt: pair first. aPreference changeInformee: self changeSelector: pair second]! !!Preferences class methodsFor: 'initialization - save/load' stamp: 'mt 3/7/2023 13:27'!loadPreferencesFrom: aFile | stream params dict desktopColor patternsToIgnore | patternsToIgnore := #('*updateMapName' '*defaultUpdateURL'). stream := ReferenceStream fileNamed: aFile. params := stream n ext. self assert: (params isKindOf: IdentityDictionary). params removeKey: #PersonalDictionaryOfPreferences. dict := stream next. self assert: (dict isKindOf: IdentityDictionary). desktopColor := stream next. stream close. dict rehash. "See http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217817.html" dict keys reject: [:key | patternsToIgnore anySatisfy: [:pattern | pattern match: key]] thenDo: [:key | | value | value := dict at: key. (self preferenceAt: key ifAbsent: [nil]) ifNotNil: [:pref | [pref preferenceValue: value preferenceValue] on: Deprecation do: [ : err | "Ignore preferences which may not be supported anymore."]]]. params keysAndValuesDo: [ :key :value | self setParameter: key to: value ]. Project current world fillStyle: desktopColor.! !!ProgressMorph methodsFor: 'private' stamp: 'mt 8/11/2023 14:00'!fontOfPointSize: size ^ (TextConstants at: Prefe rences standardDefaultTextFont familyName ifAbsent: [TextStyle default]) fontOfPointSize: size! !!Project methodsFor: 'displaying' stamp: 'mt 8/28/2023 14:08'!displayZoom: entering "Show the project transition when entering a new project" | newDisplay vanishingPoint | "Show animated zoom to new display" newDisplay := self imageForm. entering ifTrue: [vanishingPoint := Sensor cursorPoint] ifFalse: [vanishingPoint := self viewLocFor: CurrentProject]. Display zoomIn: entering orOutTo: newDisplay at: 0(a)0 vanishingPoint: vanishingPoint.! !!Project methodsFor: 'file in/out' stamp: 'mt 8/16/2023 15:46'!exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: noInteraction | exportChangeSet | "An experimental version to fileout a changeSet first so that a project can contain its own classes" "Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target i mage. Name it <project name>.extSeg. Player classes are included automatically." exportChangeSet := nil. (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [ (noInteraction or: [self confirm: 'Would you like to include all the changes in the change set as part of this publishing operation?' translated]) ifTrue: [ exportChangeSet := changeSet ]. ]. ^ self exportSegmentWithChangeSet: exportChangeSet fileName: aFileName directory: aDirectory withoutInteraction: noInteraction! !!Project methodsFor: 'menu messages' stamp: 'mt 8/23/2023 13:50'!validateProjectNameIfOK: aBlock | details | details := world valueOfProperty: #ProjectDetails. details ifNotNil: ["ensure project info matches real project name" details at: 'projectname' put: self name. ]. self doWeWantToRename ifTrue: [self notify: 'Please choose another name!!'] ifFalse: [aBlock value: details]! !!MorphicProj ect methodsFor: 'initialize' stamp: 'mt 3/8/2023 09:42'!initialize "Initialize a new Morphic Project" super initialize. world := PasteUpMorph newWorldForProject: self. self setWorldBackground: true. Locale switchToID: CurrentProject localeID. Project current isMorphic ifTrue: [ "Only trigger tool builders etc. if we are already in the same kind of project because there is global state that cannot yet be configured in a dynamic scope such as 'ToolBuilder default'." self assureMainDockingBarPresenceMatchesPreference].! !!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/16/2023 17:02'!exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileNamedirectory: aDirectory withoutInteraction: noInteraction "Store my project out on the disk as an *exported*ImageSegment. All outPointers will be in a form that can be resolvedin the target image. Name it <project name>.extSeg. Whatdo we doabout subProjects, especially if they are out as local imagesegments? Force them to come in? Player classes are included automatically." | is str ans revertSeg roots holder collector fd mgr stacks | "Files out a changeSet first, so that a project can containits own classes" world ifNil: [^ false]. ScrapBook default emptyScrapBook. world currentHand pasteBuffer: nil. "don't write the paste buffer." world currentHand mouseOverHandler initialize. "forget about any references here" "Display checkCurrentHandForObjectToPaste." Command initialize. world clearCommandHistory. world fullReleaseCachedState. world cleanseStepList. world localFlapTabs size = world flapTabs size ifFalse: [noInteraction ifTrue: [^ false]. self error: 'Still holding onto Global flaps']. world releaseSqueakPages. holder := Project allProjects. "force them in to outPointers, where DiskProxys are made" "Just export me, not my previous version" revertSeg := self parameterAt: #revert ToMe. self removeParameter: #revertToMe. roots := OrderedCollection new. roots add: self; add: world; add: transcript; add: aChangeSetOrNil; add: thumbnail; add: world activeHand. roots := roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail" fd := aDirectory directoryNamed: self resourceDirectoryName. fd assureExistence. "Clean up resource references before writing out" mgr := self resourceManager. self resourceManager: nil. ResourceCollector current: ResourceCollector new. ResourceCollector current localDirectory: fd. ResourceCollector current baseUrl: self resourceUrl. ResourceCollector current initializeFrom: mgr. ProgressNotification signal: '2:findingResources' extra:'(collecting resources...)' translated. "Must activate old world because this is run at #armsLength. Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent will not be captured correc tly if referenced from blocks or user code." world becomeActiveDuring: [is := ImageSegment copySmartRootsExport: roots asArray. "old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)"]. self resourceManager: mgr. collector := ResourceCollector current. ResourceCollector current: nil. ProgressNotification signal: '2:foundResources' extra: ''. is state = #tooBig ifTrue: [collector replaceAll. ^ false]. str := ''. "considered legal to save a project that has never been entered" (is outPointers includes: world) ifTrue: [str := str, '\Project''s own world is not in the segment.' translated withCRs]. str isEmpty ifFalse: [ans := Project uiManager chooseOptionFrom: {'Do not write file' translated. 'Write file anyway' translated. 'Debug' translated} title: str. ans = 1 ifTrue:
[revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. ^ false]. ans = 3 ifTrue: [collector replaceAll. self halt: 'Segment not written' translated]]. stacks := is findStacks. is writeForExportWithSources: aFileName inDirectory: fd changeSet: aChangeSetOrNil. SecurityManager default signFile: aFileName directory: fd. "Compress all files and update check sums" collector forgetObsolete. self storeResourceList: collector in: fd. self storeHtmlPageIn: fd. self storeManifestFileIn: fd. self writeStackText: stacks in: fd registerIn: collector. "local proj.005.myStack.t" self compressFilesIn: fd to: aFileName in: aDirectory resources: collector. "also deletes the resource directory" "Now update everything tha t we know about" mgr updateResourcesFrom: collector. revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. world flapTabs do: [:ft | (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. ^ true! !!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/11/2023 16:06'!storeSegment "Store my project out on the disk as an ImageSegment. Keep the outPointers in memory. Name it <project name>.seg. *** Caller must be holding (Project alInstances) to keep subprojects from going out. ***" | currentWorld is sizeHint | currentWorld := Project current world. (currentWorld == world) ifTrue: [^ false]. "self inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ false]. "already done" world ifNil: [^ false]. ScrapBook default emptyScrapBook. currentWorld checkCurrentHandForObjectToPaste. world releaseSqueakPages. sizeHint := self projectParame ters at: #segmentSize ifAbsent: [0]. is := ImageSegment copyFromRootsLocalFileFor: {world} sizeHint: sizeHint. is state = #tooBig ifTrue: [^ false]. is segment size < 2000 ifTrue: ["debugging" Transcript show: self name, ' only ', is segment size printString, 'bytes in Segment.'; cr]. self projectParameters at: #segmentSize put: is segment size. is extract; writeToFile: self name. ^ true! !!MorphicProject methodsFor: 'file in/out' stamp: 'mt 8/11/2023 16:08'!storeSegmentNoFile "For testing. Make an ImageSegment. Keep the outPointers in memory. Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)" | is currentWorld | currentWorld := Project current world. (currentWorld == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ self]. "already done" world ifNil: [^ self]. "Do this on project enter" ScrapBook de fault emptyScrapBook. currentWorld checkCurrentHandForObjectToPaste2. is := ImageSegment copyFromRootsLocalFileFor: {world} sizeHint: 0. is segment size < 800 ifTrue: ["debugging" Transcript show: self name, ' did not get enough objects'; cr. ^ Beeper beep]. is extract. "is instVarAt: 2 put: is segment clone." "different memory"! !!MorphicProject methodsFor: 'enter' stamp: 'mt 3/10/2023 15:01'!enterAsActiveSubprojectWithin: enclosingWorld "Install my ChangeSet, Transcript, and scheduled views as current globals. If returningFlag is true, we will return to the project from whence the current project was entered; don't change its previousProject link in this case. If saveForRevert is true, save the ImageSegment of the project being left. If revertFlag is true, make stubs for the world of the project being left. If revertWithoutAsking is true in the project being left, then always revert." "Experimental mods for i nitial multi-project work: 1. assume in morphic (this eliminated need for <showZoom>) 2. assume <saveForRevert> is false (usual case) - removed <old> 3. assume <revertFlag> is false 4. assume <revertWithoutAsking> is false - <forceRevert> now auto false <seg> n.u. 5. no zooming 6. assume <projectsSentToDisk> false - could be dangerous here 7. assume no isolation problems (isolationHead ==) 8. no closing scripts " self isCurrentProject ifTrue: [^ self]. "guards ifNotNil: [ guards := guards reject: [:obj | obj isNil]. guards do: [:obj | obj okayToEnterProject ifFalse: [^ self]] ]." "CurrentProject makeThumbnail." "--> Display bestGuessOfCurrentWorld triggerClosingScripts." CurrentProject displayDepth: Display depth. displayDepth == nil ifTrue: [displayDepth := Display depth]. "Display newDepthNoRestore: displayDepth." "(world hasProperty: #letTheMusicPlay) ifT rue: [world removeProperty: #letTheMusicPlay] ifFalse: [Smalltalk at: #ScorePlayer ifPresent: [:playerClass | playerClass allSubInstancesDo: [:player | player pause]]]." "returningFlag ifTrue: [nextProject := CurrentProject] ifFalse: [previousProject := CurrentProject]." "CurrentProject saveState." "CurrentProject := self." "Smalltalk newChanges: changeSet." "TranscriptStream newTranscript: transcript." "Sensor flushKeyboard." "recorderOrNil := Display pauseMorphicEventRecorder." "Display changeMorphicWorldTo: world." "Signifies Morphic" world installAsActiveSubprojectIn: enclosingWorld titled: self name. "recorderOrNil ifNotNil: [recorderOrNil resumeIn: world]." self removeParameter: #exportState. "self spawnNewProcessAndTerminateOld: true"! !!MorphicProject methodsFor: 'enter' stamp: 'mt 8/28/2023 14:28'!finalEnterActions: leavingP roject "Perform the final actions necessary as the receiver project is entered" | navigator armsLengthCmd navType thingsToUnhibernate | "If this image has a global World variable, update it now" Smalltalk globals at: #World ifPresent: [ :w | Smalltalk globals at: #World put: world ]. world install. world transferRemoteServerFrom: leavingProject world. "(revertFlag | saveForRevert | forceRevert) ifFalse: [ (Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [ self storeSomeSegment]]." "Transfer event recorder to me." leavingProject isMorphic ifTrue: [ leavingProject world pauseEventRecorder ifNotNil: [:rec | rec resumeIn: world]]. self initializeMenus. self projectParameters at: #projectsToBeDeleted ifPresent: [ :projectsToBeDeleted | self removeParameter: #projectsToBeDeleted. projectsToBeDeleted do: [:each | each delete]]. Locale switchToID: self localeID. thingsToUnhibernate := world valueOfProperty: #thingsToUnhibernate ifAbsent: [#()]. thingsToUnhibernate do: [:each | each unhibernate]. world removeProperty: #thingsToUnhibernate. navType := ProjectNavigationMorph preferredNavigator. armsLengthCmd := self parameterAt: #armsLengthCmd ifAbsent: [nil]. navigator := world findA: navType. (Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator and: [navigator isNil]]) ifTrue: [(navigator := navType new) bottomLeft: world bottomLeft; openInWorld: world]. navigator notNil & armsLengthCmd notNil ifTrue: [navigator color: Color lightBlue]. armsLengthCmd notNil ifTrue: [self flapsSuppressed: true. navigator ifNotNil: [navigator visible: false]. armsLengthCmd openInWorld: world]. world reformulateUpdatingMenus. self assureMainDockingBarPresenceMatchesPreference. world repairEmbeddedWorlds.! !!MorphicProject methodsFor: 'enter ' stamp: 'mt 8/11/2023 16:05'!finalExitActions: enteringProject "Pause sound players, subject to preference settings" (world hasProperty: #letTheMusicPlay) ifTrue: [world removeProperty: #letTheMusicPlay] ifFalse: [SoundService stop]. world sleep. (world findA: ProjectNavigationMorph) ifNotNil: [:navigator | navigator retractIfAppropriate]. self clearGlobalState. EventSensor default flushEvents. self world submorphsDo: [:ea | ea removeProperty: #dropShadow].! !!MorphicProject methodsFor: 'release' stamp: 'mt 3/10/2023 15:10'!prepareForDelete "The window in which the project is housed is about to deleted. Perform any necessary actions to prepare for deletion." Smalltalk at: #WonderlandCameraMorph ifPresent:[:aClass | world submorphs do: "special release for wonderlands" [:m | (m isKindOf: aClass) and: [m getWonderland release]]].! !!MorphicProject methodsFor: 'language' sta mp: 'mt 3/10/2023 16:07'!chooseNaturalLanguage "Put up a menu allowing the user to choose the natural language for the project" | aMenu availableLanguages | aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'choose language' translated. aMenu lastItem setBalloonText: 'This controls the human language in which tiles should be viewed. It is potentially extensible to be a true localization mechanism, but initially it only works in the classic tile scripting system. Each project has its own private language choice' translated. aMenu addStayUpItem. availableLanguages := NaturalLanguageTranslator availableLanguageLocaleIDs sorted:[:x :y | x displayName < y displayName]. availableLanguages do: [:localeID | aMenu addUpdating: #stringForLanguageNameIs: target: Locale selector: #switchToID: argumentList: {localeID}]. aMenu popUpInWorld"Project current chooseNaturalLanguage"! !!MorphicProject method sFor: 'language' stamp: 'mt 8/4/2023 15:20'!updateLocaleDependents "Set the project's natural language as indicated" Flaps disableGlobalFlaps: false. Flaps enableGlobalFlaps. (self isFlapIDEnabled: 'Navigator' translated) ifFalse: [Flaps enableDisableGlobalFlapWithID: 'Navigator' translated]. ScrapBook default emptyScrapBook. MenuIcons initializeTranslations. super updateLocaleDependents. "self setFlaps. self setPaletteFor: aLanguageSymbol."! !!MorphicProject methodsFor: 'scheduling & debugging' stamp: 'mt 3/10/2023 11:26'!interruptCleanUpFor: interruptedProcess "Clean up things in case of a process interrupt." super interruptCleanUpFor: interruptedProcess. self uiProcess == interruptedProcess ifTrue: [ self currentHand ifNotNil: [:hand | hand interrupted]. world removeProperty: #shouldDisplayWorld].! !!Project class methodsFor: 'utilities' stamp: 'mt 3/15/2023 14:01'!removeAll: projects "Project removeAll: (Pr oject allSubInstances copyWithout: Project current)" AllProjects := nil. Smalltalk garbageCollect. ProjectHistory currentHistory initialize. projects do: [:project | Project deletingProject: project]. Smalltalk garbageCollect. Smalltalk garbageCollect.! !!ProjectLauncher methodsFor: 'initialization' stamp: 'mt 8/4/2023 13:21'!setupFlaps "Only called when the image has been launched in a browser. If I am requested to show all flaps, then if flaps already exist, use them as is, else set up to show the default set of standard flaps." whichFlaps = 'all' ifTrue: [Flaps sharedFlapsAllowed ifFalse: [Flaps enableGlobalFlaps]]! !!ProjectLauncher methodsFor: 'running' stamp: 'mt 8/4/2023 13:23'!startUp | scriptName loader isUrl | self setupFlaps. Smalltalk firstArgMightBeDocument ifTrue: [scriptName := Smalltalk documentPath. scriptName := scriptName convertFromSystemString. scriptName isEmpty ifFalse: ["figure out if script name is a URL by itself" isUrl := (scriptName asLowercase beginsWith: 'http://') or: [(scriptName asLowercase beginsWith: 'file://') or: [scriptName asLowercase beginsWith: 'ftp://']]. isUrl ifFalse: [| encodedPath pathTokens | "Allow for ../dir/scriptName arguments" pathTokens := scriptName splitBy: FileDirectory slash. pathTokens := pathTokens collect: [:s | s encodeForHTTP]. encodedPath := pathTokens reduce: [:acc :each | acc , FileDirectory slash , each]. scriptName := (FileDirectory default uri resolveRelativeURI: encodedPath) asString]]] ifFalse: [scriptName := '']. scriptName isEmptyOrNil ifT rue: [^ self]. loader := CodeLoader new. loader loadSourceFiles: (Array with: scriptName). (scriptName asLowercase endsWith: '.pr') ifTrue: [self installProjectFrom: loader] ifFalse: [loader installSourceFiles]! !!ProjectLoading class methodsFor: 'accessing' stamp: 'mt 8/28/2023 13:46'!projectStreamFromArchive: archive | ext prFiles entry unzipped | ext := FileDirectory dot, Project projectExtension. prFiles := archive members select:[:any| any fileName endsWith: ext]. prFiles isEmpty ifTrue: ['']. entry := prFiles first. unzipped := MultiByteBinaryOrTextStream on: (ByteArray new: entry uncompressedSize). entry extractTo: unzipped. ^unzipped reset! !!ProjectLoading class methodsFor: 'loading' stamp: 'mt 8/28/2023 13:51'!openName: aFileName stream: preStream fromDirectory: aDirectoryOrNilwithProjectView: existingView clearOriginFlag: clearOriginFlag "Reconstitute a Morph from the selected file, presumed torepresent a Morph saved via the SmartRefStream mechanism, and open itin an appropriate Morphic world." | morphOrList archive mgr substituteFont numberOfFontSubstitutes resultArray anObject project manifests dict | ProgressNotification signal: '0.2'. archive := preStream isZipArchive ifTrue:[ZipArchive new readFrom: preStream] ifFalse:[nil]. archive ifNotNil:[ manifests := (archive membersMatching: '*manifest'). (manifests size = 1 and: [((dict := self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression']) ifTrue: [^ self notify: 'S-Expression format projects not supported. Use Squeak 6.0 or older.']]. morphOrList := self morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive. morphOrList ifNil: [^ self]. ProgressNotification signal: '0.4'. resultArray := self fileInName: aFileName archive: archive morphOrList: morphOrList. anObject := resultArray first. numberOfFontSubstitut es := resultArray second. substituteFont := resultArray third. mgr := resultArray fourth. preStream close. ProgressNotification signal: '0.7'. "the hard part is over" (anObject isKindOf: ImageSegment) ifTrue: [ project := self loadImageSegment: anObject fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr. project noteManifestDetailsIn: dict. clearOriginFlag ifTrue: [project forgetExistingURL]. ProgressNotification signal: '0.8'. ^ project ifNil: [self inform: 'No project found in this file' translated] ifNotNil: [ProjectEntryNotification signal: project]]. Project current openViewAndEnter: anObject! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'tak 9/3/2006 11:00'!checkSecurity: aFileName preStream: preStream projStream: projStream "Answer true if passed" | trusted enterRestricted | trusted := SecurityManager default positionToSecureContentsOf:projStream. trusted ifFalse: [enterRestricted := (preStream isTypeHTTP or:[aFileName isNil]) ifTrue: [Preferences securityChecksEnabled] ifFalse: [Preferences standaloneSecurityChecksEnabled]. enterRestricted ifTrue: [SecurityManager default enterRestrictedMode ifFalse: [preStream close. ^ false]]]. ^ true! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'mt 8/28/2023 13:49'!fileInName: aFileName archive: archive morphOrList: morphOrList | baseChangeSet substituteFont numberOfFontSubstitutes exceptions anObject mgr | ResourceCollector current: ResourceCollector new. baseChangeSet := ChangeSet current. self useTempChangeSet. "named zzTemp" "The actual reading happens here" substituteFont := Preference s standardDefaultTextFont copy. numberOfFontSubstitutes := 0. exceptions := Set new. [[anObject := morphOrList fileInObjectAndCodeForProject] on: MissingFont do: [ :ex | exceptions add: ex. numberOfFontSubstitutes := numberOfFontSubstitutes + 1. ex resume: substituteFont ]] ensure: [ ChangeSet newChanges: baseChangeSet]. mgr := ResourceManager new initializeFrom: ResourceCollector current. mgr fixJISX0208Resource. mgr registerUnloadedResources. archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName]. ResourceCollector current: nil. ^ {anObject. numberOfFontSubstitutes. substituteFont. mgr}! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'mt 8/28/2023 14:00'!loadImageSegment: morphOrList fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr | proj projectsToBeD eleted f | (f := (Flaps globalFlapTabWithID: 'Navigator' translated)) ifNotNil: [f hideFlap]. proj := morphOrList arrayOfRoots detect: [:mm | mm isKindOf: Project] ifNone: [^ nil]. proj projectParameterAt: #substitutedFont put: substituteFont. proj projectParameters at: #MultiSymbolInWrongPlace put: false. "Yoshiki did not put MultiSymbols into outPointers in older images!!" morphOrList arrayOfRoots do: [:obj | obj fixUponLoad: proj seg: morphOrList "imageSegment"]. (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [ morphOrList arrayOfRoots do: [:obj | (obj isKindOf: HashedCollection ) ifTrue: [obj rehash]]]. proj resourceManager: mgr. "proj versionFrom: preStream." proj lastDirectory: aDirectoryOrNil. proj setParent: Project current. projectsToBeDeleted := OrderedCollection new. existingView == #none ifFalse: [ self makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted]. ChangeSet allChangeSets add: proj changeSet. Project current projectParameters at: #deleteWhenEnteringNewProject ifPresent: [ :ignored | projectsToBeDeleted add: Project current. Project current removeParameter: #deleteWhenEnteringNewProject. ]. projectsToBeDeleted isEmpty ifFalse: [ proj projectParameters at: #projectsToBeDeleted put: projectsToBeDeleted. ]. ^ proj! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'pre 8/22/2019 15:03'!makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted existingView ifNil: [ Smalltalk isMorphic ifTrue: [ proj createViewIfAppropriate. ] ifFalse: [ ChangeSet allChangeSets add: proj changeSet. Project current openProject: proj. "Note: in MVC we get no further than the above" ]. ] ifNot Nil: [ (existingView project isKindOf: DiskProxy) ifFalse: [ existingView project changeSet name: ChangeSet defaultName. projectsToBeDeleted add: existingView project. ]. (existingView owner isSystemWindow) ifTrue: [ existingView owner model: proj ]. existingView project: proj. ].! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'cmm 10/23/2013 16:24'!morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive "Answer morphOrList or nil if problem happened" | projStream localDir morphOrList | projStream := archive ifNil: [preStream] ifNotNil: [self projectStreamFromArchive: archive]. (self checkSecurity: aFileName preStream: preStream projStream: projStream) ifFalse: [^nil]. localDir := Project squeakletDirectory. aFileName ifNotNil: [ (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName~= l ocalDir pathName]) ifTrue: [ localDir deleteFileNamed: aFileName. (localDir fileNamed: aFileName) binary nextPutAll: preStream remainingContents; close. ]. ]. morphOrList := projStream asUnZippedStream. preStream sleep. "if ftp, let the connection close" ^ morphOrList! !!ProjectLoading class methodsFor: 'loading - support' stamp: 'yo 2/5/2008 17:15'!parseManifest: aString | dict line index key value aStream | aStream := aString readStream. dict := Dictionary new. [(line := aStream nextLine) notNil] whileTrue: [ index := line indexOf: $:. index > 0 ifTrue: [ key := line copyFrom: 1 to: index - 1. value := (line copyFrom: index + 1 to: line size) withBlanksTrimmed. dict at: key put: value. ]. ]. ^ dict.! !!ProjectNavigationMorph methodsFor: 'buttons' stamp: 'mt 8/10/2023 11:32'!makeTheAdvancedButtons ^{ self buttonNewProject.
self buttonShare. self buttonPrev. self buttonNext. self buttonPublish. self buttonNewer. self buttonTell. self buttonFind. self buttonFullScreen. "self buttonFlaps." }, ( Preferences includeSoundControlInNavigator ifTrue: [{self buttonSound}] ifFalse: [#()] ), { self buttonLanguage. self buttonUndo. self buttonQuit. }! !!ProjectNavigationMorph methodsFor: 'buttons' stamp: 'mt 8/28/2023 14:27'!makeTheButtons ^ self makeTheAdvancedButtons! !!ProjectNavigationMorph methodsFor: 'the actions' stamp: 'mt 8/23/2023 13:51'!doPublishButtonMenuEvent: evt | selection | selection := UIManager default chooseFrom: { 'Publish' translated. 'Publish As...' translated. 'Publish to Different Server' translated. } values: { [self publishProject]. [self publishProjectAs]. [self publishDifferent]. } title: 'Publish options' translated. sel ection ifNil: [^self]. selection value.! !!ProjectSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'!addControls "Add the control bar at the top of the tool." | b r partsBinButton newButton aWrapper | newButton := ImageMorph new image: (Project current makeThumbnail scaledToSize: 48(a)36). newButton on: #mouseDown send: #insertNewProject: to: self. newButton setBalloonText: 'Make a new Project' translated. (partsBinButton := UpdatingThreePhaseButtonMorph checkBox) target: self; actionSelector: #togglePartsBinStatus; arguments: #(); getSelector: #getPartsBinStatus. (r := AlignmentMorph newRow) color: Color transparent; borderWidth: 0; layoutInset: 0; cellInset: 10(a)0; wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5(a)5. b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black. r addMorphBack: (self wrapperFor: (b label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort)). b := SimpleButtonMorph new target: self; color: self defaultColor darker; borderColor: Color black. r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #delete)); addTransparentSpacerOfSize: 8 @ 0; addMorphBack: (self wrapperFor: (newButton)); addTransparentSpacerOfSize: 8 @ 0. aWrapper := AlignmentMorph newRow beTransparent. aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0. aWrapper addMorphBack: (self wrapperFor: partsBinButton); addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated font: Preferences standardButtonFont) lock). r addMorphBack: aWrapper. self addMorphFront: r.! !!ProjectSorterMorph methodsFor: 'initialization' stamp: 'mt 8/14/2023 16:22'!in itialize "initialize the state of the receiver" super initialize. self useRoundedCorners. pageHolder useRoundedCorners; borderWidth: 0; color: (Form gridFormOrigin: 0 @ 0 grid: 32 @ 32 background: Color white line: Color blue muchLighter)! !!ProjectSorterMorph methodsFor: 'controls' stamp: 'mt 8/23/2023 13:50'!insertNewProject: evt [MorphicProject openViewOn: nil] on: ProjectViewOpenNotification do: [ :ex | ex resume: false].! !!RecordingControlsMorph methodsFor: 'button commands' stamp: 'mt 8/22/2023 15:53'!makeTile "Make a tile representing my sound. Get a sound-name from the user by which the sound is to be known." | tile | recorder verifyExistenceOfRecordedSound ifFalse: [^ self]. recorder pause. tile := InterimSoundMorph new sound: (SampledSound samples: recorder condensedSamples samplingRate: recorder samplingRate). tile bounds: tile fullBounds. tile openInHand! !!ReferenceMorph methodsFor: 'menu' stamp: 'mt 8/14/2023 17:24'!changeTabGraphic | aGraphicalMenu | aGraphicalMenu := GraphicalMenu new initializeFor: submorphs first withForms: submorphs first reasonableForms coexist: true. self primaryHand attachMorph: aGraphicalMenu.! !!ReferenceMorph methodsFor: 'menu' stamp: 'mt 7/31/2023 11:15'!graphicalMorphForTab | formToUse | formToUse := self valueOfProperty: #priorGraphic ifAbsent: [MenuIcons formAtKey: 'squeakyMouse']. ^ SketchMorph withForm: formToUse! !!FlapTab methodsFor: 'show & hide' stamp: 'mt 8/4/2023 14:02'!showFlap "Open the flap up" | thicknessToUse flapOwner | "19 sept 2000 - going for all paste ups <- raa note" flapOwner := self pasteUpMorph. self referentThickness <= 0 ifTrue: [thicknessToUse := lastReferentThickness ifNil: [100]. self orientation == #horizontal ifTrue: [referent height: thicknessToUse] ifFalse: [referent width: thicknessToUse]]. inboard ifTrue: [self stickOntoReferent]. "makes referent my owner, and positions me accordingly" referent pasteUpMorph == flapOwner ifFalse: [flapOwner accommodateFlap: self. "Make room if needed" flapOwner addMorphFront: referent. flapOwner startSteppingSubmorphsOf: referent. self positionReferent]. inboard ifFalse: [self adjustPositionVisAVisFlap]. flapShowing := true. self pasteUpMorph hideFlapsOtherThan: self ifClingingTo: edgeToAdhereTo. flapOwner bringTopmostsToFront! !!ReferenceStream class methodsFor: 'accessing' stamp: 'mt 8/28/2023 15:43'!versionCode "Answer a number representing the 'version' of the ReferenceStream facility; this is stashed at the beginning of ReferenceStreams, as a secondary versioning mechanism (the primary one is the fileTyp eCode). At present, it serves for information only, and is not checked for compatibility at reload time, but could in future be used to branch to variant code. " " 1 = original version 1992" " 2 = HyperSqueak. PathFromHome used for Objs outside the tree. SqueakSupport SysLibrary for shared globals like Display and StrikeFonts. File has version number, class structure, then an IncomingObjects manager. 8/16/96 tk. Extended to SmartRefStream. class structure also keeps superclasse chain. Does analysis on structure to see when translation methods are needed. Embedable in file-ins. (factored out HyperSqueak support) Feb-May 97 tk" " 3 = Reference objects are byte offsets relative to the start of the object portion of the file. Rectangles with values -2048 to 2047 are encoded compactly." " 4 = If UniClasses have class instance variables, append their values in the form (#Class43 (val1 val2 vla3)). An array of those. Can still read version 3." ^ 4! !!Release Builder class methodsFor: 'scripts' stamp: 'mt 8/16/2023 15:43'!configureTools "Initialize well-known tools and other resources." FileList initialize. FileServices initialize. "register file reader services" RealEstateAgent standardSize: 650(a)425. SMLoaderPlus setDefaultFilters: #(filterSafelyAvailable). "Default applications and tools." SystemBrowser default: TreeBrowser. MailSender default: nil. SoundService default: BaseSoundSystem. ToolSet default: StandardToolSet. WebBrowser default: nil.! !!ReleaseBuilder class methodsFor: 'scripts - support' stamp: 'mt 3/7/2023 14:05'!discardUserObjects "Remove the classes." MorphicModel removeUninstantiatedSubclassesSilently. "Clean-up environment hick-ups." Environment default allClassesDo: [:cls | (cls isUniClass and: [cls environment ~~ Environment default]) ifTrue: [Environment default forgetClass: cls logged: false]]. Environment default declarations select: [:bindi ng | (binding value isBehavior and: [binding value isUniClass]) and: [binding value isObsolete]] thenDo: [:binding | SystemOrganization removeElement: binding key. Environment default removeKey: binding key]. "Remove auto-generated accessors. See Preferences." (MCPackage named: 'Autogenerated') unload. "Remove empty categories for user objects. See Object class >> #categoryForUniclasses." SystemOrganizer cleanUp: true.! !!RemoteHandMorph methodsFor: 'event handling' stamp: 'mt 8/28/2023 14:35'!transmitEvent: aMorphicEvent "Transmit the given event to all remote connections." | firstEvt | self readyToTransmit ifFalse: [^ self]. self lastEventTransmitted = aMorphicEvent ifTrue: [^ self]. sendBuffer ifNil: [sendBuffer := WriteStream on: (String new: 10000)]. sendBuffer nextPutAll: aMorphicEvent storeString; cr. self lastEventTransmitted: aMorphicEvent. sendSocket isConnected ifTrue:[ sendState = #opening ifTrue: [ "connection established; disable TCP delays on sends" sendSocket setOption: 'TCP_NODELAY' value: true. "send worldExtent as first event" firstEvt := MorphicUnknownEvent new setType: #worldBounds argument: self worldBounds extent. sendSocket sendData: firstEvt storeString, (String with: Character cr). Transcript show: 'Connection established with remote WorldMorph at '; show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. sendState := #connected]. sendSocket sendData: sendBuffer contents. ] ifFalse: [ owner primaryHand removeEventListener: self. sendState = #connected ifTrue: [ "other end has closed; close our end" Transcript show: 'Closing connection with remote WorldMorph at '; show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. sendSocket cl ose. sendState := #closing]]. sendBuffer reset.! !!ResourceCollector methodsFor: 'initialize' stamp: 'mt 3/15/2023 14:07'!initialize originalMap := IdentityDictionary new. stubMap := IdentityDictionary new. locatorMap := IdentityDictionary new. internalStubs := IdentityDictionary new.! !!ScreenController methodsFor: 'nested menus' stamp: 'mt 7/31/2023 11:19'!helpMenu "Answer the help menu to be put up as a screen submenu" ^ SelectionMenu labelList: #( 'about this system...' 'update code from server' 'preferences...' 'command-key help' 'font size summary' 'useful expressions' 'view graphical imports' 'standard graphics library'), (Array with: (SoundService soundEnablingString)) , #( 'set author initials...' 'vm statistics' 'space left') lines: #(1 4 6 11) selections: #( aboutThisSystem absorbUpdatesFromServereditPreferences openCommandKeyHelp fontSizeSummary openStandardWorkspace viewImageImportssoundOnOrOff setAuthorInitials vmStatistics garbageCollect)"ScreenController new helpMenu startUp"! !!ScrollableField methodsFor: 'menu' stamp: 'mt 8/11/2023 14:47'!getMenu: shiftKeyState ^ shiftKeyState not ifTrue: [TextEditor yellowButtonMenu] ifFalse: [TextEditor shiftedYellowButtonMenu]! !!SelectionMorph methodsFor: 'halo commands' stamp: 'mt 3/10/2023 15:26'!duplicate "Make a duplicate of the receiver and havbe the hand grab it" selectedItems := self duplicateMorphCollection: selectedItems. selectedItems reverseDo: [:m | (owner ifNil: [self currentWorld]) addMorph: m]. dupLoc := self position. self currentHand grabMorph: self.! !!ServerDirectory class methodsFor: 'school support' stamp: 'mt 3/10/2023 11:45'!projectDefaultDirectory ^ FileDirectory default! !!ServerDirectory class methodsFor: 'server prefs' stamp: 'mt 8/16 /2023 15:50'!parseServerEntryFrom: stream | server type directory entries serverName | entries := ExternalSettings parseServerEntryArgsFrom: stream. serverName := entries at: 'name' ifAbsent: [^nil]. directory := entries at: 'directory' ifAbsent: [^nil]. type := entries at: 'type' ifAbsent: [^nil]. type = 'file' ifTrue: [ server := self determineLocalServerDirectory: directory. entries at: 'userListUrl' ifPresent:[:value | "Ignore" ]. entries at: 'baseFolderSpec' ifPresent:[:value | "Ignore" ]. ^self addLocalProjectDirectory: server]. type = 'bss' ifTrue: [server := SuperSwikiServer new type: #http]. type = 'http' ifTrue: [server := HTTPServerDirectory new type: #ftp]. type = 'ftp' ifTrue: [server := ServerDirectory new type: #ftp]. server directory: directory. entries at: 'server' ifPresent: [:value | server server: value]. entries at: 'user' ifPresent: [:value | server user: value]. entries at: 'group' ifPresent: [:value | server groupName: value]. entries at: 'passwdseq' ifPresent: [:value | server passwordSequence: value asNumber]. entries at: 'url' ifPresent: [:value | server altUrl: value]. entries at: 'loaderUrl' ifPresent: [:value | server loaderUrl: value]. entries at: 'acceptsUploads' ifPresent: [:value | server acceptsUploads: value asLowercase = 'true']. entries at: 'userListUrl' ifPresent:[:value | "Ignore" ]. entries at: 'encodingName' ifPresent:[:value | server encodingName: value]. ServerDirectory addServer: server named: serverName.! !!IconicButton methodsFor: 'initialization' stamp: 'mt 3/7/2023 15:06'!initializeWithThumbnail: aThumbnail withLabel: aLabel andColor: aColor andSend: aSelector to: aReceiver "Initialize the receiver to show aThumbnail on its face, giving it the label supplied and arranging for it, when the button goes down on it, to obtain a new morph by sending the supplied selector to the supplied receiver" | labeledItem nonTranslucent | nonTranslucent := aColor asNontranslucentColor. labeledItem := AlignmentMorph newColumn. labeledItem color: nonTranslucent. labeledItem borderWidth: 0. labeledItem layoutInset: 4(a)0; cellPositioning: #center. labeledItem addMorph: aThumbnail. labeledItem addMorphBack: (Morph new extent: (4(a)4)) beTransparent. labeledItem addMorphBack: (TextMorph new backgroundColor: nonTranslucent; contentsAsIs: aLabel; beAllFont: Preferences standardButtonFont; centered). self beTransparent; labelGraphic: ((labeledItem imageForm: 32 backgroundColor: nonTranslucent forRectangle: labeledItem fullBounds) replaceColor: nonTranslucent withColor: Color transparent); borderWidth: 0; target: aReceiver; actionSelector: #launchPartVia:label:; arguments: {aSelector. aLabel}; actWhen: #buttonDown. self stationarySetup.! !!IconicButton methodsFor: 'initialization' stamp: 'mt 3/15/2023 14:10'!setDefaultLabel self labelGraphic: (MenuIcons formAtKey: 'squeakyMouse')! !!HaloMorph methodsFor: 'handles' stamp: 'mt 3/15/2023 13:34'!addDismissHandle: handleSpec "Add the dismiss handle according to the spec, unless my target resists dismissal" | dismissHandle | target okayToAddDismissHandle ifTrue: [dismissHandle := self addHandle: handleSpec on: #mouseDown send: #mouseDownInDimissHandle:with: to: self. dismissHandle on: #mouseUp send: #maybeDismiss:with: to: self. dismissHandle on: #mouseDown send: #setDismissColor:with: to: self. dismissHandle on: #mouseMove send: #setDismissColor:with: to: self]! !!HaloMorph methodsFor: 'handles' stamp: 'mt 8/11/2023 14:24'!addDupHandle: haloSpec "Add the halo that offers duplication" self addHandle: haloSpec on: #mouseDown send: #doDup:with: to: self! !!HaloMorph methodsFor: 'handles' stamp: 'sw 1/26/2000 16:16'!addHelpHan dle: haloSpec target balloonText ifNotNil: [(self addHandle: haloSpec on: #mouseDown send: #mouseDownOnHelpHandle: to: innerTarget) on: #mouseUp send: #deleteBalloon to: innerTarget]! !!HaloMorph methodsFor: 'handles' stamp: 'RAA 3/15/2001 11:24'!addRecolorHandle: haloSpec "Add a recolor handle to the receiver, if appropriate" | recolorHandle | "since this halo now opens a more general properties panel, allow it in all cases" "innerTarget canSetColor ifTrue:" recolorHandle := self addHandle: haloSpec on: #mouseUp send: #doRecolor:with: to: self. recolorHandle on: #mouseUp send: #doRecolor:with: to: self! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/15/2023 14:10'!addGraphicalHandleFrom: formKey at: aPoint "Add the supplied form as a graphical handle centered at the given point. Return the handle." | handle aForm | aForm := (MenuIcons formAtKey: formKey) ifNil: [MenuIcons formAtKey: #SolidMenu]. handle := ImageMorph new image: a Form; bounds: (Rectangle center: aPoint extent: aForm extent). handle borderColor: Color black; borderWidth: 2. handle wantsYellowButtonMenu: false. self addMorph: handle. handle on: #mouseUp send: #endInteraction: to: self. ^ handle! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/15/2023 14:10'!createHandleAt: aPoint color: aColor iconName: iconName | bou handle | bou := Rectangle center: aPoint extent: self handleSize asPoint. Preferences alternateHandlesLook ifTrue: [handle := RectangleMorph newBounds: bou color: aColor. handle useRoundedCorners. self setColor: aColor toHandle: handle] ifFalse: [handle := EllipseMorph newBounds: bou color: aColor]. handle borderWidth: 0; wantsYellowButtonMenu: false. "" iconName isNil ifFalse: [| form | form := MenuIcons formAtKey: iconName. form isNil ifFalse: [| image | image := ImageMorph new.
image image: form scaleIconToDisplay. image color: aColor makeForegroundColor. image lock. handle addMorphCentered: image]]. "" ^ handle! !!HaloMorph methodsFor: 'private' stamp: 'mt 2/19/2021 14:52'!doGrow: evt with: growHandle "Called while the mouse is down in the grow handle" | newExtent extentToUse scale | evt hand obtainHalo: self. newExtent := (target pointFromWorld: evt cursorPoint - positionOffset) - target topLeft. evt shiftPressed ifTrue: [ scale := (newExtent x / (originalExtent x max: 1)) min: (newExtent y / (originalExtent y max: 1)). newExtent := (originalExtent x * scale) asInteger @ (originalExtent y * scale) asInteger ]. (newExtent x < 1 or: [newExtent y < 1 ]) ifTrue: [^ self]. target renderedMorph setExtentFromHalo: (extentToUse := newExtent). growHandle position: evt cursorPoint - (growHandle extent // 2 ). self layoutChanged. (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | "Update the final extent" cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: extentToUse]! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/8/2023 11:29'!doRecolor: evt with: aHandle "The mouse went down in the 'recolor' halo handle. Allow the user to change the color of the innerTarget" evt hand obtainHalo: self. (aHandle containsPoint: evt cursorPoint) ifFalse: "only do it if mouse still in handle on mouse up" [self delete. target addHalo: evt] ifTrue: [innerTarget changeColor. self showingDirectionHandles ifTrue: [self addHandles]]! !!HaloMorph methodsFor: 'private' stamp: 'ul 12/12/2009 14:11'!doRot: evt with: rotHandle "Update the rotation of my target if it is rotatable. Keep the relevant command object up to date." | degrees | evt hand obtainHalo: self. degre es := (evt cursorPoint - (target pointInWorld: target referencePosition)) degrees. degrees := degrees - angleOffset degrees. degrees := degrees detentBy: 10.0 atMultiplesOf: 90.0 snap: false. degrees = 0.0 ifTrue: [self setColor: Color lightBlue toHandle: rotHandle] ifFalse: [self setColor: Color blue toHandle: rotHandle]. rotHandle submorphsDo: [:m | m color: rotHandle color makeForegroundColor]. self removeAllHandlesBut: rotHandle. self showingDirectionHandles ifFalse: [self showDirectionHandles: true addHandles: false]. self addDirectionHandles. target rotationDegrees: degrees. rotHandle position: evt cursorPoint - (rotHandle extent // 2). (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | "Update the final rotation" cmd redoTarget: target renderedMorph selector: #heading: argument: degrees]. self layoutChanged! !!HaloMorph methodsFor: 'private' stamp: 'ul 12/12/2009 14:11'!doScale: evt with: scaleHandle "Update the scale of my target if it is scalable." | newHandlePos colorToUse | evt hand obtainHalo: self. newHandlePos := evt cursorPoint - (scaleHandle extent // 2). target scaleToMatch: newHandlePos. colorToUse := target scale = 1.0 ifTrue: [Color yellow] ifFalse: [Color orange]. self setColor: colorToUse toHandle: scaleHandle. scaleHandle submorphsDo: [:m | m color: colorToUse makeForegroundColor]. scaleHandle position: newHandlePos. self layoutChanged. (self valueOfProperty: #commandInProgress) ifNotNil:[:cmd | "Update the final extent" cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent ].! !!HaloMorph methodsFor: 'private' stamp: 'mt 8/11/2023 17:00'!endInteraction: event "Clean up after a user interaction with the a halo control" | m | (target isInWorld not or: [owner isNil]) ifTrue: [^self]. [target isFlexMorph and: [target hasNoScaleOrRotation]] whileTrue: [m := target firstSubmorph. target removeFlexShell. target := m]. self restoreTargetDropShadows. target changedViaHalo: self. self isInWorld ifTrue: ["make sure handles show in front, even if flex shell added" self flag: #tofix. "mt: Try to avoid deleting and re-creating an event handler (here: the handle) while handling the event." self comeToFront. self addHandles. event hand newMouseFocus: self]. (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | self rememberCommand: cmd. self removeProperty: #commandInProgress].! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/10/2023 15:08'!maybeDismiss: evt with: dismissHandle "Ask hand to dismiss my target if mouse comes up in it." evt hand obtainHalo: self. (dismissHandle containsPoint: evt cursorPoint) ifFal se: [self delete. target addHalo: evt] ifTrue: [target resistsRemoval ifTrue: [(Project uiManager chooseOptionFrom: {'Yes' translated. 'Um, no, let me reconsider' translated.} title: 'Really throw this away?' translated) = 1 ifFalse: [^ self]]. evt hand removeHalo. self delete. target dismissViaHalo].! !!HaloMorph methodsFor: 'private' stamp: 'HenrikSperreJohansen 1/21/2011 18:34'!mouseDownInDimissHandle: evt with: dismissHandle evt hand obtainHalo: self. SoundService soundEnabled ifTrue: [TrashCanMorph playMouseEnterSound]. self removeAllHandlesBut: dismissHandle. self setColor: Color darkGray toHandle: dismissHandle.! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/10/2023 13:51'!startDrag: evt with: dragHandle "Drag my target without removing it from its owner." self obtainHaloForEvent: evt andRemoveAllHandlesBut: dragHandle. target aboutToBeDraggedViaHalo. positionOffset := dragHandle center - (target point: target position in: owner).! !!HaloMorph methodsFor: 'private' stamp: 'ct 2/28/2022 16:24'!startGrow: evt with: growHandle "Initialize resizing of my target. Launch a command representing it, to support Undo" | botRt | self obtainHaloForEvent: evt andRemoveAllHandlesBut: growHandle. self backupAndHideTargetDropShadows. target aboutToBeGrownViaHalo. botRt := target point: target bottomRight in: owner. positionOffset := (self world viewBox containsPoint: botRt) ifTrue: [evt cursorPoint - botRt] ifFalse: [0(a)0]. self setProperty: #commandInProgress toValue: (Command new cmdWording: ('resize ' translated, target nameForUndoWording); undoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent). originalExtent := target extent! !!HaloMorph methodsFor: 'p rivate' stamp: 'mt 8/11/2023 16:59'!startRot: evt with: rotHandle "Initialize rotation of my target if it is rotatable. Launch a command object to represent the action" self obtainHaloForEvent: evt andRemoveAllHandlesBut: rotHandle. self backupAndHideTargetDropShadows. target aboutToBeRotatedViaHalo. target isFlexMorph ifFalse: [target addFlexShellIfNecessary]. growingOrRotating := true. self removeAllHandlesBut: rotHandle. "remove all other handles" angleOffset := evt cursorPoint - (target pointInWorld: target referencePosition). angleOffset := Point r: angleOffset r degrees: angleOffset degrees - target rotationDegrees. self setProperty: #commandInProgress toValue: (Command new cmdWording: ('rotate ' translated, target nameForUndoWording); undoTarget: target renderedMorph selector: #heading: argument: target rotationDegrees)! !!HaloMorph methodsFor: 'private' stamp: 'mt 3/7/2023 16:46'!startS cale: evt with: scaleHandle "Initialize scaling of my target." self obtainHaloForEvent: evt andRemoveAllHandlesBut: scaleHandle. self backupAndHideTargetDropShadows. target aboutToBeScaledViaHalo. target isFlexMorph ifFalse: [target addFlexShellIfNecessary]. growingOrRotating := true. positionOffset := 0(a)0. originalExtent := target extent! !!HaloMorph methodsFor: 'pop up' stamp: 'mt 3/15/2023 13:40'!popUpFor: morph at: position hand: hand super popUpFor: morph at: position hand: hand. self startStepping.! !!HaloMorph methodsFor: 'submorphs - add/remove' stamp: 'mt 3/15/2023 13:40'!delete "Delete the halo. Tell the target that it no longer has the halo; accept any pending edits to the name; and then actually delete myself" self acceptNameEdit. super delete.! !!SketchEditorMorph methodsFor: 'initialization' stamp: 'mt 8/10/2023 15:28'!initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph." | paintBoxBounds worldBounds | self setProperty: #recipientPasteUp toValue: aPasteUpMorph. paintBoxBounds := self world paintBox bounds. worldBounds := self world bounds. self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: ((boundsToUse topRight extent: paintBoxBounds extent) translatedToBeWithin: worldBounds) topLeft.! !!SketchEditorMorph methodsFor: 'start & finish' stamp: 'mt 8/10/2023 15:34'!cancelOutOfPainting "The user requested to back out of a painting session without saving" self deleteSelfAndSubordinates. emptyPicBlock ifNotNil: [emptyPicBlock value]. "note no args to block!!" hostView ifNotNil: [hostView changed]. ^ nil! !!SketchEditorMorph methodsFor: 'start & finish' stamp: 'mt 8/10/2023 15:34'!deliverPainting: result evt: evt "Done painting. May come from resume, or from original call. Execute user's post painting instructions in the block. Always use this standard one. 4/21/97 tk" | newBox newForm ans | palette ifNotNil: "nil happens" [palette setAction: #paint: evt: evt]. "Get out of odd modes" "rot := palette getRotations." "rotate with heading, or turn to and fro" "palette setRotation: #normal." result == #cancel ifTrue: [ ans := Project uiManager chooseOptionFrom: { 'throw it away' translated. 'keep painting it' translated} title: 'Do you really want to throw away what you just painted?' translated. ^ ans = 1 ifTrue: [self cancelOutOfPainting] ifFalse: [nil]]. "cancelled out of cancelling." "hostView rotationStyle: rot." "rotate with heading, or turn to and fro" newBox := paintingForm rectangleEnclosingPixelsNotOfColor: Color transparent. registrationPoint ifNotNil:
[registrationPoint := registrationPoint - newBox origin]. "relative to newForm origin" newForm := Form extent: newBox extent depth: paintingForm depth. newForm copyBits: newBox from: paintingForm at: 0(a)0 clippingBox: newForm boundingBox rule: Form over fillColor: nil. newForm isAllWhite ifTrue: [(self valueOfProperty: #background) == true ifFalse: [^ self cancelOutOfPainting]]. newForm fixAlpha. "so alpha channel stays intact for 32bpp" self delete. "so won't find me again" dimForm ifNotNil: [dimForm delete]. newPicBlock value: newForm value: (newBox copy translateBy: bounds origin).! !!SketchMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:15'!setNewFormFrom: formOrNil "Set the receiver's form as indicated. If nil is provided, then a default form will be used" formOrNil ifNotNil: [^ self form: formOrNil]. self form: (Form extent: 16(a)16 depth: 32)! !!SketchMorph methodsFor: 'initialization' stamp: 'm t 3/15/2023 14:10'!initialize"initialize the state of the receiver" ^ self initializeWith: (MenuIcons formAtKey: 'Painting') deepCopy! !!SketchMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 14:30'!addPaintingItemsTo: aMenu hand: aHandMorph | subMenu movies | subMenu := MenuMorph new defaultTarget: self. subMenu add: 'repaint' translated action: #editDrawing; add: 'set rotation center' translated action: #setRotationCenter; add: 'reset forward-direction' translated action: #resetForwardDirection; add: 'set rotation style' translated action: #setRotationStyle; add: 'erase pixels of color' translated action: #erasePixelsUsing:; add: 'recolor pixels of color' translated action: #recolorPixelsUsing:; add: 'reduce color palette' translated action: #reduceColorPalette:; add: 'detect edges' translated action: #edgeDetect; add: 'sharpen' translated action: #sharpen; add: 'blur' translated action: #blur;
add: 'emboss' translated action: #emboss; add: 'add a border around this shape...' translated action: #addBorderToShape:. movies := (self world rootMorphsAt: aHandMorph targetPoint) select: [:m | (m isKindOf: MovieMorph) or: [m isSketchMorph]]. movies size > 1 ifTrue: [subMenu add: 'insert into movie' translated action: #insertIntoMovie:]. aMenu add: 'painting...' translated subMenu: subMenu! !!SketchMorph methodsFor: 'menu' stamp: 'mt 8/10/2023 15:33'!editDrawingIn: aPasteUpMorph forBackground: forBackground "Edit an existing sketch." | w bnds sketchEditor rotCenter aWorld aPaintBox | self world assureNotPaintingElse: [^self]. w := aPasteUpMorph world. w displayWorld. self visible: false. bnds := forBackground ifTrue: [aPasteUpMorph boundsInWorld] ifFalse: [self boundsInWorld expandBy: 60 @ 60]. sketchEditor := SketchEditorMorph new. forBackground ifTrue: [sketchEditor setProperty: #background toValue: true]. w addMorphFront: sketchEditor. sketchEditor initializeFor: self inBounds: bnds pasteUpMorph: aPasteUpMorph. rotCenter := self rotationCenter. sketchEditor afterNewPicDo: [:aForm :aRect | | tfx | self visible: true. self form: aForm. tfx := aPasteUpMorph transformFrom: aPasteUpMorph world. self topRendererOrSelf position: (tfx globalPointToLocal: aRect origin). self rotationStyle: sketchEditor rotationStyle. self forwardDirection: sketchEditor forwardDirection. (rotCenter notNil and: [(rotCenter = (0.5 @ 0.5)) not]) ifTrue: [self rotationCenter: rotCenter]. aWorld := self world. (aPaintBox := aWorld paintBox) ifNotNil: [aPaintBox delete]. forBackground ifTrue: [self goBehind "shouldn't be necessary"]] ifNoBits: []! !!SketchMorph met hodsFor: 'menus' stamp: 'mt 3/10/2023 16:09'!addToggleItemsToHaloMenu: aCustomMenu "Add toggle-items to the halo menu" super addToggleItemsToHaloMenu: aCustomMenu. aCustomMenu addUpdating: #useInterpolationString target: self action: #toggleInterpolation.! !!SketchMorph methodsFor: 'menus' stamp: 'mt 8/11/2023 13:42'!chooseNewGraphic "Allow the user to choose a different form for her form-based morph" | aGraphicalMenu | aGraphicalMenu := GraphicalMenu new initializeFor: self withForms: self reasonableForms coexist: true. self primaryHand attachMorph: aGraphicalMenu.! !!SketchMorph methodsFor: 'parts bin' stamp: 'mt 3/15/2023 14:10'!initializeToStandAlone super initializeToStandAlone. self initializeWith: (MenuIcons formAtKey: 'Painting') deepCopy! !!ColorPickerMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 14:01'!mouseUp: evt self stopStepping. sourceHand := nil. deleteOnMou seUp ifTrue: [self delete]. self updateTargetColor.! !!ColorPickerMorph methodsFor: 'menu' stamp: 'mt 3/15/2023 14:09'!pickUpColorFor: aMorph "Show the eyedropper cursor, and modally track the mouse through a mouse-down and mouse-up cycle" | aHand localPt | aHand := aMorph ifNil: [self activeHand] ifNotNil: [aMorph activeHand]. aHand ifNil: [aHand := self currentHand]. self addToWorld: aHand world near: (aMorph ifNil: [aHand world]) fullBounds. self owner ifNil: [^ self]. aHand showTemporaryCursor: (MenuIcons formAtKey: #Eyedropper) hotSpotOffset: 2(a)14. "<<<< the form was changed a bit??" self updateContinuously: false. [Sensor anyButtonPressed] whileFalse: [self trackColorUnderMouse]. self deleteAllBalloons. localPt := Sensor cursorPoint - self topLeft. self inhibitDragging ifFalse: [ (DragBox containsPoint: localPt) ifTrue: ["Click or drag the drag-dot means to anchor as a modeless pick er" ^ self anchorAndRunModeless: aHand]. ]. (clickedTranslucency := TransparentBox containsPoint: localPt) ifTrue: [selectedColor := originalColor]. self updateContinuously: true. [Sensor anyButtonPressed] whileTrue: [self updateTargetColorWith: self indicateColorUnderMouse]. aHand newMouseFocus: nil; showTemporaryCursor: nil; flushEvents. self delete. ! !!ColorPickerMorph methodsFor: 'private' stamp: 'mt 3/10/2023 14:01'!pickColorAt: aGlobalPoint | alpha selfRelativePoint pickedColor | clickedTranslucency ifNil: [clickedTranslucency := false]. selfRelativePoint := (self globalPointToLocal: aGlobalPoint) - self topLeft. (FeedbackBox containsPoint: selfRelativePoint) ifTrue: [^ self]. (RevertBox containsPoint: selfRelativePoint) ifTrue: [^ self updateColor: originalColor feedbackColor: originalColor]. "check for transparent color and update using appropriate feedback color " (TransparentBox containsPoint: selfRelativePoint) ifTrue: [clickedTranslucency ifFalse: [^ self]. "Can't wander into translucency control" alpha := (selfRelativePoint x - TransparentBox left - 10) asFloat / (TransparentBox width - 20) min: 1.0 max: 0.0. "(alpha roundTo: 0.01) printString , ' ' displayAt: 0(a)0." " -- debug" self updateColor: (selectedColor alpha: alpha) feedbackColor: (selectedColor alpha: alpha). ^ self]. "pick up color, either inside or outside this world" clickedTranslucency ifTrue: [^ self]. "Can't wander out of translucency control" self locationIndicator visible: false. self refreshWorld. pickedColor := Display colorAt: aGlobalPoint. self locationIndicator visible: true. self refreshWorld. self updateColor: ( (selectedColor isColor and: [selectedColor isTranslucentColor])
ifTrue: [pickedColor alpha: selectedColor alpha] ifFalse: [pickedColor] ) feedbackColor: pickedColor! !!SmartRefStream methodsFor: 'read write' stamp: 'mt 3/10/2023 15:43'!initKnownRenames renamed at: #FlasherMorph put: #Flasher; at: #AlansTextPlusMorph put: #TextPlusMorph; at: #Project put: #MorphicProject; at: #InputSensor put: #EventSensor; yourself! !!SmartRefStream methodsFor: 'read write' stamp: 'mt 3/10/2023 15:43'!restoreClassInstVars "Install the values of the class instance variables of UniClasses." self flag: #todo. "mt: See EToys in Squeak 6.0 and before."! !!SqueakToolsDebuggerHelp class methodsFor: 'pages' stamp: 'mt 3/15/2023 14:10'!showForm: aSymbol | form contents | form := MenuIcons formAtKey: aSymbol. contents := (String with: Character cr) asText, (Text string: ' ' attribute: (TextFontReference toFont: (FormSetFont new fromFormArray: (Array with: form) asciiStart: Character space asInteger ascent: form height))), (String with: Character cr) asText. ^contents! !!SystemWindow methodsFor: 'initialization' stamp: 'mt 3/10/2023 16:09'!initializeLabelArea "Initialize the label area (titlebar) for the window." labelString ifNil: [labelString := 'Untitled Window']. label := StringMorph new contents: labelString; font: (self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont]); yourself. "Add collapse box so #labelHeight will work" collapseBox := self createCollapseBox. stripes := Array with: (RectangleMorph newBounds: bounds) with: (RectangleMorph newBounds: bounds). "see extent:" self addLabelArea. se lf setLabelWidgetAllowance. self addCloseBox. self class moveMenuButtonRight ifTrue: [self addLabel. self addMenuControl] ifFalse: [self addMenuControl. self addLabel]. self addExpandBox. labelArea addMorphBack: collapseBox. self setFramesForLabelArea.! !!SystemWindow methodsFor: 'menu' stamp: 'dao 10/1/2004 12:57'!fullScreenMaximumExtent "Zoom Window to Full World size with possible DeskMargins obey the maximum extent rules" | left right possibleBounds | left := right := 0. self paneMorphs do: [:pane | ((pane isKindOf: ScrollPane) and: [pane retractableScrollBar]) ifTrue: [pane scrollBarOnLeft ifTrue: [left := left max: pane scrollBarThickness] ifFalse: [right := right max: pane scrollBarThickness]]]. possibleBounds := self worldBounds insetBy: (left @ 0 corner: right @ 0 ). self maximumExtent ifNotNil: [possibleBounds := possibleBounds origin extent: ( self maximumExtent min: ( possibleBounds extent ))]. ((Flaps sharedFlapsAllowed and: [Project current flapsSuppressed not]) or: [Preferences fullScreenLeavesDeskMargins]) ifTrue: [possibleBounds := possibleBounds insetBy: 22]. self bounds: possibleBounds! !!SystemWindow methodsFor: 'menu' stamp: 'mt 3/10/2023 14:27'!sendToBack | aWorld nextWindow | aWorld := self world. nextWindow := aWorld submorphs detect: [:m | (m isSystemWindow) and: [m ~~ self]] ifNone: [^self]. nextWindow beKeyWindow. aWorld addMorphBack: self! !!SystemWindow methodsFor: 'open/close' stamp: 'mt 3/7/2023 17:40'!delete | thisWorld | self mustNotClose ifTrue: [^self]. model okToClose ifFalse: [^self]. thisWorld := self world. self activeHand removeKeyboardListener: self. self isFlexed ifTrue: [owner delet e] ifFalse: [super delete]. model windowIsClosing; release. model := nil. SystemWindow noteTopWindowIn: thisWorld! !!SystemWindow methodsFor: 'stepping' stamp: 'mt 8/28/2023 15:51'!stepAt: millisecondClockValue "If the receiver is not collapsed, step it, after first stepping the model." (isCollapsed not or: [self wantsStepsWhenCollapsed]) ifTrue: [model ifNotNil: [model stepAt: millisecondClockValue in: self]. super stepAt: millisecondClockValue]"Since this method ends up calling step, the model-stepping logic should not be duplicated there."! !!SystemWindow methodsFor: 'stepping' stamp: 'mt 3/10/2023 15:01'!wantsSteps "Return true if the model wants its view to be stepped. For an open system window, we give the model to offer an opinion" self isPartsDonor ifTrue: [^ false]. ^ isCollapsed not and: [model wantsStepsIn: self]! !!SystemWindow methodsFor: 'top window' stamp: 'mt 3/7/2023 17:40'!comeToFront "Modal windows: Walk along the modal owner chain, the bring all to top." self modalOwner ifNotNil: [:mo | mo isSystemWindow ifTrue: [ ^ mo modalOwner ifNil: [mo comeToFrontModally] ifNotNil: [:omo | omo comeToFront]]]. self modalChild ifNotNil: [^ self comeToFrontModally]. "Now show me." super comeToFront. "Label should be visible to interact with." self assureLabelAreaVisible.! !!TabMorph methodsFor: 'tabs' stamp: 'mt 8/4/2023 13:36'!tabSelected "Called when the receiver is hit. First, bulletproof against someone having taken the structure apart. My own action basically requires that my grand-owner be a TabbedPalette" (owner isKindOf: IndexTabs) ifFalse: [^ Beeper beep]. (owner owner isKindOf: TabbedPalette) ifFalse: [^ Beeper beep]. owner owner selectTab: self! !!TabSorterMorph methodsFor: 'initialization' stamp: 'mt 7/31/2023 11:09'!addControls "Add the control bar at the top of the tool." | b r | b := SimpleButtonMorph ne w target: self; borderColor: Color black. r := AlignmentMorph newRow. r color: b color; borderWidth: 0; layoutInset: 0. r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5(a)5. r wrapCentering: #topLeft. r addMorphBack: (b label: 'Okay' translated font: Preferences standardButtonFont; actionSelector: #acceptSort). b := SimpleButtonMorph new target: self; borderColor: Color black. r addMorphBack: (b label: 'Cancel' translated font: Preferences standardButtonFont; actionSelector: #cancelSort). self addMorphFront: r.! !!TabSorterMorph methodsFor: 'initialization' stamp: 'mt 8/16/2023 13:52'!initialize "Initialize the receiver." super initialize. self removeAllMorphs. self extent: 300(a)100. pageHolder := PasteUpMorph new. pageHolder vResizeToFit: true; autoLineLayout: true. pageHolder extent: self extent - self borderWidth. pageHolder padding: 8. pageHolder cursor: 0. self addControls. self addMorphBack: pageHolder ! !!TabbedPalette methodsFor: 'palette menu' stamp: 'mt 8/4/2023 13:42'!addBookMenuItemsTo: aCustomMenu hand: aHandMorph aCustomMenu add: 'add palette menu' translated action: #addMenuTab.! !!TabbedPalette methodsFor: 'palette menu' stamp: 'mt 7/31/2023 11:20'!addMenuTab "Add the menu tab. This is ancient code, not much in the spirit of anything current" | aMenu aTab aGraphic sk | aMenu := MenuMorph new defaultTarget: self. aMenu stayUp: true. "aMenu add: 'clear' translated action: #showNoPalette." aMenu add: 'sort tabs' translated action: #sortTabs:. aMenu add: 'choose new colors for tabs' translated action: #recolorTabs. aMenu setProperty: #paletteMenu toValue: true. "aMenu add: 'make me the Standard palette' translated action: #becomeStandardPalette." aTab := self addTabForBook: aMenu withBalloonText: 'a menu of palette-related controls' translated. aTab highlightColor: tabsMorph highlightColor; regularColor: tabsMorph regularColor.
tabsMorph laySubpartsOutInOneRow; layoutChanged. aGraphic := MenuIcons formAtKey: 'TinyMenu'. aGraphic ifNotNil: [aTab removeAllMorphs. aTab addMorph: (sk := Project current world drawingClass withForm: aGraphic). sk position: aTab position. sk lock. aTab fitContents]. self layoutChanged! !!TabbedPalette methodsFor: 'user-interface' stamp: 'mt 8/4/2023 13:36'!selectTab: aTab | currentPalette morphToInstall oldTab aSketchEditor | oldTab := tabsMorph highlightedTab. (oldTab notNil and: [(morphToInstall := oldTab morphToInstall) isKindOf: PaintBoxMorph]) ifTrue: [(aSketchEditor := self world submorphOfClass: SketchEditorMorph) ifNotNil: [aSketchEditor cancelOutOfPainting]. morphToInstall delete]. tabsMorph selectTab: aTab. morphToInstall := aTab morphToInstall. (morphToInstall isKindOf: PaintBoxMorph) "special case, maybe generalize this need?" ifFalse: [se lf goToPageMorph: morphToInstall] ifTrue: [self showNoPaletteAndHighlightTab: aTab. self world addMorphFront: morphToInstall. morphToInstall position: ((self left max: 90) "room for the pop-out-to-left panel" @ (tabsMorph bottom))]. (currentPalette := self currentPalette) ifNotNil: [currentPalette layoutChanged]. self snapToEdgeIfAppropriate! !!TabbedPalette class methodsFor: 'scripting' stamp: 'mt 7/31/2023 11:20'!authoringPrototype | aTabbedPalette aBook aTab | aTabbedPalette := self new markAsPartsDonor. aTabbedPalette pageSize: 200 @ 300. aTabbedPalette tabsMorph highlightColor: Color red regularColor: Color blue. aTabbedPalette addMenuTab. aBook := BookMorph new setNameTo: 'one'; pageSize: aTabbedPalette pageSize. aBook color: Color blue muchLighter. aBook removeEverything; insertPage; showPageControls. aBook currentPage addMorphBack: (Project current world drawingClass withFo rm: (MenuIcons formAtKey: 'squeakyMouse')). aTab := aTabbedPalette addTabForBook: aBook. aBook := BookMorph new setNameTo: 'two'; pageSize: aTabbedPalette pageSize. aBook color: Color red muchLighter. aBook removeEverything; insertPage; showPageControls. aBook currentPage addMorphBack: CurveMorph authoringPrototype. aTabbedPalette addTabForBook: aBook. aTabbedPalette selectTab: aTab. aTabbedPalette beSticky. aTabbedPalette tabsMorph hResizing: #spaceFill. ^ aTabbedPalette! !!TextMorph methodsFor: 'event handling' stamp: 'mt 3/10/2023 16:10'!getMenu: shiftKeyState ^ shiftKeyState not ifTrue: [TextEditor yellowButtonMenu] ifFalse: [TextEditor shiftedYellowButtonMenu]! !!TextMorph methodsFor: 'events-processing' stamp: 'mt 3/15/2023 13:46'!handleKeystroke: anEvent "Overwritten to support tab-among-fields preference." anEvent wasHandled ifTrue:[^self]. (self handlesKeyboard: anEvent) ifFalse: [^ self]. (anEvent hand keyboard Focus ~~ self and: [self handlesKeyboardOnlyOnFocus]) ifTrue: [^ self]. ^ super handleKeystroke: anEvent! !!TextMorph methodsFor: 'menu' stamp: 'mt 8/16/2023 13:54'!addCustomMenuItems: aCustomMenu hand: aHandMorph | outer | super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu add: 'text properties...' translated action: #changeTextColor. aCustomMenu addUpdating: #autoFitString target: self action: #autoFitOnOff. aCustomMenu addUpdating: #wrapString target: self action: #wrapOnOff. aCustomMenu add: 'text margins...' translated action: #changeMargins:. aCustomMenu add: 'add predecessor' translated action: #addPredecessor:. aCustomMenu add: 'add successor' translated action: #addSuccessor:. outer := self owner. outer ifNotNil: [ outer isLineMorph ifTrue: [container isNil ifTrue: [Smalltalk at: #TextOnCurveContainer ifPresent: [:ignored | aCustomMenu add: 'follow owner''s curve' translated actio n: #followCurve]] ifFalse: [aCustomMenu add: 'reverse direction' translated action: #reverseCurveDirection. aCustomMenu add: 'set baseline' translated action: #setCurveBaseline:]] ifFalse: [self fillsOwner ifFalse: [aCustomMenu add: 'fill owner''s shape' translated action: #fillingOnOff] ifTrue: [aCustomMenu add: 'rectangular bounds' translated action: #fillingOnOff]. self avoidsOcclusions ifFalse: [aCustomMenu add: 'avoid occlusions' translated action: #occlusionsOnOff] ifTrue: [aCustomMenu add: 'ignore occlusions' translated action: #occlusionsOnOff]]].! !!TextMorph class methodsFor: 'parts bin' stamp: 'mt 3/7/2023 15:07'!fancyPrototype | t | t := self authoringPrototype. t autoFit: false; extent: 150(a)75. t borderWidth: 2; margins: 4(a)0; useRoundedCorners. "Why not rounded?" "fancy font, shadow, rounded" t fontName: Preferences standardButtonFont familyName size: 18; textColor: Color blue; fillStyle: Color lightBrown. t addDropShadow."Strangeness here in order to avoid two offset copies of the default contents when operating in an mvc project before cursor enters the morphic window" t paragraph. ^ t! !!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 8/11/2023 15:18'!extrasMenuOn: aDockingBar aDockingBar addItem: [ :it| it contents: 'Extras' translated; addSubMenu: [:menu| menu addItem:[:item| item contents: 'Recover Changes' translated; help: 'Recover changes after a crash' translated; icon: MenuIcons smallDocumentClockIcon; target: ChangeList; selector: #browseRecentLog]. menu addItem:[:item| item contents: 'Recover Method Versions' translated; help: 'Recover ve rsions of deleted methods' translated; target: ChangeList; selector: #browseMethodVersions]. menu addLine. menu addItem:[:item| item contents: 'Themes & Colors' translated; subMenuUpdater: self selector: #themesAndWindowColorsOn: ]. menu addItem:[:item| item contents: 'Scale Factor' translated; subMenuUpdater: self selector: #scaleFactorsOn:]. menu addItem:[:item| item contents: 'Language' translated; subMenuUpdater: self selector: #languageTranslatorsOn: ]. menu addItem:[:item| item contents: 'Set Author Initials' translated; help: 'Sets the author initials' translated; icon: MenuIcons smallUserQuestionIcon; target: Utilities; selector: #setAuthorInitials]. menu addItem:[:item| item contents: 'Restore Display (r)' translated; help: 'Redraws the entire display' translated; target: Project current; selector: #restoreDisplay]. menu addItem:[:item| item contents: 'Rebuild Menus' translated; help: 'Rebuilds the menu bar' translated; target: TheWorldMainDockingBar; selector: #updateInstances]. menu addLine. menu addItem:[:item| item contents: 'Start Profiler' translated; help: 'Starts the profiler' translated; icon: MenuIcons smallTimerIcon; target: self; selector: #startMessageTally]. menu addItem:[:item| item contents: 'Collect Garbage' translated; help: 'Run the garbage collector and report space usage' translated; target: Utilities; selector: #garbageCollectAndReport]. menu addItem:[:item| item contents: 'Purge Undo Records' translated; help: 'Save space by removing all the undo information remembered in all projects' translated; target: CommandHistory; selector: #resetAllHistory]. menu addItem:[:item| item contents: 'VM statistics' translated; help: 'Virtual Machine infor mation' translated; target: self; selector: #vmStatistics]. menu addLine. menu addItem:[:item| item contents: 'Graphical Imports' translated; help: 'View the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList' translated; target: (Imports default); selector: #viewImages]. menu addItem:[:item| item contents: 'Browse My Changes' translated; help: 'Browse all of my changes since the last time #condenseSources was run.' translated; target: SystemNavigation new; selector: #browseMyChanges]. ] ]! !!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 3/7/2023 13:59'!themesAndWindowColorsOn: menu | themes | menu addItem:[:item| item contents: 'Fonts' translated; subMenuUpdater: Preferences selector: #fontConfigurationMenu:; icon: MenuIcons smallFontsIcon]. menu addLine. menu addItem:[:item| item contents: (Model useColorfulWindows ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Colorful Windows' translated; target: self; selector: #toggleColorfulWindows]. menu addItem:[:item| item contents: (SystemWindow gradientWindow not ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Flat Widget Look' translated; target: self; selector: #toggleGradients]. menu addLine. menu addItem:[:item | item contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Soft Shadows' translated; target: self; selector: #toggleSoftShadows]. menu addItem:[:item | item contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow not]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Hard Shadows' translated; target: self; selector: #toggleHardShadows]. menu addLine. menu addItem:[:item | item contents: (SystemWindow roundedWindowCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Window/Dialog Look' translated; target: self; selector: #toggleRoundedWindowLook]. menu addItem:[:item | item contents: (PluggableButtonMorph roundedButtonCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Button/Scrollbar/Menu Look' translated; target: self; selector: #toggleRoundedButtonLook]. menu addLine. themes := UserInterfaceTheme allThemes asArray sort: #name ascending. themes := themes select: [ :each | each isGenuine]. themes ifEmpty: [ menu addIt em: [ :item | item contents: '(No UI themes found.)' translated; isEnabled: false ] ]. themes do: [ :each | menu addItem: [ :item | item contents: (UserInterfaceTheme current name = each name ifTrue: ['<yes>'] ifFalse: ['<no>']), each name; target: each; selector: #applyScaled ] ]. menu addLine; add: 'Restore UI theme background' translated target: self selector: #restoreThemeBackground; add: 'Reset all UI themes' translated target: self selector: #resetAllThemes; add: 'Edit current UI theme...' translated target: self selector: #editCurrentTheme.! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/4/2023 13:59'!addObjectsAndTools: menu self fillIn: menu from: { nil. { 'objects (o)'. { #myWorld. #activateObjectsTool }. 'A tool for finding and obtaining many kinds of objects' }. { 'new morph. ..'. { self. #newMorph }. 'Offers a variety of ways to create new objects' }. nil. { 'flaps...'. { self. #flapsDo }. 'A menu relating to use of flaps. For best results, use "keep this menu up"' }. { 'projects...'. { self. #projectDo }. 'A menu of commands relating to use of projects' }. { 'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}. nil }! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:54'!addPrintAndDebug: menu self fillIn: menu from: { { 'make screenshot'. {self. #saveScreenshot}. 'makes a screenshot and saves it to disk'}. "{ 'print PS to file...'. { self. #printWorldOnFile }. 'write the world into a postscript file' }." { 'debug...'. { self. #debugDo }. 'a menu of debugging items' } }! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:58'!addUtilities: menu self
fillIn: menu from: { { 'open...'. { self. #openWindow } }. { 'windows...'. { self. #windowsDo } }. { 'changes...'. { self. #changesDo } } }. self fillIn: menu from: { { 'help...'. { self. #helpDo }. 'puts up a menu of useful items for updating the system, determining what version you are running, and much else' }. { 'appearance...'. { self. #appearanceDo }. 'put up a menu offering many controls over appearance.' } }. self fillIn: menu from: { { 'do...'. { Utilities. #offerCommonRequests }. 'put up an editible list of convenient expressions, and evaluate the one selected.' } }! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 3/15/2023 13:57'!appearanceMenu "Build the appearance menu for the world." ^self fillIn: (self menu: 'appearance...') from: { {'preferences...' . { self . #openPreferencesBrowser} . 'Opens a "Preferences Browser" which allows you to alter many settings' } . {'preferences wizard...' . { self . #openPreferencesWizard} . 'Opens a "Preferences Wizard" which allows you to alter many settings in a guided fashion' } . {'choose set of preferences...' . { Preferences . #offerThemesMenu} . 'Presents you with a menu of sets or preferences; each item''s balloon-help will tell you about the particular set. If you choose one, many different preferences that come along are set at the same time; you can subsequently change any settings by using a Preferences Panel'} . nil . {'system fonts...' . { self . #standardFontDo} . 'Choose the standard fonts to use for code, lists, menus, window titles, etc.'}. nil. {'full screen on' . { DisplayScreen . #fullScreenOn} . 'puts you in full-screen mode, if not already there.'}. {'full screen off' . { DisplayScreen . #fullScreenOff} . 'if in full-screen mode, takes you out of it.'}. nil. {'set display depth ...' . {self. #setDisplayDepth} . 'choose how many bits per pixel.'}. {'set desktop color...' . {self. #changeBackgroundColor} . 'choose a uniform color to use as desktop background.'}. {'set gradient color...' . {self. #setGradientColor} . 'choose second color to use as gradient for desktop background.'}. }! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 7/31/2023 11:19'!helpMenu "Build the help menu for the world." | menu | menu := self menu: 'help...'. self fillIn: menu from: { {'about this system...'. {Smalltalk. #aboutThisSystem}. 'current version information.'}. {'update code from server'. {MCMcmUpdater. #updateFromServer}. 'load latest code updates via the internet'}. {'preferences...'. {self. #openPreferencesBrowser}. 'view and change various options.'}. {'set language...' . {Project. #chooseNaturalLanguage}. 'choose the language in which tiles should be displaye d.'} . nil. {'command-key help'. { TheWorldMainDockingBar instance . #commandKeyHelp}. 'summary of keyboard shortcuts.'} }. self addGestureHelpItemsTo: menu. self fillIn: menu from: { {'world menu help'. { self . #worldMenuHelp}. 'helps find menu items buried in submenus.'}. "{'info about flaps' . { Utilities . #explainFlaps}. 'describes how to enable and use flaps.'}." {'font size summary' . { TextStyle . #fontSizeSummary}. 'summary of names and sizes of available fonts.'}. {'useful expressions' . { Utilities . #openStandardWorkspace}. 'a window full of useful expressions.'}. {'annotation setup...' . { Preferences . #editAnnotations}. 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools'}. nil. {'graphical imports' . { Imports default . #viewImages}. 'view the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList'}. nil. {'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}. {#soundEnablingString . { SoundService . #toggleSoundEnabled}. 'turning sound off will completely disable Squeak''s use of sound.'}. nil. {'set author initials...' . { Utilities . #setAuthorInitials }. 'supply initials to be used to identify the author of code and other content.'}. {'vm statistics' . { self . #vmStatistics}. 'obtain some intriguing data about the vm.'}. nil. {'purge undo records' . { CommandHistory . #resetAllHistory }. 'save space by removing all the undo information remembered in all projects.'}. {'space left' . { self . #garbageCollect}. 'perform a full garbage-co llection and report how many bytes of space remain in the image.'}. }. ^menu! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/16/2023 11:24'!newMorph "The user requested 'new morph' from the world menu. Put up a menu that allows many ways of obtaining new morphs." | menu | menu := self menu: 'Add a new morph'. menu add: 'from paste buffer' translated target: myHand action: #pasteMorph; add: 'from alphabetical list' translated subMenu: self alphabeticalMorphMenu; add: 'from a file...' translated target: self action: #readMorphFromAFile. menu addLine. menu add: 'grab rectangle from screen' translated target: myWorld action: #grabDrawingFromScreen:; add: 'grab with lasso from screen' translated target: myWorld action: #grabLassoFromScreen:; add: 'grab rubber band from screen' translated target: myWorld action: #grabRubberBandFromScreen:; add: 'grab flood area from screen' translated target: myWorld action: #grabFloodFromScreen:. menu addLine. menu add: 'make link to project...' translated target: self action: #projectThumbnail. self doPopUp: menu.! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/11/2023 16:37'!openMenu "Build the open window menu for the world." | menu | menu := self menu: 'open...'. menu defaultTarget: ToolSet default. menu addList: ToolSet menuItems. menu defaultTarget: self. self fillIn: menu from: { nil. {'file...' . { self . #openFileDirectly} . 'Lets you open a window on a single file'}. {'transcript (t)' . {self . #openTranscript}. 'A window used to report messages sent to Transcript' }. "{'inner world' . { WorldWindow . #test1} }." nil. }. self fillIn: menu from: self class registeredOpenCommands. menu addLine. self fillIn: menu from: { {'morphic project' . {self. #openMorphicProject} . 'Creates a new morphic project'}. {'mvc project' . {self. #openMVCProj ect} . 'Creates a new project of the classic "mvc" style'} }. ^menu! !!TheWorldMenu methodsFor: 'construction' stamp: 'mt 8/11/2023 16:37'!projectMenu "Build the project menu for the world." | menu | self flag: #bob0302. menu := self menu: 'projects...'. self fillIn: menu from: { { 'save on server (also makes a local copy)' . { #myProject . #storeOnServer } }. { 'save to a different server' . { #myProject . #saveAs } }. { 'save project on local file only' . { #myWorld . #saveOnFile } }. { 'see if server version is more recent...' . { #myProject . #loadFromServer } }. { 'load project from file...' . { self . #loadProject } }. nil. }. self fillIn: menu from: { { 'create new morphic project' . { self . #openMorphicProject } }. { 'create new mvc project'. { self . #openMVCProject } }. }. self fillIn: menu from: { nil. { 'go to previous project' . { Project . #returnToPreviousProject } }. { 'go to next project' . { Project . #advanceToNextProject } }. { 'jump to project...' . { #myWorld . #jumpToProject } }. }. self fillIn: menu from: { nil. { 'save for future revert' . { #myProject . #saveForRevert } }. { 'revert to saved copy' . { #myProject . #revert } }. }. ^ menu! !!TheWorldMenu methodsFor: '*MorphicExtras-windows & flaps menu' stamp: 'mt 8/4/2023 15:18'!formulateFlapsMenu: aMenu "Fill aMenu with appropriate content" aMenu addTitle: 'flaps' translated. aMenu addStayUpItem. Preferences classicNavigatorEnabled ifTrue: [aMenu addUpdating: #navigatorShowingString enablementSelector: #enableProjectNavigator target: Preferences selector: #toggle: argumentList: #(showProjectNavigator). aMenu balloonTextForLastItem: (Preferences preferenceAt: #showProjectNavigator) helpString translated]. Flaps sharedFlapsAllowed ifTrue:
[self fillIn: aMenu from: {{#suppressFlapsString. {Project current. #toggleFlapsSuppressed}. 'Whether prevailing flaps should be shown in the project right now or not.'}}. aMenu addUpdating: #automaticFlapLayoutString target: Preferences selector: #toggle: argumentList: #(automaticFlapLayout). aMenu balloonTextForLastItem: (Preferences preferenceAt: #automaticFlapLayout) helpString translated. aMenu addLine. Flaps addIndividualGlobalFlapItemsTo: aMenu]. self fillIn: aMenu from: { nil. {'make a new flap'. {Flaps. #addLocalFlap}. 'Create a new flap. You can later make it into a shared flap is you wish.'}. nil.}. Flaps sharedFlapsAllowed ifTrue: [aMenu addWithLabel: 'put shared flaps on bottom' translated enablementSelector: #showSharedFlaps target: Flaps selector: #sharedFlapsAlongBottom argumentList: #(). aMenu balloonTextForLastItem: 'Group all the standard shared flaps along the bottom edge of the screen' translated. self fillIn: aMenu from: { {'destroy all shared flaps'. {Flaps. #disableGlobalFlaps}. 'Destroy all the shared flaps and disable their use in all projects.'}}] ifFalse: [aMenu add: 'install default shared flaps' translated target: Flaps action: #enableGlobalFlaps. aMenu balloonTextForLastItem: 'Create the default set of shared flaps' translated. aMenu addLine]. self fillIn: aMenu from: { nil. {'about flaps...'. {Flaps . #explainFlaps}. 'Gives a window full of details about how to use flaps.'}}! !!ThreePhaseButtonMorph class methodsFor: 'class initialization' stamp: 'mt 3/15/2023 14:11'!initialize "ThreePhaseButtonMorph initialize" | extent inset | extent := 12(a)12. inset := 3. #('CheckBoxOff' 'CheckBoxOn' 'CheckBoxPressed') do: [:button | | f r | f := ColorForm extent: extent depth: 1. f colors: {Color transparent. Color black}. f borderWidth: 1. r := f boundingBox insetBy: inset. button = 'CheckBoxPressed' ifTrue: [f border: r width: 1]. button = 'CheckBoxOn' ifTrue: [f fillBlack: r]. MenuIcons saveForm: f atKey: button]. #('RadioButtonOff' 'RadioButtonOn' 'RadioButtonPressed') do: [:button | | f r c | f := ColorForm extent: extent depth: 1. f colors: {Color transparent. Color black}. r := f boundingBox. c := f getCanvas. c frameOval: r color: Color black. r := r insetBy: inset. button = 'RadioButtonPressed' ifTrue: [c frameOval: r color: Color black]. button = 'RadioButtonOn' ifTrue: [c fillOval: r color: Color black]. MenuIcons saveForm: f atKey: button]! !!ThreePhaseButtonMorph class methodsFor: 'instance creation' stamp: 'mt 3/15/2023 14:09'!labelSymbol: aSymbol "(self labelSymbol: #TryIt) openInHand" | aButton form | aButton := ThreePhaseButtonMorph new. form := MenuIcons formAtKey: aSymbol. aButton offImage: form. aButton image: form. aButton pressedImage: (MenuIcons formPressedAtKey: aSymbol). ^ aButton! !!ThumbnailMorph methodsFor: 'stepping' stamp: 'mt 8/28/2023 14:37'!stepTime "Adjust my step time to the time it takes drawing my referent" drawTime ifNil:[^ 250]. ^(20 * drawTime) max: 250.! !!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'!actualViewee "Return the actual morph to be viewed, or nil if there isn't an appropriate morph to view." | aMorph actualViewee | aMorph := self morphToView ifNil: [^ nil]. aMorph isInWorld ifFalse: [^ nil]. actualViewee := viewSelector ifNil: [aMorph] ifNotNil: [objectToView perform: viewSelector]. actualViewee == 0 ifTrue: [^ nil]. "valueAtCu rsor result for an empty HolderMorph" actualViewee ifNil: [actualViewee := objectToView]. (actualViewee isMorph and: [actualViewee isFlexMorph and: [actualViewee submorphs size = 1]]) ifTrue: [actualViewee := actualViewee firstSubmorph]. ^ actualViewee! !!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'!formOrMorphToView "Answer the form to be viewed, or the morph to be viewed, or nil" | actualViewee | (objectToView isForm) ifTrue: [^objectToView]. actualViewee := viewSelector ifNil: [objectToView] ifNotNil: [objectToView perform: viewSelector]. ^actualViewee == 0 ifTrue: [nil "valueAtCursor result for an empty HolderMorph"] ifFalse: [actualViewee]! !!ThumbnailMorph methodsFor: 'what to view' stamp: 'mt 8/16/2023 15:59'!morphToView "If the receiver is viewing some object, answer a morph can be thought of as being viewed; A gesture is made toward generalizing this beyond the morph/p layer regime, in that a plain blue rectangle is returned rather than simply failing if the referent is not itself displayable." objectToView ifNil: [^ nil]. ^ objectToView isMorph ifTrue: [objectToView] ifFalse: [RectangleMorph new color: Color blue]! !!TransformationMorph methodsFor: 'menu' stamp: 'mt 3/10/2023 15:02'!removeFlexShell "Remove the shell used to make a morph rotatable and scalable." | oldHalo unflexed myWorld refPos aPosition | self isInWorld ifFalse: [^self]. refPos := self referencePosition. myWorld := self world. oldHalo := self halo. submorphs isEmpty ifTrue: [^ self delete]. aPosition := (owner submorphIndexOf: self) ifNil: [1]. unflexed := self firstSubmorph. self submorphs do: [:m | m position: self center - (m extent // 2). owner addMorph: m asElementNumber: aPosition]. unflexed absorbStateFromRenderer: self. oldHalo ifNotNil: [oldHalo setTarget: unflexed]. myWorld ifNotNil: [myWorld startSteppingSubmorphsOf: unflexed]. self delete. unflexed referencePosition: refPos. ^ unflexed! !!TransformationMorph methodsFor: 'private' stamp: 'mt 3/10/2023 11:18'!adjustAfter: changeBlock "Cause this morph to remain centered where it was before, and choose appropriate smoothing, after a change of scale or rotation." | oldRefPos | oldRefPos := self referencePosition. changeBlock value. self chooseSmoothing. self layoutChanged. owner ifNotNil: [owner invalidRect: bounds]! !!TranslucentProgessMorph methodsFor: 'drawing' stamp: 'mt 3/7/2023 15:07'!drawOn: aCanvas | revealPercentage revealingStyle revealingColor revealingBounds revealToggle x baseColor revealTimes secondsRemaining stringToDraw where fontToUse innerBounds | innerBounds := bounds. opaqueBackgroundColor ifNotNil: [ aCanvas frameAndFillRectangle: bounds fillColor: opaqueBackgroundColor borderWidth: 8
borderColor: Color blue. innerBounds := innerBounds insetBy: 8. ]. revealTimes := (self valueOfProperty: #revealTimes) ifNil: [^self]. revealPercentage := (revealTimes first / revealTimes second) asFloat. revealingStyle := self revealingStyle. x := self valueOfProperty: #progressStageNumber ifAbsent: [1]. baseColor := Color perform: (#(red blue green magenta cyan yellow) atPin: x). revealingColor := baseColor alpha: 0.2. revealingStyle = 3 ifTrue: [ "wrap and change color" revealPercentage > 1.0 ifTrue: [ revealingColor := baseColor alpha: (0.2 + (revealingStyle / 10) min: 0.5). ]. revealPercentage := revealPercentage fractionPart. ]. revealingStyle = 2 ifTrue: [ "peg at 75 and blink" revealPercentage > 0.75 ifTrue: [ revealToggle := self valueOfProperty: #revealToggle ifAbsent: [true]. self setProperty: #revealToggle toValue: revealToggle not. revealToggle ifTru e: [revealingColor := baseColor alpha: 0.8.]. ]. revealPercentage := revealPercentage min: 0.75. ]. revealingBounds := innerBounds withLeft: innerBounds left + (innerBounds width * revealPercentage) truncated. aCanvas fillRectangle: revealingBounds color: revealingColor. secondsRemaining := (revealTimes second - revealTimes first / 1000) rounded. secondsRemaining > 0 ifTrue: [ fontToUse := StrikeFont familyName: Preferences standardButtonFont familyName size: 24. stringToDraw := secondsRemaining printString. where := innerBounds corner - ((fontToUse widthOfString: stringToDraw) @ fontToUse height). aCanvas drawString: stringToDraw in: (where corner: innerBounds corner) font: fontToUse color: Color black. aCanvas drawString: stringToDraw in: (where - (1(a)1) corner: innerBounds corner) font: fontToUse color: Color white. ]. ! !!TrashCanMorph methodsFor: 'event handling' stamp: 'mt 8/11/2023 13:45'!doubleClick: evt evt hand world addMorphCentered: ScrapBook default scrapBook! !!UpdatingRectangleMorph methodsFor: 'setting' stamp: 'mt 3/10/2023 15:02'!valueProvider "Answer the object to which my get/set messages should be sent. This is inefficient and contorted in order to support grandfathered content for an earlier design" ^ target! !!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:28'!decimalPlaces: aNumber "Set the receiver's number of decimal places to be shown." | constrained | self setProperty: #decimalPlaces toValue: (constrained := aNumber min: 11). self pvtFloatPrecision: (Utilities floatPrecisionForDecimalPlaces: constrained).! !!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 15:45'!target: anObject target := anObject. floatPrecision := 1.! !!UpdatingStringMorph methodsFor: 'accessing' stamp: 'mt 3/10/2023 14:02'!valueFromContents "Return a new value from the current contents string." format = #symbol ifTrue: [^ lastValue]. format = #string ifTrue: [^ contents]. ^ Compiler evaluate: contents! !!UpdatingStringMorph methodsFor: 'target access' stamp: 'mt 3/10/2023 14:13'!readFromTarget "Update my readout from my target" | v ret | (target isNil or: [getSelector isNil]) ifTrue: [^contents]. ret := self checkTarget. ret ifFalse: [^ '0']. v := target perform: getSelector. "scriptPerformer" (v isKindOf: Text) ifTrue: [v := v asString]. ^self acceptValueFromTarget: v! !!UserInterfaceTheme methodsFor: 'private - fonts' stamp: 'mt 7/31/2023 11:21'!installSystemFont: aFont "Establish the default text font and style. Update the #defaultFontIndex in all known text styles to reflect the system's new default point size." | aStyle | self flag: #todo. "mt: Support derivatives such as bold and italic." aStyle := aFont textStyleOrNil. "mt: Must b e installed and thus never be nil!!" aStyle defaultFontIndex: (aStyle fontIndexOfPointSize: aFont pointSize "drop emphasis"). TextStyle setDefault: aStyle. TextStyle actualTextStyles "no defaults" do: [:ea | ea isTTCStyle ifTrue: [ea defaultFont asPointSize: aFont pointSize "May generate new pointSize"]. ea defaultFontIndex: (ea fontIndexOfPointSize: aFont pointSize)]. RealEstateAgent resetScaleFactor. Flaps replaceToolsFlap.! !!CommunityTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addDarkWindowColors: aUserInterfaceTheme "self createDark apply." aUserInterfaceTheme set: #uniformWindowColor for: #Model to: Color darkGray; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color darker] ]; set: #unfocusedLabelColor for: #SystemWindow to: Color veryLightGray; set: #focusedLabelColor for: #SystemWindow to: Color white; set: #customWindowColor for: #Br owser to: self dbBlue; set: #customWindowColor for: #ChangeList to: self dbBlue; set: #customWindowColor for: #ChangeSorter to: self dbBlue; set: #customWindowColor for: #ChatNotes to: self dbPurple twiceDarker; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self dbPurple twiceDarker; set: #customWindowColor for: #Debugger to: self dbRed; set: #customWindowColor for: #DualChangeSorter to: self dbOrange twiceDarker; set: #customWindowColor for: #FileContentsBrowser to: self dbGray; set: #customWindowColor for: #FileList to: self dbGray; set: #customWindowColor for: #Inspector to: self dbYellow duller; set: #customWindowColor for: #InstanceBrowser to: self dbYellow duller; set: #customWindowColor for: #Lexicon to: self dbGreen; set: #customWindowColor for: #MCTool to: self dbOrange twiceDarker; set: #customWindowColor for: #MessageNames to: self dbGreen; set: #customWindow Color for: #MessageSet to: self dbGreen; set: #customWindowColor for: #ObjectExplorer to: self dbYellow duller; set: #customWindowColor for: #PackagePaneBrowser to: self dbBlue; set: #customWindowColor for: #PluggableFileList to: self dbGray; set: #customWindowColor for: #PreferenceBrowser to: self dbBlue; set: #customWindowColor for: #ProcesBrowser to: self dbAqua; set: #customWindowColor for: #SMLoader to: self dbOrange twiceDarker; set: #customWindowColor for: #SMLoaderPlus to: self dbOrange twiceDarker; set: #customWindowColor for: #SMReleaseBrowser to: self dbOrange twiceDarker; set: #customWindowColor for: #SelectorBrowser to: self dbBlue; set: #customWindowColor for: #StringHolder to: self dbGray; set: #customWindowColor for: #TestRunner to: self dbPink darker; set: #customWindowColor for: #TranscriptStream to: self dbGray; set: #customWindowColor for: #VersionsBrowser to: self dbPurpl e twiceDarker; set: #customWindowColor for: #Workspace to: self dbPink darker.! !!MonokaiTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addDarkWindowColors: theme "self createDark apply." theme set: #uniformWindowColor for: #Model to:( self invisibleColor adjustBrightness: 0.16) "lighter twice"; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: -0.16 "darker twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: [ Model useColorfulWindows ifTrue: [(Color r: 0.285 g: 0.282 b: 0.242) "invisible color"] ifFalse: [(Color r: 0.972 g: 0.972 b: 0.948) "foreground color"] ]; set: #focusedLabelColor for: #SystemWindow to: [ Model useColorfulWindows ifTrue: [(Color r: 0.152 g: 0.156 b: 0.133) "background color"] ifFalse: [(Color r: 0.901 g: 0.858 b: 0.455) "yellow"] ]; set: #customWindowColor for: #Browser to: self green duller; set: #customWindowColor for: #ChangeList to: self blue duller; set: #customWindowColor for: #ChangeSorter to: self blue duller; set: #customWindowColor for: #ChatNotes to: self magenta duller; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet duller; set: #customWindowColor for: #Debugger to: self red duller; set: #customWindowColor for: #DualChangeSorter to: self blue duller; set: #customWindowColor for: #FileContentsBrowser to: self yellow duller; set: #customWindowColor for: #FileList to: self yellow duller; set: #customWindowColor for: #InstanceBrowser to: self cyan duller; set: #customWindowColor for: #Lexicon to: self cyan duller; set: #customWindowColor for: #MCTool to: self violet duller; set: #customWindowColor for: #MessageNames to: self green duller; set: #customWindowColor for: #MessageSet to: se lf cyan duller; set: #customWindowColor for: #PackagePaneBrowser to: self green duller; set: #customWindowColor for: #PluggableFileList to: self yellow duller; set: #customWindowColor for: #PreferenceBrowser to: self cyan duller; set: #customWindowColor for: #SMLoader to: self orange duller; set: #customWindowColor for: #SMLoaderPlus to: self orange duller; set: #customWindowColor for: #SMReleaseBrowser to: self orange duller; set: #customWindowColor for: #SelectorBrowser to: self cyan duller; set: #customWindowColor for: #StringHolder to: self yellow duller; set: #customWindowColor for: #TestRunner to: self orange duller; set: #customWindowColor for: #TranscriptStream to: self orange duller; set: #customWindowColor for: #VersionsBrowser to: self violet duller.! !!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addDarkWindowColors: theme "doIt: [self createDark apply.]" theme set: #uniformWindowColor for: #Model to: (self darkBackgroundHighlights adjustBrightness: 0.16 "lighter twice"); set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: -0.16 "darker twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: self darkContentEmphasized; set: #focusedLabelColor for: #SystemWindow to: self darkContentEmphasizedMore; set: #customWindowColor for: #Browser to: self green; set: #customWindowColor for: #ChangeList to: self blue; set: #customWindowColor for: #ChangeSorter to: self blue; set: #customWindowColor for: #ChatNotes to: self magenta; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet; set: #customWindowColor for: #Debugger to: self red; set: #customWindowColor for: #DualChangeSorter to: self blue; set: #customWindowColor for: #FileContentsBrowser to: self yellow; set: #customWindowColor for: # FileList to: self yellow; set: #customWindowColor for: #InstanceBrowser to: self cyan; set: #customWindowColor for: #Lexicon to: self cyan; set: #customWindowColor for: #MCTool to: self violet; set: #customWindowColor for: #MessageNames to: self green; set: #customWindowColor for: #MessageSet to: self cyan; set: #customWindowColor for: #PackagePaneBrowser to: self green; set: #customWindowColor for: #PluggableFileList to: self yellow; set: #customWindowColor for: #PreferenceBrowser to: self cyan; set: #customWindowColor for: #SMLoader to: self orange; set: #customWindowColor for: #SMLoaderPlus to: self orange; set: #customWindowColor for: #SMReleaseBrowser to: self orange; set: #customWindowColor for: #SelectorBrowser to: self cyan; set: #customWindowColor for: #StringHolder to: self yellow; set: #customWindowColor for: #TestRunner to: self orange; set: #customWindowColor for: #TranscriptStream to: self orange; set: #customWindowColor for: #VersionsBrowser to: self violet.! !!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addLightWindowColors: theme "You have to create dark first. doIt: [self createDark. self createLight apply.]" theme set: #uniformWindowColor for: #Model to: (self lightBackgroundHighlights adjustBrightness: -0.16 "darker twice"); set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color adjustBrightness: 0.16 "lighter twice"] ]; set: #unfocusedLabelColor for: #SystemWindow to: self lightContentEmphasized; set: #focusedLabelColor for: #SystemWindow to: self lightContentEmphasizedMore; set: #customWindowColor for: #Browser to: self green; set: #customWindowColor for: #ChangeList to: self blue; set: #customWindowColor for: #ChangeSorter to: self blue; set: #customWindowColor for: #ChatNotes to: self magenta; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self violet; set: #customWindowColor for: #Debugger to: (self red adjustSaturation: -0.27 brightness: 0.27); set: #customWindowColor for: #DualChangeSorter to: self blue; set: #customWindowColor for: #FileContentsBrowser to: self yellow; set: #customWindowColor for: #FileList to: self yellow; set: #customWindowColor for: #InstanceBrowser to: self cyan; set: #customWindowColor for: #Lexicon to: self cyan; set: #customWindowColor for: #MCTool to: self violet; set: #customWindowColor for: #MessageNames to: self green; set: #customWindowColor for: #MessageSet to: self cyan; set: #customWindowColor for: #PackagePaneBrowser to: self green; set: #customWindowColor for: #PluggableFileList to: self yellow; set: #customWindowColor for: #PreferenceBrowser to: self cyan; set: #customWindowColor for: #SMLoader to: (self orange adjustSaturation : -0.18 brightness: 0.18); set: #customWindowColor for: #SMLoaderPlus to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SMReleaseBrowser to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #SelectorBrowser to: self cyan; set: #customWindowColor for: #StringHolder to: self yellow; set: #customWindowColor for: #TestRunner to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #TranscriptStream to: (self orange adjustSaturation: -0.18 brightness: 0.18); set: #customWindowColor for: #VersionsBrowser to: self violet.! !!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addDullerWindowColors: theme theme set: #uniformWindowColor for: #Model to: Color veryVeryLightGray duller; set: #customWindowColor for: #Browser to: (Color r: 0.764 g: 0.9 b: 0.63) duller; set: #customWindowColor f or: #ChangeList to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #ChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #ChatNotes to: (Color r: 1.0 g: 0.7 b: 0.8) duller; set: #customWindowColor for: #ClassCommentVersionsBrowser to: (Color r: 0.753 g: 0.677 b: 0.9) duller; set: #customWindowColor for: #Debugger to: (Color r: 0.9 g: 0.719 b: 0.719) duller; set: #customWindowColor for: #DualChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #FileContentsBrowser to: (Color r: 0.7 g: 0.7 b: 0.508) duller; set: #customWindowColor for: #FileList to: (Color r: 0.65 g: 0.65 b: 0.65) duller; set: #customWindowColor for: #InstanceBrowser to: (Color r: 0.726 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #Lexicon to: (Color r: 0.79 g: 0.9 b: 0.79) duller; set: #customWindowColor for: #MCTool to: (Color r: 0.65 g: 0.691 b: 0.876) duller; set: #customWindowColor for: #MessageNames to: (Color r: 0.639 g: 0.9 b: 0.497) duller; set: #customWindowColor for: #MessageSet to: (Color r: 0.719 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #PackagePaneBrowser to: (Color r: 0.9 g: 0.9 b: 0.63) duller; set: #customWindowColor for: #PluggableFileList to: Color lightYellow duller; set: #customWindowColor for: #PreferenceBrowser to: (Color r: 0.671 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #SMLoader to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SMLoaderPlus to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SMReleaseBrowser to: (Color r: 0.801 g: 0.801 b: 0.614) duller; set: #customWindowColor for: #SelectorBrowser to: (Color r: 0.45 g: 0.9 b: 0.9) duller; set: #customWindowColor for: #StringHolder to: (Color r: 0.9 g: 0.9 b: 0.719) duller; set: #customWindowColor for: #TestRunn er to: (Color r: 0.9 g: 0.576 b: 0.09) duller; set: #customWindowColor for: #TranscriptStream to: (Color r: 0.9 g: 0.75 b: 0.45) duller; set: #customWindowColor for: #VersionsBrowser to: (Color r: 0.782 g: 0.677 b: 0.9) duller.! !!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addWindowColors: theme theme set: #titleFont for: #SystemWindow to: [Preferences windowTitleFont]; set: #borderColorModifier for: #SystemWindow to: [ [:c | c adjustBrightness: -0.3] ]; set: #borderColorModifier for: #ScrollPane to: [ [:c | c adjustBrightness: -0.3] ]; set: #borderWidth for: #SystemWindow to: 1; derive: #resizerColorModifier for: #AbstractResizerMorph from: #SystemWindow at: #borderColorModifier; set: #uniformWindowColor for: #Model to: Color veryVeryLightGray; derive: #uniformWindowColor for: #TranscriptStream from: #Model; derive: #color for: #SystemWindow from: #Model at: #uniformWind owColor; "Fall back for windows without models." set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color darker] ]; set: #unfocusedLabelColor for: #SystemWindow to: Color darkGray; set: #focusedLabelColor for: #SystemWindow to: Color black; set: #customWindowColor for: #Browser to: (Color r: 0.764 g: 0.9 b: 0.63); set: #customWindowColor for: #ChangeList to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #ChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #ChatNotes to: (Color r: 1.0 g: 0.7 b: 0.8); set: #customWindowColor for: #ClassCommentVersionsBrowser to: (Color r: 0.753 g: 0.677 b: 0.9); set: #customWindowColor for: #Debugger to: (Color r: 0.9 g: 0.719 b: 0.719); set: #customWindowColor for: #DualChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #FileContentsBrowser to: (Color r: 0.7 g: 0.7 b: 0.508) ; set: #customWindowColor for: #FileList to: (Color r: 0.65 g: 0.65 b: 0.65); set: #customWindowColor for: #InstanceBrowser to: (Color r: 0.726 g: 0.9 b: 0.9); set: #customWindowColor for: #Lexicon to: (Color r: 0.79 g: 0.9 b: 0.79); set: #customWindowColor for: #MCTool to: (Color r: 0.65 g: 0.691 b: 0.876); set: #customWindowColor for: #MessageNames to: (Color r: 0.639 g: 0.9 b: 0.497); set: #customWindowColor for: #MessageSet to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #PackagePaneBrowser to: (Color r: 0.9 g: 0.9 b: 0.63); set: #customWindowColor for: #PluggableFileList to: Color lightYellow; set: #customWindowColor for: #PreferenceBrowser to: (Color r: 0.671 g: 0.9 b: 0.9); set: #customWindowColor for: #SMLoader to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SMLoaderPlus to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SMReleaseBrowser to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SelectorBrowser to: (Color r: 0.45 g: 0.9 b: 0.9); set: #customWindowColor for: #StringHolder to: (Color r: 0.9 g: 0.9 b: 0.719); set: #customWindowColor for: #TestRunner to: (Color r: 0.9 g: 0.576 b: 0.09); set: #customWindowColor for: #TranscriptStream to: (Color r: 0.9 g: 0.75 b: 0.45); set: #customWindowColor for: #VersionsBrowser to: (Color r: 0.782 g: 0.677 b: 0.9).! !!TrimTheme class methodsFor: 'instance creation' stamp: 'mt 8/29/2023 15:15'!addWindowColors: theme | windowColorBrightnessAdjustment | windowColorBrightnessAdjustment := -0.35. theme set: #titleFont for: #SystemWindow to: [Preferences windowTitleFont]; set: #borderColorModifier for: #SystemWindow to: [ [:c | c adjustBrightness: -0.1] ]; set: #borderColorModifier for: #ScrollPane to: [ [:c | c adjustBrightness: 0.1] ]; set: #borderWidth for: #SystemWindow to: 1;
set: #uniformWindowColor for: #Model to: self gray76; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color alphaMixed: 0.5 with: self gray40] ]; set: #unfocusedLabelColor for: #SystemWindow to: self gray168; set: #focusedLabelColor for: #SystemWindow to: Color white; set: #customWindowColor for: #Browser to: ((Color r: 0.764 g: 0.9 b: 0.63) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChangeList to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChangeSorter to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ChatNotes to: ((Color r: 1.0 g: 0.7 b: 0.8) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #ClassCommentVersionsBrowser to: ((Color r: 0.753 g: 0.677 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #Debugger to: ((Color r: 0.9 g: 0.719 b: 0.719) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #DualChangeSorter to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #FileContentsBrowser to: ((Color r: 0.7 g: 0.7 b: 0.508) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #FileList to: ((Color r: 0.65 g: 0.65 b: 0.65) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #InstanceBrowser to: ((Color r: 0.726 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #Lexicon to: ((Color r: 0.79 g: 0.9 b: 0.79) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MCTool to: ((Color r: 0.65 g: 0.691 b: 0.876) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MessageNames to: ((Color r: 0.639 g: 0.9 b: 0.497) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #MessageSet to: ((Color r: 0.719 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PackagePaneBrowser to: ((Color r: 0.9 g: 0.9 b: 0.63) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PluggableFileList to: (Color lightYellow adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #PreferenceBrowser to: ((Color r: 0.671 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMLoader to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMLoaderPlus to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SMReleaseBrowser to: ((Color r: 0.801 g: 0.801 b: 0.614) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #SelectorBrowser to: ((Color r: 0.45 g: 0.9 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #StringHolder to: ((Color r: 0.9 g: 0.9 b: 0.719) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #TestRunner to: ((Color r: 0.9 g: 0.576 b: 0.09) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #TranscriptStream to: ((Color r: 0.9 g: 0.75 b: 0.45) adjustBrightness: windowColorBrightnessAdjustment); set: #customWindowColor for: #VersionsBrowser to: ((Color r: 0.782 g: 0.677 b: 0.9) adjustBrightness: windowColorBrightnessAdjustment).! !!Utilities class methodsFor: 'common requests' stamp: 'mt 8/11/2023 15:01'!initializeCommonRequestStrings "Initialize the common request strings, a directly-editable list of expressions that can be evaluated from the 'do...' menu." CommonRequestStrings := StringHolder new contents: 'Utilities emergencyCollapse.Utilities closeAllDebuggers.RecentMessages default revertMostRecent.-MCFileBasedRepository flushAllCaches-Sensor keyboard.ParagraphEditor abandonChangeText.Cursor normal show.-CommandHistory resetAllHistory.Project allInstancesDo: [:p | p displayDepth: 16].ScriptingSystem inspectFormDictionary.Form fromUser bitEdit.Display border: (0(a)0 extent: 640(a)480) width: 2.-Undeclared inspect.Undeclared removeUnreferencedKeys; inspect.Transcript clear.GIFReadWriter grabScreenAndSaveOnDisk.FrameRateMorph new openInHand.-Utilities reconstructTextWindowsFromFileNamed: ''TW''.Utilities storeTextWindowContentsToFileNamed: ''TW''.ChangeSet removeEmptyUnnamedChangeSets.ChangesOrganizer reorderChangeSets.'"Utilities initializeCommonRequestStrings"! !!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:55'!addControls | slider aWrapper m aButton | aWrapper := AlignmentMorph newRow. aWrapper color: Color transparent; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 @ 5. aWrapper wrapCentering: #topLeft. aButton := self buttonName: 'X' action: #delete. aButton setBalloonText: 'Close WaveEditor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Menu' translated action: #invokeMenu. aButton setBalloonText: 'Open a menu' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play' translated action: #play. aButton setBalloonText: 'Play sound' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play Before' translated action: #playBeforeCur sor. aButton setBalloonText: 'Play before cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play After' translated action: #playAfterCursor. aButton setBalloonText: 'Play after cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Play Loop' translated action: #playLoop. aButton setBalloonText: 'Play the loop' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Test' translated action: #playTestNote. aButton setBalloonText: 'Test the note' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Save' translated action: #saveInstrument. aButton setBalloonText: 'Save the sound' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1 . aButton := self buttonName: 'Set Loop End' translated action: #setLoopEnd. aButton setBalloonText: 'Set loop end at cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set One Cycle' translated action: #setOneCycle. aButton setBalloonText: 'Set one cycle' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. aButton := self buttonName: 'Set Loop Start' translated action: #setLoopStart. aButton setBalloonText: 'Set the loop start at cursor' translated. aWrapper addMorphBack: aButton. aWrapper addTransparentSpacerOfSize: 4 @ 1. self addMorphBack: aWrapper. aWrapper := AlignmentMorph newRow. aWrapper color: self color; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5 @ 20; wrapCentering: #center; cellPositioning: #leftCenter. m := Strin gMorph new contents: 'Index: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #cursor; putSelector: #cursor:; font: Preferences standardButtonFont; growable: false; width: 71; step. aWrapper addMorphBack: m. m := StringMorph new contents: 'Value: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #valueAtCursor; putSelector: #valueAtCursor:; font: Preferences standardButtonFont; growable: false; width: 50; step. aWrapper addMorphBack: m. slider := SimpleSliderMorph new color: color; extent: 200 @ 10; target: self; actionSelec tor: #scrollTime:. aWrapper addMorphBack: slider. m := Morph new color: aWrapper color; extent: 10 @ 5. "spacer" aWrapper addMorphBack: m. m := UpdatingStringMorph new target: graph; getSelector: #startIndex; putSelector: #startIndex:; font: Preferences standardButtonFont; width: 40; step. aWrapper addMorphBack: m. self addMorphBack: aWrapper! !!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:56'!addLoopPointControls | m aWrapper | aWrapper := AlignmentMorph newRow. aWrapper color: self color; borderWidth: 0; layoutInset: 0. aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5(a)20; wrapCentering: #center; cellPositioning: #leftCenter. m := StringMorph new contents: 'Loop end: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopEn d; putSelector: #loopEnd:; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Loop length: ' translated ; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopLength; putSelector: #loopLength:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m.aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Loop cycles: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #loopCycles; putSelector: #loopCycles:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m.aWrapper addTransparentSpacerOfSize: 4 @ 1. m := StringMorph new contents: 'Frequency: ' translated; font: Preferences standardButtonFont. aWrapper addMorphBack: m. m := UpdatingStringMorph new target: self; getSelector: #perceivedFrequency; putSelector: #perceivedFrequency:; floatPrecision: 0.001; font: Preferences standardButtonFont; growable: false; width: 100; step. aWrapper addMorphBack: m. self addMorphBack: aWrapper! !!WaveEditor methodsFor: 'initialization' stamp: 'mt 8/4/2023 14:53'!buttonName: aString action: aSymbol "Create a button with the given label and action selector, and answer it." ^ SimpleButtonMorph new target: self; label: aString font: Preferences standardButtonFont; actionSelector: aSymbol! !WebCamMorph class removeSelector: #additionsToViewerCategories!SymbolListType removeSelector: #initialValueForASlotFor:!StringType removeSelector: #initialValueForASlotFor:!SoundType removeSele ctor: #initialValueForASlotFor:!PointType removeSelector: #initialValueForASlotFor:!NumberType removeSelector: #initialValueForASlotFor:!GraphicType removeSelector: #initialValueForASlotFor:!!GraphicType reorganize!('initial value')('initialization' initialize)!ColorType removeSelector: #initialValueForASlotFor:!BooleanType removeSelector: #initialValueForASlotFor:!DataType removeSelector: #initialValueForASlotFor:!Vocabulary removeSelector: #isEToyVocabulary!UpdatingStringMorph removeSelector: #isEtoyReadout!!UpdatingStringMorph reorganize!('accessing' autoAcceptOnFocusLoss autoAcceptOnFocusLoss: decimalPlaces decimalPlaces: floatPrecision format getSelector getSelector: growable growable: maximumWidth maximumWidth: minWidth minWidth: putSelector putSelector: pvtFloatPrecision: target target: valueFromContents)('copying' veryDeepFixupWith: veryDeepInner:)('editing' acceptContents acceptValue: addCustomMenuItems:hand: doneWithEdits lostFocusWithoutAccepting setDecimalPlaces: setFon tSize setFontStyle setPrecision setToAllowTextEdit toggleGrowability userEditsAllowed)('event handling' handlesMouseDown: mouseDown: wouldAcceptKeyboardFocus)('events-processing' handlerForMouseDown:)('formats' useDefaultFormat useStringFormat useSymbolFormat)('initialization' defaultMaximumWidth defaultMinimumWidth initialize)('stepping' step stepTime stepTime: updateContentsFrom:)('target access' acceptValueFromTarget: checkTarget informTarget readFromTarget setDecimalPlacesFromTypeIn: stringForNumericValue:)('layout' fitContents)('*MorphicExtras-accessing' floatPrecision:)!UpdatingRectangleMorph removeSelector: #isEtoyReadout!!UpdatingRectangleMorph reorganize!('accessing' contents contents: getSelector getSelector: putSelector putSelector: target target: userEditsAllowed)('copying' veryDeepFixupWith: veryDeepInner:)('event handling' handlesMouseDown: mouseUp:)('initialization' defaultBorderColor)('setting' setTargetColor: valueProvider)('stepping' step stepTime)('target access' readFromTarget)!UpdatingMenuItemMorph removeSelector: #adaptToWorld:!ThumbnailMorph removeSelector: #isEtoyReadout!!ThumbnailMorph reorganize!('accessing' getSelector getSelector: putSelector target)('caching' releaseCachedState)('copying' veryDeepFixupWith: veryDeepInner:)('display' drawForForm:on: drawMeOn: scaleFor:in:)('drawing' drawOn:)('initialization' defaultBorderWidth defaultColor initialize objectToView: objectToView:viewSelector:)('stepping' step stepTime)('texture support' installAsWonderlandTextureOn:)('what to view' actualViewee formOrMorphToView morphToView)!ThreePhaseButtonMorph initialize!!ThreePhaseButtonMorph class reorganize!('class initialization' initialize)('instance creation' checkBox labelSymbol: radioButton)('preferences' themeProperties)!ThreePhaseButtonMorph removeSelector: #adaptToWorld:!TheWorldMenu removeSelector: #adaptToWorld:!TheWorldMenu removeSelector: #menuColorString!TheWorldMenu removeSelector: #mvcProjectsAllowed!TheWorldMenu removeSele ctor: #roundedCornersString!TheWorldMenu removeSelector: #toggleMenuColorPolicy!!TheWorldMenu reorganize!('action' commandKeyTypedIntoMenu: doMenuItem:with: projectThumbnail saveScreenshot setGradientColor soundEnablingString staggerPolicyString toggleRoundedCorners toggleWindowPolicy)('commands' changeBackgroundColor cleanUpWorld garbageCollect loadProject lookForSlips newMorphOfClass:event: openBrowser openFileDirectly openFileList openMorphicProject openMVCProject openPreferencesBrowser openPreferencesWizard openTranscript openWorkspace projectForMyWorld quitSession readMorphFromAFile saveAndQuit saveWorldInFile setDisplayDepth splitNewMorphList:depth: startMessageTally vmStatistics worldMenuHelp)('construction' addObjectsAndTools: addPrintAndDebug: addProjectEntries: addRestoreDisplay: addSaveAndQuit: addUtilities: alphabeticalMorphMenu appearanceMenu buildWorldMenu changesMenu colorForDebugging: debugMenu fillIn:from: helpMenu makeConvenient: newMorph openMenu projectMenu remoteMenu)('mechanics' menu: world:project:hand:)('menu' addGestureHelpItemsTo:)('popups' appearanceDo changesDo debugDo doPopUp: helpDo openWindow projectDo remoteDo standardFontDo)('windows & flaps menu' suppressFlapsString windowsDo windowsMenu)('*MorphicExtras-action' createStandardPartsBin launchCustomPartsBin toggleFlapSuppressionInProject)('*MorphicExtras-construction' myMenuColor)('*MorphicExtras-mechanics')('*MorphicExtras-windows & flaps menu' flapsDo flapsMenu formulateFlapsMenu: globalFlapsEnabled newGlobalFlapString)('*Tools' browseRecentLog openChangeSorter1 openChangeSorter2 openMessageNames openProcessBrowser openSelectorBrowser startThenBrowseMessageTally)('*MorphicExtras-Postscript Canvases' printWorldOnFile)!TextMorphForEditView removeSelector: #wouldAcceptKeyboardFocusUponTab!!TextMorph class reorganize!('class initialization' cleanUp defaultEditorClass defaultEditorClass: initialize registerInFlapsRegistry unload)('connectorstext-parts bin' boldAuthoringPrototype)('new-morph participation' includeInNewMorphMenu)('parts bin' borderedPrototype exampleBackgroundLabel fancyPrototype)('scripting' authoringPrototype defaultNameStemForInstances)('instance creation' string:fontName: string:fontName:size: string:fontName:size:wrap: string:size:)('*MorphicExtras-parts bin' supplementaryPartsDescriptions)!TextMorph removeSelector: #cursor!TextMorph removeSelector: #cursorWrapped:!TextMorph removeSelector: #getAllButFirstCharacter!TextMorph removeSelector: #holderForCharacters!TextMorph removeSelector: #insertCharacters:!TextMorph removeSelector: #insertContentsOf:!TextMorph removeSelector: #setAllButFirstCharacter:!TextMorph removeSelector: #wouldAcceptKeyboardFocusUponTab!!TextMorph reorganize!('accessing' autoFit: backgroundColor backgroundColor: borderWidth: caretColor caretColor: contents contentsAsIs: contentsWrapped: contents: contents:wrappedTo: crAction crAction: editor elementCount font: getFirstCharacter getLastC haracter hasTranslucentColor isAutoFit isWrapped margins margins: newContents: plainTextOnly plainTextOnly: readOnly readOnly: selectAll selectFrom:to: selectInterval: selection selectionColor selectionColor: selectionInterval selectionInterval: setCharacters: setFirstCharacter: setLastCharacter: text textAlignment textAlignmentSymbol textColor textColor: textStyle textStyle: unfocusedSelectionColor unfocusedSelectionColor: userString wrapFlag:)('alignment' centered justified leftFlush rightFlush)('anchors' adjustTextAnchor: anchorMorph:at:type:)('caching' loadCachedState releaseCachedState)('change reporting' ownerChanged)('classification' isTextMorph)('containment' avoidsOcclusions fillingOnOff fillsOwner fillsOwner: occlusionsOnOff recognizerArena setContainer:)('copying' copy veryDeepFixupWith: veryDeepInner:)('drawing' areasRemainingToFill: debugDrawLineRectsOn: drawNullTextOn: drawOn:)('editing' acceptContents acceptOnCR cancelEdits cancelEditsSafely chooseAlignment chooseEmphas is chooseEmphasisOrAlignment chooseFont chooseStyle handleEdit: handleInteraction:fromEvent: hasUnacceptedEdits: passKeyboardFocusTo: setCompositionWindow xeqLinkText:withParameter:)('event handling' click: getMenu: handlesKeyboard: handlesMouseDown: handlesMouseMove: handlesMouseOver: handlesMouseStillDown: hasFocus keyboardFocusChange: keyStroke: mouseDown: mouseEnter: mouseLeave: mouseMove: mouseUp: startDrag: wantsKeyboardFocus yellowButtonActivity:)('events-processing' handleKeystroke:)('geometry' bounds container defaultLineHeight extent: maximumContainerExtent privateMoveBy: textBounds)('geometry testing' containsPoint:)('initialization' beAllFont: defaultBorderWidth defaultColor fontName:pointSize: fontName:size: initialize setTextStyle: string:fontName:size: string:fontName:size:wrap:)('layout' acceptDroppingMorph:event: averageLineLength averageLineLength: doLayoutIn: layoutChanged minCompositionHeight minCompositionWidth minHeight minWidth)('linked frames' addPredeces sor: addSuccessor: firstCharacterIndex firstInChain isLinkedTo: lastCharacterIndex predecessor recomposeChain startingIndex successor withSuccessorsDo:)('menu' addCustomMenuItems:hand: autoFitOnOff autoFitString changeMargins: changeTextColor followCurve reverseCurveDirection setCurveBaseline: wrapOnOff wrapString)('multi level undo' editHistory)('objects from disk' convertToCurrentVersion:refStream: fixUponLoad:seg:)('visual properties' fillStyle fillStyle:)('*MorphicExtras-accessing' getCharacters)('*MorphicExtras-copying' updateReferencesUsing:)('private' adjustLineIndicesBy: clippingRectangle composeToBounds compositionRectangle createParagraph editorClass fit installEditorToReplace: paragraph paragraphClass predecessorChanged predecessor:successor: privateOwner: releaseEditor releaseParagraph releaseParagraphReally removedMorph: selectionChanged selectionChanged: setDefaultContentsIfNil setPredecessor: setSuccessor: text:textStyle: text:textStyle:wrap:color:predecessor:succes sor: updateFromParagraph)('blinking' blinkStart blinkStart: onBlinkCursor resetBlinkCursor startBlinking stopBlinking)('layout-properties' hResizing hResizing: vResizing vResizing: wrapDirection)('printing' fullPrintOn:)('Multilingual-ImmPlugin' preferredKeyboardPosition)('submorphs - add/remove' addMorphFront:fromWorldPosition: delete goBehind)('converting' asText withNoLineLongerThan:)!TabbedPalette removeSelector: #becomeStandardPalette!!TabbedPalette reorganize!('dropping/grabbing' wantsDroppedMorph:event:)('halos and balloon help' defersHaloOnClickTo:)('initialization' addTabFor:font: addTabForBook: addTabForBook:withBalloonText: defaultColor defaultPageSize initialize newTabs: setInitialState)('misc menu items' recolorTabs showNoPalette showNoPaletteAndHighlightTab: sortTabs:)('miscellaneous' currentPalette tabsMorph)('navigation' transitionSpecFor:)('other' setExtentFromHalo:)('palette menu' addBookMenuItemsTo:hand: addMenuTab)('scraps tab' hasScrapsTab scrapsBook showScrapsTab)('user-interface' selectTab: selectTabNamed: selectTabOfBook: tabMorphs tabNamed:)('submorphs - add/remove' replaceSubmorph:by:)!SystemWindow removeSelector: #extantSketchEditor!SystemWindow removeSelector: #wantsExpandBox!SystemWindow removeSelector: #wantsHalo!!SystemWindow reorganize!('drawing' areasRemainingToFill: colorForInsets makeMeVisible wantsRoundedCorners)('events' doFastFrameDrag: filterEvent:for: handleListenEvent: handleMouseDown: handleMouseUp: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: paneTransition: secondaryPaneTransition:divider: startDragFromLabel: wantsToBeDroppedInto:)('geometry' extent: justDroppedInto:event: labelRect paneMorphs panelRect position: removeMenuBox setPaneRectsFromBounds)('initialization' addCloseBox addExpandBox addGrips addKeyboardShortcuts addLabelArea addMenuControl applyModelExtent boxExtent createBox: createCloseBox createCollapseBox createExpandBox createMenuBox defaultBounds defaultColor initialize initializeKeyboardShortcuts initializeLabelArea initializeWithLabel: maximumExtent maximumExtent: model: removeKeyboardShortcuts replaceBoxes setDefaultParameters setFramesForLabelArea)('label' addLabel getRawLabel knownName label labelArea labelHeight labelWidgetAllowance relabel relabelEvent: setLabel: setLabelWidgetAllowance tryToRenameTo: update: widthOfFullLabelText)('layout' assureLabelAreaVisible changeCellGapOfLayoutFrames: convertAlignment displayScaleChangedBy: layoutBounds putLabelItemsInLabelArea)('menu' addCustomMenuItems:hand: buildWindowMenu changeColor deleteCloseBox fullScreen fullScreenMaximumExtent makeClosable makeSecondTopmost makeUnclosable offerWindowMenu sendToBack setWindowColor takeOutOfWindow wantsYellowButtonMenu)('object fileIn' convertToCurrentVersion:refStream:)('open/close' anyOpenWindowLikeMeIn: closeBoxHit delete initialExtent mustNotClose openAsIs openAsIsI n: openInWorld: openInWorld:extent: openInWorldExtent: postAcceptBrowseFor:)('panes' addMorph:frame: addMorph:fullFrame: holdsTranscript paneMorphSatisfying: replacePane:with: setUpdatablePanesFrom: titleAndPaneText updatablePanes updateBox:color: updateBoxesColor:)('resize/collapse' allowReframeHandles allowReframeHandles: collapse collapseOrExpand collapsedFrame contractToOriginalSize dragToEdgeDistance dragToEdgesSelectorFor:in: expand expandBoxHit expandToFullScreen fastFramingOn fullFrame getBoundsWithFlex getCollapsedFrame isCollapsed isPoint:nearBottomLeftOf: isPoint:nearBottomOf: isPoint:nearBottomRightOf: isPoint:nearLeftOf: isPoint:nearRightOf: isPoint:nearTopLeftOf: isPoint:nearTopOf: isPoint:nearTopRightOf: mouseLeaveEvent:fromPane: paneWithLongestSide:near: reframePanesAdjoining:along:to: setBoundsWithFlex: unexpandedFrame unexpandedFrame:)('stepping' amendSteppingStatus stepAt: stepTime wantsSteps wantsStepsWhenCollapsed)('testing' isSystemWindow isWindowForModel: shouldDropOnMouseUp wantsToBeCachedByHand)('top window' beKeyWindow beKeyWindowIfNeeded: comeToFront comeToFrontModally dimWindowButtons isKeyWindow undimWindowButtons updatePanesFromSubmorphs)('thumbnail' icon)('polymorph' modalChild modalLockTo: modalOwner modalUnlockFrom: rememberedKeyboardFocus)('focus' activate defaultFocusMorph defaultFocusMorph: isActive isActive: isLookingFocused isLookingFocused: lockWindowDecorations lockWindowTitle lookFocused lookUnfocused passivate passivateIfNeeded unlockWindowDecorations unlockWindowTitle updateFocusLookAtHand updateFocusLookForKeyboardFocus windowDecorations)('colors' existingPaneColor gradientWithColor: paneColor paneColor: paneColorToUse paneColorToUseWhenNotActive raisedColor refreshWindowColor restoreDefaultPaneColor setStripeColorsFrom: setWindowColor: updatePaneColors)('user interface' applyUserInterfaceTheme)('*ToolBuilder-Morphic-opening' openAsTool)('*services-base' requestor topWindow)('*60Deprecated-open/close' anyOpenWindowLikeMe)!SuperSwikiServer removeSelector: #matchingEntries:!StringButtonMorph removeSelector: #adaptToWorld:!!StringButtonMorph reorganize!('accessing' actionSelector actionSelector: arguments arguments: target target:)('button' doButtonAction)('copying' updateReferencesUsing: veryDeepFixupWith: veryDeepInner:)('event handling' handlesMouseDown: handlesMouseStillDown: mouseDown: mouseMove: mouseStillDown: mouseUp:)('initialization' initialize)('menu' addCustomMenuItems:hand: addTargetingMenuItems:hand: clearTarget setActWhen setActionSelector setArguments setLabel setTarget:)('submorphs - add/remove' actWhen:)('classification' isButton)!SqueakFurtherCorePackagesHelp class removeSelector: #etoys!!SmartRefStream reorganize!('accessing' structures: superclasses:)('class changed shape' catalogValues:size: conversionMethodsFor: storeInstVarsIn:from: writeClassRename:was: writeClassRenameMethod:was:fromInstVars: writeConversionMethod:class:was:fromInstVars:to: writeConversionMethodIn:fromInstVars:to:renamedFrom:)('conversion' inputSensorx0 worldMorphbosfcebbfgccpmcpbttloiairfidcuwhavcdsll0)('import image segment' applyConversionMethodsTo:className:varMap: checkFatalReshape: convert1:to:allVarMaps: convert2:allVarMaps: mapClass:origName: reshapedClassesIn:)('read write' appendClassDefns checkCrLf initKnownRenames initShapeDicts instVarInfo: mapClass: moreObjects next nextAndClose nextPut: nextPutObjOnly: noHeader readInstance readInstanceSize:clsname:refPosn: readShortInst readWordLike recordImageSegment: renamed renamedConv restoreClassInstVars saveClassInstVars scanFrom: scanFrom:environment: setStream: setStream:reading: structures superclasses uniClasesDo: uniClassInstVarsRefs: verifyStructure versionSymbol:)('*Morphic-conversion' bookPageMorphbosfcepcbbfgcc0 clippingMorphbosfcep0 clippingMorphbosfcepc0 dropShadowMorphbosfces0 layoutMorphbosfcepbbochvimol0 layoutMorphbosfcepcbbochvimol0 morphicEventtcbks0 morphicSoundEventtcbkss 0 multiNewParagraphttfclpomsswfpp0 myMorphbosfce0 newMorphicEventts0)('*ST80-conversion' scrollControllermvslrrsmsms0)('*Graphics-conversion' transparentColorrcc0)('strings-conversion' abstractStringx0 multiStringx0 multiSymbolx0)!ColorPickerMorph removeSelector: #delete!ColorPickerMorph removeSelector: #getColorFromKedamaWorldIfPossible:!!ColorPickerMorph reorganize!('accessing' argument argument: deleteOnMouseUp deleteOnMouseUp: locationIndicator originalColor: selectedColor selector selector: sourceHand sourceHand: target target: updateContinuously updateContinuously:)('drawing' drawOn:)('event handling' handlesMouseDown: inhibitDragging mouseDown: mouseUp:)('geometry testing' containsPoint:)('halos and balloon help' isLikelyRecipientForMouseOverHalos)('initialization' buildChartForm choseModalityFromPreference initialize initializeForPropertiesPanel initializeModal: updateSelectorDisplay)('menu' addCustomMenuItems:hand: pickUpColorFor: toggleDeleteOnMouseUp toggleUpdateContinuously)('other' addToWorld:near: bestPositionNear:inWorld: indicateColorUnderMouse putUpFor:near: trackColorUnderMouse)('stepping' step stepTime)('private' anchorAndRunModeless: argumentsWith: deleteAllBalloons modalBalloonHelpAtPoint: pickColorAt: positionOfColor: trackColorAt: updateAlpha: updateColor:feedbackColor: updateTargetColor updateTargetColorWith:)('submorphs - add/remove' delete)!SketchMorph removeSelector: #firstIntersectionWithLineFrom:to:!!SketchMorph reorganize!('accessing' form form: framesToDwell framesToDwell: keepAspectRatio keepAspectRatio: nominalForm: originalForm: rotatedForm scaleFactor scalePoint scalePoint: setNewFormFrom: useInterpolation useInterpolation: wantsSimpleSketchMorphHandles)('caching' releaseCachedState)('drawing' canBeEnlargedWithB3D drawHighResolutionOn:in: drawInterpolatedImage:on: drawOn: generateInterpolatedForm generateRotatedForm)('support' baseGraphic baseGraphic: flipHorizontal flipVertical rotationStyle rotationStyle: wantsRecolorHandle)('geometry' extent:)('geometry testing' containsPoint:)('halos and balloon help' isLikelyRecipientForMouseOverHalos wantsDirectionHandles wantsDirectionHandles:)('initialization' initialize initializeWith:)('layout' layoutChanged)('menu' addBorderToShape: addCustomMenuItems:hand: addPaintingItemsTo:hand: blur callThisBaseGraphic edgeDetect editDrawing editDrawingIn:forBackground: emboss erasePixelsOfColor: erasePixelsUsing: insertIntoMovie: recolorPixelsOfColor:with: recolorPixelsUsing: reduceColorPalette: restoreBaseGraphic restoreBaseGraphicFromMenu setRotationStyle sharpen toggleInterpolation useInterpolationString)('menus' addFillStyleMenuItems:hand: addToggleItemsToHaloMenu: changePixelsOfColor:toColor: chooseNewGraphic collapse)('objects from disk' convertToCurrentVersion:refStream:)('other' newForm: replaceSelfWithMovie)('parts bin' initializeToStandAlone)('pen support' clearExtent:fillColor: penOnMyForm revealPenStrokes)('rotate scale and flex' forwardDirection: heading:)('*MorphicExtras-testing' canDrawAtHigherResolution)!SketchEditorMorph removeSelector: #wantsHaloFromClick!SimpleSliderMorph removeSelector: #isLikelyRecipientForMouseOverHalos!!SimpleSliderMorph reorganize!('accessing' actionSelector actionSelector: arguments arguments: maxVal maxVal: minVal minVal: target target:)('copying' updateReferencesUsing: veryDeepFixupWith: veryDeepInner:)('initialization' initialize)('menu' addCustomMenuItems:hand: addSliderMenuItems:hand: addTargetingMenuItems:hand: clearTarget descendingString setActionSelector setArguments setLabel setMaxVal setMinVal setMinVal: setTarget: toggleDescending toggleTruncate truncateString)('model access' setValue:)('parts bin' initializeToStandAlone)('private' adjustToValue: getScaledValue setMaxVal: setScaledValue: truncate truncate:)!SimpleHierarchicalListMorph class removeSelector: #submorphsExample!!SimpleHierarchicalListMorph class reorganize!('instance creation' expandedForm notExpandedForm on:list:selected:changeSelected: on:list:selected:changeSelected:menu: on:list:selected:changeSelected:menu:keystroke:)('preferences' applyUserInterfaceTheme expandAllLimit expandAllLimit: themeProperties wrappedNavigation wrappedNavigation:)!HaloMorph removeSelector: #addChooseGraphicHandle:!HaloMorph removeSelector: #addMakeSiblingHandle:!HaloMorph removeSelector: #addPaintBgdHandle:!HaloMorph removeSelector: #addPoohHandle:!HaloMorph removeSelector: #addRepaintHandle:!HaloMorph removeSelector: #addScriptHandle:!HaloMorph removeSelector: #addTileHandle:!HaloMorph removeSelector: #addViewHandle:!HaloMorph removeSelector: #addViewingHandle:!HaloMorph removeSelector: #doDupOrMakeSibling:with:!HaloMorph removeSelector: #doMakeSibling:with:!HaloMorph removeSelector: #doMakeSiblingOrDup:with:!HaloMorph removeSelector: #fadeIn!HaloMorph removeSelector: #fadeInInitially!HaloMorph removeSelector: #fadeOut!HaloMorph removeSelector: #fadeOutFinally!HaloMorph removeSele ctor: #handleEntered!HaloMorph removeSelector: #handleLeft!HaloMorph removeSelector: #isMagicHalo!HaloMorph removeSelector: #isMagicHalo:!HaloMorph removeSelector: #mouseDown:!HaloMorph removeSelector: #openViewerForTarget:with:!HaloMorph removeSelector: #popUpMagicallyFor:hand:!HaloMorph removeSelector: #tearOffTileForTarget:with:!SimpleHaloMorph removeSelector: #isMagicHalo!SimpleHaloMorph removeSelector: #popUpMagicallyFor:hand:!!IconicButton reorganize!('events' mouseEnter: mouseLeave:)('initialization' borderNormal borderThick buttonSetup defaultBorderWidth initialize initializeWithThumbnail:withLabel:andColor:andSend:to: initializeWithThumbnail:withLabel:andSend:to: setDefaultLabel stationarySetup)('menu' addLabelItemsTo:hand:)('button' doButtonAction)('compatibility' dim undim)('ui' darken darkenedForm restoreImage shedSelvedge)('label' labelFromString: labelGraphic: labelMorph)('*MorphicExtras-initialization' initializeToShow:withLabel:andSend:to:)!SimpleButtonMorph removeS elector: #adaptToWorld:!!ServerDirectory class reorganize!('available servers' addLocalProjectDirectory: addServer:named: localProjectDirectories nameForServer: projectServers removeServerNamed: removeServerNamed:ifAbsent: resetLocalProjectDirectories resetServers serverForURL: serverNamed: serverNamed:ifAbsent: serverNames servers)('class initialization' cleanUp: initialize)('misc' defaultStemUrl newFrom: on: parseFTPEntry: secondsForDay:month:yearOrTime:thisMonth:thisYear:)('school support' projectDefaultDirectory)('server prefs' determineLocalServerDirectory: fetchExternalSettingsIn: parseServerEntryFrom: releaseExternalSettings serverConfDirectoryName storeCurrentServersIn: transferServerDefinitionsToExternal)('*UpdateStream-server groups' convertGroupNames groupNames serverInGroupNamed: serversInGroupNamed:)!Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl keepAlive encodingName'
classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers' poolDictionaries: '' category: 'Network-RemoteDirectory'!SelectionMorph removeSelector: #couldMakeSibling!SelectionMorph removeSelector: #preferredDuplicationHandleSelector!ScrollableField removeSelector: #cursorWrapped:!ScrollableField removeSelector: #getAllButFirstCharacter!ScrollableField removeSelector: #getNumericValue!ScrollableField removeSelector: #insertCharacters:!ScrollableField removeSelector: #insertContentsOf:!ScrollableField removeSelector: #setNumericValue:!!ScreeningMorph reorganize!('accessing' passElseBlock: passingColor:)('drawing' fullDrawOn:)('halos and balloon help' wantsRecolorHandle)('geometry testing' containsPoint:)('initialization' initialize)('layout' layoutChanged)('menu' addCustomMenuItems:hand: chooseBlockingColor choosePassingColor exchange showScreenOnly showScreenOverSource showScreened showSourceOnly)('private' removedMorph: screenFor m screenMorph sourceMorph)('submorphs - add/remove' addMorph:)!ScreenController removeSelector: #standardGraphicsLibrary!ReleaseBuilder class removeSelector: #beautifyEtoys!FlapTab removeSelector: #makeNewDrawing:!FlapTab removeSelector: #startOrFinishDrawing:!FlapTab removeSelector: #thicknessString!Quadrangle class removeSelector: #exampleInViewer!!ProjectSorterMorph reorganize!('initialization' addControls defaultBorderWidth defaultColor initialize navigator:listOfPages:)('event handling' clickFromSorterEvent:morph:)('controls' insertNewProject:)('private' morphsForMyContentsFrom:sizedTo: sorterMorphForProjectNamed:)!ProjectNavigationMorph removeSelector: #buttonPaint!ProjectNavigationMorph removeSelector: #doNewPainting!ProjectNavigationMorph removeSelector: #editProjectInfo!ProjectNavigationMorph removeSelector: #makeTheSimpleButtons!!ProjectLoading class reorganize!('accessing' projectStreamFromArchive: thumbnailFromUrl:)('loading' installRemoteNamed:from:named:in: openFromDirectory:andFileName: openFromFile:fromDirectory:withProjectView: openName:stream:fromDirectory:withProjectView: openName:stream:fromDirectory:withProjectView:clearOriginFlag: openOn:)('utilities' bestAccessToFileName:andDirectory: useTempChangeSet)('loading - support' checkSecurity:preStream:projStream: fileInName:archive:morphOrList: loadImageSegment:fromDirectory:withProjectView:numberOfFontSubstitutes:substituteFont:mgr: makeExistingView:project:projectsToBeDeleted: morphOrList:stream:fromDirectory:archive: parseManifest:)!ProjectLauncher removeSelector: #cancelLogin!ProjectLauncher removeSelector: #doEtoyLogin!ProjectLauncher removeSelector: #loginAs:!ProjectLauncher removeSelector: #prepareForLogin!ProjectLauncher removeSelector: #proceedWithLogin!ProjectLauncher removeSelector: #startUpAfterLogin!AbstractLauncher subclass: #ProjectLauncher instanceVariableNames: 'showSplash splashURL whichFlaps' classVariableNames: 'SplashMorph' poolDictionaries: ''
category: 'System-Download'!!ProjectLauncher reorganize!('initialization' initialize setupFlaps setupFromParameters)('running' hideSplashMorph installProjectFrom: showSplashMorph startUp)('private' showSplash)!Project class removeSelector: #publishInSexp!!Project class reorganize!('class initialization' cleanUp: cleanUpProjectPreferences initialize localeChanged rebuildAllProjects)('constants' current uiManager uiProcess)('squeaklet on server' enterIfThereOrFind: fromUrl: isBadNameForStoring: loaderUrl mostRecent:onServer: namedUrl: parseProjectFileName: projectExtension serverDirectoryFromURL: serverFileFromURL: squeakletDirectory sweep:)('utilities' addingProject: advanceToNextProject allNames allNamesAndProjects allProjects allProjectsOrdered canWeLoadAProjectNow chooseNaturalLanguage deletingProject: enter: flattenProjectHierarchy forget: hierarchyOfNamesAndProjects jumpToProject jumpToSelection: maybeForkInterrupt named: named:in: namedWithDepth: ofWorld: projectHierarch y releaseProjectReferences: removeAll: removeAllButCurrent returnToParentProject returnToPreviousProject storeAllInSegments topProject versionForFileName:)('*Morphic-Support' allMorphicProjects)('error recovery' tryEmergencyEvaluatorForRecovery: tryOtherProjectForRecovery:)('shrinking' removeProjectsFromSystem)('snapshots' shutDown: startUp:)('*ST80-Support' allMVCProjects)('preferences')('*60Deprecated-error recovery' handlePrimitiveError:)('*61Deprecated-utilities' resumeProcess:)!MorphicProject removeSelector: #exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction:!MorphicProject removeSelector: #initMorphic!MorphicProject removeSelector: #myPlayerClasses!MorphicProject removeSelector: #setFlaps!!MorphicProject reorganize!('display' displayScaleChangedFrom:to: invalidate noDisplayDuring: previewImageForm restore viewLocFor:)('initialize' initialize installPasteUpAsWorld: openProject: setWorldBackground:)('testing' isMorphic)('menu messages' assureNavigatorPresenceMatchesPreference makeThumbnail)('utilities' addItem:toMenu:selection:color:thumbnail: composeDisplayTextIntoForm: createViewIfAppropriate do:withProgressInfoOn:label: findAFolderForProject:label: findProjectView: jumpToProject launchSystemFiles:event: offerMenu:from:shifted: pointerMoved setAsBackground: showImage:named: textWindows)('docking bars support' assureMainDockingBarPresenceMatchesPreference createOrUpdateMainDockingBar dockingBar dockingBar: removeMainDockingBar showWorldMainDockingBar showWorldMainDockingBar: showWorldMainDockingBarString toggleShowWorldMainDockingBar)('file in/out' acceptProjectDetails: armsLengthCommand:withDescription: compressFilesIn:to:in: compressFilesIn:to:in:resources: exportSegmentWithChangeSet:fileName:directory: exportSegmentWithChangeSet:fileName:directory:withoutInteraction: loadFromServer: noteManifestDetailsIn: storeSegment storeSegmentNoFile)('enter' clearGlobalState enterAsActiveSubprojectWithin: finalEnter Actions: finalExitActions: initializeMenus isIncompletelyLoaded resumeEventRecorder: scheduleProcessForEnter startUpActions suspendProcessForDebug terminateProcessForLeave wakeUpTopWindow)('squeaklet on server' enterIfThereOrFind: openBlankProjectNamed:)('release' deletingProject: prepareForDelete)('language' chooseNaturalLanguage updateLocaleDependents)('editors' bitEdit: bitEdit:at:scale: editCharacter:ofFont: formEdit: formViewClass openImage:name:saveResource:)('futures' future:do:at:args: future:send:at:args:)('active process' spawnNewProcess spawnNewProcessAndTerminateOld: spawnNewProcessIfThisIsUI: uiProcess uiProcess:)('transcripter' displayTranscripter: initializeParagraphForTranscripter:)('subprojects' addProject: subProjects)('accessing' color topMorphicProject)('updating' applyUserInterfaceTheme canApplyUserInterfaceTheme)('scheduling & debugging' addDeferredUIMessage: fatalDrawingError: interruptCleanUpFor: lastDeferredUIMessage openDebuggerWindow: recursiveError: restore Display resumeProcessSafely: suspendProcessSafely:)('flaps support' assureFlapIntegrity cleanseDisabledGlobalFlapIDsList enableDisableGlobalFlap: flapsSuppressed: globalFlapEnabledString: globalFlapWithIDEnabledString: isFlapEnabled: isFlapIDEnabled: suppressFlapsString toggleFlapsSuppressed)('protocols' currentVocabulary)!Project removeSelector: #restoreReferences!!Project reorganize!('accessing' changeSet color displayDepth displayDepth: explicitName explicitName: findProjectView: forgetExistingURL labelString lastDirectory: lastSavedAtSeconds name nameAdjustedForDepth nextProject nilParentError previousProject projectChangeSet renameTo: storeNewPrimaryURL: thumbnail thumbnail: topProject transcript uiManager urlList viewSize viewSize: world)('active process' depth spawnNewProcessIfThisIsUI: uiProcess)('displaying' displayDepthChanged displayScaleChangedFrom:to: displaySizeChanged displayZoom: imageForm imageFormOfSize:depth: invalidate noDisplayDuring: previewImageForm restore restoreDisplay showZoom shrinkDisplay viewLocFor:)('file in/out' armsLengthCommand:withDescription: assureIntegerVersion bumpVersion: couldBeSwappedOut currentVersionNumber decideAboutCreatingBlank: doArmsLengthCommand: downloadUrl ensureChangeSetNameUnique exportSegmentFileName:directory: exportSegmentFileName:directory:withoutInteraction: exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction: exportSegmentWithCatagories:classes:fileName:directory: exportSegmentWithChangeSet:fileName:directory: findAFolderToLoadProjectFrom findAFolderToStoreProjectIn fromMyServerLoad: hasBadNameForStoring htmlPagePrototype loadFromServer loadFromServer: objectForDataStream: primaryServer primaryServerIfNil: projectExtension revert saveAs saveForRevert serverList squeakletDirectory storeAttributeKey:value:on: storeAttributesOn: storeDataOn: storeHtmlPageIn: storeManifestFileIn: storeOnServer storeOnServerAssumingNameValid storeOnServerInnards storeOnServerShowProgressOn:forge tURL: storeOnServerWithProgressInfo storeOnServerWithProgressInfoOn: storeSegment storeSegmentNoFile storeSomeSegment storeToMakeRoom tryToFindAServerWithMe url urlForLoading versionForFileName versionFrom: versionedFileName writeFileNamed:fromDirectory:toServer: writeStackText:in:registerIn:)('flaps support' flapsSuppressed flapsSuppressed: showSharedFlaps)('initialization' initialExtent initialProject initialize installNewDisplay:depth: openProject: resetTranscript setChangeSet: setServer windowActiveOnFirstClick windowReqNewLabel:)('language' chooseNaturalLanguage localeChanged localeID naturalLanguage updateLocaleDependents)('menu messages' assureNavigatorPresenceMatchesPreference doWeWantToRename exit fileOut installProjectPreferences makeThumbnail saveProjectPreferences validateProjectNameIfOK:)('printing' addSubProjectNamesTo:indentation: printOn:)('project parameters' initializeProjectParameters initializeProjectPreferences noteThatParameter:justChangedTo: parameterAt: parameterAt:ifAbsent: projectParameterAt: projectParameterAt:ifAbsent: projectParameterAt:ifAbsentPut: projectParameterAt:put: projectParameters projectPreferenceAt: projectPreferenceAt:ifAbsent: projectPreferenceFlagDictionary rawParameters removeParameter:)('release' addDependent: canDiscardEdits close delete deletingProject: forget okToChange prepareForDelete release removeChangeSetIfPossible windowIsClosing)('resources' abortResourceLoading resourceDirectoryName resourceManager resourceManager: resourceUrl startResourceLoading storeResourceList:in:)('SuperSwiki' tellAFriend tellAFriend:)('*sound' beep)('enter' enter enter: enter:revert:saveForRevert: finalEnterActions: finalExitActions: loadState saveState scheduleProcessForEnter shutDownActions startUpActions terminateProcessForLeave wakeUpTopWindow)('utilities' addItem:toMenu:selection:color:thumbnail: buildJumpToMenu: composeDisplayTextIntoForm: do:withProgressInfoOn:label: findAFolderForProject:label: jumpToProject jumpToSelection: offerMenu:from:shifted: pointerMoved setAsBackground: showImage:named: textWindows)('squeaklet on server' enterIfThereOrFind: openBlankProjectNamed:)('futures' future:do:at:args: future:send:at:args:)('editors' bitEdit: bitEdit:at:scale: editCharacter:ofFont: formEdit: formViewClass openImage:name:saveResource:)('transcripter' displayTranscripter: initializeParagraphForTranscripter:)('sub-projects & hierarchy' addProject: beTopProject children isTopProject liftSubProjects parent setParent: subProjects withChildrenDo:)('enter - recovery' enterForEmergencyRecovery suspendProcessForDebug)('testing' isCurrentProject isIncompletelyLoaded isMorphic)('shrinking' removeAllOtherProjects)('*ST80-Testing' isMVC)('*60Deprecated-accessing' setThumbnail: setViewSize:)('scheduling & debugging' addDeferredUIMessage: debugProcess:inDialog: debugProcess:inWindow: guardRecursiveError:during: interruptCleanUpFor: interruptName: interruptName:message: interruptName:message:preemptedProcess: interruptName:preemptedProcess: lastDeferredUIMessage openDebuggerWindow: prepareProcessForDebugger: primitiveError: recursiveError: resumeProcessSafely: suspendProcessSafely:)('*MorphicExtras-accessing' useOwnChangeSetWithCurrentName useParentChangeSetButSetProjectName:)('protocols' currentVocabulary)!Preferences class removeSelector: #annotationEditingWindow!Preferences class removeSelector: #automaticViewerPlacement!Preferences class removeSelector: #batchPenTrails!Preferences class removeSelector: #capitalizedReferences!Preferences class removeSelector: #cautionBeforeClosing!Preferences class removeSelector: #chooseEToysFont!Preferences class removeSelector: #chooseEToysTitleFont!Preferences class removeSelector: #classicTilesSettingToggled!Preferences class removeSelector: #compactViewerFlaps!Preferences class removeSelector: #debugMenuItemsInvokableFromScripts!Preferences class removeSelector: #defaultPaintingExtent!Preferences cl ass removeSelector: #dropProducesWatcher!Preferences class removeSelector: #eToyFriendly!Preferences class removeSelector: #eToyFriendlyChanged!Preferences class removeSelector: #eToyLoginEnabled!Preferences class removeSelector: #editAnnotations!Preferences class removeSelector: #enableLocalSave!Preferences class removeSelector: #expandedPublishing!Preferences class removeSelector: #fenceEnabled!Preferences class removeSelector: #fenceSoundEnabled!Preferences class removeSelector: #fenceSoundEnabled:!Preferences class removeSelector: #haloTransitions!Preferences class removeSelector: #includeSoundControlInNavigator!Preferences class removeSelector: #keepTickingWhilePainting!Preferences class removeSelector: #largeTilesSettingToggled!Preferences class removeSelector: #magicHalos!Preferences class removeSelector: #menuColorFromWorld!Preferences class removeSelector: #menuColorString!Preferences class removeSelector: #messengersInViewers!Preferences class removeSelector: #mouseOverHalos!Preferences class removeSelector: #mouseOverHalosChanged!Preferences class removeSelector: #mvcProjectsAllowed!Preferences class removeSelector: #navigatorOnLeftEdge!Preferences class removeSelector: #noviceMode!Preferences class removeSelector: #noviceModeSettingChanged!Preferences class removeSelector: #okToReinitializeFlaps!Preferences class removeSelector: #oliveHandleForScriptedObjects!Preferences class removeSelector: #propertySheetFromHalo!Preferences class removeSelector: #selectiveHalos!Preferences class removeSelector: #setEToysFontTo:!Preferences class removeSelector: #setEToysTitleFontTo:!Preferences class removeSelector: #showAdvancedNavigatorButtons!Preferences class removeSelector: #showFlapsWhenPublishing!Preferences class removeSelector: #simpleMenus!Preferences class removeSelector: #standardEToysFont!Preferences class removeSelector: #standardEToysTitleFont!Preferences class removeSelector: #tabAmongFields!Preferences class removeSelector: #tileTranslucentDrag!Preferences class removeSelector: #typeCheckingInTileScripting!Preferences class removeSelector: #uniTilesClassic!Preferences class removeSelector: #universalTiles!Preferences class removeSelector: #universalTilesSettingToggled!Preferences class removeSelector: #unlimitedPaintArea!Preferences class removeSelector: #useCategoryListsInViewers!Preferences class removeSelector: #useVectorVocabulary!Preferences class removeSelector: #vectorVocabularySettingChanged!Preferences class removeSelector: #viewersInFlaps!!Preferences class reorganize!('accessing' allPreferences atomicUpdatePreferences: dictionaryOfPreferences pragmaIdFor:getter: pragmaPreferenceFor:getter: preferenceAt: preferenceAt:ifAbsent:)('class initialization' initialize unload)('get/set' doesNotUnderstand: setPreference:toValue: setPreference:toValue:during: valueOfPreference: valueOfPreference:ifAbsent:)('initialization' chooseInitialSettings cleanUp: cleanUpPragmaPreferences initializeDictionaryOfPreferences registerForEvents removeObsolete resetDefaultValues setPreferencesFrom:)('parameters' expungeParameter: initializeParameters inspectParameters parameterAt: parameterAt:ifAbsentPut: parameterAt:ifAbsent: parameters setParameter:to:)('reacting to change' isChangeSelector:)('standard queries' alphabeticalProjectMenu alternateHandlesLook alternativeBrowseIt alternativeWindowBoxesLook alwaysHideHScrollbar alwaysShowHScrollbar alwaysShowVScrollbar annotationPanes areaFillsAreTolerant areaFillsAreVeryTolerant autoIndent automaticFlapLayout automaticKeyGeneration balloonHelpEnabled balloonHelpInMessageLists biggerHandles caseSensitiveFinds changeSetVersionNumbers checkForSlips checkForUnsavedProjects classicNavigatorEnabled cmdDotEnabled cmdGesturesEnabled collapseWindowsInPlace confirmFirstUseOfStyle conversionMethodsAtFileOut debugHaloHandle debugLogTimestamp debugPrintSpaceLog debugShowDamage decorateBrowserButtons diffsInChangeList diffsWithPrett yPrint dismissAllOnOptionClose easySelection extraDebuggerButtons fastDragWindowForMorphic fullScreenLeavesDeskMargins generalizedYellowButtonMenu haloEnclosesFullBounds higherPerformance honorDesktopCmdKeys infiniteUndo logDebuggerStackToFile maintainHalos menuAppearance3d menuKeyboardControl menuWithIcons modalColorPickers mouseOverForKeyboardFocus optionalButtons passwordsOnPublish personalizedWorldMenu postscriptStoredAsEPS projectsSentToDisk projectViewsInWindows projectZoom purgeUndoOnQuit readDocumentAtStartup readDocumentAtStartup: restartAlsoProceeds reverseWindowStagger scrollBarsNarrow scrollBarsOnRight securityChecksEnabled serverMode showBoundsInHalo showDirectionForSketches showDirectionHandles showProjectNavigator showSecurityStatus showSharedFlaps showSplitterHandles signProjectFiles smartUpdating standaloneSecurityChecksEnabled startInUntrustedDirectory swapMouseButtons systemWindowEmbedOK timeStampsInMenuTitles tinyDisplay traceMessages turnOffPowerManager twentyFourHourFileStamps uniqueNamesInHalos useButtonPropertiesToFire useUndo visualExplorer warnAboutInsecureContent warnIfNoChangesFile warnIfNoSourcesFile wordStyleCursorMovement)('themes' outOfTheBox personal)('*PreferenceBrowser' addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:viewRegistry:)('private' compileAccessorForPreference: compileAccessorForPreferenceNamed:value: preference:category:description:type: preference:categoryList:description:type:)('prefs - fonts' aaFontsColormapDepth chooseBalloonHelpFont chooseCodeFont chooseFixedFont chooseFlapsFont chooseFontWithPrompt:andSendTo:withSelector:highlightSelector: chooseHaloLabelFont chooseListFont chooseMenuFont chooseStandardButtonFont chooseSystemFont chooseWindowTitleFont decreaseFontSize fontConfigurationMenu fontConfigurationMenu: increaseFontSize printStandardSystemFonts refreshFontSettings restoreDefaultFonts restoreDefaultFontsForJapanese restoreFontsAfter: setBalloonHel pFontTo: setButtonFontTo: setCodeFontTo: setDemoFonts setFixedFontTo: setFlapFontTo: setFlapsFontTo: setHaloLabelFontTo: setListFontTo: setMenuFontTo: setPaintBoxButtonFontTo: setSystemFontTo: setWindowTitleFontTo: standardBalloonHelpFont standardButtonFont standardCodeFont standardDefaultTextFont standardFixedFont standardFlapFont standardHaloLabelFont standardListFont standardMenuFont standardPaintBoxButtonFont standardSystemFont standardWindowTitleFont subPixelRenderColorFonts subPixelRenderFonts windowTitleFont windowTitleStyle)('support - misc' acceptAnnotationsFrom: addModelItemsToWindowMenu: automaticFlapLayoutString initialExtent inspectPreferences letUserPersonalizeMenu navigatorShowingString personalizeUserMenu: setArrowheads staggerPolicyString wantsChangeSetLogging)('add/remove - specific' addBooleanPreference:categories:default:balloonHelp: addBooleanPreference:category:default:balloonHelp: addColorPreference:categories:default:balloonHelp: addColorPreference:category:default:balloonHelp: addFontPreference:categories:default:balloonHelp: addFontPreference:category:default:balloonHelp: addNumericPreference:categories:default:balloonHelp: addNumericPreference:category:default:balloonHelp: addTextPreference:categories:default:balloonHelp: addTextPreference:category:default:balloonHelp:)('add/remove' addPragmaPreference: addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:type: removeAllPreferencesSuchThat: removePreference:)('add/remove - convenience' addPreference:categories:default:balloonHelp: addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: addPreference:category:default: addPreference:category:default:balloonHelp: addPreference:default:)('prefs - annotations' annotationInfo defaultAnnotationInfo defaultAnnotationRequests defaultAnnotationRequests:)('updating - system' annotationPanesChanged displaySizeChanged infiniteUndoChanged optionalButtonsChanged roundedWindowCornersChanged sharedFlapsSettingChanged showProjectNavigatorChanged smartUpdatingChanged)('prefs - misc' balloonHelpDelayTime borderColorWhenRunning cmdKeysInText defaultAuthorName defaultWorldColor desktopColor desktopColor: desktopMenuTitle enableProjectNavigator maxBalloonHelpLineLength maxBalloonHelpLineLength: metaMenuDisabled preserveCommandExcursions scrollBarColor scrollBarWidth suppressWindowTitlesInInstanceBrowsers useFormsInPaintBox:)('themes - tools' browseThemes installTheme: offerThemesMenu themeChoiceButtonOfColor:font:)('support' categoryList categoryListOfPreference: giveHelpWithPreferences okayToChangeProjectLocalnessOf: preferencesInCategory: typeForValue:)('prefs - halos' classicHaloSpecs classicHalosInForce customHaloSpecs customHalosInForce editCustomHalos haloSpecifications haloSpecificationsForWorld haloTheme iconicHaloSpecifications iconicHalosInForce installClassicHaloSpecs installCustomHaloSpecs installHaloSpecsFromArray: installHaloTheme: installIconicHaloSpecs installSimpleHaloSpecs resetHaloSpecifications showChooseGraphicHaloHandle simpleFullHaloSpecifications simpleHalosInForce)('defaults' defaultValueTableForCurrentRelease unclassifiedCategory)('get/set - flags' disable: enable: setFlag:toValue: setFlag:toValue:during: toggle: valueOfFlag: valueOfFlag:ifAbsent:)('initialization - misc' disableProgrammerFacilities enableProgrammerFacilities setDefaultAnnotationInfo setNotificationParametersForStandardPreferences)('support - file list services' fileReaderServicesForFile:suffix: serviceLoadPreferencesFromDisk services)('initialization - save/load' loadPreferencesFrom: restorePersonalPreferences restorePreferencesFromDisk restorePreferencesFromDisk: savePersonalPreferences storePreferencesIn: storePreferencesToDisk)('updating' localeChanged prefEvent:)('*60Deprecated-menu colors' menuBorderColor menuBorderWidth menuColor menuLineColor menuSelectionColor menuTitleBorderColor menuTitleBorderWidth menuTitleColor)('*morphicextras' rotationAndScaleHandlesInPaintBox)('*60Deprecated-prefs-text' chooseInsertionPointColor chooseKeyboardFocusColor chooseTextHighlightColor initializeTextHighlightingParameters insertionPointColor insertionPointColor: keyboardFocusColor keyboardFocusColor: textHighlightColor textHighlightColor:)('*60Deprecated-Etoys-Squeakland-window colors' windowColorHelp windowSpecificationPanel)('*60Deprecated-parameters' parameterAt:default:)!!PolygonMorph reorganize!('access' isClosed isCurve isOpen makeOpenOrClosed midVertices openOrClosePhrase smoothOrSegmentedPhrase vertices)('accessing' borderColor: borderDashSpec borderStyle: borderWidth: couldHaveRoundedCorners)('caching' loadCachedState releaseCachedState)('dashes' borderDashOffset dashedBorder dashedBorder: removeVertex: vertexAt:)('debug and other' installModelIn: rotateTestFlip:)('drawing' areasRemainingToFill: drawArrowOn:at:from: drawArrowsOn: drawBorde rOn: drawBorderOn:usingEnds: drawClippedBorderOn:usingEnds: drawDashedBorderOn: drawDashedBorderOn:usingEnds: drawOnFormCanvas: drawOn:)('editing' addHandles clickVertex:event:fromHandle: deleteVertexAt: dragVertex:event:fromHandle: dragVertex:fromHandle:vertIndex: dropVertex:event:fromHandle: dropVertex:fromHandle:vertIndex: handleColorAt: insertVertexAt:put: newVertex:event:fromHandle: newVertex:fromHandle:afterVert: updateHandles verticesAt:put:)('event handling' handlesMouseDown: mouseDown:)('geometry' arrowsContainPoint: bounds: closestPointTo: closestSegmentTo: extent: flipHAroundX: flipVAroundY: intersectionsWith: intersectionWithLineSegmentFromCenterTo: intersects: isBordered lineBorderColor lineBorderColor: lineBorderWidth lineBorderWidth: lineColor lineColor: lineWidth lineWidth: mergeDropThird:in:from: merge: nextDuplicateVertexIndex reduceVertices straighten transformedBy:)('geometry testing' containsPoint:)('initialization' beSmoothCurve beStraightSegments defaultBord erColor defaultColor initialize vertices:color:borderWidth:borderColor:)('menu' addCustomMenuItems:hand: addPolyArrowMenuItems:hand: addPolyLIneCurveMenuItems:hand: addPolyShapingMenuItems:hand: arrowLength: arrowSpec: arrows customizeArrows: handlesShowingPhrase makeBackArrow makeBothArrows makeClosed makeForwardArrow makeNoArrows makeOpen quickFill: removeHandles setRotationCenterFrom: showingHandles showOrHideHandles specifyDashedLine standardArrows toggleHandles toggleSmoothing unrotatedLength unrotatedLength: unrotatedWidth unrotatedWidth:)('objects from disk' convertToCurrentVersion:refStream:)('rotate scale and flex' addFlexShellIfNecessary heading heading: referencePosition rotationCenter rotationCenter: rotationDegrees rotationDegrees:)('smoothing' coefficients computeNextToEndPoints derivs:first:second:third: lineSegmentsDo: nextToFirstPoint nextToLastPoint slopes: straightLineSegmentsDo:)('stepping' step stepTime wantsSteps)('testing' hasArrows isCurvier isCurvy isLineMorph)('visual properties' canHaveFillStyles fillStyle fillStyle:)('*MorphicExtras-geometry eToy' scale:)('private' arrowBoundsAt:from: arrowForms borderForm computeArrowFormAt:from: computeBounds curveBounds filledForm getVertices includesHandle: lineSegments privateMoveBy: setVertices: transformVerticesFrom:to:)('shaping' diamondOval rectOval)('attachments' defaultAttachmentPointSpecs endShapeColor: endShapeWidth: firstVertex lastVertex midpoint nudgeForLabel: totalLength)('rounding' cornerStyle:)('*MorphicExtras-Postscript Canvases' drawPostscriptOn:)!PluggableTextMorph removeSelector: #tileForIt!PasteUpMorphTest removeSelector: #testCursorWrapped!PasteUpMorphTest removeSelector: #testCursorWrappedWithFraction!PasteUpMorphTest removeSelector: #testGridToGradient!PasteUpMorph initialize!PasteUpMorph class removeSelector: #supplementaryPartsDescriptions!!PasteUpMorph class reorganize!('printing' defaultNameStemForInstances)('project' newWorldForProject:)('scripting' authoringPrototype)('preferences' globalCommandKeysEnabled globalCommandKeysEnabled:)('recompilation' postRecompileAction)('*MorphicExtras-class initialization' initialize registerInFlapsRegistry unload)('*MorphicExtras-project' newWorldTesting)('*MorphicExtras-parts bin')('parts bin' descriptionForPartsBin)!PartsBin removeSelector: #morphToDropFrom:!PasteUpMorph removeSelector: #abandonCostumeHistory!PasteUpMorph removeSelector: #abandonVocabularyPreference!PasteUpMorph removeSelector: #adaptedToWorld:!PasteUpMorph removeSelector: #addPenMenuItems:hand:!PasteUpMorph removeSelector: #addPenTrailsMenuItemsTo:!PasteUpMorph removeSelector: #addPlayfieldMenuItems:hand:!PasteUpMorph removeSelector: #addStackMenuItems:hand:!PasteUpMorph removeSelector: #allScriptEditors!PasteUpMorph removeSelector: #allScriptors!PasteUpMorph removeSelector: #allTileScriptingElements!PasteUpMorph removeSelector: #assureNotPaintingEvent:!PasteUpMorph removeSelector: #automaticPhraseExpansion!PasteUpM orph removeSelector: #automaticViewing!PasteUpMorph removeSelector: #behaveLikeHolder!PasteUpMorph removeSelector: #behaveLikeHolder:!PasteUpMorph removeSelector: #behavingLikeAHolder!PasteUpMorph removeSelector: #browseAllScriptsTextually!PasteUpMorph removeSelector: #buildDebugMenu:!PasteUpMorph removeSelector: #closedViewerFlapTabs!PasteUpMorph removeSelector: #couldMakeSibling!PasteUpMorph removeSelector: #cursor!PasteUpMorph removeSelector: #cursor:!PasteUpMorph removeSelector: #cursorWrapped:!PasteUpMorph removeSelector: #detachableScriptingSpace!PasteUpMorph removeSelector: #drawOn:!PasteUpMorph removeSelector: #dumpPresenter!PasteUpMorph removeSelector: #hideViewerFlaps!PasteUpMorph removeSelector: #hideViewerFlapsOtherThanFor:!PasteUpMorph removeSelector: #indicateCursor!PasteUpMorph removeSelector: #indicateCursor:!PasteUpMorph removeSelector: #indicateCursorString!PasteUpMorph removeSelector: #installVectorVocabulary!PasteUpMorph removeSelector: #isPlayfieldLike!PasteUp Morph removeSelector: #makeNewDrawing:!PasteUpMorph removeSelector: #makeNewDrawing:at:!PasteUpMorph removeSelector: #makeNewDrawingWithin!PasteUpMorph removeSelector: #makeVectorUseConformToPreference!PasteUpMorph removeSelector: #mouseOverHalosString!PasteUpMorph removeSelector: #newDrawingFromMenu:!PasteUpMorph removeSelector: #numberAtCursor!PasteUpMorph removeSelector: #openScrapsBook:!PasteUpMorph removeSelector: #paintArea!PasteUpMorph removeSelector: #paintAreaFor:!PasteUpMorph removeSelector: #paintingBoundsAround:!PasteUpMorph removeSelector: #paintingFlapTab!PasteUpMorph removeSelector: #prepareToBeSaved!PasteUpMorph removeSelector: #prepareToPaint!PasteUpMorph removeSelector: #prepareToPaint:!PasteUpMorph removeSelector: #presentCardAndStackMenu!PasteUpMorph removeSelector: #presentPlayfieldMenu!PasteUpMorph removeSelector: #presenter!PasteUpMorph removeSelector: #printScriptSummary!PasteUpMorph removeSelector: #putUpPenTrailsSubmenu!PasteUpMorph removeSelector: #reasonablePaintingExtent!PasteUpMorph removeSelector: #rectifyCursor!PasteUpMorph removeSelector: #referencePlayfield!PasteUpMorph removeSelector: #referencePool!PasteUpMorph removeSelector: #releaseViewers!PasteUpMorph removeSelector: #removeAllViewers!PasteUpMorph removeSelector: #restoreBoundsOfSubmorphs!PasteUpMorph removeSelector: #resumeScriptsPausedByPainting!PasteUpMorph removeSelector: #roundUpStrays!PasteUpMorph removeSelector: #saveBoundsOfSubmorphs!PasteUpMorph removeSelector: #selectedRect!PasteUpMorph removeSelector: #sendTextContentsBackToDonor!PasteUpMorph removeSelector: #showStatusOfAllScripts!PasteUpMorph removeSelector: #showingListView!PasteUpMorph removeSelector: #sortSubmorphsBy:!PasteUpMorph removeSelector: #standardPlayerHit!PasteUpMorph removeSelector: #startRunningAll!PasteUpMorph removeSelector: #stepAll!PasteUpMorph removeSelector: #stopRunningAll!PasteUpMorph removeSelector: #toggleAutoLineLayout!PasteUpMorph removeSelector: #toggleClassicNavigatorIfAppropriate!PasteUpMorph removeSelector: #toggleMouseOverHalos!PasteUpMorph removeSelector: #triggerClosingScripts!PasteUpMorph removeSelector: #triggerOpeningScripts!PasteUpMorph removeSelector: #updateStatusForAllScriptEditors!PasteUpMorph removeSelector: #valueAtCursor!PasteUpMorph removeSelector: #valueAtCursor:!PasteUpMorph removeSelector: #viewingNormally!PasteUpMorph removeSelector: #wantsHaloFor:!PasteUpMorph removeSelector: #wantsMouseOverHalos!PasteUpMorph removeSelector: #wantsMouseOverHalos:!BorderedMorph subclass: #PasteUpMorph instanceVariableNames: 'model padding isPartsBin worldState' classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler' poolDictionaries: '' category: 'Morphic-Worlds'!!PasteUpMorph reorganize!('accessing' assureFlapWidth: flapTab lastKeystroke lastKeystroke: modelOrNil useRoundedCorners)('alarms-scheduler' addAlarm:withArguments:for:at: removeAlarm:for:)('caching' releaseCachedState)('change rep orting' invalidRect:from:)('classification' isWorldMorph)('copying' veryDeepCopyWith:)('display' gradientFillColor: setGradientColor:)('dropping/grabbing' acceptDroppingMorph:event: dropEnabled hasTransferMorphConverter justDroppedInto:event: morphToDropForTransferMorph: morphToDropFrom: originAtCenter positionNear:forExtent:adjustmentSuggestion: repelsMorph:event: resetTransferMorphConverter transferMorphConverter transferMorphConverter: wantsDroppedMorph:event: wantsDroppedTransferMorph:)('event handling' dropExplorerField:from:event: dropFiles:event: dropInspectorField:event: dropSourceCode:event: handleDroppedItem:event: handlesKeyboard: handlesMouseDown: keyStroke: morphToGrab: mouseDown: mouseUp: wantsEasySelection wantsKeyboardFocusFor: wantsWindowEvent: windowEvent: windowEventHandler windowEventHandler:)('events-processing' filterEvent:for: processEvent:using: tryInvokeHalo: tryInvokeKeyboardShortcut: tryInvokeMetaMenu:)('geometry' bringTopmostsToFront extent: position:)('ge ometry testing' fullContainsPoint:)('halos and balloon help' defersHaloOnClickTo: wantsDirectionHandles wantsHaloFromClick)('initialization' addKeyboardShortcuts addMouseShortcuts becomeActiveDuring: defaultBorderColor defaultBorderWidth defaultColor initialize initializeKeyboardShortcuts initializeMouseShortcuts newResourceLoaded removeKeyboardShortcuts)('interaction loop' doOneCycleNow)('layout' addCenteredAtBottom:offset: convertAlignment laySubpartsOutInOneRow layoutChanged)('menu & halo' addCustomMenuItems:hand: addScalingMenuItems:hand: addWorldHaloMenuItemsTo:hand: addWorldToggleItemsToHaloMenu: autoLineLayoutString currentlyUsingVectorVocabulary defineApplicationView defineFactoryView deleteBalloonTarget: isPartsBinString originAtCenterString reformulateUpdatingMenus showApplicationView showExpandedView showFactoryView showFullView showReducedView showThumbnailString showWorldMainDockingBarString toggleShowWorldMainDockingBar transformToShow:)('misc' alwaysShowThumbnail cachedOrNewThumbnailFrom: cartesianOrigin heightForThumbnails hideFlapsOtherThan:ifClingingTo: innocuousName maxHeightToAvoidThumbnailing maximumThumbnailWidth mouseX mouseY nameForCopyIfAlreadyNamed: padding: smallThumbnailForPageSorter thumbnailForPageSorter unhideHiddenObjects)('model' createCustomModel model setModel:)('name' unusedMorphNameLike:)('objects from disk' convertToCurrentVersion:refStream: fixUponLoad:seg: saveOnFile)('options' autoLineLayout autoLineLayout: isPartsBin: replaceTallSubmorphsByThumbnails resizeToFit resizeToFitString setPartsBinStatusTo: toggleIsPartsBin toggleResizeToFit)('parts bin' initializeToStandAlone isPartsBin residesInPartsBin)('printing' printOn:)('project' project releaseSqueakPages storeProjectsAsSegments)('project state' canvas canvas: firstHand hands handsDo: handsReverseDo: isStepping: isStepping:selector: listOfSteppingMorphs stepListSize stepListSummary steppingMorphsNotInWorld viewBox viewBox:)('stepping' cleanseStepList runLocalStepMethods runStepMethods startStepping: startStepping:at:selector:arguments:stepTime: step stepTime stopStepping: stopStepping:selector:)('structure' primaryHand world)('testing' isEasySelecting)('undo' clearCommandHistory commandHistory onceAgainDismiss: reintroduceIntoWorld:)('update cycle' startBackgroundProcess)('user interface' modelWakeUp)('naming' defaultNameStemForInstances)('visual properties' canHaveFillStyles fillStyle: setAsBackground:)('WiW support' addMorphInLayer: installAsActiveSubprojectIn:at:titled: installAsActiveSubprojectIn:titled: restartWorldCycleWithEvent: shouldGetStepsFrom: validateMouseEvent:)('world menu' activateObjectsTool addUndoItemsTo: bringWindowsFullOnscreen buildWorldMenu: closeUnchangedWindows collapseAll collapseNonWindows commandKeySelectors connectRemoteUser connectRemoteUserWithName:picture:andIPAddress: delayedInvokeWorldMenu: deleteNonWindows disconnectAllRemoteUsers disconnectRemoteUser dispatchCommandKeyInWorld:event: drawingClass expandAll extractScreenRegion:andPutSketchInHand: findAChangeSorter: findAFileList: findAMessageNamesWindow: findAPreferencesPanel: findATranscript: findAWindowSatisfying:orMakeOneUsing: findDirtyBrowsers: findDirtyWindows: findWindow: getWorldMenu: grabDrawingFromScreen: grabFloodFromScreen: grabLassoFromScreen: grabRubberBandFromScreen: initializeDesktopCommandKeySelectors invokeWorldMenu: keyboardNavigationHandler keyboardNavigationHandler: keystrokeInWorld: putUpNewMorphMenu putUpWorldMenu: putUpWorldMenuFromEscapeKey reportLocalAddress respondToCommand:bySending:to: undoOrRedoCommand yellowButtonClickOnDesktopWithEvent:)('world state' abandonAllHalos addHand: addMorph:centeredNear: addMorphsAndModel: allNonFlapRelatedSubmorphs allNonWindows assureNotPaintingElse: assuredCanvas beWorldForProject: checkCurrentHandForObjectToPaste checkCurrentHandForObjectToPaste2 chooseClickTarget colorAt:belowMorph: deEmphasizeViewMVC: deleteAllHalos displayWorld displayWorldAsTwoTone displayWorldNonIncrementally displayWorldSafely doOneCycle doOneCycleInBackground doOneSubCycle dragThroughOnDesktop: embeddedProjectDisplayMode endDrawing: exit flashRects:color: fullRepaintNeeded goBack haloMorphs initForProject: install installFlaps jumpToProject nextPage noDisplayDuring: optimumExtentFromAuthor paintBox paintBoxOrNil patchAt:without:andNothingAbove: pauseEventRecorder previousPage privateOuterDisplayWorld removeHand: repairEmbeddedWorlds repositionFlapsAfterScreenSizeChange restoreFlapsDisplay restoreMainDockingBarDisplay restoreMorphicDisplay saveAsWorld sketchEditorOrNil sleep someHalo specialNameInModelFor: startSteppingSubmorphsOf:)('*Tools' defaultDesktopCommandKeyTriplets findAMonticelloBrowser)('private' privateFullMoveBy: privateMoveBy:)('thumbnail' icon)('polymorph' modalLockTo: modalUnlockFrom:)('recompilation' updateStatePostRecompile)('submorphs - add/remove' addAllMorphs: addMorphFront:)('submorphs - accessing' allMorphs Do: morphsInFrontOf:overlapping:do:)('flaps' accommodateFlap: addGlobalFlaps assureFlapTabsFitOnScreen correspondingFlapTab deleteGlobalFlapArtifacts enableGlobalFlaps flapTabs localFlapTabs offsetForAccommodating:onEdge: removeAccommodationForFlap:)('Nebraska' addRemoteClient: convertRemoteClientToBuffered: hasRemoteServer releaseRemoteServer remoteServer remoteServer: removeRemoteClient: transferRemoteServerFrom:)('*60Deprecated-menu & halo' isOpenForDragNDropString)('*services-base' focusedRequestor openWorldMenu requestor worldMenu)('*60Deprecated-accessing' modalWindow: removeModalWindow)('*MorphicExtras-flaps' deleteAllFlapArtifacts)('*ST80-Support' standardSystemController)('*Protocols' currentVocabulary)!ParagraphEditor class removeSelector: #yellowButtonExpertMenu!ParagraphEditor class removeSelector: #yellowButtonNoviceMenu!PackageDependencyTest removeSelector: #testEtoys!ObjectlandMorph removeSelector: #createEtoysProject!ObjectExplorer removeSelector: #viewerForValue!NativeImageSegment removeSelector: #findRogueRootsAllMorphs:!NativeImageSegment removeSelector: #rootsIncludingPlayers!NativeImageSegment removeSelector: #savePlayerReferences:!MorphicModel removeSelector: #addModelYellowButtonMenuItemsTo:forMorph:hand:!!MorphicModel reorganize!('accessing' model modelOrNil slotName wantsSlot)('caching' releaseCachedState)('classification' isMorphicModel)('compilation' addPartNameLike:withValue: compileAccessForSlot: compilePropagationMethods nameFor: propagate:as: removeAll slotSelectorFor: use:orMakeModelSelectorFor:in:)('debug and other' installModelIn:)('drag and drop' allowSubmorphExtraction isOpen)('geometry' charactersOccluded newBounds: recomputeBounds)('initialization' defaultBorderColor defaultBounds defaultColor duplicate:from: initialize model: model:slotName:)('menu' addCustomMenuItems:hand: closeToEdits openToEdits)('naming' choosePartName)('printing' initString)('submorphs - accessing' allKnownNames)('submorphs
add/remove' delete)('*MorphicExtras-compilation' compileInitMethods)!MorphExtension removeSelector: #player!MorphExtension removeSelector: #player:!Object subclass: #MorphExtension instanceVariableNames: 'locked visible sticky balloonText balloonTextSelector externalName isPartsDonor actorState eventHandler otherProperties' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Kernel'!!MorphExtension reorganize!('accessing' actorState actorState: balloonText balloonTextSelector balloonTextSelector: balloonText: eventHandler eventHandler: externalName: locked locked: sticky sticky: visible visible:)('accessing - layout properties' layoutFrame layoutFrame: layoutPolicy layoutPolicy: layoutProperties layoutProperties:)('accessing - other properties' assureOtherProperties hasOtherProperties hasProperty: initializeOtherProperties otherProperties privateOtherProperties: removeOtherProperties removeProperty: setProperty:toValue: sortedPropertyNames valueOfProper ty: valueOfProperty:ifAbsentPut: valueOfProperty:ifAbsent:)('connectors-copying' copyWeakly propertyNamesNotCopied veryDeepFixupWith: veryDeepInner:)('initialization' initialize)('objects from disk' comeFullyUpOnReload:)('other' isDefault)('printing' printOn:)('viewer' externalName)('*MorphicExtras-copying' updateReferencesUsing:)('*MorphicExtras-Undo' removeUndoCommands)('parts bin' isPartsDonor isPartsDonor:)('*60Deprecated-other' inspectElement)!ImageMorph class removeSelector: #descriptionForPartsBin!!ImageMorph class reorganize!('accessing' defaultForm)('class initialization' initialize registerInFlapsRegistry unload)('instance creation' fromString: fromString:font:)('scripting' authoringPrototype)!Morph class removeSelector: #selectionBackground!!Morph class reorganize!('class initialization' initialize)('fileIn/Out' fileReaderServicesForFile:suffix: fromFileName: serviceLoadMorphFromFile services)('initialize-release' unload)('instance creation' initializedInstance newBoun ds: newBounds:color: newSticky)('misc' morphsUnknownToTheirOwners)('new-morph participation' includeInNewMorphMenu newStandAlone partName:categories:documentation: partName:categories:documentation:sampleImageForm:)('scripting' authoringPrototype)('testing' allSketchMorphClasses allSketchMorphForms isSketchMorphClass)('preferences' haloForAll haloForAll: indicateKeyboardFocus indicateKeyboardFocus: metaMenuForAll metaMenuForAll: preferredCornerRadius preferredCornerRadius: themeProperties useSoftDropShadow useSoftDropShadow:)('*Tools-icons' toolIcon)('defaults')('layer names' backmostLayer balloonLayer defaultLayer dialogLayer frontmostLayer haloLayer menuLayer navigatorLayer progressLayer windowLayer)('*MorphicExtras-arrow head size' defaultArrowheadSize obtainArrowheadFor:defaultValue:)('*MorphicExtras-parts bin' supplementaryPartsDescriptions)('*MorphicExtras-new-morph participation' addPartsDescriptorQuadsTo:if:)!MenuMorph removeSelector: #allWordings!MenuMorph removeSelector : #allWordingsNotInSubMenus:!MenuMorph removeSelector: #undoGrabCommand!!MenuMorph reorganize!('accessing' addBlankIconsIfNecessary: commandKeyHandler commandKeyHandler: defaultTarget hasItems hasSubMenu: itemWithWording: items lastItem lastSelection matchString matchString: popUpOwner popUpOwner: rootMenu stayUp stayUp:)('construction' add:action: add:help:action: add:icon:help:subMenu: add:icon:subMenu: add:selector:argument: add:subMenu: add:subMenu:target:selector:argumentList: add:target:action: add:target:selector: add:target:selector:argument: add:target:selector:argumentList: addAllFrom: addItem: addLine addList: addMenuItem: addService:for: addServices2:for:extraLines: addServices:for:extraLines: addStayUpIcons addStayUpItem addStayUpItemSpecial addTitle: addTitle:icon: addTitle:icon:updatingSelector:updateTarget: addTitle:updatingSelector:updateTarget: addTranslatedList: addUpdating:action: addUpdating:enablement:action: addUpdating:enablementSelector:target:selector:argumentList: addUpdating:target:action: addUpdating:target:selector:argumentList: addUpdatingItem: addWithLabel:enablement:action: addWithLabel:enablementSelector:target:selector:argumentList: balloonTextForLastItem: defaultTarget: labels:lines:selections: title:)('control' activeSubmenu: deleteIfPopUp deleteIfPopUp: popUpAdjacentTo:forHand:from: popUpAt:forHand:in: popUpAt:forHand:in:allowKeyboard: popUpEvent:in: popUpForHand:in: popUpInWorld popUpInWorld: popUpNoKeyboard selectItem:event: updateColor wantsToBeDroppedInto:)('copying' veryDeepFixupWith: veryDeepInner:)('dropping/grabbing' justDroppedInto:event:)('events' activate: deactivate: handlesMouseDown: handlesMouseOver: mouseDown: mouseLeave: mouseMove: mouseUp: processFocusEvent:using: wantsEveryMouseMove)('initialization' delete initialize setDefaultParameters setTitleParameters setTitleParametersFor:)('keyboard control' displayFiltered: handlesKeyboard: keyStroke: matchString:event: moveSelectionDown:event: removeMatchString removeMatchString: selectCurrentItem: selectMoreItem:)('menu' addCustomMenuItems:hand: addItem addTitle detachSubMenu: doButtonAction removeStayUpBox removeStayUpItems setInvokingView: setTarget: target: toggleStayUp: toggleStayUpIgnore:evt: updateItemsWithTarget:orWithHand:)('modal control' informUserAt:during: invokeAt:in:allowKeyboard: invokeModal invokeModal: invokeModalAt:in: invokeModalAt:in:allowKeyboard: isModalInvokationDone isModalInvokationDone: modalSelection modalSelection:)('private' invokeMetaMenu: positionAt:relativeTo:inWorld: selectedItem)('update' applyUserInterfaceTheme updateMenu)('keystroke helpers' handleCRStroke: handleCommandKeyPress: handleDelStroke: handleDownStroke: handleEscStroke: handleFiltering: handleLeftStroke: handlePageDownStroke: handlePageUpStroke: handleRightStroke: handleUpStroke: hideKeyboardHelp keyStrokeHandlers noteRootMenuHasUsedKeyboard showKeyboardHelp stepIntoSubmenu:)('rounding' wantsRoundedCorners)('testing' indicateKeyboardFocus)('*ToolBuilder-Morphic-opening' openAsTool)('*MorphicExtras-accessing')('*60Deprecated-keyboard control' filterListWith: unfilterOrEscape:)!MenuItemMorph removeSelector: #adaptToWorld:!MenuItemMorph removeSelector: #allWordingsNotInSubMenus:!!MenuItemMorph reorganize!('accessing' action: addSubMenu: addUpdatingSubMenu: arguments arguments: colorToUse contentString contentString: contents: contents:withMarkers: contents:withMarkers:inverse: hasIcon hasIconOrMarker hasMarker hasSubMenu hasSubMenu: help: icon icon: isEnabled isEnabled: isStayUpItem itemWithWording: selector selector: subMenu subMenu: subMenuUpdater:selector: subMenuUpdater:selector:arguments: target target:)('copying' veryDeepFixupWith: veryDeepInner:)('drawing' drawBackgroundOn: drawIconOn: drawLabelOn: drawOn: drawSubMenuMarkerOn:)('events' activateOwnerMenu: activateSubmenu: doButtonAction handleMouseUp: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: invokeWithEvent: mouseDown: mouseEnter: mouseEnterDragging: mouseUp:)('grabbing' aboutToBeGrabbedBy: duplicateMorph:)('initialization' defaultBounds deleteIfPopUp: initialize)('layout' doLayoutIn: minHeight minWidth stringMargin)('selecting' adjacentTo deselect: isSelected isSelected: select:)('private' bottomArrow createSubmenu createUpdatingSubmenu deselectItem iconForm leftArrow offImage onImage rightArrow selectionFillStyle subMenuMarker upArrow updateLayoutInDockingBar)('browse' browseImplementationOfActionSelector buildDebugMenu: debugAction effectiveActionSelector effectiveActionTarget)('testing' isMenuItemMorph)('updating' applyUserInterfaceTheme)!!LassoPatchMorph reorganize!('dropping' justDroppedInto:event: wantsToBeDroppedInto:)('initialization' initialize initializeToStandAlone)!!GrabPatchMorph reorganize!('dropping' justDroppedInto:event: wantsToBeDroppedInto:)('initialization' initialize initializeToStandAlone)!!ImageM orph reorganize!('accessing' borderStyle: borderWidth: color: form image image: isOpaque isOpaque: preferredExtent setNewImageFrom: wantsRecolorHandle withSnapshotBorder)('caching' releaseCachedState)('drawing' drawOn:)('geometry' extent:)('initialization' initialize)('menu' changeOpacity opacityString)('menu commands' grabFromScreen readFromFile)('menus' addCustomMenuItems:hand:)('other' newForm:)('parts bin' initializeToStandAlone)('testing' isImageMorph)('*MorphicExtras-Postscript Canvases' drawPostscriptOn:)!HandMorph removeSelector: #removePendingHaloFor:!HandMorph removeSelector: #spawnMagicHaloFor:!HandMorph removeSelector: #triggerHaloFor:after:!!HandMorph reorganize!('accessing' anyButtonPressed colorForInsets lastEvent mouseOverHandler noButtonPressed targetOffset targetPoint userInitials userPicture userPicture:)('balloon help' addBalloonHelp: balloonHelpList deleteBalloonTarget: removePendingBalloonFor: resetBalloonHelp: spawnBalloonFor: triggerBalloonFor:after:)('cach ing' releaseCachedState)('change reporting' invalidRect:from:)('classification' isHandMorph)('copying' veryDeepCopyWith:)('cursor' cursorBounds showTemporaryCursor: showTemporaryCursor:hotSpotOffset: temporaryCursor)('double click support' resetClickState waitForClicksOrDrag:event: waitForClicksOrDrag:event:selectors:threshold:)('drawing' drawOn: fullDrawOn: hasChanged hasUserInformation needsToBeDrawn nonCachingFullDrawOn: restoreSavedPatchOn: savePatchFrom: shadowForm showHardwareCursor: updateCacheCanvas: visible:)('drop shadows' shadowOffset)('event handling' cursorPoint flushEvents noticeMouseOver:event: processEvents)('events-processing' handleEvent: isCapturingGesturePoints sendFilterEventCaptureAgain:for:)('focus handling' keyboardFocus keyboardFocus: mouseFocus mouseFocus: newKeyboardFocus: newMouseFocus: newMouseFocus:event: releaseAllFoci releaseKeyboardFocus releaseKeyboardFocus: releaseMouseFocus releaseMouseFocus:)('genie-stubs' autoFocusRectangleBoundsFor: disableGe nieFocus enableGenie focusStartEvent genieGestureProcessor isGenieAvailable isGenieEnabled isGenieFocused)('geometry' position position: userInitials:andPicture:)('grabbing/dropping' attachMorph: dropMorphs dropMorphs: dropMorph:event: grabMorph:from: targetOffset:)('halo handling' halo: obtainHalo: releaseHalo: removeHalo removeHaloFromClick:on:)('halos and balloon help' halo)('initialization' becomeActiveDuring: initForEvents initialize interrupted resourceJustLoaded)('layout' fullBounds)('meta-actions' copyToPasteBuffer: grabMorph:)('multilingual' clearKeyboardInterpreter keyboardInterpreter)('objects from disk' objectForDataStream:)('paste buffer' objectToPaste pasteBuffer pasteBuffer: pasteMorph)('updating' applyUserInterfaceTheme changed)('private events' generateDropFilesEvent: generateKeyboardEvent: generateMouseEvent: generateMouseWheelEvent: generateMouseWheelEvent:direction: generateWindowEvent: mouseDragTrailFrom: mouseTrailFrom: moveToEvent: sendEvent:focus: sendEvent:focus:clear: sendFocusEvent:to:clear: sendKeyboardEvent: sendListenEvent:to: sendListenEvents: sendMouseEvent:)('selected object' selectedObject)('*MorphicExtras-event handling' pauseEventRecorderIn:)('gridded cursor' gridPointRaw gridTo:origin: griddedPoint: griddingOn turnOffGridding turnOnGridding)('events-listening' addEventListener: addKeyboardListener: addListener:to: addMouseListener: eventListeners eventListeners: keyboardListeners keyboardListeners: mouseListeners mouseListeners: removeEventListener: removeKeyboardListener: removeListener:from: removeMouseListener:)('events-filtering-bubbling' eventBubbleFilters keyboardBubbleFilters mouseBubbleFilters)('events-filtering-capturing' eventCaptureFilters eventCaptureFilters: keyboardCaptureFilters keyboardCaptureFilters: mouseCaptureFilters mouseCaptureFilters:)('events-debugging' logEvent: showEvent:)('events-filtering' filterEvent:for: ignoreEvent:)('Multilingual-ImmPlugin' compositionWindowManager)('initialize-release' cleanUp:)!!GraphMorph reorganize!('accessing' color: cursor cursor: cursorAtEnd cursorColor cursorColor: cursorColorAtZeroCrossing cursorColorAtZeroCrossings: cursorWrapped: data data: dataColor dataColor: interpolatedValueAtCursor lastValue lastValue: startIndex startIndex: valueAtCursor valueAtCursor:)('commands' appendValue: centerCursor clear loadSineWave loadSound: loadSoundData: playOnce reverse)('drawing' drawOn:)('event handling' handlesMouseDown: mouseMove:)('initialization' defaultColor initialize)('layout' layoutChanged)('objects from disk' convertToCurrentVersion:refStream:)('stepping' step)('private' asNumber: drawCursorOn: drawDataOn: flushCachedForm keepIndexInView:)('sound' addCustomMenuItems:hand: openWaveEditor readDataFromFile)!DockingBarMorph removeSelector: #isSticky!DockingBarMorph removeSelector: #resistsRemoval!BookMorph removeSelector: #goToPage:transitionSpec:runTransitionScripts:!BookMorph removeSelecto r: #goToPageMorph:runTransitionScripts:!BookMorph removeSelector: #goToPageMorph:transitionSpec:runTransitionScripts:!BookMorph removeSelector: #goto:!BookMorph removeSelector: #keepTogether!BooklikeMorph removeSelector: #currentPlayerDo:!!BooklikeMorph reorganize!('menu commands' clearNewPagePrototype firstPage insertPage sortPages)('menus' addCustomMenuItems:hand:)('misc' addBookMenuItemsTo:hand: move pageSize pageSize: playPageFlipSound: showingFullScreenString showingPageControlsString)('page controls' addPageControlMorph: fewerPageControls fullControlSpecs hidePageControls indexForPageControls makeDescriptionViewer makePageControlsFrom: makePageNumberItem setEventHandlerForPageControls: shortControlSpecs showPageControls showPageControls:)!!BookPageSorterMorph reorganize!('copying' veryDeepFixupWith: veryDeepInner:)('dropping/grabbing' wantsToBeDroppedInto:)('initialization' addControls book:morphsToSort: defaultBorderWidth defaultColor initialize)('buttons' acceptSort getPartsBinStatus togglePartsBinStatus)('private' changeExtent: closeButtonOnly columnWith: rowWith: wrapperFor:)('accessing' pageHolder)!!AlignmentMorph reorganize!('classification' isAlignmentMorph)('event handling' wantsKeyboardFocusFor:)('geometry' addTransparentSpacerOfSize:)('initialization' defaultBorderWidth defaultColor initialize openInWindowLabeled:inWorld:)('object fileIn' convertOldAlignmentsNov2000:using:)('objects from disk' convertToCurrentVersion:refStream:)('visual properties' canHaveFillStyles)('*MorphicExtras-initialization' basicInitialize)!!BorderedMorph reorganize!('accessing' borderColor: borderStyle: borderWidth: hasTranslucentColor useRoundedCorners useSquareCorners)('drawing' areasRemainingToFill:)('geometry' acquireBorderWidth: closestPointTo: intersectionWithLineSegmentFromCenterTo:)('initialization' borderInitialize borderInset borderRaised borderSimple defaultBorderColor defaultBorderStyle defaultBorderWidth initialize)('menu' addBorderStyleMenuItems:hand: changeBorderColor: changeBorderWidth:)('resize handling' addCellGapToLayoutFrames addCornerGrips addEdgeGrips addGrips addMorph:fullFrame: addPaneHSplitterAtBottomOfRow: addPaneHSplitters addPaneSplitters addPaneVSplitterAtRightOfColumn: addPaneVSplitters changeCellGapOfLayoutFrames: cornerGrips doFastWindowReframe: edgeGrips fastFramingOn grips linkSubmorphsToSplitters paneMorphs removeCellGapFromLayoutFrames removeCornerGrips removeEdgeGrips removeGrips removePaneSplitters splitters wantsGrips wantsGrips: wantsPaneSplitters wantsPaneSplitters:)('printing' fullPrintOn:)('layout properties' cellGap:)('display scale' displayScaleChangedBy: handlesDisplayScaleChangedBy:)('*MorphicExtras-initialization' basicInitialize)('*60Deprecated-private' setBorderWidth:borderColor: setColor:borderWidth:borderColor:)('*60Deprecated-accessing' doesBevels)!Morph removeSelector: #adaptToWorld:!Morph removeSelector: #addMagicHaloFor:!Morph removeSelector: #addMorphNearBack:!Morph removeSelector: #addPaintingItemsTo:hand:!Morph removeSelector: #allMenuWordings!Morph removeSelector: #allMorphsAndBookPagesInto:!Morph removeSelector: #allMorphsWithPlayersDo:!Morph removeSelector: #applyStatusToAllSiblings:!Morph removeSelector: #asNumber:!Morph removeSelector: #automaticViewing!Morph removeSelector: #bringAllSiblingsToMe:!Morph removeSelector: #chooseNewGraphic!Morph removeSelector: #chooseNewGraphicCoexisting:!Morph removeSelector: #chooseNewGraphicFromHalo!Morph removeSelector: #couldMakeSibling!Morph removeSelector: #currentPlayerDo:!Morph removeSelector: #cursor!Morph removeSelector: #cursor:!Morph removeSelector: #decimalPlacesForGetter:!Morph removeSelector: #defaultValueOrNil!Morph removeSelector: #demandsBoolean!Morph removeSelector: #demandsThumbnailing!Morph removeSelector: #doMenuItem:!Morph removeSelector: #embedInWindow!Morph removeSelector: #embeddedInMorphicWindowLabeled:!Morph removeSelector: #getNumericValue!Morph removeSelector: #gridFormOrigin:grid:background:line:!Morph removeSelector: #handUserASibling!Morph removeSelector: #indicateAllSiblings!Morph removeSelector: #inspectArgumentsPlayerInMorphic:!Morph removeSelector: #isAViewer!Morph removeSelector: #isCompoundTileMorph!Morph removeSelector: #isKedamaMorph!Morph removeSelector: #isLikelyRecipientForMouseOverHalos!Morph removeSelector: #isModalShell!Morph removeSelector: #isNumericReadoutTile!Morph removeSelector: #isPhraseTileMorph!Morph removeSelector: #isPlayfieldLike!Morph removeSelector: #isSoundTile!Morph removeSelector: #isStandardViewer!Morph removeSelector: #isStickySketchMorph!Morph removeSelector: #isSyntaxMorph!Morph removeSelector: #isTileEditor!Morph removeSelector: #isTileMorph!Morph removeSelector: #isTilePadMorph!Morph removeSelector: #isViewer!Morph removeSelector: #makeGraphPaper!Morph removeSelector: #makeGraphPaperGrid:background:line:!Morph removeSelector: #makeMultipleSiblings:!Morph removeSelector: #makeNascentScript!Morph removeSelector: #makeNewPlayerInstance:!Morph removeSelector: #makeSiblings:!Morph removeSelector: #makeSiblingsLookLikeMe:!Morph removeSelector: #menuItemAfter:!Morph removeSelector: #menuItemBefore:!Morph removeSelector: #methodCommentAsBalloonHelp!Morph removeSelector: #mustBeBackmost!Morph removeSelector: #noteDecimalPlaces:forGetter:!Morph removeSelector: #objectViewed!Morph removeSelector: #offerCostumeViewerMenu:!Morph removeSelector: #openAPropertySheet!Morph removeSelector: #openViewerForArgument!Morph removeSelector: #overlapsShadowForm:bounds:!Morph removeSelector: #pasteUpMorphHandlingTabAmongFields!Morph removeSelector: #player!Morph removeSelector: #player:!Morph removeSelector: #playerRepresented!Morph removeSelector: #preferredDuplicationHandleSelector!Morph removeSelector: #presenter!Morph removeSelector: #readoutForField:!Morph removeSelector: #referencePlayfield!Morph removeSelector: #renameInternal:!Morph removeSelector: #rotationStyle!Morph removeSelector: #rotationStyle:!Morph removeSelector: #roundUpStrays!Morph removeSelector: #saveDocPane!Morph removeSelector: #screenLocation!Morph removeSelector: #screenRectangle!Morph removeSelector: #setAsActionInButtonProperties:!Morph removeSelector: #setNumericValue:!Morph removeSelector: #setStandardTexture!Morph removeSelector: #shouldRememberCostumes!Morph removeSelector: #shuffleSubmorphs!Morph removeSelector: #standardPalette!Morph removeSelector: #tabAmongFields!Morph removeSelector: #textureParameters!Morph removeSelector: #unlockOneSubpart!Morph removeSelector: #updateAllScriptingElements!Morph removeSelector: #usableSiblingInstance!Morph removeSelector: #viewMorphDirectly!Morph removeSelector: #wantsHalo!Morph removeSelector: #wantsHaloFor:!Morph removeSelector: #wantsScriptorHaloHandle!Morph removeSelector: #wouldAcceptKeyboardFocusUponTab!Morph removeSelector: #wrappedInWindow:!Morph removeSelector: #wrappedInWindowWithTitle:!!Morph reorganize!('accessing' actorState: actorStateOrNil adoptPaneColor: balloonText balloonText: balloonTextSelector balloonTextSelector: beFlap: beSticky beTransparent beUnsticky borderColor borderColor: borderStyle borderStyle: borderStyleForSymbol: borderWidth borderWidth: borderWidthForRounding clearArea color color: colorForInsets couldHaveRoundedCorners defaultNameStemForInstances eventHandler eventHandler: hasTranslucentColor highlight highlightColor highlightColor: insetColor isFlap isLocked isShared isSticky lock lock: modelOrNil raisedColor regularColor regularColor: rememberedColor rememberedColor: resistsRemoval resistsRemoval: scaleFactor setBorderStyle: sqkPage sticky: toggleLocked toggleResistsRemoval toggleStickiness unHighlight unlock unlockContents url userString viewBox visibleClearArea wantsToBeCachedByHand)('accessing - extension' assureExtension extension hasExtension initializeExtension privateExtension: resetExtension)('accessing - properties' hasProperty: otherProperties removeProperty: setProperties: setProperty:toValue: valueOfProperty: valueOfProperty:ifAbsent: valueOfProperty:ifAbsentPut: valueOfProperty:ifPresentDo:)('caching' fullLoadCachedState fullReleaseCachedState loadCachedState releaseCachedState)('change reporting' addedMorph: colorChangedForSubmorph: invalidRect: invalidRect:from: privateInvalidateMorph: userSelectedColor:)('classification' isAlignmentMorph isBalloonHelp isButton isFlapOrTab isFlapTab isFlexMorph isHandMorph isRenderer isTextMorph isWorldMorph isWorldOrHandMorph)('connectors-scripting' wantsConnectorVocabulary)('converting' asSnapshotThumbnail)('copying' copy deepCopy duplicate duplicateMorphCollection: okayToDuplicate updateReferencesUsing: veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:)('creation' asMorph)('debug and other' addDebuggingItemsTo:hand: addMouseActionIndicatorsWidth:color: addMouseUpAction addMouseUpActionWith: addViewingItemsTo: allStringsAfter: allStringsAfter:do: altSpecial Cursor0 altSpecialCursor1 altSpecialCursor2 altSpecialCursor3 altSpecialCursor3: buildDebugMenu: defineTempCommand deleteAnyMouseActionIndicators hasStrings inspectOwnerChain installModelIn: mouseUpCodeOrNil ownerChain programmedMouseDown:for: programmedMouseEnter:for: programmedMouseLeave:for: programmedMouseUp:for: removeMouseUpAction resumeAfterDrawError resumeAfterLayoutError resumeAfterStepError tempCommand)('dispatching' disableSubmorphFocusForHand:)('drawing' areasRemainingToFill: boundingBoxOfSubmorphs boundsWithinCorners changeClipSubmorphs clipLayoutCells clipLayoutCells: clipSubmorphs clipSubmorphs: clippingBounds doesOwnRotation drawDropHighlightOn: drawDropShadowOn: drawErrorOn: drawKeyboardFocusIndicationOn: drawMouseDownHighlightOn: drawOn: drawOverlayOn: drawRolloverBorderOn: drawSubmorphsOn: expandFullBoundsForDropShadow: expandFullBoundsForRolloverBorder: flashBounds fullDrawOn: hasClipSubmorphsString hide highlightedForMouseDown highlightedForMouseDown: imageForm imageForm:backgroundColor:forRectangle: imageForm:forRectangle: imageFormDepth: imageFormForRectangle: imageFormWithout:andStopThere: keyboardFocusColor keyboardFocusWidth refreshWorld shadowForm show updateDropShadowCache visible visible:)('drop shadows' addDropShadow addDropShadowMenuItems:hand: changeShadowColor hasDropShadow hasDropShadow: hasDropShadowString hasRolloverBorder hasRolloverBorder: removeDropShadow setShadowOffset: shadowColor shadowColor: shadowOffset shadowOffset: shadowPoint: toggleDropShadow useSoftDropShadow useSoftDropShadow:)('dropping/grabbing' aboutToBeGrabbedBy: acceptDroppingMorph:event: disableDragNDrop dragEnabled dragEnabled: dragNDropEnabled dragSelectionColor dropEnabled dropEnabled: dropHighlightColor dropSuccessColor enableDrag: enableDragNDrop enableDragNDrop: enableDrop: formerOwner formerOwner: formerPosition formerPosition: grabTransform handledOwnDraggingBy:on: highlightForDrop highlightForDrop: highlightedForDrop justDroppedInto:event : justGrabbedFrom: morphToDropInPasteUp: nameForUndoWording rejectDropMorphEvent: repelsMorph:event: resetHighlightForDrop separateDragAndDrop slideBackToFormerSituation: slideToTrash: startDrag:with: transportedMorph undoGrabCommand vanishAfterSlidingTo:event: wantsDroppedMorph:event: wantsToBeDroppedInto: wantsToBeOpenedInWorld willingToBeDiscarded)('event handling' click click: cursorPoint doubleClick: doubleClickTimeout: firstClickTimedOut: handlerForMouseDown: handlerForYellowButtonDown: handlesKeyboard: handlesKeyboardOnlyOnFocus handlesKeyboardOnlyOnFocus: handlesMouseDown: handlesMouseMove: handlesMouseOver: handlesMouseOverDragging: handlesMouseStillDown: handlesMouseWheel: hasFocus hasKeyboardFocus hasKeyboardFocus: hasMouseFocus hasMouseFocus: keyDown: keyStroke: keyUp: keyboardFocusChange: keyboardFocusDelegate mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: mouseMove: mouseStillDown: mouseStillDownThreshold mouseUp: mouseWheel: moveOrResizeFromKeystroke: on:send:to: on:send:to:withValue: removeLink: restoreSuspendedEventHandler startDrag: suspendEventHandler transformFrom: transformFromOutermostWorld transformFromWorld wantsEveryMouseMove wantsKeyboardFocus wantsKeyboardFocusFor: wantsWindowEvents: windowEvent: wouldAcceptKeyboardFocus yellowButtonActivity:)('events-accessing' actionMap updateableActionMap)('events-alarms' addAlarm:after: addAlarm:at: addAlarm:with:after: addAlarm:with:at: addAlarm:with:with:after: addAlarm:with:with:at: addAlarm:withArguments:after: addAlarm:withArguments:at: alarmScheduler removeAlarm: removeAlarm:at:)('events-processing' containsPoint:event: defaultEventDispatcher handleDropMorph: handleEvent: handleFocusEvent: handleKeyDown: handleKeyUp: handleKeystroke: handleListenEvent: handleMouseDown: handleMouseEnter: handleMouseLeave: handleMouseMove: handleMouseOver: handleMouseStillDown: handleMouseUp: handleMouseWheel: handleUnknownEvent: handleWindowEvent: mouseDownPr iority mouseDownPriority: processEvent: processEvent:using: processFocusEvent: processFocusEvent:using: rejectDropEvent: rejectsEvent: sendFilterEvent:for:to: sendFilterEventBubble:for: sendFilterEventBubbleAgain:for: sendFilterEventCapture:for: sendFilterEventCaptureAgain:for: transformedFrom:)('events-removing' releaseActionMap)('fileIn/out' attachToResource prepareToBeSaved reserveUrl: saveAsResource saveOnFile saveOnURL saveOnURL: saveOnURLbasic updateAllFromResources updateFromResource)('filter streaming' drawOnCanvas:)('geometry' bottom bottom: bottomCenter bottomLeft bottomLeft: bottomRight bottomRight: bounds bounds: center center: extent extent: height height: left left: leftCenter pointAtFraction: position position: right right: rightCenter top top: topCenter topLeft topLeft: topRight topRight: width width:)('geometry testing' containsPoint: fullContainsPoint: obtrudesBeyondContainer)('halos and balloon help' addHalo addHalo: addHandlesTo:box: addOptionalHandlesTo:box: addSimpleHandlesTo:box: addWorldHandlesTo:box: balloonColor balloonColor: balloonFont balloonFont: balloonHelpAligner balloonHelpDelayTime balloonHelpTextForHandle: balloonMorphClass boundsForBalloon comeToFrontAndAddHalo createHalo defaultBalloonColor defaultBalloonFont defaultHaloDispatcher defersHaloOnClickTo: deleteBalloon editBalloonHelpContent: editBalloonHelpText halo haloClass haloDelayTime hasHalo hasHalo: mouseDownOnHelpHandle: noHelpString okayToAddDismissHandle okayToAddGrabHandle okayToBrownDragEasily okayToExtractEasily okayToResizeEasily okayToRotateEasily removeHalo setBalloonText: setBalloonText:maxLineLength: setCenteredBalloonText: showBalloon showBalloon: showBalloon:at: showBalloon:hand: transferHalo: transferHalo:using: wantsBalloon wantsDirectionHandles wantsDirectionHandles: wantsHaloFromClick wantsHaloFromClick: wantsHaloHandleWithSelector:inHalo: wantsRecolorHandle wantsSimpleSketchMorphHandles)('initialization' basicInitialize defaultBounds defaultC olor inAScrollPane initialize openCenteredInWorld openInHand openInWindow openInWindowLabeled: openInWindowLabeled:inWorld: openInWorld openInWorld: openNear: openNear:in: openNearMorph: resourceJustLoaded)('layout' adjustLayoutBounds checkCellSpacingProperty: checkListSpacingProperty: checkResizingProperty: doLayout doLayoutIn: doLayoutSafely fullBounds layoutChanged layoutComputed layoutInBounds: layoutInBounds:positioning: layoutProportionallyIn: layoutProportionallyInBounds:positioning: minExtent minExtent: minHeight minHeight: minWidth minWidth: ownerChanged ownerChangedHandler ownerChangedHandler: privateFullBounds privateFullBoundsForRedraw setExtentFromLayout: setLayoutBoundsFromLayout: setPositionFromLayout: submorphBounds submorphBoundsForShrinkWrap)('layout-menu' addCellLayoutMenuItems:hand: addLayoutMenuItems:hand: addTableLayoutMenuItems:hand: cellPositioningString: cellSpacingString: changeCellGap: changeCellInset: changeClipLayoutCells changeDisableTableLayout changeHeightForWidth changeLayoutInset: changeListDirection: changeMaxCellSize: changeMinCellSize: changeNoLayout changeProportionalLayout changeReverseCells changeRubberBandCells changeTableLayout changeWidthForHeight changesHeightForWidth changesWidthForHeight hResizingString: hasClipLayoutCellsString hasDisableTableLayoutString hasNoLayoutString hasProportionalLayoutString hasReverseCellsString hasRubberBandCellsString hasTableLayoutString layoutMenuPropertyString:from: listCenteringString: listDirectionString: listSpacingString: vResizingString: wrapCenteringString: wrapDirectionString:)('macpal' flash)('menu' addBorderStyleMenuItems:hand: addGestureMenuItems:hand: addGraphModelYellowButtonItemsTo:event: addModelYellowButtonItemsTo:event: addMyYellowButtonMenuItemsToSubmorphMenus addNestedYellowButtonItemsTo:event: addTitleForHaloMenu: addYellowButtonMenuItemsTo:event: buildYellowButtonMenu: hasYellowButtonMenu outermostOwnerWithYellowButtonMenu startWiring wantsMetaMenu wantsMetaMenu: wantsYellowButtonMenu wantsYellowButtonMenu:)('menus' absorbStateFromRenderer: addAddHandMenuItemsForHalo:hand: addCopyItemsTo: addCustomHaloMenuItems:hand: addCustomMenuItems:hand: addExportMenuItems:hand: addFillStyleMenuItems:hand: addHaloActionsTo: addMiscExtrasTo: addStandardHaloMenuItemsTo:hand: addToggleItemsToHaloMenu: addWorldTargetSightingItems:hand: adhereToEdge adhereToEdge: adjustedCenter adjustedCenter: changeColor changeDirectionHandles changeDrag changeDragAndDrop changeDrop collapse defaultArrowheadSize exploreInMorphic exploreInMorphic: exportAsBMP exportAsBMPNamed: exportAsGIF exportAsGIFNamed: exportAsJPEG exportAsJPEGNamed: exportAsPNG exportAsPNGNamed: hasDirectionHandlesString hasDragAndDropEnabledString hasDragEnabledString hasDropEnabledString helpButton inspectInMorphic inspectInMorphic: lockUnlockMorph lockedString maybeAddCollapseItemTo: model presentHelp reasonableBitmapFillForms reasonableForms resetForwardDirection resistsRemovalS tring setArrowheads setRotationCenter setRotationCenterFrom: setToAdhereToEdge: snapToEdgeIfAppropriate stickinessString transferStateToRenderer: uncollapseSketch)('meta-actions' addEmbeddingMenuItemsTo:hand: beThisWorldsModel buildHandleMenu: buildMetaMenu: changeColorTarget:selector:originalColor:hand: copyToPasteBuffer: dismissMorph dismissMorph: duplicateMorph: duplicateMorphImage: embedInto: grabMorph: inspectAt:event: invokeMetaMenu: invokeMetaMenuAt:event: maybeDuplicateMorph maybeDuplicateMorph: openATextPropertySheet potentialEmbeddingTargets potentialTargets potentialTargetsAt: resizeFromMenu resizeMorph: saveAsPrototype showActions showHiders sightTargets: sightWorldTargets: subclassMorph targetFromMenu: targetWith:)('miscellaneous' setExtentFromHalo: setFlexExtentFromHalo:)('naming' assureExternalName downshiftedNameOfObjectRepresented externalName innocuousName knownName name: nameForFindWindowFeature nameInModel nameOfObjectRepresented renameTo: setNamePropertyTo: set NameTo: specialNameInModel tryToRenameTo:)('objects from disk' objectForDataStream: storeDataOn:)('other events' menuButtonMouseEnter: menuButtonMouseLeave:)('parts bin' inPartsBin initializeToStandAlone isPartsBin isPartsDonor isPartsDonor: markAsPartsDonor partRepresented residesInPartsBin)('printing' clipText colorString: constructorString fullPrintOn: initString morphReport morphReportFor: morphReportFor:on:indent: pagesHandledAutomatically printConstructorOn:indent: printConstructorOn:indent:nodeDict: printOn: printSpecs printSpecs: printStructureOn:indent: reportableSize structureString textToPaste)('rotate scale and flex' addFlexShell addFlexShellIfNecessary assureFlexShell forwardDirection forwardDirection: heading heading: keepsTransform newTransformationMorph referencePosition referencePosition: referencePositionInWorld referencePositionInWorld: removeFlexShell rotationCenter rotationCenter: rotationDegrees rotationDegrees: setDirectionFrom:)('rounding' cornerRadius cornerR adius: cornerStyle cornerStyle: roundedCorners roundedCornersString toggleCornerRounding wantsRoundedCorners)('stepping' arrangeToStartStepping arrangeToStartSteppingIn: isStepping isSteppingSelector: start startStepping startStepping:at:arguments:stepTime: startSteppingIn: startSteppingSelector: step stepAt: stepTime stop stopStepping stopSteppingSelector: stopSteppingSelfAndSubmorphs wantsSteps)('structure' activeHand allOwners allOwnersDo: containingWindow firstOwnerSuchThat: hasOwner: isInDockingBar isInSystemWindow isInWorld morphPreceding: nearestOwnerThat: orOwnerSuchThat: outermostMorphThat: outermostWorldMorph owner ownerThatIsA: ownerThatIsA:orA: pasteUpMorph primaryHand renderedMorph root rootAt: topPasteUp topRendererOrSelf withAllOwners withAllOwnersDo: world)('testing' canDrawAtHigherResolution canDrawBorder: completeModificationHash indicateKeyboardFocus isDockingBar isFlexed isFullOnScreen isImageMorph isLineMorph isMenuItemMorph isMorph isSafeToServe isSelectionMorp h isSketchMorph isTransferMorph modificationHash shouldDropOnMouseUp)('text-anchor' addTextAnchorMenuItems:hand: asTextAnchor textAnchorProperties)('thumbnail' icon iconOrThumbnail iconOrThumbnailOfSize: morphRepresented permitsThumbnailing representativeNoTallerThan:norWiderThan:thumbnailHeight: thumbnail updateThumbnailUrl updateThumbnailUrlInBook:)('undo' commandHistory undoMove:redo:owner:bounds:predecessor:)('updating' applyUserInterfaceTheme changed)('user interface' defaultLabelForInspector doCancel initialExtent playSoundNamed:)('visual properties' canApplyUserInterfaceTheme canHaveFillStyles defaultBitmapFillForm fillStyle fillStyle: fillWithRamp:oriented: useBitmapFill useDefaultFill useGradientFill useSolidFill)('WiW support' eToyRejectDropMorph:event: randomBoundsFor: shouldGetStepsFrom:)('private' canBeEncroached privateAddAllMorphs:atIndex: privateAddMorph:atIndex: privateBounds: privateColor: privateDeleteWithAbsolutelyNoSideEffects privateFullBounds: privateFull MoveBy: privateMoveBy: privateOwner: privateRemove: privateRemoveMorphWithAbsolutelyNoSideEffects: privateSubmorphs privateSubmorphs:)('accessing-backstop' target:)('geniestubs' allowsGestureStart: isGestureStart: mouseStillDownStepRate redButtonGestureDictionaryOrName: yellowButtonGestureDictionaryOrName:)('*morphic-Postscript Canvases' asPostscript clipPostscript drawPostscriptOn: fullDrawPostscriptOn: printPSToFile)('button' doButtonAction)('model access' models)('other' removeAllButFirstSubmorph)('selected object' selectedObject)('polymorph' modalLockTo: modalUnlockFrom: openModal:)('*Morphic-Sound-piano rolls' addMorphsTo:pianoRoll:eventTime:betweenTime:and: encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: justDroppedIntoPianoRoll:event: pauseFrom: resetFrom: resumeFrom: triggerActionFromPianoRoll)('events-filtering-bubbling' addEventBubbleFilter: addKeyboardBubbleFilter: addMouseBubbleFilter: eventBubbleFilters eventBubbleFilters: keyboardBubbleFilters keyboardBubbleFilters: mouseBubbleFilters mouseBubbleFilters: removeEventBubbleFilter: removeKeyboardBubbleFilter: removeMouseBubbleFilter:)('events-filtering-capturing' addEventCaptureFilter: addKeyboardCaptureFilter: addMouseCaptureFilter: eventCaptureFilters eventCaptureFilters: keyboardCaptureFilters keyboardCaptureFilters: mouseCaptureFilters mouseCaptureFilters: removeEventCaptureFilter: removeKeyboardCaptureFilter: removeMouseCaptureFilter:)('events-filtering' addFilter:to: eventFilterDocumentation removeFilter:from:)('*ToolBuilder-Morphic-opening' buildWith: openAsTool)('geometry - misc' align:with: positionSubmorphs setConstrainedPosition:hangOut: shiftSubmorphsOtherThan:by: transformedBy: worldBounds worldBoundsForHalo)('geometry - local/global' bounds:from: bounds:in: boundsIn: boundsInWorld fullBoundsInWorld globalPointToLocal: intersects: localPointToGlobal: point:from: point:in: pointFromWorld: pointInWorld: positionInWorld)('geometry - layout' innerBounds inner Bounds: innerExtent innerExtent: innerPosition innerPosition: layoutBounds layoutBounds: layoutExtent layoutExtent: layoutPosition layoutPosition: minimumExtent minimumExtent: minimumHeight minimumHeight: minimumWidth minimumWidth: outerBounds outerBounds: outerExtent outerExtent: outerPosition outerPosition:)('Multilingual-ImmPlugin' preferredKeyboardBounds preferredKeyboardPosition)('*ToolBuilder-Morphic' inspectorClass)('submorphs - add/remove' abandon addAllMorphs: addAllMorphs:after: addAllMorphs:behind: addAllMorphs:inFrontOf: addAllMorphsBack: addAllMorphsFront: addMorph: addMorph:after: addMorph:asElementNumber: addMorph:atIndex: addMorph:behind: addMorph:inFrontOf: addMorphBack: addMorphFront: comeToFront delete goBehind privateDelete removeAllMorphs removeAllMorphsIn: removeMorph:)('submorphs - misc' actWhen actWhen: addMorph:fullFrame: addMorphCentered: addMorphFront:fromWorldPosition: addMorphFrontFromWorldPosition: allNonSubmorphMorphs copyWithoutSubmorph: deleteDockingB ars deleteSubmorphsWithProperty: deleteUnlessHasFocus dismissViaHalo dockingBars findA: findDeepSubmorphThat:ifAbsent: findDeeplyA: findSubmorphBinary: hasSubmorphWithProperty: indexOfMorphAbove: mainDockingBars morphsAt:behind:unlocked: morphsInFrontOf:overlapping:do: morphsInFrontOverlapping: morphsInFrontOverlapping:do: replaceSubmorph:by: rootMorphsAt: rootMorphsAtGlobal: submorphAfter submorphBefore submorphOfClass: submorphWithProperty:)('submorphs - layers' addAllMorphsBackInLayers: addAllMorphsFrontInLayers: addAllMorphsInLayers: addMorphBackInLayer: addMorphFrontInLayer: addMorphInLayer: morphicLayerNumber morphicLayerNumber: reorderSubmorphsInLayers wantsToBeTopmost)('submorphs - accessing' allKnownNames allMorphs firstSubmorph lastSubmorph morphsAt: morphsAt:unlocked: morphsAt:unlocked:useFullBounds: submorphCount submorphIndexOf: submorphNamed: submorphNamed:ifNone: submorphThat:ifNone: submorphs submorphsSatisfying:)('submorphs - enumerating' allMorphsBreadthFirstDo: allMorphsBreadthFirstDo:sorted: allMorphsDepthFirstDo: allMorphsDo: allSubmorphNamesDo: morphsAt:unlocked:do: morphsAt:unlocked:useFullBounds:do: submorphsBehind:do: submorphsDo: submorphsInFrontOf:do: submorphsReverseDo:)('layout properties' assureGridLayoutProperties assureLayoutProperties assureTableLayoutProperties copyLayoutProperties disableLayout disableLayout: disableTableLayout disableTableLayout: hResizing hResizing: layoutInset layoutInset: layoutPolicy layoutPolicy: layoutProperties layoutProperties: vResizeToFit: vResizing vResizing:)('layout properties - table' cellGap cellGap: cellInset cellInset: cellPositioning cellPositioning: cellSpacing cellSpacing: listCentering listCentering: listDirection listDirection: listSpacing listSpacing: maxCellSize maxCellSize: minCellSize minCellSize: reverseTableCells reverseTableCells: rubberBandCells rubberBandCells: spaceFillWeight spaceFillWeight: wrapCentering wrapCentering: wrapDirection wrapDirection:)('layout propertie s - grid' gridModulus gridModulus: gridOrigin gridOrigin:)('submorphs - testing' hasSubmorphs)('submorphs - callbacks' intoWorld: noteNewOwner: outOfWorld: removedMorph:)('layout properties - proportional' layoutFrame layoutFrame:)('halo notification' aboutToBeDraggedViaHalo aboutToBeGrownViaHalo aboutToBeRotatedViaHalo aboutToBeScaledViaHalo changedViaHalo:)('display scale' displayScaleChangedBy: handlesDisplayScaleChangedBy:)('*60Deprecated-events-processing' handleDropFiles:)('*MorphicExtras-menus' dismissButton printPSToFileNamed:)('*60Deprecated-rotate scale and flex' degreesOfFlex)('*60Deprecated-text-anchor' changeDocumentAnchor changeInlineAnchor changeParagraphAnchor hasDocumentAnchorString hasInlineAnchorString hasParagraphAnchorString relativeTextAnchorPosition relativeTextAnchorPosition: textAnchorType textAnchorType:)('*MorphicExtras' nextOwnerPage previousOwnerPage)('*60Deprecated-event handling' dropFiles: wantsDropFiles:)('*60Deprecated-geometry' gridPoint: griddedPoint:)('*services-base' requestor)('*60Deprecated-accessing' doesBevels)('*60Deprecated-meta-actions' blueButtonDown: blueButtonUp: handlerForBlueButtonDown: handlerForMetaMenu:)('*60Deprecated-user-interface' becomeModal)('*MorphicExtras-books' updateCachedThumbnail)('*60Deprecated-initialization' inATwoWayScrollPane)('*MorphicExtras-geometry' shiftSubmorphsBy:)('*60Deprecated-dropping/grabbing' toggleDragNDrop)('*60Deprecated-copying' fullCopy)('*MorphicExtras-postscript' asEPS asPostscriptPrintJob exportAsEPS exportAsEPSNamed:)('*60Deprecated-WiW support' addMorphInFrontOfLayer: morphicLayerNumberWithin:)('*60Deprecated-MorphicExtras-accessing' highlightOnlySubmorph:)('*61Deprecated-drawing' highlightForMouseDown highlightForMouseDown:)!InstanceBrowser removeSelector: #viewViewee!!Lexicon reorganize!('basic operation' annotation displaySelector: messageListIndex:)('category list' categoriesPane categoryDefiningSelector: categoryList categoryListIndex categoryListIn dex: categoryListKey:from: categoryListMenu:shifted: categoryListMenuTitle categoryWithNameSpecifiedBy: chooseCategory: mainCategoryListMenu: newCategoryPane reformulateCategoryList selectCategoryAll selectWithinCurrentCategoryIfPossible: selectedCategoryName selectorsReferringToClassVar showCategoriesPane)('contents' contents)('control buttons' customButtonSpecs)('history' navigateToNextMethod navigateToPreviousMethod navigateToRecentMethod removeFromSelectorsVisited removeFromSelectorsVisited: selectorsVisited updateSelectorsVisitedfrom:to:)('initialization' customButtonsFrame: initListFrom:highlighting: listFrame:fromLeft:width:)('limit class' chooseLimitClass initialLimitClass limitClass limitClass: limitClassString setLimitClass:)('menu commands' offerMenu removeMessage showCategory showHomeCategory showMainCategory)('message category functions' canShowMultipleMessageCategories)('message list menu' messageListKey:from:)('model glue' doItReceiver okayToAccept targetObject)('ne w-window queries' browseVariableAssignments browseVariableReferences)('search' hasSearchPane lastSearchString lastSearchString: lastSendersSearchSelector methodListFromSearchString: obtainNewSearchString selectorsMatching setMethodListFromSearchString showSearchPane toggleSearch)('selection' categoryOfSelector: selectImplementedMessageAndEvaluate: selectSelectorItsNaturalCategory: selectWithinCurrentCategory: selectedClassOrMetaClass selectedMessage setToShowSelector:selectCategory:)('senders' navigateToASender selectorsSendingSelectedSelector setSendersSearch)('transition' maybeReselectClass:selector: noteAcceptanceOfCodeFor: preserveSelectorIfPossibleSurrounding: reformulateList reformulateListNoting: retainMethodSelectionWhileSwitchingToCategory:)('vocabulary' chooseVocabulary switchToVocabulary: useVocabulary:)('window title' addModelItemsToWindowMenu: adjustWindowTitle startingWindowTitle)('within-tool queries' currentQueryParameter methodsWithInitials methodsWithInitials: queryCharacterization seeAlso seeAlso: selectorsChanged selectorsDefiningInstVar selectorsReferringToInstVar selectorsRetrieved setLocalClassVarRefs setLocalInstVarDefs setLocalInstVarRefs showMethodsInCurrentChangeSet showMethodsWithInitials showMethodsWithInitials: showQueryResultsCategory)('toolbuilder' addSpecialButtonsTo:with: buildCategoryListWith: buildCustomButtonsWith: buildWith: openOnClass:inWorld:showingSelector: openOnClass:showingSelector: wantsAnnotationPane)('morphic' representsSameBrowseeAs: targetClass)('message list' formattedLabel:forSelector:inClass: messageHelpAt: messageIconAt:)('user interface' defaultWindowColor)('private' contents:notifying: contents:oldSelector:in:classified:notifying: targetForContents:)!Object subclass: #MenuIcons instanceVariableNames: '' classVariableNames: 'Icons ScriptingIcons TranslatedIcons TranslationLocale' poolDictionaries: '' category: 'Morphic-Menus'!Inspector removeSelector: #addEtoysItemsTo:!!Inspector reorganize!('accessing' context context: customFields doItContext doItReceiver fields object object: selectionIndex selectionIndex:)('private' allInstVarsTranslated)('toolbuilder' buildCodePaneWith: buildExploreButtonWith: buildFieldListWith: buildValuePaneWith: buildWith: replaceInspectorWithExplorer)('*Protocols-Tools' browseFullProtocol spawnFullProtocol spawnProtocol)('*60Deprecated-selecting' selectedSlotName)('user interface - styling' aboutToStyle:requestor: fieldListStyler typeValue: updateStyler: updateStyler:requestor:)('menu - construction' addClassItemsTo: addCollectionItemsTo: addFieldItemsTo: addInstVarItemsTo: addObjectItemsTo:)('fields - custom' addCustomField addCustomField: hasCustomFields newCustomField removeCustomField: requestCustomFieldOrCancel:)('user interface' applyUserInterfaceTheme defaultIntegerBase fieldList getContents representsSameBrowseeAs: textColorForError valuePane)('menu - commands' browseClass browseClassHierarchy browseVariableAssignmen ts browseVariableReferences chaseSelectionPointers copyExpression copyName exploreSelection exploreSelectionPointers inspectOne inspectOneOf: inspectOneOfFrom:to: inspectSelection inspectSelectionBasic objectReferencesToSelection removeSelection)('selection - convenience' classOfSelection selectedClass selectedInstVarName selectionIsReadOnly selectionOrObject typeOfSelection)('accessing - contents' contents:notifying: contentsTyped contentsTyped: expression expression:)('fields - error handling' contentsForErrorDoing: emphasizeError: streamError:on: streamErrorDoing:on:)('fields - truncation' contentsForTruncationOf: streamOn:truncate:collectFields: streamOn:truncate:collectFields:ellipsisFrom: truncationLimit truncationTail)('fields - drag and drop' dragFromFieldList: dragTypeInFieldListAt: dropOnFieldList:at:shouldCopy:)('selection' ensureSelectedField hasSelection noteSelectionIndex:for: replaceSelectionValue: selectField: selectFieldNamed: selectFieldSuchThat: selectedField selectedFieldName selection)('fields' expressionForField: fieldAllInstVars fieldSelf newFieldForType: newFieldForType:key:)('initialization' fieldClass initialExtent initialize inspect: resetContents resetFields setContents: setContentsTyped: setExpression:)('menu' fieldListMenu: fieldListMenu:shifted: inspectorKey:from: mainFieldListMenu: metaFieldListMenu:)('user interface - window' labelString objectOkToClose okToClose okToDiscardCustomFields)('updating - steps' modelWakeUpIn: stepAt:in: stepTimeIn: updateListsAndCodeIn: wantsStepsIn:)('fields - streaming' streamBaseFieldsOn: streamCustomFieldsOn: streamFieldsOn: streamIndexedVariablesOn: streamInstanceVariablesOn: streamVariableFieldsOn:)('updating' update update: update:with: updateContentsSafely updateFieldList updateFields)('*60Deprecated-menu' classHierarchy)('*60Deprecated-toolbuilder' exploreObject)('copying' veryDeepInner:)('private - collections' elementAt: elementGetterAt:)('user edits' okToRevertChanges:)!!Image Segment reorganize!('access' allObjectsDo: arrayOfRoots arrayOfRoots:)('read/write segment' install loadSegmentFrom:outPointers: localName readFromFile)('error checking' checkAndReportLoadError)('fileIn' comeFullyUpOnReload: declare: declareAndPossiblyRename: dependentsCancel: dependentsRestore: fixCapitalizationOfSymbols processRoots rehashDictionaries: reshapeClasses:refStream: restoreEndianness:)('fileIn/Out' acceptSingleMethodSource: endianness restoreEndianness scanFrom: scanFrom:environment:)('testing' errorWrongState forFile:outPointers:)('private' forgetDoItsInClass: segmentFormatFrom:)!Form removeSelector: #graphicForViewerTab!!Form reorganize!('accessing' bits bitsSize bits: defaultCanvasClass depth depth: extent form getCanvas hasBeenModified hasBeenModified: nativeDepth offset offset: size)('analyzing' cgForPixelValue:orNot: colorsUsed dominantColor innerPixelRectFor:orNot: pixelCompare:with:at: primCountBits rectangleEnclosingPixelsNotOfColor: tallyPixelValues tallyPixelValuesInRect:into: xTallyPixelValue:orNot: yTallyPixelValue:orNot:)('bordering' borderFormOfWidth:sharpCorners: borderWidth: borderWidth:color: borderWidth:fillColor: border:width:rule:fillColor: shapeBorder:width: shapeBorder:width:interiorPoint:sharpCorners:internal:)('color mapping' balancedPatternFor: bitPatternFor: colormapFromARGB colormapIfNeededForDepth: colormapIfNeededFor: colormapToARGB makeBWForm: mapColors:to: mapColor:to: maskingMap newColorMap pixelValueFor: pixelWordFor: reducedPaletteOfSize: rgbaBitMasks)('converting' adjustBrightness: adjustSaturation: as8BitColorForm asCursorForm asFormOfDepth: asGrayScale asSourceForm asTextAnchor blendColor: collectColors: collectPixels: colorReduced copyWithColorsReducedTo: darker dimmed dyed: flipVertically lighter orderedDither32To16)('copying' blankCopyOf:scaledBy: contentsOfArea: contentsOfArea:into: copyBits:at:translucent: copyBits:from:at:clippingBox:rule:fillColor: copyBits:from:at:clippingBox:rule:fillColor:map: copyBits:from:at:colorMap: copy: copy:from:in:rule: copy:from:to:rule: deepCopy postCopy veryDeepCopyWith:)('display box access' boundingBox center computeBoundingBox height width)('displaying' displayInterpolatedIn:on: displayInterpolatedOn: displayOnPort:at: displayOn:at:clippingBox:rule:fillColor: displayOn:transformation:clippingBox:align:with:rule:fillColor: displayResourceFormOn: displayScaledOn: drawLine:from:to:clippingBox:rule:fillColor: paintBits:at:translucent:)('editing' bitEdit bitEditAt:scale: edit)('fileIn/Out' comeFullyUpOnReload: hibernate objectForDataStream: printOn: readAttributesFrom: readBitsFrom: readFromOldFormat: readFrom: replaceByResource: storeBitsOn:base: storeOn: storeOn:base: unhibernate writeAttributesOn: writeBitsOn: writeBMPfileNamed: writeJPEGfileNamed: writeJPEGfileNamed:progressive: writeOnMovie: writeOn: writePNGfileNamed: writeUncompressedOn:)('filling' anyShapeFill bitPatternForDepth: convexShapeFill: eraseShape: fillFromXColorBlock: fillFromXYColorBlock: fillFromYColorBlock: fill:rule:fillColor: findShapeAroundSeedBlock: floodFill2:at: floodFillMapFrom:to:mappingColorsWithin:to: floodFill:at: floodFill:at:tolerance: shapeFill:interiorPoint: shapeFill:seedBlock:)('image manipulation' replaceColor:withColor: smear:distance: trimBordersOfColor:)('initialize-release' allocateForm: finish flush fromDisplay: shutDown swapEndianness)('other' fillAlpha: fixAlpha formForColorCount: preMultiplyAlpha primPrintHScale:vScale:landscape: relativeTextAnchorPosition setAsBackground)('pixel access' colorAt: colorAt:put: isTransparentAt: pixelValueAt: pixelValueAt:put: primPixelValueAtX:y: primPixelValueAtX:y:put:)('postscript generation' bitsPerComponent bytesPerRow decodeArray numComponents paddedWidth printPostscript:operator: rowPadding setColorspaceOn: store15To24HexBitsOn: store32To24HexBitsOn: storeBits:to:on: storeHexBitsOn: storePostscriptHexOn:)('resources' readNativeResourceFrom: readResourceFrom: resourceTag storeResourceOn:)('scaling, rotation' clippedToSize: flipBy:centerAt: magnifyBy: magnify:by: magnify:by:smoothing: rotateBy: rotateBy:centerAt: rotateBy:magnify:smoothing: rotateBy:smoothing: scaledToHeight: scaledToSize: scaledToSize:smoothing: scaledToWidth: shrink:by:)('testing' hasNonStandardPalette isAllWhite isBigEndian isDisplayScreen isForm isGrayScale isLittleEndian isStatic isTranslucent isVirtualScreen shouldPreserveContents)('transitions' fadeImageCoarse:at: fadeImageFine:at: fadeImageHorFine:at: fadeImageHor:at: fadeImageSquares:at: fadeImageVert:at: fadeImage:at:indexAndMaskDo: pageImage:at:corner: pageWarp:at:forward: slideImage:at:delta: wipeImage:at:clippingBox:rectForIndex: wipeImage:at:delta: wipeImage:at:delta:clippingBox: zoomInTo:at: zoomIn:orOutTo:at:vanishingPoint: zoomOutTo:at:)('*MorphicExtras-postscript generation' encodePostscriptOn:)('*nebraska-encoding' addDeltasFrom: deltaFrom: deltaFrom:at: encodeForRemoteCanvas)('private' hackBits: initFromArray: privateFloodFillValue: setExtent:depth: setExtent:depth:bits: setResourceBits:)('*Morphic' asMorph blankCopyOf: iconOrThumbnailOfSize: scaledIntoFormOfSize: scaledIntoFormOfSize:smoothing:)('*Morphic-Support-image manipulation' stencil)('processing' approxGaussianBlur at:bias: dither: edgeDetect emboss processUsingKernel: processUsingKernel:factor:bias: sharpen)('*System-icon scaling' scaleIconToDisplay)('*Morphic-Text Support' textAnchorProperties)('*Tools-Inspector' inspectorClass)('*TrueType-displaying' advanceWidth)!Flaps class removeSelector: #addAndEnableEToyFlaps!Flaps class removeSelector: #defaultsQuadsDefiningPlugInSuppliesFlap!Flaps class removeSelector: #defaultsQuadsDefiningScriptingFlap!Flaps class removeSelector: #enableEToyFlaps!Flaps class removeSelector: #newLoneSuppliesFlap!Flaps class removeSelector: #newPaintingFlap!Flaps class removeSelector: #paintFlapButton!Flaps class removeSelector: #possiblyReplaceEToyFlaps!Flaps class removeSelector: #setUpSuppliesFlapOnly!!Flaps class reorganize!('class initialization' initialize)('construction support' addMorph:asElementNumber:inGlobalFlapSatisfying: addMorph:asElementNumber:inGlobalFlapWithID: addToSuppliesFlap:asElementNumber: deleteMorphsSatisfying:fromGlobalFlapSatisfying:)('flap mechanics' clobberFlapTabList freshFlapsStart reinstateDefaultFlaps removeFlapTab:keepInList:)('flaps registry' defaultsQuadsDefiningStackToolsFlap defaultsQuadsDefiningSuppliesFlap defaultsQuadsDefiningToolsFlap defaultsQuadsDefiningWidgetsFlap initializeFlapsQuads registeredFlapsQuads registeredFlapsQuadsAt: registerQuad:forFlapNamed: unregisterQuadsWithReceiver: unregisterQuadsWithReceiver:fromFlapNamed: unregisterQuad:forFlapNamed:)('menu commands' disableGlobalFlaps disableGlobalFlaps: disableGlobalFlapWithID: enableDisableGlobalFlapWithID: enableGlobalFlapWithID: explainFlaps explainFlapsText)('menu support' addIndividualGlobalFlap ItemsTo: enableGlobalFlaps globalFlapWithIDEnabledString: showSharedFlaps suppressFlapsString)('miscellaneous' automaticFlapLayoutChanged doAutomaticLayoutOfFlapsIfAppropriate enableClassicNavigatorChanged fileOutChanges makeNavigatorFlapResembleGoldenBar orientationForEdge: removeFromGlobalFlapTabList:)('new flap' addLocalFlap addLocalFlap: addLocalFlap:titled:onEdge: askForEdgeOfNewFlap defaultColorForFlapBackgrounds newFlapTitled:onEdge: newFlapTitled:onEdge:inPasteUp:)('predefined flaps' addNewDefaultSharedFlaps addStandardFlaps initializeStandardFlaps newNavigatorFlap newObjectsFlap newSqueakFlap newStackToolsFlap newSuppliesFlap newSuppliesFlapFromQuads:positioning: newToolsFlap newWidgetsFlap quadsDefiningPlugInSuppliesFlap quadsDefiningStackToolsFlap quadsDefiningSuppliesFlap quadsDefiningToolsFlap quadsDefiningWidgetsFlap quadsDeiningScriptingFlap twiddleSuppliesButtonsIn:)('replacement' replaceGlobalFlapwithID: replacePartSatisfying:inGlobalFlapSatisfying:with: replacePartSatisfying:inGlobalFlapWithID:with: replaceToolsFlap)('shared flaps' addGlobalFlap: enableOnlyGlobalFlapsWithIDs: globalFlapTabOrDummy: globalFlapTabs globalFlapTabsIfAny globalFlapTabsWithID: globalFlapTabWithID: globalFlapTab: positionNavigatorAndOtherFlapsAccordingToPreference positionVisibleFlapsRightToLeftOnEdge:butPlaceAtLeftFlapsWithIDs: removeDuplicateFlapTabs sharedFlapsAllowed sharedFlapsAlongBottom)('testing' anyFlapsVisibleIn:)!EventHandler removeSelector: #adaptToWorld:!DeepCopier removeSelector: #mapUniClasses!DeepCopier removeSelector: #newUniClasses!DeepCopier removeSelector: #newUniClasses:!DeepCopier removeSelector: #uniClasses!Object subclass: #DeepCopier instanceVariableNames: 'references' classVariableNames: '' poolDictionaries: '' category: 'System-Object Storage'!!DeepCopier reorganize!('like fullCopy' checkBasicClasses checkClass: checkDeep checkVariables fixDependents initialize initialize: objInMemory: references warnIverNotCopiedIn:sel:)!ChangeList removeSelector: #buildMorphicCodePaneWith:!CodeHolder removeSelector: #installTextualCodingPane!CodeHolder removeSelector: #restoreTextualCodingPane!!CodeHolder reorganize!('annotation' addPriorVersionsCountForSelector:ofClass:to: annotation annotation: annotationForClassCommentFor: annotationForClassDefinitionFor: annotationForHierarchyFor: annotationForSelector:ofClass: annotationPaneMenu:shifted: annotationRequests annotationSeparator)('categories' categoryFromUserWithPrompt:for: categoryOfCurrentMethod changeCategory letUserReclassify:in: methodCategoryChanged selectedMessageCategoryName selectedSystemCategoryName)('categories & search pane' listPaneWithSelector: newSearchPane searchTextMorph)('commands' adoptMessageInCurrentChangeset browseImplementors browseSenders copyUpOrCopyDown offerMenu offerShiftedClassListMenu offerUnshiftedClassListMenu shiftedYellowButtonActivity spawn: spawnToClass: spawnToCollidingClass: unshiftedYellowButtonActivity)('construction' buildClassBrowserEditString: buildMessageBrowserEditString: buildMessageCategoryBrowserForCategory:class:selector:editString: buildMorphicCodePaneWith:)('contents' commentContents contents contentsChanged contentsSymbol contentsSymbol: editContents editContentsWithDefault: isModeStyleable)('controls' codePaneProvenanceString contentsSymbolQuints decorateButtons optionalButtonPairs sourceAndDiffsQuintsOnly)('diffs' defaultDiffsSymbol diffFromPriorSourceFor: showDiffs showDiffs: showPrettyDiffs: showRegularDiffs: showingAnyKindOfDiffs showingPrettyDiffs showingPrettyDiffsString showingRegularDiffs showingRegularDiffsString toggleDiffing togglePlainSource togglePrettyDiffing togglePrettyPrint toggleRegularDiffing wantsDiffFeedback)('message category functions' canShowMultipleMessageCategories removeMessageCategory)('message list' decompiledSourceIntoContents decompiledSourceIntoContentsWithTempNames: formattedLabel: formattedLabel:forSelector:inClass: messageHelpForMethod: messageHelpTruncated: selectedBytecodes selectedMessage sourceStringPrettifiedAndDiffed validateMessageSource:forSelector:inClass:)('message list menu' messageListKey:from: messageListMenuMore: shiftedMessageListMore:)('misc' addModelItemsToWindowMenu: getSelectorAndSendQuery:to: getSelectorAndSendQuery:to:with: informPossiblyCorruptSource isThereAnOverride isThisAnOverride modelWakeUpIn: okayToAccept priorSourceOrNil refreshAnnotation refusesToAcceptCode releaseCachedState sampleInstanceOfSelectedClass sendQuery:to: sendQuery:to:with: setClassAndSelectorIn: suggestCategoryToSpawnedBrowser: useSelector:orGetSelectorAndSendQuery:to:)('self-updating' didCodeChangeElsewhere stepIn: updateCodePaneIfNeeded updateListsAndCodeIn: wantsStepsIn:)('toolbuilder' annotationFrame annotationPaneHeight browseButtonEnabled buildAnnotationPaneWith: buildCodePaneWith: buildCodeProvenanceButtonWith: buildOptionalButtonsWith: buttonHeight hierarchyButtonEnabled inheritanceButtonColor inheritanceButtonEnabled optionalButtonsFrame receiverClass textFrame variablesButtonEnabled versionsButtonEnabled)('traits' makeSampleInstance showUnreferencedClassVars showUnreferencedInstVars spawnHierarchy)('what to show' offerWhatToShowMenu prettyPrintString setContentsToForceRefetch showByteCodes: showDecompile: showDocumentation: showingByteCodes showingByteCodesString showingDecompile showingDecompileString showingDocumentation showingDocumentationString showingEditContentsOption showingPlainSource showingPlainSourceString showingPrettyPrint showingSource toggleDecompile toggleShowDocumentation toggleShowingByteCodes wantsCodeProvenanceButton)('*services-base' messageListMenuServices: requestor)('*Protocols-Tools' spawnFullProtocol spawnProtocol)('multi-window support' multiWindowState multiWindowState:)('message functions' exploreMethod inspectMethod removeMessage)('*SUnitTools-running' testAskToCreateNewTest: testBinarySelectorNames testBrowseClassNamed:possibleMessageNamed: testFindTest testFindTested testRunSuite: testSelectorFrom:)('*SUnitTools-message list functions' testDebugTest testRunTest)('*SUnitTools-menus' testsMessageListMenu: testsTestFindingMenu:)('breakpoints' isBreakOnEntry toggleBreakOnEntry)('code pane' aboutToStyle: compileMessage:notifying:)('accessing' contents:notifying: doItReceiver metaClassIndicated selectedClass selectedClassOrMetaClass selectedMessageName systemOrganizer)('initialize-release' defaultBrowserTitle labelString setClass:selector:)('*monticello-revisions' classListMenuMonticello: messageListMenuMonticello:)('class functions' removeClass)('system category functions' removeSystemCategory)('*60Deprecated-annotation' defaultAnnotationPaneHeight defaultButtonPaneHeight)('*60Deprecated-categories & search pane' searchPane)!Object removeSelector: #adaptedToWorld:!Object removeSelector: #beViewed!Object removeSelector: #belongsToUniClass!Object removeSelector: #costumes!Object removeSelector: #defaultFloatPrecisionFor:!Object removeSelector: #evaluateUnloggedForSelf:!Object removeSelector: #isPlayer!Object removeSelector: #isPrimitiveCostume!Object removeSelector: #isScriptEditorMorph!Object removeSelector: #isUniversalTiles!Object removeSelector: #methodInterfacesForCategory:inVocabulary:limitClass:!Object removeSelector: #methodInterfacesForInstanceVariablesCategoryIn:!Object removeSelector: #methodInterfacesForScriptsCategoryIn:!Object removeSelector: #presenter!Object removeSelector: #renameInternal:!Object removeSelector: #scriptPerformer!Object removeSelector: #selfWrittenAsIll!Object removeSelector: #selfWrittenAsIm!Object removeSelector: #selfWrittenAsMe!Object removeSelector: #selfWrittenAsMy!Object removeSelector: #selfWrittenAsThis!Object removeSelector: #slotInfo!Object removeSelector: #veryDeepCopySibling!!Object reorganize!('accessing' at: at:modify: at:put: basicAt: basicAt:put: basicSize bindWithTemp : enclosedSetElement in: readFromString: size yourself)('associating' ->)('binding' bindingOf:)('casing' caseOf: caseOf:otherwise:)('class membership' class inheritsFromAnyIn: isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass)('comparing' = closeTo: hash identityHashPrintString literalEqual: ~=)('converting' adaptToFloat:andCompare: adaptToFloat:andSend: adaptToFraction:andCompare: adaptToFraction:andSend: adaptToInteger:andCompare: adaptToInteger:andSend: adaptToScaledDecimal:andCompare: adaptToScaledDecimal:andSend: as: asOrderedCollection asSetElement asString asStringOrText changeClassTo: complexContents mustBeBoolean mustBeBooleanIn: printDirectlyToDisplay withoutListWrapper)('copying' copy copyAddedStateFrom: copyFrom: copySameFrom: copyTwoLevel deepCopy initialDeepCopierSize postCopy shallowCopy veryDeepCopy veryDeepCopyUsing: veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:)('debugging' evaluate:wheneverChangeIn: haltIf: haltOnceIf: meetsHaltCondition: needsWork)('debugging-haltOnce' checkHaltCountExpired clearHaltOnce decrementAndCheckHaltCount decrementHaltCount doExpiredHaltCount doExpiredHaltCount: doExpiredInspectCount halt:onCount: haltIfNil haltOnCount: haltOnce haltOnce: haltOnceEnabled hasHaltCount inspectOnCount: inspectOnce inspectUntilCount: removeHaltCount setHaltCountTo: setHaltOnce toggleHaltOnce)('dependents access' addDependent: breakDependents canDiscardEdits dependents hasUnacceptedEdits myDependents myDependents: release removeDependent:)('drag and drop' acceptDroppingMorph:event:inMorph: dragPassengerFor:inMorph: dragStartedFor:transferMorph: dragTransferTypeForMorph: wantsDroppedMorph:event:inMorph:)('error handling' assert: assert:description: assert:descriptionBlock: backwardCompatibilityOnly: caseError deprecated deprecated: deprecated:block: doesNotUnderstand: dpsTrace: dpsTrace:levels: dpsTrace:levels:withContext: error error: halt halt: handles: notify: notify:at: primitiveFailed primitiveFailed: shouldBeImplemented shouldNotImplement subclassResponsibility traitConflict)('evaluating' value valueWithArguments:)('filter streaming' byteEncode: drawOnCanvas: elementSeparator encodePostscriptOn: flattenOnStream: fullDrawPostscriptOn: putOn: writeOnFilterStream:)('flagging' isThisEverCalled isThisEverCalled: logEntry logExecution logExit)('graph model' addModelYellowButtonMenuItemsTo:forMorph:hand: hasModelYellowButtonMenuItems)('macpal' codeStrippedOut: contentsChanged flash instanceVariableValues objectRepresented refusesToAcceptCode)('message handling' executeMethod: perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:with:with:with:with: perform:with:with:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: perform:withEnoughArguments: with:executeMethod: with:with:executeMethod: with:with:with:executeMethod: with:with:with:with:executeMethod: withArgs:executeMethod:)('objects from disk' comeFullyUpOnReload: convertToCurrentVersion:refStream: fixUponLoad:seg: objectForDataStream: readDataFrom:size: saveOnFile saveOnFileNamed: storeDataOn:)('printing' fullPrintString isLiteral longPrintOn: longPrintOn:limitedTo:indent: longPrintString longPrintStringLimitedTo: nominallyUnsent: printOn: printString printStringLimitedTo: printWithClosureAnalysisOn: reportableSize storeOn: storeString stringForReadout stringRepresentation)('system primitives' asOop become: becomeForward: becomeForward:copyHash: className creationStamp instVarAt: instVarAt:put: instVarNamed: instVarNamed:put: oopString primitiveChangeClassTo: rootStubInImageSegment: someObject)('testing' isArray isBehavior isBlock isBoolean isCharacter isClassReference isClosure isCodeReference isCollection isColor isColorForm isCompiledCode isCompiledCodeClass isCompiledMethod isComplex isContext isDictionary isFloat isForm isFraction isHeap isInteger isInterval isMessageSend isMethodContext isMethodProperties isMethodReference isMor ph isMorphicEvent isMorphicModel isNumber isPoint isPromise isRectangle isScaledDecimal isSketchMorph isStream isString isSymbol isSystemWindow isText isTextView isTrait isTransparent isVariableBinding isWebBrowser isWindowForModel: knownName name nameForViewer renameTo: shouldBePrintedAsLiteral shouldBePrintedAsLiteralVisiting: showDiffs stepAt:in: stepIn: stepTime stepTimeIn: vocabularyDemanded wantsDiffFeedback wantsSteps wantsStepsIn:)('updating' changed changed: changed:with: handledListVerification noteSelectionIndex:for: okToChange okToClose update: update:with: updateListsAndCodeIn: windowIsClosing)('user interface' addModelItemsToWindowMenu: addModelMenuItemsTo:forMorph:hand: asExplorerString defaultLabelForInspector launchPartVia: launchPartVia:label: launchTileToRefer modelSleep modelWakeUp modelWakeUpIn: mouseUpBalk: notYetImplemented windowActiveOnFirstClick windowReqNewLabel:)('*monticello' isConflict)('*system-support' isPrimitiveError systemNavigation)('*Tools-Ex plorer' explore exploreWithLabel:)('*tools-browser' browseHierarchy)('private' errorImproperStore errorNonIntegerIndex errorNotIndexable errorSubscriptBounds: setPinned: species storeAt:inTempFrame:)('thumbnail' iconOrThumbnailOfSize:)('*Morphic-Explorer' explorerContents hasContentsInExplorer)('futures' future future: futureDo:at:args: futureSend:at:args:)('*Tools-MessageSets' browseAllCallsOn: browseAllCallsOn:requestor: browseAllImplementorsOf: browseAllImplementorsOf:requestor:)('*Tools-multi-window support' canHaveUnacceptedEdits)('*morphic' asMorph asStringMorph asTextMorph isPluggableListMorph openAsMorph)('tracing' inboundPointers inboundPointersExcluding: outboundPointers outboundPointersDo:)('*Tools-Debugger' canonicalArgumentName chasePointers explorePointers shouldFollowOutboundPointers)('*System-Object Events-accessing' actionForEvent: actionForEvent:ifAbsent: actionMap actionSequenceForEvent: actionsDo: createActionMap hasActionForEvent: setActionSequence:forEvent: updateableActionMap)('*System-Change Notification-events' actionsWithReceiver:forEvent: renameActionsWithReceiver:forEvent:toEvent:)('*System-Change Notification-converting' asActionSequence asActionSequenceTrappingErrors)('*System-Tools-breakpoint' break)('*ToolBuilder-Kernel-error handling' confirm: confirm:orCancel:)('*ToolBuilder-Kernel-user interface' inform:)('*System-Support-user interface' initialExtent)('*System-Localization-locales' localeChanged localeChangedGently translatedNoop)('*System-Object Events-accessing-removing' releaseActionMap removeAction:forEvent: removeActionsForEvent: removeActionsSatisfying: removeActionsSatisfying:forEvent: removeActionsWithReceiver: removeActionsWithReceiver:forEvent:)('*System-Object Events-accessing-triggering' triggerEvent: triggerEvent:ifNotHandled: triggerEvent:with: triggerEvent:with:ifNotHandled: triggerEvent:withArguments: triggerEvent:withArguments:ifNotHandled:)('*System-Object Events-accessing-registering' when:evalua te: when:send:to: when:send:to:with: when:send:to:withArguments:)('*Traits' explicitRequirement requirement)('*Graphics-KernelExtensions' fullScreenSize)('*System-Finalization' actAsExecutor executor finalizationRegistry finalize hasMultipleExecutors retryWithGC:until: toFinalizeSend:to:with:)('*collections' asLink compareSafely:)('*Tools-Browsing' browse)('*System-Recovery-error handling' primitiveError:)('*SUnit-testing' isTestClass)('*Morphic-Events-Filtering' filterEvent:for:)('*System-Preferences' applyUserInterfaceTheme canApplyUserInterfaceTheme userInterfaceTheme)('*Tools' environment)('pinning' isPinned pin unpin)('literals' allLiteralsDo: hasLiteral: hasLiteralSuchThat:)('write barrier' attemptToAssign:withIndex: beReadOnlyObject beWritableObject isReadOnlyObject setIsReadOnlyObject:)('*Tools-Inspector' basicInspect inspect inspectWithLabel: inspectorClass)('*Morphic-Kernel-accessing' currentEvent currentHand currentWorld)('*Monticello-Patching-testing' isMCPatchOperation)('*JSON' asJsonString)('*60Deprecated-accessing' ifNil:ifNotNilDo: ifNotNilDo: ifNotNilDo:ifNil:)('*MorphicExtras-Undo' capturedState commandHistory purgeAllCommands redoFromCapturedState: refineRedoTarget:selector:arguments:in: refineUndoTarget:selector:arguments:in: rememberCommand: rememberUndoableAction:named: undoFromCapturedState:)('*Protocols' currentVocabulary haveFullProtocolBrowsed haveFullProtocolBrowsedShowingSelector:)('*services-base' requestor)('*60Deprecated-copying' clone)('*60Deprecated-Tools' exploreAndYourself notifyWithLabel:)('*MorphicExtras-PartsBin' descriptionForPartsBin)!| currentChanges |currentChanges := ChangeSet current.Smalltalk globals removeKey: #References.Smalltalk globals removeKey: #CustomEventsRegistry.Smalltalk globals removeKey: #ScriptingSystem.ChangeSet newChanges: (ChangeSet new name: 'unload-etoys-more').(Smalltalk classNamed: #StandardScriptingSystem) removeFromSystem.(Smalltalk classNamed: #Presenter) removeFromSystem.(Smalltalk classNamed: #MethodHolder) removeFromSystem.(Smalltalk classNamed: #PaintInvokingMorph) removeFromSystem.(Smalltalk classNamed: #ViewerFlapTab) removeFromSystem.(Smalltalk classNamed: #AcceptableCleanTextMorph) removeFromSystem.(Smalltalk classNamed: #BrowserCommentTextMorph) removeFromSystem.(Smalltalk classNamed: #BorderedSubpaneDividerMorph) removeFromSystem.(Smalltalk classNamed: #TextFieldMorph) removeFromSystem.(Smalltalk classNamed: #KeyboardBuffer) removeFromSystem.(Smalltalk classNamed: #PluggableTabButtonMorph) removeFromSystem.(Smalltalk classNamed: #MorphWithSubmorphsWrapper) removeFromSystem.(Smalltalk classNamed: #TwoWayScrollPane) removeFromSystem.Preferences removePreference: #noviceMode.Preferences removePreference: #eToyFriendly.Preferences removePreference: #universalTiles.Preferences removePreference: #uniTilesClassic.Preferences removePreference: #tileTranslucentDrag.Preferences removePreference: #typeCheckingInTileScripting.Preferences removePreference: #compactViewerFlaps.Preferences removePreference: #viewersInFlaps.Preferences removePreference: #batchPenTrails.Preferences removePreference: #keepTickingWhilePainting.Preferences removePreference: #unlimitedPaintArea.Preferences removePreference: #mvcProjectsAllowed.Preferences removePreference: #eToyLoginEnabled.Preferences removePreference: #oliveHandleForScriptedObjects.Preferences removePreference: #dropProducesWatcher.Preferences removePreference: #automaticViewerPlacement.Preferences removePreference: #capitalizedReferences.Preferences removePreference: #fenceEnabled.Preferences removePreference: #fenceSoundEnabled.Preferences removePreference: #haloTransitions.Preferences removePreference: #selectiveHalos.Preferences removePreference: #useVectorVocabulary.Preferences removePreference: #simpleMenus.Preferences removePreference: #propertySheetFromHalo.Preferences removePreference: #menuColorFromWorld.Preferences removePreference: #enableVirtualOLPCDisplay.Preferences removePreference: #enablePortraitMode.Preferences removePreference: #magicHalos.Preferences removePreference: #tabAmongFields.Preferences removePreference: #sugarAutoSave.Preferences removePreference: #showAdvancedNavigatorButtons.FileServices removeObsolete.ChangeSet newChanges: currentChanges.ChangeSet newChanges: (ChangeSet new name: 'clean-up-categories').SystemChangeNotifier uniqueInstance doSilently: [Smalltalk allClassesDo: [:cls | cls organization renameCategory: 'stepping and presenter' toBe: 'stepping']].Smalltalk removeEmptyMessageCategories.ChangeSet newChanges: currentChanges.Preferences resetHaloSpecifications.TheWorldMainDockingBar updateInstances.Flaps initializeFlapsQuads; initializeStandardFlaps.Vocabulary initializeStandardVocabularies.UserInterfaceTheme cleanUpAndReset."Next: Remove Etoys package from update map."!
Hi Christoph,
The idea is to compare the trunk image to the trunk-without-etoys image, where trunk-without-etoys is the result of running Marcel's script.
Methods that exist only in the trunk image are assumed to be used only by Etoys, and are categorized under *Etoys.
Methods that are identical in both images are assumed to belong in trunk, and are moved out of Etoys.
Methods (and class definitions) that exist in both images but are different are set aside for future refactoring.
For example, #wantsHalo may or may not be a method of general interest for trunk, but since it is never used in trunk-without-etoys, we assume that it is somehow related to Etoys usage and does not need to be in trunk.
Certainly many of these category changes will turn out to be wrong, but it's a start.
Dave
On 2023-12-16T21:44:42+01:00, christoph.thiede@student.hpi.uni-potsdam.de wrote:
Hi Dave, hi Marcel, hi all,
first, thank you a lot for working on this important refactoring!
I have finally found some time to take a briefly look at these changes (dtl's commits from 2023-11-25f.) and are confused by many of them. Maybe you can help me understand the overall goal? :-) These changes move many methods from other packages into the Trunk despite they are still used in these other packages. I have made a non-exhaustive list that fills about three workspaces, I will just briefly sketch two categorizes:
- Logic that IMHO belongs into a base package indeed: Morphic halo
invocation (#wantsHalo, #triggerHaloFor:after:, #removePendingHaloFor:), Morphic halo's duplicate handles, Morph>>#addMorphNearBack:, Morphic undo (MenuMorph>>#undoGrabCommand), annotation setup (docking bar > extras), ProjectLauncher startUp (afaik currently responsible for running changesets provided via command line). I am unsure about uniclasses: Should they belong into the trunk? I like to use a quick #newSubclass in different scripting/testing situations. 2. Logic that does belong to Etoys but is still intertwined with the original package. If we unload the Etoys package today, this will lead to DNUs in the trunk. Many of them might require better hooks (e.g., pragmas or registries) in the base packages. This is probably expected at the current state of making Etoys optional, but I'm listing them here for later reference anyway: Menu items in inspector/explorer (use menu pragmas consistently, introduce pragmas for keyboard shortcuts), CodeHolder>>#restoreTextualCodingPane, DeepCopier>>#mapUniClasses (generic global fixup hook*), NativeImageSegment>>#rootsIncludingPlayers, several preferences (haloTransitions, captializedReferences, ...), ReleaseBuilder ebautifyEtoys, ObjectlandMorph etoysProject 2b. Logic that belongs to Etoys but abuses an unused internal hook of a base package class: MorphicModel>>#addModelYellowButtonMenuItemsTo:forMorph:hand:, PasteUpMorph>>#drawOn: - this will conflict once we decide that these classes want to use these hooks themselves, so they also would require an explicit hook in the long term.
Again, thank you a lot, and I am looking forward to talk about these questions again, in particular about the first category. :-)
Best, Christoph
Hi Dave, Hi Marcel,
On 2023-12-17T10:08:27-05:00, lewis@mail.msen.com wrote:
Hi Christoph,
The idea is to compare the trunk image to the trunk-without-etoys image, where trunk-without-etoys is the result of running Marcel's script.
Methods that exist only in the trunk image are assumed to be used only by Etoys, and are categorized under *Etoys.
Methods that are identical in both images are assumed to belong in trunk, and are moved out of Etoys.
Methods (and class definitions) that exist in both images but are different are set aside for future refactoring.
thanks for the context!
For example, #wantsHalo may or may not be a method of general interest for trunk, but since it is never used in trunk-without-etoys, we assume that it is somehow related to Etoys usage and does not need to be in trunk.
No, #wantsHalo is indeed used in the Trunk-without-etoys. See Morph>>#handleMouseEnter:. :-)
Certainly many of these category changes will turn out to be wrong, but it's a start.
So we could just move back the methods I mentioned in my previous message under point 1 to the Trunk? Who has classified them as "Etoys-only" - you or Marcel? I'm still trying to understand how this classification has been decided. :-)
Dave
On 2023-12-16T21:44:42+01:00, christoph.thiede(a)student.hpi.uni-potsdam.de wrote:
Hi Dave, hi Marcel, hi all,
first, thank you a lot for working on this important refactoring!
I have finally found some time to take a briefly look at these changes (dtl's commits from 2023-11-25f.) and are confused by many of them. Maybe you can help me understand the overall goal? :-) These changes move many methods from other packages into the Trunk despite they are still used in these other packages. I have made a non-exhaustive list that fills about three workspaces, I will just briefly sketch two categorizes:
- Logic that IMHO belongs into a base package indeed: Morphic halo
invocation (#wantsHalo, #triggerHaloFor:after:, #removePendingHaloFor:), Morphic halo's duplicate handles, Morph>>#addMorphNearBack:, Morphic undo (MenuMorph>>#undoGrabCommand), annotation setup (docking bar > extras), ProjectLauncher startUp (afaik currently responsible for running changesets provided via command line). I am unsure about uniclasses: Should they belong into the trunk? I like to use a quick #newSubclass in different scripting/testing situations. 2. Logic that does belong to Etoys but is still intertwined with the original package. If we unload the Etoys package today, this will lead to DNUs in the trunk. Many of them might require better hooks (e.g., pragmas or registries) in the base packages. This is probably expected at the current state of making Etoys optional, but I'm listing them here for later reference anyway: Menu items in inspector/explorer (use menu pragmas consistently, introduce pragmas for keyboard shortcuts), CodeHolder>>#restoreTextualCodingPane, DeepCopier>>#mapUniClasses (generic global fixup hook*), NativeImageSegment>>#rootsIncludingPlayers, several preferences (haloTransitions, captializedReferences, ...), ReleaseBuilder ebautifyEtoys, ObjectlandMorph etoysProject 2b. Logic that belongs to Etoys but abuses an unused internal hook of a base package class: MorphicModel>>#addModelYellowButtonMenuItemsTo:forMorph:hand:, PasteUpMorph>>#drawOn: - this will conflict once we decide that these classes want to use these hooks themselves, so they also would require an explicit hook in the long term.
Again, thank you a lot, and I am looking forward to talk about these questions again, in particular about the first category. :-)
Best, Christoph
Best, Christoph
--- Sent from Squeak Inbox Talk
Hi Christoph,
When I said "trunk-without-etoys" I meant a trunk image after running Marcel's unload-etoys script. This is quite different from what you will see if you just remove the Etoys package from trunk.
For the example of #wantsHalo, here are the steps to reproduce:
1) Start with trunk image Squeak6.1alpha-22743-64bit.zip
https://files.squeak.org/trunk/Squeak6.1alpha-22743-64bit/
2) In that image, run the unload-etoys.33.cs change set (attachment to Marcel's email of 29-Aug-2023):
https://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfoun...
This is now a "trunk-without-etoys" image.
3) Look for senders of #wantsHalo. There are none.
4) Look at Morph>>handleMouseEnter: to confirm that it no longer sends #wantsHalo. The method history shows that this is one of many refactorings that Marcel did to clean up the separation of Etoys.
Dave
On 2023-12-26 17:41, christoph.thiede@student.hpi.uni-potsdam.de wrote:
Hi Dave, Hi Marcel,
On 2023-12-17T10:08:27-05:00, lewis@mail.msen.com wrote:
Hi Christoph,
The idea is to compare the trunk image to the trunk-without-etoys image, where trunk-without-etoys is the result of running Marcel's script.
Methods that exist only in the trunk image are assumed to be used only by Etoys, and are categorized under *Etoys.
Methods that are identical in both images are assumed to belong in trunk, and are moved out of Etoys.
Methods (and class definitions) that exist in both images but are different are set aside for future refactoring.
thanks for the context!
For example, #wantsHalo may or may not be a method of general interest for trunk, but since it is never used in trunk-without-etoys, we assume that it is somehow related to Etoys usage and does not need to be in trunk.
No, #wantsHalo is indeed used in the Trunk-without-etoys. See Morph>>#handleMouseEnter:. :-)
Certainly many of these category changes will turn out to be wrong, but it's a start.
So we could just move back the methods I mentioned in my previous message under point 1 to the Trunk? Who has classified them as "Etoys-only" - you or Marcel? I'm still trying to understand how this classification has been decided. :-)
Dave
On 2023-12-16T21:44:42+01:00, christoph.thiede(a)student.hpi.uni-potsdam.de wrote:
Hi Dave, hi Marcel, hi all,
first, thank you a lot for working on this important refactoring!
I have finally found some time to take a briefly look at these changes (dtl's commits from 2023-11-25f.) and are confused by many of them. Maybe you can help me understand the overall goal? :-) These changes move many methods from other packages into the Trunk despite they are still used in these other packages. I have made a non-exhaustive list that fills about three workspaces, I will just briefly sketch two categorizes:
- Logic that IMHO belongs into a base package indeed: Morphic halo
invocation (#wantsHalo, #triggerHaloFor:after:, #removePendingHaloFor:), Morphic halo's duplicate handles, Morph>>#addMorphNearBack:, Morphic undo (MenuMorph>>#undoGrabCommand), annotation setup (docking bar > extras), ProjectLauncher startUp (afaik currently responsible for running changesets provided via command line). I am unsure about uniclasses: Should they belong into the trunk? I like to use a quick #newSubclass in different scripting/testing situations. 2. Logic that does belong to Etoys but is still intertwined with the original package. If we unload the Etoys package today, this will lead to DNUs in the trunk. Many of them might require better hooks (e.g., pragmas or registries) in the base packages. This is probably expected at the current state of making Etoys optional, but I'm listing them here for later reference anyway: Menu items in inspector/explorer (use menu pragmas consistently, introduce pragmas for keyboard shortcuts), CodeHolder>>#restoreTextualCodingPane, DeepCopier>>#mapUniClasses (generic global fixup hook*), NativeImageSegment>>#rootsIncludingPlayers, several preferences (haloTransitions, captializedReferences, ...), ReleaseBuilder ebautifyEtoys, ObjectlandMorph etoysProject 2b. Logic that belongs to Etoys but abuses an unused internal hook of a base package class: MorphicModel>>#addModelYellowButtonMenuItemsTo:forMorph:hand:, PasteUpMorph>>#drawOn: - this will conflict once we decide that these classes want to use these hooks themselves, so they also would require an explicit hook in the long term.
Again, thank you a lot, and I am looking forward to talk about these questions again, in particular about the first category. :-)
Best, Christoph
Best, Christoph
_Sent from __Squeak Inbox Talk [1]_
Links: ------ [1] https://github.com/hpi-swa-lab/squeak-inbox-talk
Hi Dave,
thank you for this clarification! Now I can better understand your changes. I was just confused by the process in which these changes are integrated into the trunk, but I guess this is fine since it could mean that we are committing to making trunk-without-etoys reality before the next release. :-)
Best, Christoph
--- Sent from Squeak Inbox Talk
On 2023-12-26T18:57:06+00:00, lewis@mail.msen.com wrote:
Hi Christoph,
When I said "trunk-without-etoys" I meant a trunk image after running Marcel's unload-etoys script. This is quite different from what you will see if you just remove the Etoys package from trunk.
For the example of #wantsHalo, here are the steps to reproduce:
- Start with trunk image Squeak6.1alpha-22743-64bit.zip
https://files.squeak.org/trunk/Squeak6.1alpha-22743-64bit/
- In that image, run the unload-etoys.33.cs change set (attachment to
Marcel's email of 29-Aug-2023):
https://lists.squeakfoundation.org/archives/list/squeak-dev(a)lists.squeakfo...
This is now a "trunk-without-etoys" image.
Look for senders of #wantsHalo. There are none.
Look at Morph>>handleMouseEnter: to confirm that it no longer sends
#wantsHalo. The method history shows that this is one of many refactorings that Marcel did to clean up the separation of Etoys.
Dave
On 2023-12-26 17:41, christoph.thiede(a)student.hpi.uni-potsdam.de wrote:
Hi Dave, Hi Marcel,
On 2023-12-17T10:08:27-05:00, lewis(a)mail.msen.com wrote:
Hi Christoph,
The idea is to compare the trunk image to the trunk-without-etoys image, where trunk-without-etoys is the result of running Marcel's script.
Methods that exist only in the trunk image are assumed to be used only by Etoys, and are categorized under *Etoys.
Methods that are identical in both images are assumed to belong in trunk, and are moved out of Etoys.
Methods (and class definitions) that exist in both images but are different are set aside for future refactoring.
thanks for the context!
For example, #wantsHalo may or may not be a method of general interest for trunk, but since it is never used in trunk-without-etoys, we assume that it is somehow related to Etoys usage and does not need to be in trunk.
No, #wantsHalo is indeed used in the Trunk-without-etoys. See Morph>>#handleMouseEnter:. :-)
Certainly many of these category changes will turn out to be wrong, but it's a start.
So we could just move back the methods I mentioned in my previous message under point 1 to the Trunk? Who has classified them as "Etoys-only" - you or Marcel? I'm still trying to understand how this classification has been decided. :-)
Dave
On 2023-12-16T21:44:42+01:00, christoph.thiede(a)student.hpi.uni-potsdam.de wrote:
Hi Dave, hi Marcel, hi all,
first, thank you a lot for working on this important refactoring!
I have finally found some time to take a briefly look at these changes (dtl's commits from 2023-11-25f.) and are confused by many of them. Maybe you can help me understand the overall goal? :-) These changes move many methods from other packages into the Trunk despite they are still used in these other packages. I have made a non-exhaustive list that fills about three workspaces, I will just briefly sketch two categorizes:
- Logic that IMHO belongs into a base package indeed: Morphic halo
invocation (#wantsHalo, #triggerHaloFor:after:, #removePendingHaloFor:), Morphic halo's duplicate handles, Morph>>#addMorphNearBack:, Morphic undo (MenuMorph>>#undoGrabCommand), annotation setup (docking bar > extras), ProjectLauncher startUp (afaik currently responsible for running changesets provided via command line). I am unsure about uniclasses: Should they belong into the trunk? I like to use a quick #newSubclass in different scripting/testing situations. 2. Logic that does belong to Etoys but is still intertwined with the original package. If we unload the Etoys package today, this will lead to DNUs in the trunk. Many of them might require better hooks (e.g., pragmas or registries) in the base packages. This is probably expected at the current state of making Etoys optional, but I'm listing them here for later reference anyway: Menu items in inspector/explorer (use menu pragmas consistently, introduce pragmas for keyboard shortcuts), CodeHolder>>#restoreTextualCodingPane, DeepCopier>>#mapUniClasses (generic global fixup hook*), NativeImageSegment>>#rootsIncludingPlayers, several preferences (haloTransitions, captializedReferences, ...), ReleaseBuilder ebautifyEtoys, ObjectlandMorph etoysProject 2b. Logic that belongs to Etoys but abuses an unused internal hook of a base package class: MorphicModel>>#addModelYellowButtonMenuItemsTo:forMorph:hand:, PasteUpMorph>>#drawOn: - this will conflict once we decide that these classes want to use these hooks themselves, so they also would require an explicit hook in the long term.
Again, thank you a lot, and I am looking forward to talk about these questions again, in particular about the first category. :-)
Best, Christoph
Best, Christoph
_Sent from __Squeak Inbox Talk [1]_
Links:
If I were to sketch out a high level project plan for "make Etoys separable" it might look like this:
(X) Figure out how to make a trunk-without-etoys image from existing trunk (Marcel) - Recode methods and some classes - Remove Etoys related preferences - Remove Etoys related globals - Remove as many methods and classes as possible (X) Separate all methods and classes that do not require refactoring (Dave) - Identify differences between trunk and trunk-without-etoys (using Montecello packages) - Move Etoys only classes and methods to Etoys package extensions (committed to trunk) - Move Etoys things to base packages if used in the trunk-without-etoys image (committed to trunk) (_) Refactor the hard stuff (methods and classes that differ between trunk and trunk-without-etoys) - Identify classes and methods requiring refactoring (done by Dave but not published to list) - Refactor methods (lots of them, many may be easy, some will be hard) - Refactor classes that have Etoys only instance variables - If class shapes change, make image segments and project imports work (_) Clean up preferences and globals (probably from Marcel's script) (_) Make Etoys unloading work (without ongoing support as trunk changes) - Make unloading script (possibly a much simpler version of Marcel's original) - Make the tests pass after unloading (_) Extra credit - make Etoys reloading work - Verify that package(s) can be loaded - Figure out how to restore state (non-code things lost in the removal) - Make tests pass again - Worlds of Squeak, Etoys return to life
If this makes sense maybe we can put it on a swiki page and let people check the boxes as we make progress.
Dave
On Sat, Dec 30 2023 at 04:44:50 PM +0100, christoph.thiede@student.hpi.uni-potsdam.de wrote:
Hi Dave,
thank you for this clarification! Now I can better understand your changes. I was just confused by the process in which these changes are integrated into the trunk, but I guess this is fine since it could mean that we are committing to making trunk-without-etoys reality before the next release. :-)
Best, Christoph
/Sent from//_Squeak Inbox Talk_ https://github.com/hpi-swa-lab/squeak-inbox-talk/
On 2023-12-26T18:57:06+00:00, lewis@mail.msen.com wrote:
Hi Christoph,
When I said "trunk-without-etoys" I meant a trunk image after
running
Marcel's unload-etoys script. This is quite different from what
you will
see if you just remove the Etoys package from trunk.
For the example of #wantsHalo, here are the steps to reproduce:
- Start with trunk image Squeak6.1alpha-22743-64bit.zip
https://files.squeak.org/trunk/Squeak6.1alpha-22743-64bit/
- In that image, run the unload-etoys.33.cs change set
(attachment to
Marcel's email of 29-Aug-2023):
https://lists.squeakfoundation.org/archives/list/squeak-dev(a)lists.squeakfo...
This is now a "trunk-without-etoys" image.
Look for senders of #wantsHalo. There are none.
Look at Morph>>handleMouseEnter: to confirm that it no longer
sends
#wantsHalo. The method history shows that this is one of many refactorings that Marcel did to clean up the separation of Etoys.
Dave
On 2023-12-26 17:41, christoph.thiede(a)student.hpi.uni-potsdam.de
wrote:
Hi Dave, Hi Marcel,
On 2023-12-17T10:08:27-05:00, lewis(a)mail.msen.com wrote:
Hi Christoph,
The idea is to compare the trunk image to the
trunk-without-etoys
image, where trunk-without-etoys is the result of running Marcel's
script.
Methods that exist only in the trunk image are assumed to be
used only
by Etoys, and are categorized under *Etoys.
Methods that are identical in both images are assumed to belong
in
trunk, and are moved out of Etoys.
Methods (and class definitions) that exist in both images but
are
different are set aside for future refactoring.
thanks for the context!
For example, #wantsHalo may or may not be a method of general
interest
for trunk, but since it is never used in trunk-without-etoys, we assume that it is somehow related to Etoys usage and does not need to
be in
trunk.
No, #wantsHalo is indeed used in the Trunk-without-etoys. See Morph>>#handleMouseEnter:. :-)
Certainly many of these category changes will turn out to be
wrong,
but it's a start.
So we could just move back the methods I mentioned in my previous message under point 1 to the Trunk? Who has classified them as "Etoys-only" - you or Marcel? I'm still trying to understand how
this
classification has been decided. :-)
Dave
On 2023-12-16T21:44:42+01:00, christoph.thiede(a)student.hpi.uni-potsdam.de wrote:
Hi Dave, hi Marcel, hi all,
first, thank you a lot for working on this important
refactoring!
I have finally found some time to take a briefly look at these changes (dtl's commits from 2023-11-25f.) and are confused by many of
them.
Maybe you can help me understand the overall goal? :-) These
changes
move many methods from other packages into the Trunk despite
they are
still used in these other packages. I have made a
non-exhaustive list
that fills about three workspaces, I will just briefly sketch
two
categorizes:
- Logic that IMHO belongs into a base package indeed: Morphic
halo
invocation (#wantsHalo, #triggerHaloFor:after:, #removePendingHaloFor:), Morphic halo's duplicate handles, Morph>>#addMorphNearBack:, Morphic undo (MenuMorph>>#undoGrabCommand), annotation setup (docking bar > extras), ProjectLauncher
startUp
(afaik currently responsible for running changesets provided via
command
line). I am unsure about uniclasses: Should they belong into
the
trunk? I like to use a quick #newSubclass in different
scripting/testing
situations. 2. Logic that does belong to Etoys but is still intertwined
with the
original package. If we unload the Etoys package today, this
will
lead to DNUs in the trunk. Many of them might require better hooks
(e.g.,
pragmas or registries) in the base packages. This is probably expected at the current state of making Etoys optional, but I'm listing
them
here for later reference anyway: Menu items in
inspector/explorer
(use menu pragmas consistently, introduce pragmas for keyboard
shortcuts),
CodeHolder>>#restoreTextualCodingPane,
DeepCopier>>#mapUniClasses
(generic global fixup hook*), NativeImageSegment>>#rootsIncludingPlayers, several preferences (haloTransitions, captializedReferences, ...), ReleaseBuilder ebautifyEtoys, ObjectlandMorph etoysProject 2b. Logic that belongs to Etoys but abuses an unused internal
hook of
a base package class: MorphicModel>>#addModelYellowButtonMenuItemsTo:forMorph:hand:, PasteUpMorph>>#drawOn: - this will conflict once we decide
that these
classes want to use these hooks themselves, so they also would require an explicit hook in the long term.
Again, thank you a lot, and I am looking forward to talk about
these
questions again, in particular about the first category. :-)
Best, Christoph
Best, Christoph
_Sent from __Squeak Inbox Talk [1]_
Links:
Thank you for the excellent overview! If it's not too hard, I would add that it would be nice if we could support unloading Etoys at each release of Squeak. We could test this on the CI.
Best, Christoph
--- Sent from Squeak Inbox Talk
On 2023-12-30T12:19:18-06:00, lewis@mail.msen.com wrote:
If I were to sketch out a high level project plan for "make Etoys separable" it might look like this:
(X) Figure out how to make a trunk-without-etoys image from existing trunk (Marcel)
- Recode methods and some classes
- Remove Etoys related preferences
- Remove Etoys related globals
- Remove as many methods and classes as possible
(X) Separate all methods and classes that do not require refactoring (Dave)
- Identify differences between trunk and trunk-without-etoys
(using Montecello packages)
- Move Etoys only classes and methods to Etoys package
extensions (committed to trunk)
- Move Etoys things to base packages if used in the
trunk-without-etoys image (committed to trunk) (_) Refactor the hard stuff (methods and classes that differ between trunk and trunk-without-etoys)
- Identify classes and methods requiring refactoring (done by
Dave but not published to list)
- Refactor methods (lots of them, many may be easy, some will be
hard)
- Refactor classes that have Etoys only instance variables
- If class shapes change, make image segments and project
imports work (_) Clean up preferences and globals (probably from Marcel's script) (_) Make Etoys unloading work (without ongoing support as trunk changes)
- Make unloading script (possibly a much simpler version of
Marcel's original)
- Make the tests pass after unloading
(_) Extra credit - make Etoys reloading work
- Verify that package(s) can be loaded
- Figure out how to restore state (non-code things lost in the
removal)
- Make tests pass again
- Worlds of Squeak, Etoys return to life
If this makes sense maybe we can put it on a swiki page and let people check the boxes as we make progress.
Dave
On Sat, Dec 30 2023 at 04:44:50 PM +0100, christoph.thiede(a)student.hpi.uni-potsdam.de wrote:
Hi Dave,
thank you for this clarification! Now I can better understand your changes. I was just confused by the process in which these changes are integrated into the trunk, but I guess this is fine since it could mean that we are committing to making trunk-without-etoys reality before the next release. :-)
Best, Christoph
/Sent from//_Squeak Inbox Talk_ https://github.com/hpi-swa-lab/squeak-inbox-talk/
On 2023-12-26T18:57:06+00:00, lewis(a)mail.msen.com wrote:
Hi Christoph,
When I said "trunk-without-etoys" I meant a trunk image after
running
Marcel's unload-etoys script. This is quite different from what
you will
see if you just remove the Etoys package from trunk.
For the example of #wantsHalo, here are the steps to reproduce:
- Start with trunk image Squeak6.1alpha-22743-64bit.zip
https://files.squeak.org/trunk/Squeak6.1alpha-22743-64bit/
- In that image, run the unload-etoys.33.cs change set
(attachment to
Marcel's email of 29-Aug-2023):
https://lists.squeakfoundation.org/archives/list/squeak-dev(a)lists.squeakfo...
This is now a "trunk-without-etoys" image.
Look for senders of #wantsHalo. There are none.
Look at Morph>>handleMouseEnter: to confirm that it no longer
sends
#wantsHalo. The method history shows that this is one of many refactorings that Marcel did to clean up the separation of Etoys.
Dave
On 2023-12-26 17:41, christoph.thiede(a)student.hpi.uni-potsdam.de
wrote:
Hi Dave, Hi Marcel,
On 2023-12-17T10:08:27-05:00, lewis(a)mail.msen.com wrote:
Hi Christoph,
The idea is to compare the trunk image to the
trunk-without-etoys
image, where trunk-without-etoys is the result of running Marcel's
script.
Methods that exist only in the trunk image are assumed to be
used only
by Etoys, and are categorized under *Etoys.
Methods that are identical in both images are assumed to belong
in
trunk, and are moved out of Etoys.
Methods (and class definitions) that exist in both images but
are
different are set aside for future refactoring.
thanks for the context!
For example, #wantsHalo may or may not be a method of general
interest
for trunk, but since it is never used in trunk-without-etoys, we assume that it is somehow related to Etoys usage and does not need to
be in
trunk.
No, #wantsHalo is indeed used in the Trunk-without-etoys. See Morph>>#handleMouseEnter:. :-)
Certainly many of these category changes will turn out to be
wrong,
but it's a start.
So we could just move back the methods I mentioned in my previous message under point 1 to the Trunk? Who has classified them as "Etoys-only" - you or Marcel? I'm still trying to understand how
this
classification has been decided. :-)
Dave
On 2023-12-16T21:44:42+01:00, christoph.thiede(a)student.hpi.uni-potsdam.de wrote:
Hi Dave, hi Marcel, hi all,
first, thank you a lot for working on this important
refactoring!
I have finally found some time to take a briefly look at these changes (dtl's commits from 2023-11-25f.) and are confused by many of
them.
Maybe you can help me understand the overall goal? :-) These
changes
move many methods from other packages into the Trunk despite
they are
still used in these other packages. I have made a
non-exhaustive list
that fills about three workspaces, I will just briefly sketch
two
categorizes:
- Logic that IMHO belongs into a base package indeed: Morphic
halo
invocation (#wantsHalo, #triggerHaloFor:after:, #removePendingHaloFor:), Morphic halo's duplicate handles, Morph>>#addMorphNearBack:, Morphic undo (MenuMorph>>#undoGrabCommand), annotation setup (docking bar > extras), ProjectLauncher
startUp
(afaik currently responsible for running changesets provided via
command
line). I am unsure about uniclasses: Should they belong into
the
trunk? I like to use a quick #newSubclass in different
scripting/testing
situations. 2. Logic that does belong to Etoys but is still intertwined
with the
original package. If we unload the Etoys package today, this
will
lead to DNUs in the trunk. Many of them might require better hooks
(e.g.,
pragmas or registries) in the base packages. This is probably expected at the current state of making Etoys optional, but I'm listing
them
here for later reference anyway: Menu items in
inspector/explorer
(use menu pragmas consistently, introduce pragmas for keyboard
shortcuts),
CodeHolder>>#restoreTextualCodingPane,
DeepCopier>>#mapUniClasses
(generic global fixup hook*), NativeImageSegment>>#rootsIncludingPlayers, several preferences (haloTransitions, captializedReferences, ...), ReleaseBuilder ebautifyEtoys, ObjectlandMorph etoysProject 2b. Logic that belongs to Etoys but abuses an unused internal
hook of
a base package class: MorphicModel>>#addModelYellowButtonMenuItemsTo:forMorph:hand:, PasteUpMorph>>#drawOn: - this will conflict once we decide
that these
classes want to use these hooks themselves, so they also would require an explicit hook in the long term.
Again, thank you a lot, and I am looking forward to talk about
these
questions again, in particular about the first category. :-)
Best, Christoph
Best, Christoph
_Sent from __Squeak Inbox Talk [1]_
Links:
squeak-dev@lists.squeakfoundation.org