The Trunk: Kernel-ar.267.mcz

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

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

Name: Kernel-ar.267
Author: ar
Time: 13 October 2009, 8:11:45 am
UUID: a066b2fe-34d3-c241-8341-d490787d70a7
Ancestors: Kernel-ar.266

Create Kernel-Models category and 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 Kernel-ar.266 ===============

Item was added:
+ ----- 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 changed:
  Array weakSubclass: #DependentsArray
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
+ category: 'Kernel-Models'!
- category: 'Kernel-Objects'!
 
  !DependentsArray commentStamp: '<historical>' prior: 0!
  An array of (weak) dependents of some object.!

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

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: StringHolder>>defaultContents (in category 'initialize-release') -----
+ defaultContents
+
+ ^''!

Item was added:
+ ----- 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 added:
+ ----- 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 changed:
  SystemOrganization addCategory: #'Kernel-Chronology'!
  SystemOrganization addCategory: #'Kernel-Classes'!
- SystemOrganization addCategory: #'Kernel-Contexts'!
  SystemOrganization addCategory: #'Kernel-Methods'!
  SystemOrganization addCategory: #'Kernel-Numbers'!
  SystemOrganization addCategory: #'Kernel-Objects'!
  SystemOrganization addCategory: #'Kernel-Processes'!
+ SystemOrganization addCategory: #'Kernel-Models'!
- SystemOrganization addCategory: #'Kernel-ST80 Remnants'!
  SystemOrganization addCategory: #'Kernel-Tests-ClassBuilder'!

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

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

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: StringHolder>>okToChange (in category 'user edits') -----
+ okToChange
+
+ self canDiscardEdits ifTrue: [^ true].
+ self changed: #wantToChange.  "Solicit cancel from view"
+ ^ self canDiscardEdits
+ !

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

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

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

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

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

Item was changed:
  Object subclass: #Model
  instanceVariableNames: 'dependents'
  classVariableNames: ''
  poolDictionaries: ''
+ category: 'Kernel-Models'!
- category: 'Kernel-Objects'!
 
  !Model commentStamp: '<historical>' prior: 0!
  Provides a superclass for classes that function as models.  The only behavior provided is fast dependents maintenance, which bypasses the generic DependentsFields mechanism.  1/23/96 sw!

Item was added:
+ ----- 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 added:
+ ----- Method: StringHolder>>contents (in category 'accessing') -----
+ contents
+ "Answer the contents that the receiver is holding--presumably a string."
+
+ ^contents!

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

Item was changed:
  ScrollController subclass: #ParagraphEditor
  instanceVariableNames: 'paragraph startBlock stopBlock beginTypeInBlock emphasisHere initialText selectionShowing otherInterval lastParentLocation'
  classVariableNames: 'ChangeText CmdActions FindText Keyboard ShiftCmdActions UndoInterval UndoMessage UndoParagraph UndoSelection Undone'
  poolDictionaries: 'TextConstants'
+ category: 'Kernel-Models'!
- category: 'Kernel-ST80 Remnants'!
 
  !ParagraphEditor commentStamp: '<historical>' prior: 0!
  I am a Controller for editing a Paragraph. I am a kind of ScrollController, so that more text can be created for the Paragraph than can be viewed on the screen. Editing messages are sent by issuing commands from a yellow button menu or from keys on the keyboard. My instances keep control as long as the cursor is within the view when the red or yellow mouse button is pressed; they give up control if the blue button is pressed.!

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: StringHolder>>selectedClassName (in category 'accessing') -----
+ selectedClassName
+ "I may know what class is currently selected"
+
+ self selectedClass ifNotNil: [^ self selectedClass name].
+ ^ nil!

Item was added:
+ ----- 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 added:
+ ----- Method: StringHolder>>clearUserEditFlag (in category 'user edits') -----
+ clearUserEditFlag
+ "Clear the hasUnacceptedEdits flag in all my dependent views."
+
+ self changed: #clearUserEdits!

Item was added:
+ ----- 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 added:
+ ----- Method: ValueHolder>>contents: (in category 'as yet unclassified') -----
+ contents: newContents
+ contents := newContents.
+ self contentsChanged!

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: StringHolder>>spawn: (in category 'code pane menu') -----
+ spawn: contentsString
+
+ UIManager default edit: contentsString label: 'Workspace'
+ !

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: StringHolder>>selectedClassOrMetaClass (in category 'accessing') -----
+ selectedClassOrMetaClass
+
+ ^ self selectedClass "I don't know any better"!

Item was added:
+ Model subclass: #StringHolder
+ instanceVariableNames: 'contents'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Models'!
+
+ !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 added:
+ ----- Method: StringHolder>>doItContext (in category 'evaluation') -----
+ doItContext
+ "Answer the context in which a text selection can be evaluated."
+
+ ^nil!

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ Model subclass: #ValueHolder
+ instanceVariableNames: 'contents'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Models'!

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

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

Item was added:
+ ----- 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 added:
+ ----- 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"!