The Inbox: Morphic-ct.1499.mcz

A new version of Morphic was added to project The Inbox:
http://source.squeak.org/inbox/Morphic-ct.1499.mcz

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

Name: Morphic-ct.1499
Author: ct
Time: 9 August 2019, 5:36:07.127365 pm
UUID: 386c9557-ae1e-1744-925e-4060156f1add
Ancestors: Morphic-ct.1496, Morphic-mt.1498

Handle insert key to avoid an invisible character being displayed

Complements ST80-ct.237.

=============== Diff against Morphic-mt.1498 ===============

Item was changed:
  ----- Method: Editor class>>specialShiftCmdKeys (in category 'keyboard shortcut tables') -----
  specialShiftCmdKeys
 
  "Private - return array of key codes that represent single keys acting
  as if shift-command were also being pressed"
 
  ^#(
  1 "home"
  3 "enter"
  4 "end"
+ 5 "insert"
  8 "backspace"
  11 "page up"
  12 "page down"
  27 "escape"
  28 "left arrow"
  29 "right arrow"
  30 "up arrow"
  31 "down arrow"
  127 "delete"
  )!

Item was changed:
  ----- Method: Morph>>addFlexShell (in category 'rotate scale and flex') -----
  addFlexShell
  "Wrap a rotating and scaling shell around this morph."
 
  | oldHalo myWorld flexMorph anIndex |
+
  oldHalo:= self halo.
  myWorld := self world.
  self owner
  ifNil: [flexMorph := self newTransformationMorph asFlexOf: self]
  ifNotNil: [:myOwner |
  anIndex := myOwner submorphIndexOf: self.
+ flexMorph := self newTransformationMorph asFlexOf: self.
- "Avoid triggering outOfWorld: on self by first adding flexMorph to myOwner and only then making myself a submorph of flexMorph via asFlexOf:"
- flexMorph := self newTransformationMorph.
  myOwner addMorph: flexMorph asElementNumber: anIndex.
- flexMorph asFlexOf: self.
  myWorld ifNotNil: [myWorld startSteppingSubmorphsOf: flexMorph]].
  self transferStateToRenderer: flexMorph.
  oldHalo ifNotNil: [oldHalo setTarget: flexMorph].
 
  ^ flexMorph!

Item was changed:
  ScrollPane subclass: #PluggableTextMorph
+ instanceVariableNames: 'textMorph getTextSelector setTextSelector getSelectionSelector hasUnacceptedEdits askBeforeDiscardingEdits selectionInterval hasEditingConflicts editTextSelector wantsWrapBorder'
- instanceVariableNames: 'textMorph getTextSelector setTextSelector getSelectionSelector hasUnacceptedEdits hasUserEdited askBeforeDiscardingEdits selectionInterval hasEditingConflicts editTextSelector wantsWrapBorder'
  classVariableNames: 'AdornmentCache SimpleFrameAdornments SoftLineWrap VisualWrapBorder VisualWrapBorderLimit'
  poolDictionaries: ''
  category: 'Morphic-Pluggable Widgets'!

Item was changed:
+ ----- Method: PluggableTextMorph>>hasUnacceptedEdits (in category 'dependents access') -----
- ----- Method: PluggableTextMorph>>hasUnacceptedEdits (in category 'unaccepted edits') -----
  hasUnacceptedEdits
  "Return true if this view has unaccepted edits."
 
  ^ hasUnacceptedEdits!

Item was changed:
  ----- Method: PluggableTextMorph>>hasUnacceptedEdits: (in category 'unaccepted edits') -----
+ hasUnacceptedEdits: aBoolean
+ "Set the hasUnacceptedEdits flag to the given value. "
+ aBoolean == hasUnacceptedEdits ifFalse:
+ [hasUnacceptedEdits := aBoolean.
- hasUnacceptedEdits: wasJustEdited
-
- wasJustEdited = hasUnacceptedEdits ifFalse: [
- hasUnacceptedEdits := wasJustEdited.
  self changed].
+ aBoolean ifFalse: [hasEditingConflicts := false]!
-
- wasJustEdited
- ifTrue: [self hasUserEdited: true]
- ifFalse: [self hasEditingConflicts: false].!

Item was removed:
- ----- Method: PluggableTextMorph>>hasUserEdited (in category 'unaccepted edits') -----
- hasUserEdited
-
- ^ hasUserEdited!

Item was removed:
- ----- Method: PluggableTextMorph>>hasUserEdited: (in category 'unaccepted edits') -----
- hasUserEdited: aBoolean
-
- hasUserEdited := aBoolean.!

Item was changed:
  ----- Method: PluggableTextMorph>>update: (in category 'updating') -----
  update: aSymbol
  aSymbol ifNil: [^self].
  aSymbol == #flash ifTrue: [^self flash].
 
  aSymbol == getTextSelector
  ifTrue: [
  self setText: self getText.
  getSelectionSelector
  ifNotNil: [self setSelection: self getSelection].
  ^ self].
  aSymbol == getSelectionSelector
  ifTrue: [^self setSelection: self getSelection].
 
  aSymbol == #acceptChanges ifTrue: [^ self accept].
  aSymbol == #revertChanges ifTrue: [^ self cancel].
 
  (aSymbol == #autoSelect and: [getSelectionSelector notNil])
  ifTrue:
  [self handleEdit:
  [(textMorph editor)
  abandonChangeText; "no replacement!!"
  setSearch: model autoSelectString;
+ findAgain]].
- findAgainNow "do not reset search string"]].
  aSymbol == #clearUserEdits ifTrue: [^self hasUnacceptedEdits: false].
  aSymbol == #wantToChange
  ifTrue:
  [self canDiscardEdits ifFalse: [^self promptForCancel].
  ^self].
  aSymbol == #appendEntry
  ifTrue:
  [self handleEdit: [self appendEntry].
  ^self refreshWorld].
  aSymbol == #appendEntryLater
  ifTrue: [self handleEdit: [self appendEntry]].
  aSymbol == #clearText
  ifTrue:
  [self handleEdit: [self changeText: Text new].
  ^self refreshWorld].
  aSymbol == #bs
  ifTrue:
  [self handleEdit: [self bsText].
  ^self refreshWorld].
  aSymbol == #codeChangedElsewhere
  ifTrue:
  [self hasEditingConflicts: true.
  ^self changed].
  aSymbol == #saveContents
  ifTrue:
  [^self saveContentsInFile].
  aSymbol == #showContents
  ifTrue:
  [^ self scrollToTop].
  !

Item was changed:
  ----- Method: SearchBar>>smartSearch:in: (in category 'searching') -----
  smartSearch: text in: morph
  "Take the user input and perform an appropriate search"
  | input newContents |
  self removeResultsWidget.
  input := text asString ifEmpty:[^self].
  self class useSmartSearch ifFalse: [^ ToolSet default browseMessageNames: input].
 
  "If it is a global or a full class name, browse that class."
  (Smalltalk bindingOf: input) ifNotNil:[:assoc| | global |
  global := assoc value.
  ^ToolSet browse: (global isBehavior ifTrue:[global] ifFalse:[global class]) selector: nil].
 
  "If it is a symbol and there are implementors of it, browse those implementors."
+ (Symbol lookup: input) ifNotNil: [:selector |
- Symbol hasInterned: input ifTrue: [:selector |
  (SystemNavigation new allImplementorsOf: selector) ifNotEmpty:[:list|
  ^SystemNavigation new
  browseMessageList: list
  name: 'Implementors of ' , input]].
 
  "If it starts uppercase, browse classes if any. Otherwise, just search for messages."
  input first isUppercase
  ifTrue: [
  (UIManager default classFromPattern: input withCaption: '')
  ifNotNil:[:aClass| ^ToolSet browse: aClass selector: nil]
  ifNil: [
  newContents := input, ' -- not found.'.
  self searchTerm: newContents.
  self selection: (input size+1 to: newContents size).
  self currentHand newKeyboardFocus: morph textMorph.
  ^ self]]
  ifFalse: [
  ToolSet default browseMessageNames: input].!

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>addMorphsTo:from:allowSorting:withExpandedItems:atLevel: (in category 'private') -----
  addMorphsTo: morphList from: aCollection allowSorting: sortBoolean withExpandedItems: expandedItems atLevel: newIndent
 
  | priorMorph newCollection firstAddition |
  priorMorph := nil.
  newCollection := (sortBoolean and: [sortingSelector notNil]) ifTrue: [
  aCollection sorted: [ :a :b |
  (a perform: sortingSelector) <= (b perform: sortingSelector)]
  ] ifFalse: [
  aCollection
  ].
  firstAddition := nil.
  newCollection do: [:item |
  priorMorph := self indentingItemClass basicNew
  initWithContents: item
  prior: priorMorph
  forList: self
  indentLevel: newIndent.
  priorMorph
+ color: (priorMorph color ifNil: [self textColor]);
- color: self textColor;
  font: self font;
  selectionColor: self selectionColor;
  selectionTextColor: self selectionTextColor;
  hoverColor: self hoverColor;
  highlightTextColor: self highlightTextColor;
  filterColor: self filterColor;
  filterTextColor: self filterTextColor.
  firstAddition ifNil: [firstAddition := priorMorph].
  morphList add: priorMorph.
  ((item hasEquivalentIn: expandedItems) or: [priorMorph isExpanded]) ifTrue: [
  priorMorph isExpanded: true.
  priorMorph
  addChildrenForList: self
  addingTo: morphList
  withExpandedItems: expandedItems.
  ].
  ].
  ^firstAddition
 
  !

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>addSubmorphsAfter:fromCollection:allowSorting: (in category 'private') -----
  addSubmorphsAfter: parentMorph fromCollection: aCollection allowSorting: sortBoolean
 
  | priorMorph morphList newCollection |
  priorMorph := nil.
  newCollection := (sortBoolean and: [sortingSelector notNil]) ifTrue: [
  aCollection sorted: [ :a :b |
  (a perform: sortingSelector) <= (b perform: sortingSelector)]
  ] ifFalse: [
  aCollection
  ].
  morphList := OrderedCollection new.
  newCollection do: [:item |
  priorMorph := self indentingItemClass basicNew
  initWithContents: item
  prior: priorMorph
  forList: self
  indentLevel: parentMorph indentLevel + 1.
  priorMorph
+ color: (priorMorph color ifNil: [self textColor]);
- color: self textColor;
  font: self font;
  selectionColor: self selectionColor;
  selectionTextColor: self selectionTextColor;
  hoverColor: self hoverColor;
  highlightTextColor: self highlightTextColor;
  filterColor: self filterColor;
  filterTextColor: self filterTextColor.
  morphList add: priorMorph.
  ].
  scroller addAllMorphs: morphList after: parentMorph.
  ^morphList
 
  !

Item was changed:
  TextEditor subclass: #SmalltalkEditor
+ instanceVariableNames: 'styler'
- instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Morphic-Text Support'!
 
  !SmalltalkEditor commentStamp: 'jmv 8/8/2009 15:10' prior: 0!
  The editor built specifically for Smalltalk code!

Item was changed:
  ----- Method: SmalltalkEditor>>changeEmphasis: (in category 'editing keys') -----
  changeEmphasis: characterStream
  "Change emphasis without styling if necessary"
+ styler ifNil: [^super changeEmphasis: characterStream].
+ ^styler evaluateWithoutStyling: [super changeEmphasis: characterStream].!
- self styler ifNil: [^super changeEmphasis: characterStream].
- ^ self styler evaluateWithoutStyling: [super changeEmphasis: characterStream].!

Item was changed:
  ----- Method: SmalltalkEditor>>emphasisExtras (in category 'editing keys') -----
  emphasisExtras
  ^#(
  'Do it'
+ 'Print it'
- 'Print it'
- 'Style it'
  'Link to comment of class'
  'Link to definition of class'
  'Link to hierarchy of class'
  'Link to method'
  'URL Link'
  ).!

Item was changed:
  ----- Method: SmalltalkEditor>>handleEmphasisExtra:with: (in category 'editing keys') -----
  handleEmphasisExtra: index with: aKeyboardEvent
  "Handle an extra emphasis menu item"
  | action attribute thisSel |
  action := {
  [attribute := TextDoIt new.
  thisSel := attribute analyze: self selection].
  [attribute := TextPrintIt new.
  thisSel := attribute analyze: self selection].
- [thisSel := self styleSelection].
  [attribute := TextLink new.
  thisSel := attribute analyze: self selection asString with: 'Comment'].
  [attribute := TextLink new.
  thisSel := attribute analyze: self selection asString with: 'Definition'].
  [attribute := TextLink new.
  thisSel := attribute analyze: self selection asString with: 'Hierarchy'].
  [attribute := TextLink new.
  thisSel := attribute analyze: self selection asString].
  [attribute := TextURL new.
  thisSel := attribute analyze: self selection asString].
  ["Edit hidden info"
  thisSel := self hiddenInfo. "includes selection"
  attribute := TextEmphasis normal].
  ["Copy hidden info"
  self copyHiddenInfo.
  ^true]. "no other action"
  } at: index.
  action value.
 
+ thisSel ifNil: [^true]. "Could not figure out what to link to"
- thisSel ifNil: [^ true]. "Could not figure out what to link to"
 
+ attribute ifNotNil: [
+ thisSel ifEmpty:[ | oldAttributes |
- (thisSel isEmpty and: [attribute notNil])
- ifTrue: [
- | oldAttributes |
  "only change emphasisHere while typing"
  oldAttributes := paragraph text attributesAt: self pointIndex.
+ emphasisHere := Text addAttribute: attribute toArray: oldAttributes.
+ ] ifNotEmpty: [
+ self replaceSelectionWith: (thisSel asText addAttribute: attribute).
+ ]
+ ].
+ ^true!
- emphasisHere := Text addAttribute: attribute toArray: oldAttributes]
- ifFalse: [
- self replaceSelectionWith: (attribute ifNil: [thisSel] ifNotNil: [thisSel asText addAttribute: attribute]) ].
- ^ true!

Item was removed:
- ----- Method: SmalltalkEditor>>styleIt (in category 'do-its') -----
- styleIt
-
- ^ self styleSelection!

Item was removed:
- ----- Method: SmalltalkEditor>>styleSelection (in category 'do-its') -----
- styleSelection
-
- | styler |
- self lineSelectAndEmptyCheck: [^ ''].
- styler := self styler ifNil: [(Smalltalk classNamed: #SHTextStylerST80) new].
- ^ styler styledTextFor: self selection!

Item was changed:
  ----- Method: SmalltalkEditor>>styler (in category 'accessing') -----
  styler
  "Answers the styler for this editor. Only code editors support syntax highlighting"
+ ^styler
- ^ self morph editView styler
  !

Item was added:
+ ----- Method: SmalltalkEditor>>styler: (in category 'accessing') -----
+ styler: aStyler
+ "Sets the styler for this editor. Only code editors support syntax highlighting"
+ ^styler := aStyler!

Item was changed:
  ----- Method: StandardScriptingSystem class>>cleanUp: (in category 'class initialization') -----
  cleanUp: agressive
  "Clean up unreferenced players. If agressive, reinitialize and nuke players"
 
  self removeUnreferencedPlayers.
  agressive ifTrue:[
  References keys do: [:k | References removeKey: k].
- ClassVarNamesInUse := nil.
  self initialize.
  ].!

Item was changed:
  ----- Method: SyntaxError class>>buildMorphicViewOn: (in category '*Morphic-Support') -----
  buildMorphicViewOn: aSyntaxError
  "Answer an Morphic view on the given SyntaxError."
  | window |
  window := (SystemWindow labelled: 'Syntax Error') model: aSyntaxError.
 
  window addMorph: (PluggableListMorph on: aSyntaxError list: #list
  selected: #listIndex changeSelected: nil menu: #listMenu:)
  frame: (0@0 corner: 1@0.15).
 
  window addMorph: ((PluggableTextMorphPlus on: aSyntaxError text: #contents
  accept: #contents:notifying: readSelection: #contentsSelection
  menu: #codePaneMenu:shifted:)
+ useDefaultStyler;
+ in: [ :morph | " Ugly hack, to restyle our contents. "
+ morph setText: morph textMorph text asString asText ];
- useDefaultStyler; updateStyleNow;
  selectionInterval: aSyntaxError errorMessageInterval;
  yourself)
  frame: (0@0.15 corner: 1@1).
 
  ^ window openInWorldExtent: 380@220!

Item was added:
+ ----- Method: TextEditor>>cursorInsert: (in category 'nonediting/nontyping keys') -----
+ cursorInsert: aKeyboardEvent
+
+ "Catch character, but do nothing"
+ ^ true!

Item was changed:
  ----- Method: TextEditor>>referencesToIt (in category 'menu messages') -----
  referencesToIt
  "Open a MessageSet with the references to the selected global or variable name."
  | selection environment binding |
  self selection isEmpty ifTrue: [ self selectWord ].
  environment := (model respondsTo: #selectedClassOrMetaClass)
  ifTrue: [ model selectedClassOrMetaClass ifNil: [ model environment ] ]
  ifFalse: [ model environment ].
  selection := self selectedSymbol ifNil: [ self selection asString ].
  (environment isBehavior and:
  [ (environment
  instVarIndexFor: selection
  ifAbsent: [ 0 ]) ~= 0 ]) ifTrue: [ ^ self systemNavigation
  browseAllAccessesTo: selection
  from: environment ].
  selection isSymbol ifFalse: [ ^ morph flash ].
  binding := (environment bindingOf: selection) ifNil: [ ^ morph flash ].
+ self systemNavigation browseAllCallsOn: binding!
-
- self systemNavigation browseAllCallsOnClass: binding.!

Item was changed:
  ----- Method: TextMorphForEditView>>keyStroke: (in category 'event handling') -----
  keyStroke: evt
  | view |
 
  editView deleteBalloon.
  self editor model: editView model.  "For evaluateSelection"
  view := editView.  "Copy into temp for case of a self-mutating doit"
  (acceptOnCR and: [evt keyCharacter = Character cr])
  ifTrue: [^ self editor accept].
-
- view hasUserEdited: false.
  super keyStroke: evt.
  view scrollSelectionIntoView.
 
+ "Make a cheap check and guess editing. (Alternative would be to copy the old contents and then compare them against the new ones. Maybe add a better hook in the TextEditor."
+ (self readOnly not and: [self eventCharacterModifiesText: evt keyCharacter])
+ ifTrue: [view textEdited: self contents]!
- view hasUserEdited
- ifTrue: [ view textEdited: self contents].!