Move keymapping UI to NewTools

To fix a dependency test

src/BaselineOfNewTools/BaselineOfNewTools.class.st

@@ -113,6 +113,8 @@ BaselineOfNewTools >> baseline: spec [
 
 			package: 'NewTools-WelcomeBrowser';
 
+			package: 'NewTools-Keymapping';
+
 			package: 'ColorPicker';
 			package: 'ColorPicker-Tests' with: [ spec requires: #( ColorPicker ) ].
 
@@ -191,6 +193,8 @@ BaselineOfNewTools >> baseline: spec [
 
 			group: 'WelcomeBrowser' with: #( 'NewTools-WelcomeBrowser' );
 
+			group: 'Keymapping' with: #( 'NewTools-Keymapping' );
+
 			group: 'ColorPickerGroup' with: #('ColorPicker' 'ColorPicker-Tests');
 
 			group: 'default' with: #( 
@@ -210,6 +214,7 @@ BaselineOfNewTools >> baseline: spec [
 						'Profiler'
 						'SettingsBrowser'
 						'WelcomeBrowser'
+						'Keymapping'
 						'ColorPickerGroup' ) ]
 ]
 

src/NewTools-Keymapping/KMCategory.extension.st

@@ -0,0 +1,13 @@
+Extension { #name : 'KMCategory' }
+
+{ #category : '*NewTools-Keymapping' }
+KMCategory >> scopeName [
+
+	^  self name
+]
+
+{ #category : '*NewTools-Keymapping' }
+KMCategory >> shortcuts [
+
+	^ (self entriesAt: #all) keymaps
+]

src/NewTools-Keymapping/KMCategoryAll.class.st

@@ -0,0 +1,95 @@
+Class {
+	#name : 'KMCategoryAll',
+	#superclass : 'Object',
+	#instVars : [
+		'categoryName',
+		'shortcuts'
+	],
+	#category : 'NewTools-Keymapping',
+	#package : 'NewTools-Keymapping'
+}
+
+{ #category : 'copying' }
+KMCategoryAll >> , aKMCategory [
+
+	self shortcuts addAll: aKMCategory allEntries keymaps
+]
+
+{ #category : 'comparing' }
+KMCategoryAll >> = anObject [
+	"Answer whether the receiver and anObject represent the same object."
+
+	self == anObject ifTrue: [ ^ true ].
+	self class = anObject class ifFalse: [ ^ false ].
+	^ categoryName = anObject categoryName and: [
+		  shortcuts = anObject shortcuts ]
+]
+
+{ #category : 'adding' }
+KMCategoryAll >> addAll: aCollection [ 
+	"Add all shortcuts in aCollection to the receiver"
+
+	self shortcuts addAll: aCollection
+]
+
+{ #category : 'accessing' }
+KMCategoryAll >> categoryName [
+
+	^ categoryName
+]
+
+{ #category : 'accessing' }
+KMCategoryAll >> categoryName: anObject [
+
+	categoryName := anObject
+]
+
+{ #category : 'comparing' }
+KMCategoryAll >> hash [
+	"Answer an integer value that is related to the identity of the receiver."
+
+	^ categoryName hash bitXor: shortcuts hash
+]
+
+{ #category : 'accessing' }
+KMCategoryAll >> icon [
+
+	^ self iconNamed: self systemIconName
+]
+
+{ #category : 'accessing' }
+KMCategoryAll >> model [
+	"Required by <SpDropListPresenter> ?"
+
+	^ self
+]
+
+{ #category : 'accessing' }
+KMCategoryAll >> name [
+
+	^  self categoryName
+]
+
+{ #category : 'printing' }
+KMCategoryAll >> printOn: aStream [
+	"Generate a string representation of the receiver based on its instance variables."
+
+	super printOn: aStream.
+	aStream
+		nextPutAll: ' [';
+		print: categoryName;
+		nextPutAll: ']'
+]
+
+{ #category : 'accessing' }
+KMCategoryAll >> shortcuts [
+
+	^ shortcuts
+		ifNil: [ shortcuts := OrderedCollection new ]
+]
+
+{ #category : 'accessing' }
+KMCategoryAll >> shortcuts: anObject [
+
+	shortcuts := anObject
+]

src/NewTools-Keymapping/KMDescriptionPresenter.class.st

@@ -0,0 +1,186 @@
+"
+A KMDescription is a window showing the description of shortcuts for a specified set of symbols reprensenting KMCategories
+"
+Class {
+	#name : 'KMDescriptionPresenter',
+	#superclass : 'StPresenter',
+	#instVars : [
+		'actionBar',
+		'categoryList',
+		'shortcutTable',
+		'inputPresenter'
+	],
+	#category : 'NewTools-Keymapping',
+	#package : 'NewTools-Keymapping'
+}
+
+{ #category : 'accessing' }
+KMDescriptionPresenter class >> defaultPreferredExtent [
+
+	^ 900 @ 650
+]
+
+{ #category : 'instance creation' }
+KMDescriptionPresenter class >> descriptionText [
+
+	^ 'Show the system''s shortcuts'
+]
+
+{ #category : 'accessing' }
+KMDescriptionPresenter class >> icon [
+
+	^ self iconNamed: #keymapBrowser
+]
+
+{ #category : 'instance creation' }
+KMDescriptionPresenter class >> menuCommandOn: aBuilder [
+	<worldMenu>
+
+	(aBuilder item: 'Shortcuts Browser')
+		action: [ self open ];
+		order: 34;
+		parent: #Tools;
+		icon: self icon;
+		help: self descriptionText
+]
+
+{ #category : 'instance creation' }
+KMDescriptionPresenter class >> open [
+
+	<script>
+	^ (self newApplication: StPharoApplication current) open
+]
+
+{ #category : 'initialization' }
+KMDescriptionPresenter >> allAPIsEntry [
+	"Set the receiver's category items to a list of categories in aCollectionOfSymbols.
+	We also build an 'All' category including all keymaps in aCollectionOfSymbols"
+
+	| newCategoryItem |
+	newCategoryItem := KMCategoryAll new categoryName: 'All'.
+	KMRepository default categories inject: newCategoryItem into: [ : a : b | a , b ].
+	newCategoryItem addAll: self shortcutActivationCmdInstances.
+	^ newCategoryItem
+]
+
+{ #category : 'initialization' }
+KMDescriptionPresenter >> connectPresenters [
+
+	categoryList transmitTo: shortcutTable transform: [ :item | self keymapsAtCategory: item model ].
+	inputPresenter whenTextChangedDo: [ :text | self filterTable: text ].
+	shortcutTable whenActivatedDo: [ :item | item value inspect selectedItem ]
+]
+
+{ #category : 'layout' }
+KMDescriptionPresenter >> defaultLayout [
+
+	^ SpBoxLayout newTopToBottom
+		  spacing: 6;
+		  add: (SpBoxLayout newLeftToRight
+				   add: 'Filter scopes' expand: false;
+				   add: categoryList;
+				   yourself)
+		  expand: false;
+		  add: inputPresenter expand: false;
+		  add: shortcutTable;
+		  add: actionBar withConstraints: [ :c | c height: 25 ];
+		  yourself
+]
+
+{ #category : 'callbacks' }
+KMDescriptionPresenter >> filterTable: aText [
+
+	| newItems |
+	aText ifEmpty: [
+		shortcutTable items: (self keymapsAtCategory: categoryList selectedItem).
+		^ self ].
+
+	newItems := (self keymapsAtCategory: categoryList selectedItem) select: [ :each |
+		            { each name. each scopeName. each description } anySatisfy: [ :aString | 
+								aString includesSubstring: aText caseSensitive: false ] ].
+	shortcutTable items: newItems
+]
+
+{ #category : 'initialization' }
+KMDescriptionPresenter >> initialize [
+
+	| shortcutCategories |
+	super initialize.
+
+	shortcutCategories := { self allAPIsEntry } , self shortcutActivationCategoriesItems
+	                      , (KMRepository default categories keys collect: [ :e | KMRepository default categoryForName: e ]).
+	categoryList items: shortcutCategories
+]
+
+{ #category : 'initialization' }
+KMDescriptionPresenter >> initializePresenters [
+
+	categoryList := self newDropList
+		                display: [ :category | category name ];
+		                yourself.
+	inputPresenter := self newTextInput
+		                  placeholder: 'Filter';
+		                  yourself.
+
+	shortcutTable := self newTable.
+	shortcutTable
+		activateOnDoubleClick;
+		addColumn: (SpStringTableColumn new
+				 title: 'Name';
+				 evaluated: #name;
+				 beSortable;
+				 yourself);
+		addColumn: (SpStringTableColumn title: 'Shortcut' evaluated: #shortcut);
+		addColumn: (SpStringTableColumn title: 'Description' evaluated: #description);
+		addColumn: (SpStringTableColumn new
+				 title: 'Scope';
+				 evaluated: [ :each | each scopeName ];
+				 beSortable;
+				 width: 150;
+				 yourself);
+		beResizable.
+
+	actionBar := self newActionBar.
+	actionBar
+		addLast: (SpButtonPresenter new
+				 action: [ "self application tools browser openOn:" shortcutTable selectedItem action browser ];
+				 label: 'Browse';
+				 yourself);
+		addLast: (SpButtonPresenter new
+				 action: [ self application tools inspector openOn: shortcutTable selectedItem inspect ];
+				 label: 'Inspect';
+				 yourself)
+]
+
+{ #category : 'callbacks' }
+KMDescriptionPresenter >> keymapsAtCategory: aKMCategoryOrKMCategoryAll [
+	"Answer a <Collection> of keymaps"
+	^ aKMCategoryOrKMCategoryAll shortcuts
+]
+
+{ #category : 'initialization' }
+KMDescriptionPresenter >> shortcutActivationCategoriesItems [
+	"Answer a <Collection> of <KMCategoryItemPresenter> representing each a category of shortcuts created using the Commander 1 framework"
+
+	| shortcutActivationCategories |
+	shortcutActivationCategories := (self shortcutActivationCmdInstances groupedBy: [ :cmdShortcutActivation |
+		                                 cmdShortcutActivation annotatedClass packageName ]) values.
+
+	^ shortcutActivationCategories collect: [ :shortcuts |
+		  KMCategoryAll new
+			  categoryName: shortcuts anyOne annotatedClass packageName;
+			  shortcuts: shortcuts;
+			  yourself ]
+]
+
+{ #category : 'initialization' }
+KMDescriptionPresenter >> shortcutActivationCmdInstances [
+
+	^ CmdShortcutActivation registeredInstances copyWithoutAll: CmdShortcutActivation redefiningInstances
+]
+
+{ #category : 'initialization' }
+KMDescriptionPresenter >> windowTitle [
+
+	^ 'Shortcuts Browser'
+]

src/NewTools-Keymapping/KMKeymap.extension.st

@@ -0,0 +1,14 @@
+Extension { #name : 'KMKeymap' }
+
+{ #category : '*NewTools-Keymapping' }
+KMKeymap >> scope [
+
+	^ KMRepository default categories 
+		detect: [ : cat | cat keymaps includes: self ]
+]
+
+{ #category : '*NewTools-Keymapping' }
+KMKeymap >> scopeName [
+
+	^  self scope scopeName
+]

src/NewTools-Keymapping/package.st

@@ -0,0 +1 @@
+Package { #name : 'NewTools-Keymapping' }