[squeak-dev] The Inbox: Morphic-ct.1499.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Aug 9 15:36:28 UTC 2019


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 at 0 corner: 1 at 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 at 0.15 corner: 1 at 1).
  
  	^ window openInWorldExtent: 380 at 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].!



More information about the Squeak-dev mailing list