@@ 704,8 704,7 @@ privateNewSubclassOf: newSuper from: old
methodDictionary: MethodDictionary new
format: (self computeFormat: oldMeta typeOfClass
instSize: oldMeta instVarNames size
- forSuper: newSuperMeta
- ccIndex: 0);
+ forSuper: newSuperMeta);
setInstVarNames: oldMeta instVarNames;
organization: oldMeta organization.
"Recompile the meta class"
@@ 1,4 1,4 @@
-'From Haver6.3 [latest update: #6169] on 26 January 2024 at 10:01:15 pm'!
+'From Haver6.3 [latest update: #6200] on 29 January 2024 at 10:43:51 pm'!
'Description Convert the running Cuis image to an Haver image.'!
!provides: 'Haverize' 1 151!
SystemOrganization addCategory: #Haverize!
@@ 267,7 267,7 @@ killAllBrowsers
morph is: #SystemWindow :: and: [ morph model isKindOf: Browser ] ] ::
do: [ :browserWindow | browserWindow delete ] ]! !
-!HaverizePackage class methodsFor: 'installing' stamp: 'KLG 11/16/2023 10:02:06'!
+!HaverizePackage class methodsFor: 'installing' stamp: 'KLG 1/29/2024 22:43:36'!
postPackageInstall
"This gets called after installing all the package code.
Redefine as appropriate"
@@ 279,7 279,7 @@ postPackageInstall
world backgroundImageData: nil ].
HaverDarkPhisherBryceTheme beCurrent.
self ensureHaverPreferences.
- UnicodeCodePoint initializeAsciArtCharactersMap.
+ Character initializeAsciArtCharactersMap.
self shouldIntegrate ifTrue: [
StdIOWriteStream stdout
nextPutAll: ' image created!!';
@@ 607,55 607,7 @@ 5 seconds asDelay wait.
self error: 'error'.
"! !
-!SystemOrganizer methodsFor: '*Haverize-fileIn/Out' stamp: 'KLG 12/30/2023 19:00:34'!
-fileOutAllCategories
- "
- Cursor write showWhile: [
- SystemOrganization fileOutAllCategories ]
- "
- DirectoryEntry fileOutsDirectory // 'Haver-AllCode.st' writeStreamDo: [ :stream |
- self categories do: [ :category |
- self fileOutCategoryNoPoolsNoInit: category on: stream ]]! !
-
-!UnicodeCodePoint class methodsFor: '*Haverize-class initialization' stamp: 'KLG 11/7/2023 22:59:30'!
-initializeAsciArtCharactersMap
- "Add all the AsciiArt to the named characters map."
-
- ^ #(
- ':-)' $😀 ';-)' $😉 ":Feel free to add others"
- '||>' $⧐ '<||' $⧏ '<|' $⊲ '|>' $⊳
- '>><' $⧑ '><<' $⧒ '>><<' $⧓ '^><<' $⧕ ": Because I was fiddling with that code block"
- '(C)' $© '(TM)' $™ '0F' $℉ '0C' $℃
- '$E' $€ '$P' $£ '$Y' $¥ '$W' $₩ '$B' $฿ '$C' $₵ '$L' $₺ '$R' $₹ '$N' $₪ '$NIS' $₪ '$$' $$ ":For reasions of consistency"
- '\/\_' $↯
- '-/->' $↛ '<-/-' $↚
- '|->' $↦ '<-|' $↤ '|-^' $↥'|-v' $↧ '|=>' $⤇ '<=|' $⤆
- '<-|-' $⇷ '-|->' $⇸ '<-|->' $⇹ '<-||-' $⇺ '-||->' $⇻ '<-||->' $⇼
- '->>' $↠ '<<-' $↞ '-vv' $↡ '-^^' $↟
- '->|' $⇥ '|<-' $⇤ '<-<' $↢ '>->' $↣
- '~>' $⇝ '<~' $⇜
- '|-->' $⟼ '<--|' $⟻ '|==>' $⟾ '<==|' $⟽
- '<-' $← '->' $→ '<=' $⇐ '=>' $⇒ '^|v' $↕ '-^' $↑ '-v' $↓
- '-->' $⟶ '<--' $⟵ '<-->' $⟷ '<==>' $⟺ '0+>' $⟴ '~~>' $⟿
- '<->' $↔ '<=>' $⇔
- '2->' $⇉ '<2-' $⇇ '2-^' $⇈ '2-v' $⇊ '3->' $⇛ '<3-' $⇚
- '<;;' $⇠ ';;>' $⇢ ';;^' $⇡';;v' $⇣
- '<]-' $⇽ '-[>' $⇾
- '>=' $≥ '=<' $≤ ":Use Prolog's convention to avoid arrow shapes."
- '~=' $≠ '=/' $≠
- '<<' $« '>>' $» '<{' $⟨ '}>' $⟩ '{|' $⦃ '|}' $⦄ '[|' $⟦ '|]' $⟧
- '|^' $⌈ '|_' $⌊ '^|' $⌉ '_|' $⌋
- '...' $… ';;;' $⋯ '.;^' $⋰ '^;.' $⋱
- '0x' $⊗ '0+' $⊕ '0-' $⊖ '0.' $⊙ '00' $⊚ '0*' $⊛ '0=' $⊜ '0;' $⊝ '0/' $⊘ '+-' $±
- '[+]' $⊞ '[x]' $⊠ '[.]' $⊡
- '|--' $⊢ '--|' $⊣ '|-' $⊦ '|+' $⊧ '|==' $⊨ '||-' $⊩ '|||-' $⊪ '||=' $⊫
- '**' $× '//' $÷ '00' $∘ '0O' $∙
- '--' $—
- ) pairsDo: [ :symbol :codePoint |
- self assert: [ codePoint isKindOf: UnicodeCodePoint :: or: [ codePoint isCharacter ] ].
- NamedCharactersMap at: symbol put: codePoint ]! !
-
-!UnicodeCodePoint class methodsFor: '*Haverize-class initialization' stamp: 'KLG 11/7/2023 22:58:21'!
+!UndefinedObject methodsFor: '*Haverize-class initialization' stamp: 'KLG 11/7/2023 22:58:21'!
initializeNamedCharactersMap
"Dictionary of named characters that we can enter in an editor using \name.
Please keep the names short and try to follow the naming convention used in LaTeX."
@@ 711,6 663,54 @@ initializeNamedCharactersMap
"Contains the maximum symbol length hardcoded:"
"Editor recompile: #normalCharacter:"! !
+!SystemOrganizer methodsFor: '*Haverize-fileIn/Out' stamp: 'KLG 12/30/2023 19:00:34'!
+fileOutAllCategories
+ "
+ Cursor write showWhile: [
+ SystemOrganization fileOutAllCategories ]
+ "
+ DirectoryEntry fileOutsDirectory // 'Haver-AllCode.st' writeStreamDo: [ :stream |
+ self categories do: [ :category |
+ self fileOutCategoryNoPoolsNoInit: category on: stream ]]! !
+
+!Character class methodsFor: '*Haverize-class initialization' stamp: 'KLG 11/7/2023 22:59:30'!
+initializeAsciArtCharactersMap
+ "Add all the AsciiArt to the named characters map."
+
+ ^ #(
+ ':-)' $😀 ';-)' $😉 ":Feel free to add others"
+ '||>' $⧐ '<||' $⧏ '<|' $⊲ '|>' $⊳
+ '>><' $⧑ '><<' $⧒ '>><<' $⧓ '^><<' $⧕ ": Because I was fiddling with that code block"
+ '(C)' $© '(TM)' $™ '0F' $℉ '0C' $℃
+ '$E' $€ '$P' $£ '$Y' $¥ '$W' $₩ '$B' $฿ '$C' $₵ '$L' $₺ '$R' $₹ '$N' $₪ '$NIS' $₪ '$$' $$ ":For reasions of consistency"
+ '\/\_' $↯
+ '-/->' $↛ '<-/-' $↚
+ '|->' $↦ '<-|' $↤ '|-^' $↥'|-v' $↧ '|=>' $⤇ '<=|' $⤆
+ '<-|-' $⇷ '-|->' $⇸ '<-|->' $⇹ '<-||-' $⇺ '-||->' $⇻ '<-||->' $⇼
+ '->>' $↠ '<<-' $↞ '-vv' $↡ '-^^' $↟
+ '->|' $⇥ '|<-' $⇤ '<-<' $↢ '>->' $↣
+ '~>' $⇝ '<~' $⇜
+ '|-->' $⟼ '<--|' $⟻ '|==>' $⟾ '<==|' $⟽
+ '<-' $← '->' $→ '<=' $⇐ '=>' $⇒ '^|v' $↕ '-^' $↑ '-v' $↓
+ '-->' $⟶ '<--' $⟵ '<-->' $⟷ '<==>' $⟺ '0+>' $⟴ '~~>' $⟿
+ '<->' $↔ '<=>' $⇔
+ '2->' $⇉ '<2-' $⇇ '2-^' $⇈ '2-v' $⇊ '3->' $⇛ '<3-' $⇚
+ '<;;' $⇠ ';;>' $⇢ ';;^' $⇡';;v' $⇣
+ '<]-' $⇽ '-[>' $⇾
+ '>=' $≥ '=<' $≤ ":Use Prolog's convention to avoid arrow shapes."
+ '~=' $≠ '=/' $≠
+ '<<' $« '>>' $» '<{' $⟨ '}>' $⟩ '{|' $⦃ '|}' $⦄ '[|' $⟦ '|]' $⟧
+ '|^' $⌈ '|_' $⌊ '^|' $⌉ '_|' $⌋
+ '...' $… ';;;' $⋯ '.;^' $⋰ '^;.' $⋱
+ '0x' $⊗ '0+' $⊕ '0-' $⊖ '0.' $⊙ '00' $⊚ '0*' $⊛ '0=' $⊜ '0;' $⊝ '0/' $⊘ '+-' $±
+ '[+]' $⊞ '[x]' $⊠ '[.]' $⊡
+ '|--' $⊢ '--|' $⊣ '|-' $⊦ '|+' $⊧ '|==' $⊨ '||-' $⊩ '|||-' $⊪ '||=' $⊫
+ '**' $× '//' $÷ '00' $∘ '0O' $∙
+ '--' $—
+ ) pairsDo: [ :symbol :codePoint |
+ self assert: codePoint isCharacter.
+ NamedCharactersMap at: symbol put: codePoint ]! !
+
!SystemDictionary methodsFor: '*Haverize-snapshot and quit' stamp: 'KLG 9/7/2023 16:05:46'!
askConfirmationOnQuit
"Answer true unless the user cancels quitting because of some warning given.
@@ 960,7 960,7 @@ normalCharacter: aKeyboardEvent
string := self privateCurrentString.
"This is a bit haccky"
maxNamedCharacterSymbolSize :=
- `UnicodeCodePoint namedCharactersMap keys
+ `Character namedCharactersMap keys
inject: 0 into: [ :max :symbol | symbol size max: max ]`.
self pointIndex - 1 to: (self pointIndex - maxNamedCharacterSymbolSize max: 1) by: -1 do: [ :index |
string at: index :: = $\ ifTrue: [ | key |
@@ 971,14 971,14 @@ normalCharacter: aKeyboardEvent
ifTrue: [ | stream number value |
stream := ReadStream on: key asUppercase from: 2 to: key size.
[ number := Integer readFrom: stream base: 16 ] on: Error do: [ ^ false ].
- value := UnicodeCodePoint codePoint: number.
+ value := Character codePoint: number.
self
selectFrom: index to: self pointIndex - 1;
replaceSelectionWith: (UnicodeString with: value).
^ false ]
ifFalse: [
key at: 1 :: = $. ifTrue: [ | codePoint |
- codePoint := UnicodeCodePoint namedCharactersMap
+ codePoint := Character namedCharactersMap
at: (key copyFrom: 2 to: key size)
ifAbsent: [ ^false ].
self
@@ 992,11 992,11 @@ normalCharacter: aKeyboardEvent
i := self pointIndex-1.
(i > 0 and: [ (self privateCurrentString at: i) = $ ]) ifTrue: [
replacement := character caseOf: {
- [ `UnicodeCodePoint codePoint: 16r300` ] -> [ '`' ].
- [ `UnicodeCodePoint codePoint: 16r301` ] -> [ '''' ].
- [ `UnicodeCodePoint codePoint: 16r302` ] -> [ '^' ].
- [ `UnicodeCodePoint codePoint: 16r303` ] -> [ '~' ].
- [ `UnicodeCodePoint codePoint: 16r308` ] -> [ '"' ].
+ [ `Character codePoint: 16r300` ] -> [ '`' ].
+ [ `Character codePoint: 16r301` ] -> [ '''' ].
+ [ `Character codePoint: 16r302` ] -> [ '^' ].
+ [ `Character codePoint: 16r303` ] -> [ '~' ].
+ [ `Character codePoint: 16r308` ] -> [ '"' ].
} otherwise: [].
replacement notNil ifTrue: [
self selectFrom: i to: i; replaceSelectionWith: replacement.
@@ 1508,7 1508,7 @@ selectorDocumentationText
stream
nextPutAll: `' character: ' gray`;
nextPutAll:
- (UnicodeCodePoint namedCharactersMap
+ (Character namedCharactersMap
at: (characterName)
ifAbsent: [ 'NOT FOUND' ]) asString magenta ] ]! !
@@ 1764,7 1764,7 @@ computeUnicodeCharacterEntriesFor: someS
someSource size to: (someSource size - 20 max: 1) by: -1 do: [ :index |
someSource at: index :: = $\ :: ifTrue: [ | namedCharactersMap |
- namedCharactersMap := UnicodeCodePoint namedCharactersMap.
+ namedCharactersMap := Character namedCharactersMap.
^ someSource copyFrom: index + 1 to: someSource size ::
correctAgainstDictionary: namedCharactersMap
continuedFrom: nil ::