The Trunk: ST80-ar.58.mcz

Andreas Raab uploaded a new version of ST80 to project The Trunk:
http://source.squeak.org/trunk/ST80-ar.58.mcz

==================== Summary ====================

Name: ST80-ar.58
Author: ar
Time: 13 October 2009, 8:13:39 am
UUID: c00e3a31-0aec-5947-8c22-73aed16d9b52
Ancestors: ST80-mha.57

Promote ValueHolder and StringHolder to be a Kernel (instead of an ST80) entity. Enables support for Model-based Tools without having MVC loaded.

=============== Diff against ST80-mha.57 ===============

Item was changed:
  Object subclass: #ControlManager
  instanceVariableNames: 'scheduledControllers activeController activeControllerProcess screenController newTopClicked'
  classVariableNames: ''
  poolDictionaries: ''
+ category: 'ST80-Controllers'!
- category: 'ST80-Kernel-Remnants'!
 
  !ControlManager commentStamp: '<historical>' prior: 0!
  I represent the top level control over scheduling which controller of a view on the screen the user is actively using. ScheduledControllers is the global reference to an instance of me, the one attached to the Project currently being used.!

Item was changed:
  Controller subclass: #ScreenController
  instanceVariableNames: ''
  classVariableNames: 'LastScreenModeSelected'
  poolDictionaries: ''
+ category: 'ST80-Controllers'!
- category: 'ST80-Kernel-Remnants'!
 
  !ScreenController commentStamp: '<historical>' prior: 0!
  I am the controller for the parts of the display screen that have no view on them. I only provide a standard yellow button menu. I view (a FormView of) an infinite gray form.  (ScheduledControllers screenController) is the way to find me.!

Item was changed:
  Controller subclass: #MouseMenuController
  instanceVariableNames: 'redButtonMenu redButtonMessages'
  classVariableNames: ''
  poolDictionaries: ''
+ category: 'ST80-Controllers'!
- category: 'ST80-Kernel-Remnants'!
 
  !MouseMenuController commentStamp: '<historical>' prior: 0!
  I am a Controller that modifies the scheduling of user activities so that the three mouse buttons can be used to make selections or display menus. The menu items are unary messages to the value of sending my instance the message menuMessageReceiver.!

Item was changed:
  MouseMenuController subclass: #ScrollController
  instanceVariableNames: 'scrollBar marker savedArea menuBar savedMenuBarArea'
  classVariableNames: ''
  poolDictionaries: ''
+ category: 'ST80-Controllers'!
- category: 'ST80-Kernel-Remnants'!
 
  !ScrollController commentStamp: '<historical>' prior: 0!
  I represent control for scrolling using a scrollBar. I am a MouseMenuController that creates a scrollBar, rather than menus. My subclasses add the button menus. I keep control as long as the cursor is inside the view or the scrollBar area.
 
  A scrollBar is a rectangular area representing the length of the information being viewed. It contains an inner rectangle whose top y-coordinate represents the relative position of the information visible on the screen with respect to all of the information, and whose size represents the relative amount of that information visible on the screen. The user controls which part of the information is visible by pressing the red button. If the cursor is to the right of the inner rectangle, the window onto the visible information moves upward, if the cursor is to the left, the window moves downward, and if the cursor is inside, the inner rectangle is grabbed and moved to a desired position.!

Item was changed:
  SystemOrganization addCategory: #'ST80-Editors'!
  SystemOrganization addCategory: #'ST80-Framework'!
+ SystemOrganization addCategory: #'ST80-Controllers'!
- SystemOrganization addCategory: #'ST80-Kernel-Remnants'!
  SystemOrganization addCategory: #'ST80-Menus'!
  SystemOrganization addCategory: #'ST80-Menus-Tests'!
  SystemOrganization addCategory: #'ST80-Paths'!
  SystemOrganization addCategory: #'ST80-Pluggable Views'!
  SystemOrganization addCategory: #'ST80-Support'!
  SystemOrganization addCategory: #'ST80-Support-Tests'!
  SystemOrganization addCategory: #'ST80-Symbols'!
  SystemOrganization addCategory: #'ST80-Views'!

Item was changed:
  Object subclass: #Controller
  instanceVariableNames: 'model view sensor deferredActionQueue lastActivityTime'
  classVariableNames: 'MinActivityLapse'
  poolDictionaries: ''
+ category: 'ST80-Controllers'!
- category: 'ST80-Kernel-Remnants'!
 
  !Controller commentStamp: '<historical>' prior: 0!
  A Controller coordinates a View, its model, and user actions. It provides scheduling (control) behavior to determine when the user wants to communicate with the model or view.!

Item was removed:
- ----- Method: StringHolder>>wantsOptionalButtons (in category 'optional panes') -----
- wantsOptionalButtons
- "Answer whether the receiver, seen in some browser window, would like to have the so-called optional button pane included.  By default, various browsers defer to the global preference 'optionalButtons' -- but individual subclasses can insist to the contrary."
-
- ^ Preferences optionalButtons!

Item was removed:
- ----- Method: Clipboard>>setInterpreter (in category 'accessing') -----
- setInterpreter
-
- interpreter := LanguageEnvironment defaultClipboardInterpreter.
- interpreter ifNil: [
- "Should never be reached, but just in case."
- interpreter := NoConversionClipboardInterpreter new].
- !

Item was removed:
- ----- Method: Clipboard class>>clipboardText (in category 'accessing') -----
- clipboardText "Clipboard clipboardText"
- ^self default clipboardText.!

Item was removed:
- ----- Method: Clipboard>>primitiveClipboardText: (in category 'primitives') -----
- primitiveClipboardText: aString
- "Set the current clipboard text to the given string."
-
- <primitive: 141>
- "don't fail if the primitive is not implemented"!

Item was removed:
- ----- Method: Clipboard>>chooseRecentClipping (in category 'accessing') -----
- chooseRecentClipping  "Clipboard chooseRecentClipping"
- "Choose by menu from among the recent clippings"
-
- recent ifNil: [^ nil].
- ^ UIManager default
- chooseFrom: (recent collect: [:txt | ((txt asString contractTo: 50)
- copyReplaceAll: Character cr asString with: '\')
- copyReplaceAll: Character tab asString with: '|'])
- values: recent!

Item was removed:
- ----- Method: Clipboard>>primitiveClipboardText (in category 'primitives') -----
- primitiveClipboardText
- "Get the current clipboard text. Return the empty string if the primitive fails."
- <primitive: 141>
- ^ ''!

Item was removed:
- ----- Method: StringHolder>>contents: (in category 'accessing') -----
- contents: textOrString
- "Set textOrString to be the contents of the receiver."
-
- contents := textOrString "asString"!

Item was removed:
- ----- Method: StringHolder>>clearUserEditFlag (in category 'user edits') -----
- clearUserEditFlag
- "Clear the hasUnacceptedEdits flag in all my dependent views."
-
- self changed: #clearUserEdits!

Item was removed:
- ----- Method: StringHolder>>buildWindowWith: (in category 'toolbuilder') -----
- buildWindowWith: builder
- | windowSpec |
- windowSpec := builder pluggableWindowSpec new.
- windowSpec model: self.
- windowSpec label: #labelString.
- windowSpec children: OrderedCollection new.
- ^windowSpec!

Item was removed:
- ----- Method: Clipboard class>>default (in category 'accessing') -----
- default
- ^Default ifNil:[Default := self new].!

Item was removed:
- ----- Method: Clipboard>>interpreter (in category 'accessing') -----
- interpreter
-
- interpreter ifNil: [self setInterpreter].
- ^ interpreter.
- !

Item was removed:
- ----- Method: StringHolder>>openSyntaxView (in category 'tiles') -----
- openSyntaxView
- "Open a syntax view on the current method"
-
- | class selector |
-
- (selector := self selectedMessageName) ifNotNil: [
- class := self selectedClassOrMetaClass.
- SyntaxMorph testClass: class andMethod: selector.
- ]!

Item was removed:
- ----- Method: StringHolder>>defaultContents (in category 'initialize-release') -----
- defaultContents
-
- ^''!

Item was removed:
- ----- Method: StringHolder>>buildCodePaneWith: (in category 'toolbuilder') -----
- buildCodePaneWith: builder
- | textSpec |
- textSpec := builder pluggableTextSpec new.
- textSpec
- model: self;
- getText: #contents;
- setText: #contents:notifying:;
- selection: #contentsSelection;
- menu: #codePaneMenu:shifted:.
- ^textSpec!

Item was removed:
- ----- Method: Clipboard>>clipboardText: (in category 'accessing') -----
- clipboardText: text
-
- | string |
- string := text asString.
- self noteRecentClipping: text asText.
- contents := text asText.
- string := self interpreter toSystemClipboard: string.
- self primitiveClipboardText: string.
- !

Item was removed:
- ----- Method: StringHolder class>>windowColorSpecification (in category 'window color') -----
- windowColorSpecification
- "Answer a WindowColorSpec object that declares my preference"
-
- ^ WindowColorSpec classSymbol: self name wording: 'Workspace' brightColor: #lightYellow pastelColor: #paleYellow helpMessage: 'A place for text in a window.'!

Item was removed:
- ----- Method: ValueHolder>>contents: (in category 'as yet unclassified') -----
- contents: newContents
- contents := newContents.
- self contentsChanged!

Item was removed:
- ----- Method: Clipboard class>>clearInterpreters (in category 'class initialization') -----
- clearInterpreters
-
- self allInstances do: [:each | each clearInterpreter].
- !

Item was removed:
- ----- Method: StringHolder>>noteAcceptanceOfCodeFor: (in category 'accessing') -----
- noteAcceptanceOfCodeFor: aSelector
- "A method has possibly been submitted for the receiver with aSelector as its selector; If the receiver wishes to take soem action here is a chance for it to do so"
- !

Item was removed:
- ----- Method: Clipboard>>noteRecentClipping: (in category 'private') -----
- noteRecentClipping: text
- "Keep most recent clippings in a queue for pasteRecent (paste... command)"
- text isEmpty ifTrue: [^ self].
- text size > 50000 ifTrue: [^ self].
- (recent includes: text) ifTrue: [^ self].
- recent addFirst: text.
- [recent size > 5] whileTrue: [recent removeLast].
- !

Item was removed:
- ----- Method: StringHolder>>codePaneMenu:shifted: (in category 'code pane menu') -----
- codePaneMenu: aMenu shifted: shifted
- "Fill in the given menu with additional items. The menu is prepoulated with the 'standard' text commands that the editor supports. Note that unless we override perform:orSendTo:, the editor will respond to all menu items in a text pane"
- ^self class codePaneMenu: aMenu shifted: shifted!

Item was removed:
- ----- Method: Clipboard class>>clipboardText: (in category 'accessing') -----
- clipboardText: aText
- ^self default clipboardText: aText!

Item was removed:
- ----- Method: StringHolder>>buildWith: (in category 'toolbuilder') -----
- buildWith: builder
- | windowSpec |
- windowSpec := self buildWindowWith: builder specs: {
- (0@0corner: 1@1) -> [self buildCodePaneWith: builder].
- }.
- ^builder build: windowSpec!

Item was removed:
- ----- Method: StringHolder>>spawn: (in category 'code pane menu') -----
- spawn: contentsString
-
- UIManager default edit: contentsString label: 'Workspace'
- !

Item was removed:
- ----- Method: StringHolder>>classCommentIndicated (in category 'accessing') -----
- classCommentIndicated
- "Answer true iff we're viewing the class comment."
- ^false!

Item was removed:
- ----- Method: StringHolder>>selectedMessageName (in category 'accessing') -----
- selectedMessageName
-
- ^ nil!

Item was removed:
- ----- Method: Clipboard class>>startUp (in category 'class initialization') -----
- startUp
-
- self clearInterpreters.
- !

Item was removed:
- ----- Method: StringHolder>>doItReceiver (in category 'evaluation') -----
- doItReceiver
- "Answer the object that should be informed of the result of evaluating a
- text selection."
-
- ^nil!

Item was removed:
- ----- Method: StringHolder>>wantsAnnotationPane (in category 'optional panes') -----
- wantsAnnotationPane
- "Answer whether the receiver, seen in some browser window, would like to have the so-called  annotationpane included.  By default, various browsers defer to the global preference 'optionalButtons' -- but individual subclasses can insist to the contrary."
-
- ^ Preferences annotationPanes!

Item was removed:
- ----- Method: StringHolder>>openLabel: (in category 'initialize-release') -----
- openLabel: aString
- "Create a standard system view of the model, me, a StringHolder and open it.  If in mvc, terminate the active controller so that the new window will immediately be activated."
- ^ToolBuilder open: self label: aString!

Item was removed:
- Object subclass: #Clipboard
- instanceVariableNames: 'contents recent interpreter'
- classVariableNames: 'Default'
- poolDictionaries: ''
- category: 'ST80-Kernel-Remnants'!
-
- !Clipboard commentStamp: '<historical>' prior: 0!
- The Clipboard class implements a basic buffering scheme for text. The currently selected text is also exported to the OS so that text can be copied from and to other applications. Commonly only a single instance is used (the default clipboard) but applications are free to use other than the default clipboard if necessary.!

Item was removed:
- ----- Method: StringHolder>>optionalButtonPairs (in category 'toolbuilder') -----
- optionalButtonPairs
- "Answer a tuple (formerly pairs) defining buttons, in the format:
- button label
- selector to send
- help message"
- ^#()!

Item was removed:
- ----- Method: StringHolder>>selectedClassOrMetaClass (in category 'accessing') -----
- selectedClassOrMetaClass
-
- ^ self selectedClass "I don't know any better"!

Item was removed:
- ----- Method: StringHolder class>>codePaneMenu:shifted: (in category 'yellow button menu') -----
- codePaneMenu: aMenu shifted: shifted
- "Utility method for the 'standard' codePane menu"
- aMenu addList: (shifted
- ifTrue:[self shiftedYellowButtonMenuItems]
- ifFalse:[self yellowButtonMenuItems]).
- ^aMenu!

Item was removed:
- Model subclass: #StringHolder
- instanceVariableNames: 'contents'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'ST80-Kernel-Remnants'!
-
- !StringHolder commentStamp: '<historical>' prior: 0!
- I am a kind of Model that includes a piece of text.  In some cases, the text can be edited, and in some the text is a method.
-
- Categories 'code pane menu' and 'message list menu' are messages that may be called by my menus when the text is a method, and when some pane is a list of methods.  Other of my subclasses may ignore these two catagories altogether.!

Item was removed:
- ----- Method: Clipboard class>>chooseRecentClipping (in category 'accessing') -----
- chooseRecentClipping  "Clipboard chooseRecentClipping"
- "Choose by menu from among the recent clippings"
- ^self default chooseRecentClipping!

Item was removed:
- ----- Method: StringHolder>>doItContext (in category 'evaluation') -----
- doItContext
- "Answer the context in which a text selection can be evaluated."
-
- ^nil!

Item was removed:
- ----- Method: StringHolder class>>shiftedYellowButtonMenuItems (in category 'yellow button menu') -----
- shiftedYellowButtonMenuItems
- "Returns the standard yellow button menu items"
- ^{
- {'explain' translated. #explain}.
- {'pretty print' translated. #prettyPrint}.
- {'pretty print with color' translated. #prettyPrintWithColor}.
- {'file it in (G)' translated. #fileItIn}.
- {'tiles from it' translated. #selectionAsTiles}.
- {'spawn (o)' translated. #spawn}.
- #-.
- {'browse it (b)' translated. #browseIt}.
- {'senders of it (n)' translated. #sendersOfIt}.
- {'implementors of it (m)' translated. #implementorsOfIt}.
- {'references to it (N)' translated. #referencesToIt}.
- #-.
- {'selectors containing it (W)' translated. #methodNamesContainingIt}.
- {'method strings with it (E)' translated. #methodStringsContainingit}.
- {'method source with it' translated. #methodSourceContainingIt}.
- {'class names containing it' translated. #classNamesContainingIt}.
- {'class comments with it' translated. #classCommentsContainingIt}.
- {'change sets with it' translated. #browseChangeSetsWithSelector}.
- #-.
- {'save contents to file...' translated. #saveContentsInFile}.
- {'send contents to printer' translated. #sendContentsToPrinter}.
- {'printer setup' translated. #printerSetup}.
- #-.
- {'special menu...' translated. #presentSpecialMenu}.
- {'more...' translated. #yellowButtonActivity}.
- }!

Item was removed:
- ----- Method: StringHolder>>okToChange (in category 'user edits') -----
- okToChange
-
- self canDiscardEdits ifTrue: [^ true].
- self changed: #wantToChange.  "Solicit cancel from view"
- ^ self canDiscardEdits
- !

Item was removed:
- ----- Method: StringHolder class>>openLabel: (in category 'instance creation') -----
- openLabel: aString
-
- self new openLabel: aString!

Item was removed:
- ----- Method: StringHolder>>contents:notifying: (in category 'code pane menu') -----
- contents: aString notifying: aController
- "Accept text"
- ^self acceptContents: aString!

Item was removed:
- ----- Method: StringHolder>>initialize (in category 'initialize-release') -----
- initialize
- "Initialize the state of the receiver with its default contents."
-
- contents := self defaultContents.
- !

Item was removed:
- ----- Method: StringHolder>>annotation (in category 'toolbuilder') -----
- annotation
- ^''!

Item was removed:
- ----- Method: StringHolder>>perform:orSendTo: (in category 'code pane menu') -----
- perform: selector orSendTo: otherTarget
- "Selector was just chosen from a menu by a user.  If can respond, then
- perform it on myself. If not, send it to otherTarget, presumably the
- editPane from which the menu was invoked."
-
- (self respondsTo: selector)
- ifTrue: [^ self perform: selector]
- ifFalse: [^ otherTarget perform: selector]!

Item was removed:
- ----- Method: StringHolder>>acceptContents: (in category 'accessing') -----
- acceptContents: aString
- "Set aString to be the contents of the receiver.  Return true cuz happy"
-
- self contents: aString.
- ^ true!

Item was removed:
- ----- Method: StringHolder class>>open (in category 'instance creation') -----
- open
- (Smalltalk at: #Workspace ifAbsent:[self]) new openLabel: 'Workspace'
- "Not to be confused with our own class var 'Workspace'"!

Item was removed:
- ----- Method: StringHolder>>labelString (in category 'toolbuilder') -----
- labelString
- ^self class name!

Item was removed:
- ----- Method: StringHolder>>reformulateListNoting: (in category 'accessing') -----
- reformulateListNoting: newSelector
- "A method has possibly been submitted for the receiver with newSelector as its selector; If the receiver has a way of reformulating its message list, here is a chance for it to do so"
-
- ^ self reformulateList!

Item was removed:
- ----- Method: Clipboard>>initialize (in category 'initialize') -----
- initialize
- contents := '' asText.
- recent := OrderedCollection new.!

Item was removed:
- ----- Method: StringHolder class>>initialize (in category 'class initialization') -----
- initialize
- "The class variables were initialized once, and subsequently filled with
- information. Re-executing this method is therefore dangerous."
-
- "workSpace := StringHolder new"
-
- "StringHolder initialize"!

Item was removed:
- ----- Method: Clipboard>>clearInterpreter (in category 'accessing') -----
- clearInterpreter
-
- interpreter := nil.
- !

Item was removed:
- ----- Method: StringHolder>>contents (in category 'accessing') -----
- contents
- "Answer the contents that the receiver is holding--presumably a string."
-
- ^contents!

Item was removed:
- ----- Method: StringHolder>>textContents: (in category 'accessing') -----
- textContents: aStringOrText
- "Set aStringOrText to be the contents of the receiver."
-
- contents := aStringOrText!

Item was removed:
- ----- Method: Clipboard class>>default: (in category 'accessing') -----
- default: aClipboard
- "So that clients can switch between different default clipboards"
- Default := aClipboard.!

Item was removed:
- Model subclass: #ValueHolder
- instanceVariableNames: 'contents'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'ST80-Kernel-Remnants'!

Item was removed:
- ----- Method: StringHolder>>buildOptionalButtonsWith: (in category 'toolbuilder') -----
- buildOptionalButtonsWith: builder
-
- | panelSpec buttonSpec |
- panelSpec := builder pluggablePanelSpec new.
- panelSpec children: OrderedCollection new.
- self optionalButtonPairs do:[:spec|
- buttonSpec := builder pluggableActionButtonSpec new.
- buttonSpec model: self.
- buttonSpec label: spec first.
- buttonSpec action: spec second.
- spec size > 2 ifTrue:[buttonSpec help: spec third].
- panelSpec children add: buttonSpec.
- ].
- panelSpec layout: #horizontal. "buttons"
- ^panelSpec!

Item was removed:
- ----- Method: Clipboard>>clipboardText (in category 'accessing') -----
- clipboardText
- "Return the text currently in the clipboard. If the system clipboard is empty, or if it differs from the Smalltalk clipboard text, use the Smalltalk clipboard. This is done since (a) the Mac clipboard gives up on very large chunks of text and (b) since not all platforms support the notion of a clipboard."
-
- | string decodedString |
- string := self primitiveClipboardText withSqueakLineEndings.
- (string isEmpty
- or: [string = contents asString])
- ifTrue: [^ contents].
- decodedString := self interpreter fromSystemClipboard: string.
- ^ decodedString = contents asString
- ifTrue: [contents]
- ifFalse: [decodedString asText].
- !

Item was removed:
- ----- Method: StringHolder>>showBytecodes (in category 'code pane menu') -----
- showBytecodes
- "We don't know how to do this"
-
- ^ self changed: #flash!

Item was removed:
- ----- Method: StringHolder class>>yellowButtonMenuItems (in category 'yellow button menu') -----
- yellowButtonMenuItems
- "Returns the standard yellow button menu items"
- ^{
- {'set font... (k)' translated. #offerFontMenu}.
- {'set style... (K)' translated. #changeStyle}.
- {'set alignment... (u)' translated. #chooseAlignment}.
- #-.
- {'make project link (P)' translated. #makeProjectLink}.
- #-.
- {'find...(f)' translated. #find}.
- {'find again (g)' translated. #findAgain}.
- {'set search string (h)' translated. #setSearchString}.
- #-.
- {'do again (j)' translated. #again}.
- {'undo (z)' translated. #undo}.
- #-.
- {'copy (c)' translated. #copySelection}.
- {'cut (x)' translated. #cut}.
- {'paste (v)' translated. #paste}.
- {'paste...' translated. #pasteRecent}.
- #-.
- {'do it (d)' translated. #doIt}.    
- {'print it (p)' translated. #printIt}.    
- {'inspect it (i)' translated. #inspectIt}.    
- {'explore it (I)' translated. #exploreIt}.    
- {'debug it' translated. #debugIt}.    
- {'tally it' translated. #tallyIt}.
- #-.
- {'accept (s)' translated. #accept}.
- {'cancel (l)' translated. #cancel}.
- #-.
- {'show bytecodes' translated. #showBytecodes}.
- #-.
- {'copy html' translated. #copyHtml}.
- #-.
- {'more...' translated. #shiftedTextPaneMenuRequest}.
- }!

Item was removed:
- ----- Method: ValueHolder>>contents (in category 'as yet unclassified') -----
- contents
- ^contents!

Item was removed:
- ----- Method: StringHolder>>selectedClassName (in category 'accessing') -----
- selectedClassName
- "I may know what class is currently selected"
-
- self selectedClass ifNotNil: [^ self selectedClass name].
- ^ nil!

Item was removed:
- ----- Method: StringHolder>>contentsSelection (in category 'accessing') -----
- contentsSelection
- "Return the interval of text in the code pane to select when I set the pane's contents"
-
- ^ 1 to: 0  "null selection"!

Item was removed:
- ----- Method: StringHolder>>buildWindowWith:specs: (in category 'toolbuilder') -----
- buildWindowWith: builder specs: specs
- | windowSpec rect action widgetSpec |
- windowSpec := self buildWindowWith: builder.
- specs do:[:assoc|
- rect := assoc key.
- action := assoc value.
- widgetSpec := action value.
- widgetSpec ifNotNil:[
- widgetSpec frame: rect.
- windowSpec children add: widgetSpec]].
- ^windowSpec!

Item was removed:
- ----- Method: StringHolder>>reformulateList (in category 'accessing') -----
- reformulateList
- "If the receiver has a way of reformulating its message list, here is a chance for it to do so"!