=============== Summary ===============
Change Set: sanitize-cat-names
Date: 15 August 2023
Author: Christoph Thiede
Sanitizes names of categories and packages by removing leading/trailing blanks before construction/lookup. This fixes a bug with invisible categories in the tree browser.
Answer new package from PackageOrganizer>>#registerPackage*. Recategorize PackageServices.
=============== Postscript ===============
PackageServices initialize
=============== Diff ===============
Categorizer>>addCategory:before: {accessing} · ct 8/15/2023 12:14 (changed)
addCategory: catString before: nextCategory
"Add a new category named heading.
If default category exists and is empty, remove it.
If nextCategory is nil, then add the new one at the end,
otherwise, insert it before nextCategory."
| index newCategory |
- newCategory := catString asSymbol.
+ newCategory := (self sanitizeName: catString) asSymbol.
(categoryArray indexOf: newCategory) > 0
ifTrue: [^self]. "heading already exists, so done"
(self isSpecialCategoryName: newCategory)
ifTrue: [^self inform: 'This category name is system reserved' translated].
index := categoryArray indexOf: nextCategory
ifAbsent: [categoryArray size + 1].
categoryArray := categoryArray
copyReplaceFrom: index
to: index-1
with: (Array with: newCategory).
categoryStops := categoryStops
copyReplaceFrom: index
to: index-1
with: (Array with: (index = 1
ifTrue: [0]
ifFalse: [categoryStops at: index-1])).
"remove empty default category"
(newCategory ~= Default
and: [(self listAtCategoryNamed: Default) isEmpty])
ifTrue: [self removeCategory: Default]
Categorizer>>classify:under:suppressIfDefault: {classifying} · ct 8/15/2023 12:15 (changed)
classify: element under: heading suppressIfDefault: aBoolean
"Store the argument, element, in the category named heading. If aBoolean is true, then invoke special logic such that the classification is NOT done if the new heading is the Default and the element already had a non-Default classification -- useful for filein"
| catName catIndex elemIndex realHeading |
realHeading := (heading isEmptyOrNil or: [self isSpecialCategoryName: heading])
ifTrue: [Default]
- ifFalse: [heading asSymbol].
+ ifFalse: [(self sanitizeName: heading) asSymbol].
(catName := self categoryOfElement: element) = realHeading
ifTrue: [^ self]. "done if already under that category"
catName ifNotNil: [
(aBoolean and: [realHeading = Default])
ifTrue: [^ self]. "return if non-Default category already assigned in memory"
self basicRemoveElement: element]. "remove if in another category"
(categoryArray indexOf: realHeading) = 0 ifTrue: [self addCategory: realHeading].
catIndex := categoryArray indexOf: realHeading.
elemIndex :=
catIndex > 1
ifTrue: [categoryStops at: catIndex - 1]
ifFalse: [0].
[(elemIndex := elemIndex + 1) <= (categoryStops at: catIndex)
and: [element >= (elementArray at: elemIndex)]] whileTrue.
"elemIndex is now the index for inserting the element. Do the insertion before it."
elementArray := elementArray copyReplaceFrom: elemIndex to: elemIndex-1
with: (Array with: element).
"add one to stops for this and later categories"
catIndex to: categoryArray size do:
[:i | categoryStops at: i put: (categoryStops at: i) + 1].
((categoryArray includes: Default)
and: [(self listAtCategoryNamed: Default) size = 0]) ifTrue: [self removeCategory: Default].
self assertInvariant.
Categorizer>>listAtCategoryNamed: {accessing} · ct 8/15/2023 12:14 (changed)
listAtCategoryNamed: categoryName
"Answer the array of elements associated with the name, categoryName."
| i |
- i := categoryArray indexOf: categoryName ifAbsent: [^Array new].
+ i := categoryArray indexOf: (self sanitizeName: categoryName) ifAbsent: [^Array new].
^self listAtCategoryNumber: i
Categorizer>>removeCategory: {accessing} · ct 8/15/2023 12:14 (changed)
removeCategory: cat
"Remove the category named, cat. Create an error notificiation if the
category has any elements in it."
| index lastStop |
- index := categoryArray indexOf: cat ifAbsent: [^self].
+ index := categoryArray indexOf: (self sanitizeName: cat) ifAbsent: [^self].
lastStop :=
index = 1
ifTrue: [0]
ifFalse: [categoryStops at: index - 1].
(categoryStops at: index) - lastStop > 0
ifTrue: [^self error: 'cannot remove non-empty category'].
categoryArray := categoryArray copyReplaceFrom: index to: index with: Array new.
categoryStops := categoryStops copyReplaceFrom: index to: index with: Array new.
categoryArray size = 0
ifTrue:
[categoryArray := Array with: Default.
categoryStops := Array with: 0]
Categorizer>>renameCategory:toBe: {accessing} · ct 8/15/2023 12:14 (changed)
renameCategory: oldCatString toBe: newCatString
"Rename a category. No action if new name already exists, or if old name does not exist."
| index oldCategory newCategory |
- oldCategory := oldCatString asSymbol.
- newCategory := newCatString asSymbol.
+ oldCategory := (self sanitizeName: oldCatString) asSymbol.
+ newCategory := (self sanitizeName: newCatString) asSymbol.
(categoryArray indexOf: newCategory) > 0
ifTrue: [^ self]. "new name exists, so no action"
(index := categoryArray indexOf: oldCategory) = 0
ifTrue: [^ self]. "old name not found, so no action"
categoryArray := categoryArray copy. "need to change identity so smart list update will notice the change"
categoryArray at: index put: newCategory
Categorizer>>sanitizeName: {private} · ct 8/15/2023 12:13
+ sanitizeName: aString
+
+ ^ aString withBlanksTrimmed
ClassOrganizer>>addCategory:before: {accessing} · ct 8/15/2023 12:21 (changed)
addCategory: catString before: nextCategory
SystemChangeNotifier uniqueInstance
doSilently: [super addCategory: catString before: nextCategory];
- protocolAdded: catString inClass: self subject
+ protocolAdded: (self sanitizeName: catString) inClass: self subject
ClassOrganizer>>removeCategory: {accessing} · ct 8/15/2023 12:20 (changed)
removeCategory: cat
SystemChangeNotifier uniqueInstance
doSilently: [super removeCategory: cat];
- protocolRemoved: cat inClass: self subject
+ protocolRemoved: (self sanitizeName: cat) inClass: self subject
ClassOrganizer>>renameCategory:toBe: {accessing} · ct 8/15/2023 12:20 (changed)
renameCategory: oldCatString toBe: newCatString
SystemChangeNotifier uniqueInstance
doSilently: [super renameCategory: oldCatString toBe: newCatString];
- protocolRenamedFrom: oldCatString asSymbol to: newCatString asSymbol inClass: self subject.
- self logSelectorsInChangedCategory: newCatString.
+ protocolRenamedFrom: (self sanitizeName: oldCatString) asSymbol to: (self sanitizeName: newCatString) asSymbol inClass: self subject.
+ self logSelectorsInChangedCategory: (self sanitizeName: newCatString).
MCWorkingCopyBrowser>>addWorkingCopy {actions} · ct 8/15/2023 12:11 (changed)
addWorkingCopy
|name|
name := Project uiManager request: 'Name of package:' translated.
name isEmptyOrNil ifFalse:
- [PackageInfo registerPackageName: name.
+ [name := (PackageInfo registerPackageName: name) name.
workingCopy := MCWorkingCopy forPackage: (MCPackage new name: name).
workingCopyWrapper := nil.
self repositorySelection: 0].
self workingCopyListChanged; changed: #workingCopySelection; changed: #repositoryList.
self changedButtons.
PackageInfo class>>named: {packages access} · ct 8/15/2023 12:25 (changed)
named: aString
- ^ Environment current packageOrganizer packageNamed: aString ifAbsent: [(self new packageName: aString) register]
+ ^ Environment current packageOrganizer packageNamed: (self sanitizeName: aString) ifAbsent: [(self new packageName: aString) register]
PackageInfo class>>sanitizeName: {private} · ct 8/15/2023 12:24
+ sanitizeName: aString
+ ^ aString withBlanksTrimmed
PackageInfo>>packageName: {naming} · ct 8/15/2023 12:24 (changed)
packageName: aString
- packageName := aString
+ packageName := (self class sanitizeName: aString)
PackageOrganizer>>packageNamed:ifAbsent: {searching} · ct 8/15/2023 12:24 (changed)
packageNamed: aString ifAbsent: errorBlock
- ^ packages at: aString ifAbsent: errorBlock
+ ^ packages at: (PackageInfo sanitizeName: aString) ifAbsent: errorBlock
PackageOrganizer>>packageNamed:ifPresent: {searching} · ct 8/15/2023 12:24 (changed)
packageNamed: aString ifPresent: aBlock
- ^ packages at: aString ifPresent: aBlock
+ ^ packages at: (PackageInfo sanitizeName: aString) ifPresent: aBlock
PackageOrganizer>>packageNamed:ifPresent:ifAbsent: {searching} · ct 8/15/2023 12:24 (changed)
packageNamed: aString ifPresent: aBlock ifAbsent: errorBlock
- ^ packages at: aString ifPresent: aBlock ifAbsent: errorBlock
+ ^ packages at: (PackageInfo sanitizeName: aString) ifPresent: aBlock ifAbsent: errorBlock
PackageOrganizer>>registerPackage: {registering} · ct 8/15/2023 12:11 (changed)
registerPackage: aPackageInfo
packages at: aPackageInfo packageName put: aPackageInfo.
self changed: #packages; changed: #packageNames.
+ ^ aPackageInfo
PackageServices class>>allServices {services} · avi 10/11/2003 13:01 (changed and recategorized)
allServices
^ ServiceClasses gather: [:ea | ea services]
PackageServices class>>initialize {class initialization} · avi 10/11/2003 12:59 (changed and recategorized)
initialize
ServiceClasses := Set new
PackageServices class>>register: {services} · avi 10/11/2003 12:59 (changed and recategorized)
register: aClass
ServiceClasses add: aClass
PackageServices class>>unregister: {services} · avi 10/11/2003 12:59 (changed and recategorized)
unregister: aClass
ServiceClasses remove: aClass
---
Sent from Squeak Inbox Talk
["sanitize-cat-names.1.cs"]