The Trunk: Morphic-cmm.372.mcz

Chris Muller uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-cmm.372.mcz

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

Name: Morphic-cmm.372
Author: cmm
Time: 3 March 2010, 3:16:59.984 pm
UUID: 7e315edd-fe3e-4733-9194-76612facf8c7
Ancestors: Morphic-cmm.371, Morphic-laza.370

Merged laza.370.

=============== Diff against Morphic-laza.370 ===============

Item was added:
+ ----- Method: AlternatePluggableListMorphOfMany>>listSelectionAt:put: (in category 'drawing') -----
+ listSelectionAt: index put: value
+ setSelectionListSelector ifNil:[^false].
+ ^model perform: setSelectionListSelector with: index with: value!

Item was added:
+ ----- Method: AlternatePluggableListMorphOfMany>>changeModelSelection:shifted:controlled: (in category 'model access') -----
+ changeModelSelection: anInteger shifted: shiftedBoolean controlled: controlledBoolean
+ "Change the model's selected item index to be anInteger."
+
+ setIndexSelector ifNotNil:
+ [ model
+ perform: setIndexSelector
+ with: anInteger
+ with: shiftedBoolean
+ with: controlledBoolean ]
+ !

Item was added:
+ ----- Method: AlternatePluggableListMorphOfMany>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: evt
+ ^ true!

Item was changed:
  ----- Method: TextEditor>>prettyPrint: (in category 'menu messages') -----
+ prettyPrint: decorated
- prettyPrint: decorated
  "Reformat the contents of the receiver's view (a Browser)."
-
  | selectedClass newText |
+ model selectedMessageName ifNil: [ ^ morph flash ].
- model selectedMessageName ifNil: [^ morph flash].
  selectedClass := model selectedClassOrMetaClass.
  newText := selectedClass compilerClass new
  format: self text
  in: selectedClass
  notifying: self
  decorated: decorated.
  newText ifNotNil:
+ [ self
+ deselect ;
+ selectInvisiblyFrom: 1
+ to: paragraph text size.
- [self deselect; selectInvisiblyFrom: 1 to: paragraph text size.
  self replaceSelectionWith: (newText asText makeSelectorBoldIn: selectedClass).
+ self selectAt: self text size + 1 ]!
- self selectAt: 1]!

Item was added:
+ ----- Method: AlternatePluggableListMorphOfMany classSide>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu: (in category 'instance creation') -----
+ on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel
+ ^ self new
+ on: anObject
+ list: listSel
+ primarySelection: getSelectionSel
+ changePrimarySelection: setSelectionSel
+ listSelection: getListSel
+ changeListSelection: setListSel
+ menu: getMenuSel
+ keystroke: #arrowKey:from: "default"!

Item was added:
+ ----- Method: AlternatePluggableListMorphOfMany>>itemSelectedAmongMultiple: (in category 'model access') -----
+ itemSelectedAmongMultiple: index
+ ^model isMessageSelectedAt: index!

Item was changed:
  ----- Method: PluggableMessageCategoryListMorph>>verifyContents (in category 'updating') -----
  verifyContents
-
  | newList existingSelection anIndex newRawList |
  (model editSelection == #editComment) ifTrue: [^ self].
  model classListIndex = 0 ifTrue: [^ self].
  newRawList := model perform: getRawListSelector.
  newRawList == priorRawList ifTrue: [^ self].  "The usual case; very fast"
  priorRawList := newRawList.
  newList := (Array with: ClassOrganizer allCategory), priorRawList.
  list = newList ifTrue: [^ self].
- self flash.  "could get annoying, but hell"
  existingSelection := self selection.
  self updateList.
  (anIndex := newList indexOf: existingSelection ifAbsent: [nil])
  ifNotNil:
  [model noteSelectionIndex: anIndex for: getListSelector.
  self selectionIndex: anIndex]
  ifNil:
  [self changeModelSelection: 0]!

Item was added:
+ ----- Method: MessageSet>>representsSameBrowseeAs: (in category '*morphic') -----
+ representsSameBrowseeAs: anotherModel
+ ^ self hasUnacceptedEdits not
+ and: [ messageList = anotherModel messageList ]!

Item was added:
+ ----- Method: SmalltalkEditor>>invokePrettyPrint: (in category 'editing keys') -----
+ invokePrettyPrint: dummy
+ self prettyPrint: false.
+ ^ true!

Item was changed:
  ----- Method: TextEditor>>implementorsOfIt (in category 'menu messages') -----
  implementorsOfIt
  "Open an implementors browser on the selected selector"
-
  | aSelector |
  self lineSelectAndEmptyCheck: [^ self].
  (aSelector := self selectedSelector) == nil ifTrue: [^ morph flash].
+ model browseAllImplementorsOf: aSelector!
- self systemNavigation browseAllImplementorsOf: aSelector!

Item was added:
+ ----- Method: AlternatePluggableListMorphOfMany classSide>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu:keystroke: (in category 'instance creation') -----
+ on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel keystroke: keyActionSel
+ ^ self new
+ on: anObject
+ list: listSel
+ primarySelection: getSelectionSel
+ changePrimarySelection: setSelectionSel
+ listSelection: getListSel
+ changeListSelection: setListSel
+ menu: getMenuSel
+ keystroke: keyActionSel!

Item was added:
+ ----- Method: AlternatePluggableListMorphOfMany>>mouseDown: (in category 'event handling') -----
+ mouseDown: event
+ | row |
+
+ event yellowButtonPressed ifTrue: [^ self yellowButtonActivity: event shiftPressed].
+
+ row := self rowAtLocation: event position.
+
+ row = 0 ifTrue: [^super mouseDown: event].
+
+ model okToChange ifFalse: [^ self].  "No change if model is locked"
+
+ "Inform model of selected item and let it toggle."
+ self
+ changeModelSelection: row
+ shifted: event shiftPressed
+ controlled: event controlKeyPressed.
+
+
+ "
+ event hand releaseMouseFocus: aMorph.
+ submorphs do: [ :each | each changed ]
+ "!

Item was added:
+ ----- Method: AlternatePluggableListMorphOfMany>>listSelectionAt: (in category 'drawing') -----
+ listSelectionAt: index
+ getSelectionListSelector ifNil:[^false].
+ ^model perform: getSelectionListSelector with: index!

Item was changed:
  ----- Method: PluggableListMorph>>verifyContents (in category 'updating') -----
  verifyContents
  "Verify the contents of the receiver, reconstituting if necessary.  Called whenever window is reactivated, to react to possible structural changes.  Also called periodically in morphic if the smartUpdating preference is true"
  | newList existingSelection anIndex oldList |
  oldList := list ifNil: [ #() ].
  newList := self getList.
+ oldList = newList ifTrue: [ ^ self ].
- ((oldList == newList) "fastest" or: [oldList = newList]) ifTrue: [^ self].
- self flash.  "list has changed beneath us; give the user a little visual feedback that the contents of the pane are being updated."
  existingSelection := self selectionIndex > 0 ifTrue: [ oldList at: self selectionIndex ] ifFalse: [ nil ].
  self updateList.
  (existingSelection notNil and: [(anIndex := list indexOf: existingSelection asStringOrText ifAbsent: [nil]) notNil])
  ifTrue:
  [model noteSelectionIndex: anIndex for: getListSelector.
  self selectionIndex: anIndex]
  ifFalse:
  [self changeModelSelection: 0]!

Item was added:
+ ----- Method: AlternatePluggableListMorphOfMany>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu:keystroke: (in category 'initialization') -----
+ on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel keystroke: keyActionSel
+ "setup a whole load of pluggability options"
+
+ getSelectionListSelector := getListSel.
+ setSelectionListSelector := setListSel.
+ self
+ on: anObject
+ list: listSel
+ selected: getSelectionSel
+ changeSelected: setSelectionSel
+ menu: getMenuSel
+ keystroke: keyActionSel!

Item was added:
+ ----- Method: AlternatePluggableListMorphOfMany>>list: (in category 'initialization') -----
+ list: listOfStrings
+ scroller removeAllMorphs.
+ list := listOfStrings ifNil: [Array new].
+ list isEmpty ifTrue: [^ self selectedMorph: nil].
+ super list: listOfStrings.
+
+ "At this point first morph is sensitized, and all morphs share same handler."
+ scroller firstSubmorph on: #mouseEnterDragging
+ send: #mouseEnterDragging:onItem:
+ to: self.
+ scroller firstSubmorph on: #mouseUp
+ send: #mouseUp:onItem:
+ to: self.
+ "This should add this behavior to the shared event handler thus affecting all items"!

Item was added:
+ PluggableListMorph subclass: #AlternatePluggableListMorphOfMany
+ instanceVariableNames: 'getSelectionListSelector setSelectionListSelector'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Morphic-Pluggable Widgets'!
+
+ !AlternatePluggableListMorphOfMany commentStamp: 'cmm 3/2/2010 14:39' prior: 0!
+ This is a multi-select list that is more conventional in its behavior than PluggableListMorphOfMany.  It utilizes a shift+click mechanism for selecting ranges, and control+click for toggling individual selections.  This list also allows fast mouse swipes without missing any message selections.!

Item was added:
+ ----- Method: AlternatePluggableListMorphOfMany>>mouseMove: (in category 'event handling') -----
+ mouseMove: event
+ "The mouse has moved, as characterized by the event provided.  Adjust the scrollbar, and alter the selection as appropriate"
+
+ | oldIndex oldVal row |
+ event position y < self top
+ ifTrue:
+ [scrollBar scrollUp: 1.
+ row := self rowAtLocation: scroller topLeft + (1 @ 1)]
+ ifFalse:
+ [row := event position y > self bottom
+ ifTrue:
+ [scrollBar scrollDown: 1.
+ self rowAtLocation: scroller bottomLeft + (1 @ -1)]
+ ifFalse: [ self rowAtLocation: event position]].
+ row = 0 ifTrue: [^super mouseDown: event].
+
+ model okToChange ifFalse: [^self]. "No change if model is locked"
+
+ "Set meaning for subsequent dragging of selection"
+ oldIndex := self getCurrentSelectionIndex.
+ oldIndex ~= 0 ifTrue: [oldVal := self listSelectionAt: oldIndex].
+ "Need to restore the old one, due to how model works, and set new one."
+ oldIndex ~= 0 ifTrue: [self listSelectionAt: oldIndex put: oldVal].
+
+ "Inform model of selected item and let it toggle."
+ self
+ changeModelSelection: row
+ shifted: true
+ controlled: event controlKeyPressed.
+ submorphs do: [:each | each changed]!

Item was added:
+ ----- Method: AlternatePluggableListMorphOfMany>>changeModelSelection: (in category 'model access') -----
+ changeModelSelection: anInteger
+ "Change the model's selected item index to be anInteger."
+
+ ^self
+ changeModelSelection: anInteger
+ shifted: Sensor shiftPressed
+ controlled: Sensor controlKeyPressed
+ !

Item was added:
+ ----- Method: AlternatePluggableListMorphOfMany>>mouseUp: (in category 'event handling') -----
+ mouseUp: event
+ "Not needed.  Overridden to do nothing."!

Item was changed:
  ----- Method: SmalltalkEditor class>>initializeShiftCmdKeyShortcuts (in category 'keyboard shortcut tables') -----
  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."
 
  "SmalltalkEditor initialize"
 
  | cmds |
  super initializeShiftCmdKeyShortcuts.
 
  cmds := #(
  $a argAdvance:
  $b browseItHere:
  $e methodStringsContainingIt:
  $f displayIfFalse:
  $g fileItIn:
  $i exploreIt:
  $n referencesToIt:
+ $s invokePrettyPrint:
  $t displayIfTrue:
  $v pasteInitials:
  $w methodNamesContainingIt:
  ).
  1 to: cmds size by: 2 do: [ :i |
  shiftCmdActions at: ((cmds at: i) asciiValue + 1) put: (cmds at: i + 1). "plain keys"
  shiftCmdActions at: ((cmds at: i) asciiValue - 32 + 1) put: (cmds at: i + 1). "shifted keys"
  shiftCmdActions at: ((cmds at: i) asciiValue - 96 + 1) put: (cmds at: i + 1). "ctrl keys"
  ].!

Item was added:
+ ----- Method: AlternatePluggableListMorphOfMany>>update: (in category 'event handling') -----
+ update: aSymbol
+ aSymbol == #allSelections ifTrue:
+ [self selectionIndex: self getCurrentSelectionIndex.
+ ^ self changed].
+ ^ super update: aSymbol!

Item was removed:
- ----- Method: MorphicProject>>currentVocabulary (in category 'protocols') -----
- currentVocabulary
- "Answer the currently-prevailing default vocabulary."
-
- ^ ActiveWorld currentVocabulary
- !