>From 7b268bb09e02c14f12327046ce2d686745197a8b Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio
Date: Sun, 2 Jun 2013 19:16:46 +0200
Subject: [PATCH] Refactor some Smalltalk undo commands: make them subclass of
commands; add a MIT licence; and refactor those who use them. Smalltalk
commands don't works as undoable commands, they could only be executed: a
simple eval in the workspace could break the undo/redo code.
---
.../CategoryMenus/RenameCategoryCommand.st | 37 +++++-
.../Commands/ClassMenus/AddClassCommand.st | 39 ++++++-
.../Commands/ClassMenus/DeleteClassCommand.st | 37 +++++-
.../Commands/ClassMenus/RenameClassCommand.st | 37 +++++-
packages/visualgst/Commands/Command.st | 50 +++++++-
.../Commands/MethodMenus/DeleteMethodCommand.st | 37 +++++-
.../Commands/NamespaceMenus/AddNamespaceCommand.st | 37 +++++-
.../NamespaceMenus/DeleteNamespaceCommand.st | 37 +++++-
.../NamespaceMenus/RenameNamespaceCommand.st | 37 +++++-
.../Commands/SmalltalkMenus/AcceptItCommand.st | 4 +-
.../visualgst/Commands/System/AddClassCommand.st | 80 +++++++++++++
.../visualgst/Commands/System/AddMethodCommand.st | 130 +++++++++++++++++++++
.../Commands/System/AddNamespaceCommand.st | 77 ++++++++++++
.../Commands/System/DeleteClassCommand.st | 75 ++++++++++++
.../Commands/System/DeleteMethodCommand.st | 69 +++++++++++
.../Commands/System/DeleteNamespaceCommand.st | 66 +++++++++++
.../Commands/System/RenameCategoryCommand.st | 83 +++++++++++++
.../Commands/System/RenameClassCommand.st | 81 +++++++++++++
.../Commands/System/RenameNamespaceCommand.st | 79 +++++++++++++
packages/visualgst/Gtk/GtkEntry.st | 9 ++
packages/visualgst/Gtk/GtkEntryBuffer.st | 9 ++
packages/visualgst/Undo/AddClassUndoCommand.st | 60 ----------
packages/visualgst/Undo/AddMethodUndoCommand.st | 109 -----------------
packages/visualgst/Undo/AddNamespaceUndoCommand.st | 48 --------
packages/visualgst/Undo/DeleteClassUndoCommand.st | 47 --------
packages/visualgst/Undo/DeleteMethodUndoCommand.st | 46 --------
.../visualgst/Undo/DeleteNamespaceUndoCommand.st | 37 ------
.../visualgst/Undo/RenameCategoryUndoCommand.st | 59 ----------
packages/visualgst/Undo/RenameClassUndoCommand.st | 53 ---------
.../visualgst/Undo/RenameNamespaceUndoCommand.st | 52 ---------
packages/visualgst/package.xml | 40 ++++---
31 files changed, 1120 insertions(+), 541 deletions(-)
create mode 100644 packages/visualgst/Commands/System/AddClassCommand.st
create mode 100644 packages/visualgst/Commands/System/AddMethodCommand.st
create mode 100644 packages/visualgst/Commands/System/AddNamespaceCommand.st
create mode 100644 packages/visualgst/Commands/System/DeleteClassCommand.st
create mode 100644 packages/visualgst/Commands/System/DeleteMethodCommand.st
create mode 100644 packages/visualgst/Commands/System/DeleteNamespaceCommand.st
create mode 100644 packages/visualgst/Commands/System/RenameCategoryCommand.st
create mode 100644 packages/visualgst/Commands/System/RenameClassCommand.st
create mode 100644 packages/visualgst/Commands/System/RenameNamespaceCommand.st
create mode 100644 packages/visualgst/Gtk/GtkEntry.st
create mode 100644 packages/visualgst/Gtk/GtkEntryBuffer.st
delete mode 100644 packages/visualgst/Undo/AddClassUndoCommand.st
delete mode 100644 packages/visualgst/Undo/AddMethodUndoCommand.st
delete mode 100644 packages/visualgst/Undo/AddNamespaceUndoCommand.st
delete mode 100644 packages/visualgst/Undo/DeleteClassUndoCommand.st
delete mode 100644 packages/visualgst/Undo/DeleteMethodUndoCommand.st
delete mode 100644 packages/visualgst/Undo/DeleteNamespaceUndoCommand.st
delete mode 100644 packages/visualgst/Undo/RenameCategoryUndoCommand.st
delete mode 100644 packages/visualgst/Undo/RenameClassUndoCommand.st
delete mode 100644 packages/visualgst/Undo/RenameNamespaceUndoCommand.st
diff --git a/packages/visualgst/Commands/CategoryMenus/RenameCategoryCommand.st b/packages/visualgst/Commands/CategoryMenus/RenameCategoryCommand.st
index fc27f7e..f7dfc14 100644
--- a/packages/visualgst/Commands/CategoryMenus/RenameCategoryCommand.st
+++ b/packages/visualgst/Commands/CategoryMenus/RenameCategoryCommand.st
@@ -1,3 +1,38 @@
+"======================================================================
+|
+| RenameCategoryCommand class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
CategoryCommand subclass: RenameCategoryCommand [
item [
@@ -11,7 +46,7 @@ CategoryCommand subclass: RenameCategoryCommand [
| dlg |
dlg := GtkEntryDialog title: 'Rename a category' text: 'Name of the category'.
dlg hasPressedOk: [
- (RenameCategoryUndoCommand rename: target state category in: target state classOrMeta as: dlg result onModel: target viewedCategoryModel) push ]
+ (SysRenameCategoryCommand rename: target state category in: target state classOrMeta as: dlg result onModel: target viewedCategoryModel) executeIfValid ]
]
]
diff --git a/packages/visualgst/Commands/ClassMenus/AddClassCommand.st b/packages/visualgst/Commands/ClassMenus/AddClassCommand.st
index 6d011a0..1a6f1db 100644
--- a/packages/visualgst/Commands/ClassMenus/AddClassCommand.st
+++ b/packages/visualgst/Commands/ClassMenus/AddClassCommand.st
@@ -1,3 +1,38 @@
+"======================================================================
+|
+| AddClassCommand class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
NamespaceCommand subclass: AddClassCommand [
item [
@@ -14,11 +49,11 @@ NamespaceCommand subclass: AddClassCommand [
ifFalse: [ Object ].
dlg := GtkEntryDialog title: 'Add a class' text: 'Name of the new class'.
dlg hasPressedOk: [
- (AddClassUndoCommand
+ (SysAddClassCommand
add: dlg result asSymbol
to: target state namespace
classCategory: target state classCategory
- withSuperclass: superclass) push ]
+ withSuperclass: superclass) executeIfValid ]
]
]
diff --git a/packages/visualgst/Commands/ClassMenus/DeleteClassCommand.st b/packages/visualgst/Commands/ClassMenus/DeleteClassCommand.st
index 0ff4af9..aca4ada 100644
--- a/packages/visualgst/Commands/ClassMenus/DeleteClassCommand.st
+++ b/packages/visualgst/Commands/ClassMenus/DeleteClassCommand.st
@@ -1,3 +1,38 @@
+"======================================================================
+|
+| DeleteClassCommand class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
ClassCommand subclass: DeleteClassCommand [
item [
@@ -8,6 +43,6 @@ ClassCommand subclass: DeleteClassCommand [
execute [
- (DeleteClassUndoCommand delete: target state classOrMeta) push
+ (SysDeleteClassCommand delete: target state classOrMeta) executeIfValid
]
]
diff --git a/packages/visualgst/Commands/ClassMenus/RenameClassCommand.st b/packages/visualgst/Commands/ClassMenus/RenameClassCommand.st
index b80aa86..3a9553c 100644
--- a/packages/visualgst/Commands/ClassMenus/RenameClassCommand.st
+++ b/packages/visualgst/Commands/ClassMenus/RenameClassCommand.st
@@ -1,3 +1,38 @@
+"======================================================================
+|
+| RenameClassCommand class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
ClassCommand subclass: RenameClassCommand [
item [
@@ -11,7 +46,7 @@ ClassCommand subclass: RenameClassCommand [
| dlg |
dlg := GtkEntryDialog title: 'Rename a class' text: 'Name of the class'.
dlg hasPressedOk: [
- (RenameClassUndoCommand rename: target state classOrMeta as: dlg result asSymbol) push ]
+ (SysRenameClassCommand rename: target state classOrMeta as: dlg result asSymbol) executeIfValid ]
]
]
diff --git a/packages/visualgst/Commands/Command.st b/packages/visualgst/Commands/Command.st
index a1789df..32e826d 100644
--- a/packages/visualgst/Commands/Command.st
+++ b/packages/visualgst/Commands/Command.st
@@ -1,3 +1,38 @@
+"======================================================================
+|
+| Command class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
Object subclass: Command [
Command class >> execute [
@@ -30,7 +65,7 @@ Object subclass: Command [
yourself
]
- | target |
+ | target error |
target: anObject [
@@ -50,6 +85,19 @@ Object subclass: Command [
^ true
]
+ preconditionFailed: aString [
+
+
+ error := aString.
+ ^ false
+ ]
+
+ error [
+
+
+ ^ error
+ ]
+
executeIfValid [
diff --git a/packages/visualgst/Commands/MethodMenus/DeleteMethodCommand.st b/packages/visualgst/Commands/MethodMenus/DeleteMethodCommand.st
index e67592d..0a17317 100644
--- a/packages/visualgst/Commands/MethodMenus/DeleteMethodCommand.st
+++ b/packages/visualgst/Commands/MethodMenus/DeleteMethodCommand.st
@@ -1,3 +1,38 @@
+"======================================================================
+|
+| DeleteMethodCommand class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
MethodCommand subclass: DeleteMethodCommand [
item [
@@ -8,7 +43,7 @@ MethodCommand subclass: DeleteMethodCommand [
execute [
- (DeleteMethodUndoCommand delete: target state selector in: target state classOrMeta) push
+ (SysDeleteMethodCommand delete: target state selector in: target state classOrMeta) executeIfValid
]
]
diff --git a/packages/visualgst/Commands/NamespaceMenus/AddNamespaceCommand.st b/packages/visualgst/Commands/NamespaceMenus/AddNamespaceCommand.st
index 8b87546..45992ca 100644
--- a/packages/visualgst/Commands/NamespaceMenus/AddNamespaceCommand.st
+++ b/packages/visualgst/Commands/NamespaceMenus/AddNamespaceCommand.st
@@ -1,3 +1,38 @@
+"======================================================================
+|
+| AddNamespaceCommand class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
NamespaceCommand subclass: AddNamespaceCommand [
item [
@@ -11,7 +46,7 @@ NamespaceCommand subclass: AddNamespaceCommand [
| dlg |
dlg := GtkEntryDialog title: 'Add a namespace' text: 'Name of the new namespace'.
dlg hasPressedOk: [
- (AddNamespaceUndoCommand add: dlg result asSymbol to: target state namespace) push ]
+ (SysAddNamespaceCommand add: dlg result asSymbol to: target state namespace) executeIfValid ]
]
]
diff --git a/packages/visualgst/Commands/NamespaceMenus/DeleteNamespaceCommand.st b/packages/visualgst/Commands/NamespaceMenus/DeleteNamespaceCommand.st
index 4df54f2..36e3e7c 100644
--- a/packages/visualgst/Commands/NamespaceMenus/DeleteNamespaceCommand.st
+++ b/packages/visualgst/Commands/NamespaceMenus/DeleteNamespaceCommand.st
@@ -1,3 +1,38 @@
+"======================================================================
+|
+| DeleteNamespaceCommand class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
NamespaceCommand subclass: DeleteNamespaceCommand [
item [
@@ -11,7 +46,7 @@ NamespaceCommand subclass: DeleteNamespaceCommand [
| namespace |
namespace := target state namespace.
namespace subspaces isEmpty ifFalse: [ self error: 'Namespace has subspaces' ].
- (DeleteNamespaceUndoCommand delete: namespace) push
+ (SysDeleteNamespaceCommand delete: namespace) executeIfValid
]
]
diff --git a/packages/visualgst/Commands/NamespaceMenus/RenameNamespaceCommand.st b/packages/visualgst/Commands/NamespaceMenus/RenameNamespaceCommand.st
index b2b8e6c..76f15a6 100644
--- a/packages/visualgst/Commands/NamespaceMenus/RenameNamespaceCommand.st
+++ b/packages/visualgst/Commands/NamespaceMenus/RenameNamespaceCommand.st
@@ -1,3 +1,38 @@
+"======================================================================
+|
+| RenameNamespaceCommand class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
NamespaceCommand subclass: RenameNamespaceCommand [
item [
@@ -11,7 +46,7 @@ NamespaceCommand subclass: RenameNamespaceCommand [
| dlg |
dlg := GtkEntryDialog title: 'Rename a namespace' text: 'Name of the new namespace'.
dlg hasPressedOk: [
- (RenameNamespaceUndoCommand rename: target state namespace as: dlg result asSymbol) push ]
+ (SysRenameNamespaceCommand rename: target state namespace as: dlg result asSymbol) executeIfValid ]
]
]
diff --git a/packages/visualgst/Commands/SmalltalkMenus/AcceptItCommand.st b/packages/visualgst/Commands/SmalltalkMenus/AcceptItCommand.st
index b7c5c3e..977957e 100644
--- a/packages/visualgst/Commands/SmalltalkMenus/AcceptItCommand.st
+++ b/packages/visualgst/Commands/SmalltalkMenus/AcceptItCommand.st
@@ -39,11 +39,11 @@ Command subclass: AcceptItCommand [
target state hasSelectedCategory ifFalse: [ ^ self acceptClassDefinition ].
- (AddMethodUndoCommand
+ SysAddMethodCommand
add: target sourceCode
classified: target state category
in: target state classOrMeta
- browser: target) push
+ browser: target
]
]
diff --git a/packages/visualgst/Commands/System/AddClassCommand.st b/packages/visualgst/Commands/System/AddClassCommand.st
new file mode 100644
index 0000000..55c636f
--- /dev/null
+++ b/packages/visualgst/Commands/System/AddClassCommand.st
@@ -0,0 +1,80 @@
+"======================================================================
+|
+| SysAddClassCommand class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
+Command subclass: SysAddClassCommand [
+
+ | namespace newClassName parentClass newClass classCategory |
+
+ SysAddClassCommand class >> add: aSymbol to: aNamespace classCategory: aCategory withSuperclass: aClass [
+
+
+ ^ (self new)
+ add: aSymbol to: aNamespace classCategory: aCategory withSuperclass: aClass;
+ yourself
+ ]
+
+ add: aSymbol to: aNamespace classCategory: aCategory withSuperclass: aClass [
+
+
+ newClassName := aSymbol.
+ namespace := aNamespace.
+ classCategory := aCategory.
+ parentClass := aClass
+ ]
+
+ description [
+
+
+ ^ 'Add a class'
+ ]
+
+ valid [
+
+
+ newClassName = #Smalltalk ifTrue: [ ^ self preconditionFailed: 'class name can''t be the same has a namespace name' ].
+ Smalltalk subspacesDo: [ :each | each name = newClassName ifTrue: [ ^ self preconditionFailed: 'class name can''t be the same has a namespace name' ] ].
+ (namespace findIndexOrNil: newClassName) ifNotNil: [ ^ self preconditionFailed: 'class exist in the namespace' ].
+ ^ true
+ ]
+
+ execute [
+
+
+ newClass := parentClass subclass: newClassName environment: namespace.
+ namespace at: newClass name put: newClass.
+ newClass category: classCategory fullname.
+ ]
+]
+
diff --git a/packages/visualgst/Commands/System/AddMethodCommand.st b/packages/visualgst/Commands/System/AddMethodCommand.st
new file mode 100644
index 0000000..bc0621a
--- /dev/null
+++ b/packages/visualgst/Commands/System/AddMethodCommand.st
@@ -0,0 +1,130 @@
+"======================================================================
+|
+| SysAddMethodCommand class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
+Command subclass: SysAddMethodCommand [
+
+ | selector method category classOrMeta oldCompiledMethod browserWidget compiledMethod |
+
+ SysAddMethodCommand class >> add: aString classified: aCategory in: aClass [
+
+
+ ^ (self new)
+ add: aString classified: aCategory in: aClass;
+ yourself
+ ]
+
+ SysAddMethodCommand class >> add: aString classified: aCategory in: aClass browser: aGtkBrowserWidget [
+
+
+ ^ (self new)
+ add: aString classified: aCategory in: aClass browser: aGtkBrowserWidget;
+ yourself
+ ]
+
+ compileError: aString line: anInteger [
+
+
+ browserWidget isNil ifFalse: [ GtkLauncher compileError: aString line: anInteger ].
+ ^ self preconditionFailed: aString
+ ]
+
+ compileError: aString pos: pos [
+
+
+ ^ self compileError: aString line: nil
+ ]
+
+ add: aString classified: aCategory in: aClass browser: aGtkBrowserWidget [
+
+
+ self add: aString classified: aCategory in: aClass.
+ browserWidget := aGtkBrowserWidget.
+ ]
+
+ add: aString classified: aCategory in: aClass [
+
+
+ method := aString.
+ category := (#('still unclassified' '*') includes: (aCategory))
+ ifTrue: [ nil ]
+ ifFalse: [ aCategory ].
+ classOrMeta := aClass
+ ]
+
+ description [
+
+
+ ^ 'Add a method'
+ ]
+
+ valid [
+
+
+ | parser node |
+ parser := STInST.RBBracketedMethodParser new
+ errorBlock: [ :string :pos | self compileError: string pos: pos. ^false ];
+ initializeParserWith: method type: #'on:errorBlock:';
+ yourself.
+
+ selector := parser parseMethod selector.
+ oldCompiledMethod := classOrMeta methodDictionary ifNotNil: [ classOrMeta methodDictionary at: selector ifAbsent: [ nil ] ].
+ " TODO: use compile:classified:ifError: if there is no category "
+ compiledMethod := classOrMeta
+ compile: method
+ ifError: [ :fname :lineNo :errorString |
+ self compileError: errorString line: lineNo.
+ ^ false ].
+ ^ true
+ ]
+
+ execute [
+
+
+ browserWidget ifNotNil: [ browserWidget codeSaved ].
+
+ oldCompiledMethod ifNotNil: [ classOrMeta methodDictionary removeMethod: oldCompiledMethod ].
+ classOrMeta methodDictionary insertMethod: compiledMethod.
+
+ browserWidget ifNotNil: [ classOrMeta isClass
+ ifTrue: [ browserWidget selectAnInstanceMethod: compiledMethod selector ]
+ ifFalse: [ browserWidget selectAClassMethod: compiledMethod selector ] ]
+ ]
+
+ displayError [
+
+
+ ]
+]
+
diff --git a/packages/visualgst/Commands/System/AddNamespaceCommand.st b/packages/visualgst/Commands/System/AddNamespaceCommand.st
new file mode 100644
index 0000000..2eafaec
--- /dev/null
+++ b/packages/visualgst/Commands/System/AddNamespaceCommand.st
@@ -0,0 +1,77 @@
+"======================================================================
+|
+| SysAddNamespace class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
+Command subclass: SysAddNamespaceCommand [
+ | parentNamespace namespaceName newNamespace |
+
+ SysAddNamespaceCommand class >> add: aSymbol to: aNamespace [
+
+
+ ^ (self new)
+ add: aSymbol to: aNamespace;
+ yourself
+ ]
+
+ add: aSymbol to: aNamespace [
+
+
+ parentNamespace := aNamespace.
+ namespaceName := aSymbol.
+ ]
+
+ description [
+
+
+ ^ 'Add a namespace'
+ ]
+
+ valid [
+
+
+ namespaceName = #Smalltalk ifTrue: [ ^ self preconditionFailed: 'class name can''t be the same has a namespace name' ].
+ parentNamespace subspacesDo: [ :each |
+ each name = namespaceName ifTrue: [ ^ self preconditionFailed: 'class name can''t be the same has a namespace name' ] ].
+ (parentNamespace includesKey: namespaceName) ifTrue: [ ^ self preconditionFailed: 'parent namespace can''t be the same has a namespace name' ].
+ newNamespace := Namespace gstNew: parentNamespace name: namespaceName asSymbol.
+ ^ true
+ ]
+
+ execute [
+
+
+ parentNamespace insertSubspace: newNamespace
+ ]
+]
+
diff --git a/packages/visualgst/Commands/System/DeleteClassCommand.st b/packages/visualgst/Commands/System/DeleteClassCommand.st
new file mode 100644
index 0000000..a3ad7dd
--- /dev/null
+++ b/packages/visualgst/Commands/System/DeleteClassCommand.st
@@ -0,0 +1,75 @@
+"======================================================================
+|
+| SysDeleteClassCommand class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
+Command subclass: SysDeleteClassCommand [
+
+ | class |
+
+ SysDeleteClassCommand class >> delete: aClass [
+
+
+ ^ (self new)
+ delete: aClass;
+ "precondition;"
+ yourself
+ ]
+
+ delete: aClass [
+
+
+ class := aClass.
+ ]
+
+ description [
+
+
+ ^ 'Delete a class'
+ ]
+
+ valid [
+
+
+ class subclasses isEmpty ifFalse: [ ^ self preconditionFailed: 'class has subclasses' ].
+ ^ true
+ ]
+
+ execute [
+
+
+ class superclass ifNotNil: [ class superclass removeSubclass: class ].
+ class environment removeClass: class name
+ ]
+]
+
diff --git a/packages/visualgst/Commands/System/DeleteMethodCommand.st b/packages/visualgst/Commands/System/DeleteMethodCommand.st
new file mode 100644
index 0000000..f0ad368
--- /dev/null
+++ b/packages/visualgst/Commands/System/DeleteMethodCommand.st
@@ -0,0 +1,69 @@
+"======================================================================
+|
+| SysDeleteMethodCommand class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
+Command subclass: SysDeleteMethodCommand [
+
+ | selector classOrMeta compiledMethod |
+
+ SysDeleteMethodCommand class >> delete: aSymbol in: aClass [
+
+
+ ^ (self new)
+ delete: aSymbol in: aClass;
+ "precondition;"
+ yourself
+ ]
+
+ delete: aSymbol in: aClass [
+
+
+ selector := aSymbol.
+ classOrMeta := aClass.
+ ]
+
+ description [
+
+
+ ^ 'Delete a method'
+ ]
+
+ execte [
+
+
+ compiledMethod := classOrMeta >> selector.
+ classOrMeta methodDictionary removeMethod: compiledMethod.
+ ]
+]
+
diff --git a/packages/visualgst/Commands/System/DeleteNamespaceCommand.st b/packages/visualgst/Commands/System/DeleteNamespaceCommand.st
new file mode 100644
index 0000000..718bdba
--- /dev/null
+++ b/packages/visualgst/Commands/System/DeleteNamespaceCommand.st
@@ -0,0 +1,66 @@
+"======================================================================
+|
+| SysDeleteNamespaceCommand class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
+Command subclass: SysDeleteNamespaceCommand [
+
+ | namespace treeStore |
+
+ SysDeleteNamespaceCommand class >> delete: aNamespace [
+
+
+ ^ (self new)
+ delete: aNamespace;
+ yourself
+ ]
+
+ delete: aNamespace [
+
+
+ namespace := aNamespace
+ ]
+
+ description [
+
+
+ ^ 'Delete a namespace'
+ ]
+
+ execute [
+
+
+ namespace superspace removeSubspace: namespace name
+ ]
+]
+
diff --git a/packages/visualgst/Commands/System/RenameCategoryCommand.st b/packages/visualgst/Commands/System/RenameCategoryCommand.st
new file mode 100644
index 0000000..3fc0beb
--- /dev/null
+++ b/packages/visualgst/Commands/System/RenameCategoryCommand.st
@@ -0,0 +1,83 @@
+"======================================================================
+|
+| SysRenameCategorycommand class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
+Command subclass: SysRenameCategoryCommand [
+
+ | category class newCategory treeStore |
+
+ SysRenameCategoryCommand class >> rename: aString in: aClass as: aNewName onModel: aGtkTreeStore [
+
+
+ ^ (self new)
+ rename: aString in: aClass as: aNewName onModel: aGtkTreeStore;
+ "precondition;"
+ yourself
+ ]
+
+ rename: aString in: aClass as: aNewName onModel: aGtkTreeStore [
+
+
+ category := aString.
+ class := aClass.
+ newCategory := aNewName.
+ treeStore := aGtkTreeStore
+ ]
+
+ description [
+
+
+ ^ 'Rename a category'
+ ]
+
+ valid [
+
+
+ newCategory = '*' ifTrue: [ ^ self preconditionFailed: 'Can''t create a * category' ].
+ (treeStore hasCategory: newCategory asString) ifTrue: [ ^ self preconditionFailed: 'Category is present' ].
+ ^ true
+ ]
+
+ execute [
+
+
+ class methodDictionary do: [ :each |
+ each methodCategory = category
+ ifTrue: [ each methodCategory: newCategory ] ].
+ treeStore
+ removeCategory: category;
+ appendCategory: newCategory
+ ]
+]
+
diff --git a/packages/visualgst/Commands/System/RenameClassCommand.st b/packages/visualgst/Commands/System/RenameClassCommand.st
new file mode 100644
index 0000000..dd3edcc
--- /dev/null
+++ b/packages/visualgst/Commands/System/RenameClassCommand.st
@@ -0,0 +1,81 @@
+"======================================================================
+|
+| SysRenameClassCommand class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
+Command subclass: SysRenameClassCommand [
+
+ | class newClassName oldClassName |
+
+ SysRenameClassCommand class >> rename: aClass as: aSymbol [
+
+
+ ^ (self new)
+ rename: aClass as: aSymbol;
+ "precondition;"
+ yourself
+ ]
+
+ rename: aClass as: aSymbol [
+
+
+ class := aClass.
+ oldClassName := class name.
+ newClassName := aSymbol.
+ ]
+
+ description [
+
+
+ ^ 'Rename a class'
+ ]
+
+ execute [
+
+
+ newClassName = #Smalltalk ifTrue: [ ^ self preconditionFailed: 'class name can''t be the same has a namespace name' ].
+ class environment subspacesDo: [ :each | each name = newClassName ifTrue: [ ^ self preconditionFailed: 'class name can''t be the same has a namespace name' ] ].
+ (class environment findIndexOrNil: newClassName) ifNotNil: [ :class | ^ self preconditionFailed: 'class exist in the namespace' ].
+ ^ true
+ ]
+
+
+ valid [
+
+
+ class environment removeClass: oldClassName.
+ class setName: newClassName.
+ class environment insertClass: class
+ ]
+]
+
diff --git a/packages/visualgst/Commands/System/RenameNamespaceCommand.st b/packages/visualgst/Commands/System/RenameNamespaceCommand.st
new file mode 100644
index 0000000..80268c6
--- /dev/null
+++ b/packages/visualgst/Commands/System/RenameNamespaceCommand.st
@@ -0,0 +1,79 @@
+"======================================================================
+|
+| SysRenameNamespaceCommand class definition
+|
+======================================================================"
+
+"======================================================================
+|
+| Copyright (c) 2013
+| Gwenael Casaccio ,
+|
+|
+| This file is part of VisualGST.
+|
+| Permission is hereby granted, free of charge, to any person obtaining
+| a copy of this software and associated documentation files (the
+| 'Software'), to deal in the Software without restriction, including
+| without limitation the rights to use, copy, modify, merge, publish,
+| distribute, sublicense, and/or sell copies of the Software, and to
+| permit persons to whom the Software is furnished to do so, subject to
+| the following conditions:
+|
+| The above copyright notice and this permission notice shall be
+| included in all copies or substantial portions of the Software.
+|
+| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|
+======================================================================"
+
+Command subclass: SysRenameNamespaceCommand [
+
+ | namespace oldName newName |
+
+ SysRenameNamespaceCommand class >> rename: aNamespace as: aSymbol [
+
+
+ ^ (self new)
+ rename: aNamespace as: aSymbol;
+ "precondition;"
+ yourself
+ ]
+
+ rename: aNamespace as: aSymbol [
+
+
+ namespace := aNamespace.
+ oldName := namespace name.
+ newName := aSymbol.
+ ]
+
+ description [
+
+
+ ^ 'Rename a namespace'
+ ]
+
+ execute [
+
+
+ newName = #Smalltalk ifTrue: [ ^ self preconditionFailed: 'Namespace name can''t be the same has a namespace name' ].
+ namespace subspacesDo: [ :each | each name = newName ifTrue: [ ^ self preconditionFailed: 'Namespace name can''t be the same has a namespace name' ] ].
+ ^ true
+ ]
+
+ valid [
+
+
+ namespace superspace removeSubspace: namespace name.
+ namespace name: newName.
+ namespace superspace insertSubspace: namespace
+ ]
+]
+
diff --git a/packages/visualgst/Gtk/GtkEntry.st b/packages/visualgst/Gtk/GtkEntry.st
new file mode 100644
index 0000000..fc34fdb
--- /dev/null
+++ b/packages/visualgst/Gtk/GtkEntry.st
@@ -0,0 +1,9 @@
+GTK.GtkEntry extend [
+
+ getText [
+
+ ^ self getBuffer getText
+ ]
+
+]
+
diff --git a/packages/visualgst/Gtk/GtkEntryBuffer.st b/packages/visualgst/Gtk/GtkEntryBuffer.st
new file mode 100644
index 0000000..eceb980
--- /dev/null
+++ b/packages/visualgst/Gtk/GtkEntryBuffer.st
@@ -0,0 +1,9 @@
+GTK.GtkEntryBuffer extend [
+
+ getText [
+
+
+ ]
+
+]
+
diff --git a/packages/visualgst/Undo/AddClassUndoCommand.st b/packages/visualgst/Undo/AddClassUndoCommand.st
deleted file mode 100644
index 5baae9f..0000000
--- a/packages/visualgst/Undo/AddClassUndoCommand.st
+++ /dev/null
@@ -1,60 +0,0 @@
-UndoCommand subclass: AddClassUndoCommand [
-
- | first namespace newClassName parentClass newClass classCategory |
-
- AddClassUndoCommand class >> add: aSymbol to: aNamespace classCategory: aCategory withSuperclass: aClass [
-
-
- ^ (self new)
- add: aSymbol to: aNamespace classCategory: aCategory withSuperclass: aClass;
- precondition;
- yourself
- ]
-
- add: aSymbol to: aNamespace classCategory: aCategory withSuperclass: aClass [
-
-
- first := true.
- newClassName := aSymbol.
- namespace := aNamespace.
- classCategory := aCategory.
- parentClass := aClass
- ]
-
- description [
-
-
- ^ 'Add a class'
- ]
-
- precondition [
-
-
- newClassName = #Smalltalk ifTrue: [ ^ self preconditionFailed: 'class name can''t be the same has a namespace name' ].
- Smalltalk subspacesDo: [ :each | each name = newClassName ifTrue: [ ^ self preconditionFailed: 'class name can''t be the same has a namespace name' ] ].
- (namespace findIndexOrNil: newClassName) ifNotNil: [ ^ self preconditionFailed: 'class exist in the namespace' ].
- ^ true
- ]
-
- undo [
-
-
- parentClass removeSubclass: newClass.
- namespace removeClass: newClass name
- ]
-
- redo [
-
-
- first
- ifTrue: [
- newClass := parentClass subclass: newClassName environment: namespace.
- namespace at: newClass name put: newClass.
- newClass category: classCategory fullname.
- first := false ]
- ifFalse: [
- parentClass addSubclass: newClass.
- namespace insertClass: newClass ]
- ]
-]
-
diff --git a/packages/visualgst/Undo/AddMethodUndoCommand.st b/packages/visualgst/Undo/AddMethodUndoCommand.st
deleted file mode 100644
index 661cbb9..0000000
--- a/packages/visualgst/Undo/AddMethodUndoCommand.st
+++ /dev/null
@@ -1,109 +0,0 @@
-UndoCommand subclass: AddMethodUndoCommand [
-
- | selector method category classOrMeta oldCompiledMethod browserWidget compiledMethod |
-
- AddMethodUndoCommand class >> add: aString classified: aCategory in: aClass [
-
-
- ^ (self new)
- add: aString classified: aCategory in: aClass;
- yourself
- ]
-
- AddMethodUndoCommand class >> add: aString classified: aCategory in: aClass browser: aGtkBrowserWidget [
-
-
- ^ (self new)
- add: aString classified: aCategory in: aClass browser: aGtkBrowserWidget;
- yourself
- ]
-
- compileError: aString line: anInteger [
-
-
- browserWidget isNil ifFalse: [ GtkLauncher compileError: aString line: anInteger ].
- ^ self preconditionFailed: aString
- ]
-
- compileError: aString pos: pos [
-
-
- ^ self compileError: aString line: nil
- ]
-
- add: aString classified: aCategory in: aClass browser: aGtkBrowserWidget [
-
-
- self add: aString classified: aCategory in: aClass.
- browserWidget := aGtkBrowserWidget.
- ]
-
- add: aString classified: aCategory in: aClass [
-
-
- method := aString.
- category := (#('still unclassified' '*') includes: (aCategory))
- ifTrue: [ nil ]
- ifFalse: [ aCategory ].
- classOrMeta := aClass
- ]
-
- description [
-
-
- ^ 'Add a method'
- ]
-
- precondition [
-
-
- | parser node |
- parser := STInST.RBBracketedMethodParser new
- errorBlock: [ :string :pos | self compileError: string pos: pos. ^false ];
- initializeParserWith: method type: #'on:errorBlock:';
- yourself.
-
- selector := parser parseMethod selector.
- oldCompiledMethod := classOrMeta methodDictionary ifNotNil: [ classOrMeta methodDictionary at: selector ifAbsent: [ nil ] ].
- " TODO: use compile:classified:ifError: if there is no category "
- compiledMethod := classOrMeta
- compile: method
- ifError: [ :fname :lineNo :errorString |
- self compileError: errorString line: lineNo.
- ^ false ].
- ^ true
- ]
-
- undo [
-
-
- | selector |
- browserWidget ifNotNil: [ browserWidget codeSaved ].
-
- classOrMeta methodDictionary removeMethod: compiledMethod.
- oldCompiledMethod
- ifNotNil: [
- classOrMeta methodDictionary insertMethod: oldCompiledMethod.
- selector := oldCompiledMethod selector ]
- ifNil: [ selector := nil ].
- ]
-
- redo [
-
-
- browserWidget ifNotNil: [ browserWidget codeSaved ].
-
- oldCompiledMethod ifNotNil: [ classOrMeta methodDictionary removeMethod: oldCompiledMethod ].
- classOrMeta methodDictionary insertMethod: compiledMethod.
-
- browserWidget ifNotNil: [ classOrMeta isClass
- ifTrue: [ browserWidget selectAnInstanceMethod: compiledMethod selector ]
- ifFalse: [ browserWidget selectAClassMethod: compiledMethod selector ] ]
- ]
-
- displayError [
-
-
- ]
-]
-
diff --git a/packages/visualgst/Undo/AddNamespaceUndoCommand.st b/packages/visualgst/Undo/AddNamespaceUndoCommand.st
deleted file mode 100644
index e9f9bbb..0000000
--- a/packages/visualgst/Undo/AddNamespaceUndoCommand.st
+++ /dev/null
@@ -1,48 +0,0 @@
-UndoCommand subclass: AddNamespaceUndoCommand [
- | parentNamespace namespaceName newNamespace |
-
- AddNamespaceUndoCommand class >> add: aSymbol to: aNamespace [
-
-
- ^ (self new)
- add: aSymbol to: aNamespace;
- yourself
- ]
-
- add: aSymbol to: aNamespace [
-
-
- parentNamespace := aNamespace.
- namespaceName := aSymbol.
- ]
-
- description [
-
-
- ^ 'Add a namespace'
- ]
-
- precondition [
-
-
- namespaceName = #Smalltalk ifTrue: [ ^ self preconditionFailed: 'class name can''t be the same has a namespace name' ].
- parentNamespace subspacesDo: [ :each |
- each name = namespaceName ifTrue: [ ^ self preconditionFailed: 'class name can''t be the same has a namespace name' ] ].
- (parentNamespace includesKey: namespaceName) ifTrue: [ ^ self preconditionFailed: 'parent namespace can''t be the same has a namespace name' ].
- newNamespace := Namespace gstNew: parentNamespace name: namespaceName asSymbol.
- ^ true
- ]
-
- undo [
-
-
- parentNamespace removeSubspace: newNamespace name
- ]
-
- redo [
-
-
- parentNamespace insertSubspace: newNamespace
- ]
-]
-
diff --git a/packages/visualgst/Undo/DeleteClassUndoCommand.st b/packages/visualgst/Undo/DeleteClassUndoCommand.st
deleted file mode 100644
index 471aa7c..0000000
--- a/packages/visualgst/Undo/DeleteClassUndoCommand.st
+++ /dev/null
@@ -1,47 +0,0 @@
-UndoCommand subclass: DeleteClassUndoCommand [
-
- | class |
-
- DeleteClassUndoCommand class >> delete: aClass [
-
-
- ^ (self new)
- delete: aClass;
- "precondition;"
- yourself
- ]
-
- delete: aClass [
-
-
- class := aClass.
- ]
-
- description [
-
-
- ^ 'Delete a class'
- ]
-
- precondition [
-
-
- class subclasses isEmpty ifFalse: [ ^ self preconditionFailed: 'class has subclasses' ].
- ^ true
- ]
-
- undo [
-
-
- class superclass ifNotNil: [ class superclass addSubclass: class ].
- class environment insertClass: class
- ]
-
- redo [
-
-
- class superclass ifNotNil: [ class superclass removeSubclass: class ].
- class environment removeClass: class name
- ]
-]
-
diff --git a/packages/visualgst/Undo/DeleteMethodUndoCommand.st b/packages/visualgst/Undo/DeleteMethodUndoCommand.st
deleted file mode 100644
index 0a45667..0000000
--- a/packages/visualgst/Undo/DeleteMethodUndoCommand.st
+++ /dev/null
@@ -1,46 +0,0 @@
-UndoCommand subclass: DeleteMethodUndoCommand [
-
- | selector classOrMeta compiledMethod |
-
- DeleteMethodUndoCommand class >> delete: aSymbol in: aClass [
-
-
- ^ (self new)
- delete: aSymbol in: aClass;
- "precondition;"
- yourself
- ]
-
- delete: aSymbol in: aClass [
-
-
- selector := aSymbol.
- classOrMeta := aClass.
- ]
-
- description [
-
-
- ^ 'Delete a method'
- ]
-
- precondition [
-
-
- ^ true
- ]
-
- undo [
-
-
- classOrMeta methodDictionary insertMethod: compiledMethod.
- ]
-
- redo [
-
-
- compiledMethod := classOrMeta >> selector.
- classOrMeta methodDictionary removeMethod: compiledMethod.
- ]
-]
-
diff --git a/packages/visualgst/Undo/DeleteNamespaceUndoCommand.st b/packages/visualgst/Undo/DeleteNamespaceUndoCommand.st
deleted file mode 100644
index 5f9fa7a..0000000
--- a/packages/visualgst/Undo/DeleteNamespaceUndoCommand.st
+++ /dev/null
@@ -1,37 +0,0 @@
-UndoCommand subclass: DeleteNamespaceUndoCommand [
-
- | namespace treeStore |
-
- DeleteNamespaceUndoCommand class >> delete: aNamespace [
-
-
- ^ (self new)
- delete: aNamespace;
- yourself
- ]
-
- delete: aNamespace [
-
-
- namespace := aNamespace
- ]
-
- description [
-
-
- ^ 'Delete a namespace'
- ]
-
- undo [
-
-
- namespace superspace insertSubspace: namespace
- ]
-
- redo [
-
-
- namespace superspace removeSubspace: namespace name
- ]
-]
-
diff --git a/packages/visualgst/Undo/RenameCategoryUndoCommand.st b/packages/visualgst/Undo/RenameCategoryUndoCommand.st
deleted file mode 100644
index f1b9860..0000000
--- a/packages/visualgst/Undo/RenameCategoryUndoCommand.st
+++ /dev/null
@@ -1,59 +0,0 @@
-UndoCommand subclass: RenameCategoryUndoCommand [
-
- | category class newCategory treeStore |
-
- RenameCategoryUndoCommand class >> rename: aString in: aClass as: aNewName onModel: aGtkTreeStore [
-
-
- ^ (self new)
- rename: aString in: aClass as: aNewName onModel: aGtkTreeStore;
- "precondition;"
- yourself
- ]
-
- rename: aString in: aClass as: aNewName onModel: aGtkTreeStore [
-
-
- category := aString.
- class := aClass.
- newCategory := aNewName.
- treeStore := aGtkTreeStore
- ]
-
- description [
-
-
- ^ 'Rename a category'
- ]
-
- precondition [
-
-
- newCategory = '*' ifTrue: [ ^ self preconditionFailed: 'Can''t create a * category' ].
- (treeStore hasCategory: newCategory asString) ifTrue: [ ^ self preconditionFailed: 'Category is present' ].
- ^ true
- ]
-
- undo [
-
-
- class methodDictionary do: [ :each |
- each methodCategory = newCategory
- ifTrue: [ each methodCategory: category ] ].
- treeStore
- removeCategory: newCategory;
- appendCategory: category
- ]
-
- redo [
-
-
- class methodDictionary do: [ :each |
- each methodCategory = category
- ifTrue: [ each methodCategory: newCategory ] ].
- treeStore
- removeCategory: category;
- appendCategory: newCategory
- ]
-]
-
diff --git a/packages/visualgst/Undo/RenameClassUndoCommand.st b/packages/visualgst/Undo/RenameClassUndoCommand.st
deleted file mode 100644
index 47018c0..0000000
--- a/packages/visualgst/Undo/RenameClassUndoCommand.st
+++ /dev/null
@@ -1,53 +0,0 @@
-UndoCommand subclass: RenameClassUndoCommand [
-
- | class newClassName oldClassName |
-
- RenameClassUndoCommand class >> rename: aClass as: aSymbol [
-
-
- ^ (self new)
- rename: aClass as: aSymbol;
- "precondition;"
- yourself
- ]
-
- rename: aClass as: aSymbol [
-
-
- class := aClass.
- oldClassName := class name.
- newClassName := aSymbol.
- ]
-
- description [
-
-
- ^ 'Rename a class'
- ]
-
- precondition [
-
-
- newClassName = #Smalltalk ifTrue: [ ^ self preconditionFailed: 'class name can''t be the same has a namespace name' ].
- class environment subspacesDo: [ :each | each name = newClassName ifTrue: [ ^ self preconditionFailed: 'class name can''t be the same has a namespace name' ] ].
- (class environment findIndexOrNil: newClassName) ifNotNil: [ :class | ^ self preconditionFailed: 'class exist in the namespace' ].
- ^ true
- ]
-
- undo [
-
-
- class environment removeClass: newClassName.
- class setName: oldClassName.
- class environment insertClass: class
- ]
-
- redo [
-
-
- class environment removeClass: oldClassName.
- class setName: newClassName.
- class environment insertClass: class
- ]
-]
-
diff --git a/packages/visualgst/Undo/RenameNamespaceUndoCommand.st b/packages/visualgst/Undo/RenameNamespaceUndoCommand.st
deleted file mode 100644
index 8cf3944..0000000
--- a/packages/visualgst/Undo/RenameNamespaceUndoCommand.st
+++ /dev/null
@@ -1,52 +0,0 @@
-UndoCommand subclass: RenameNamespaceUndoCommand [
-
- | namespace oldName newName |
-
- RenameNamespaceUndoCommand class >> rename: aNamespace as: aSymbol [
-
-
- ^ (self new)
- rename: aNamespace as: aSymbol;
- "precondition;"
- yourself
- ]
-
- rename: aNamespace as: aSymbol [
-
-
- namespace := aNamespace.
- oldName := namespace name.
- newName := aSymbol.
- ]
-
- description [
-
-
- ^ 'Rename a namespace'
- ]
-
- precondition [
-
-
- newName = #Smalltalk ifTrue: [ ^ self preconditionFailed: 'Namespace name can''t be the same has a namespace name' ].
- namespace subspacesDo: [ :each | each name = newName ifTrue: [ ^ self preconditionFailed: 'Namespace name can''t be the same has a namespace name' ] ].
- ^ true
- ]
-
- undo [
-
-
- namespace superspace removeSubspace: namespace name.
- namespace name: oldName.
- namespace superspace insertSubspace: namespace
- ]
-
- redo [
-
-
- namespace superspace removeSubspace: namespace name.
- namespace name: newName.
- namespace superspace insertSubspace: namespace
- ]
-]
-
diff --git a/packages/visualgst/package.xml b/packages/visualgst/package.xml
index 4267d1d..b46f4f8 100644
--- a/packages/visualgst/package.xml
+++ b/packages/visualgst/package.xml
@@ -68,6 +68,8 @@
VisualGST.GtkConcreteWidgetTest
+ Gtk/GtkEntry.st
+ Gtk/GtkEntryBuffer.st
Extensions.st
Notification/AbstractEvent.st
Notification/AddedEvent.st
@@ -208,9 +210,9 @@
HistoryStack.st
Undo/UndoStack.st
Undo/UndoCommand.st
- Undo/AddNamespaceUndoCommand.st
- Undo/RenameNamespaceUndoCommand.st
- Undo/DeleteNamespaceUndoCommand.st
+ Commands/System/AddNamespaceCommand.st
+ Commands/System/RenameNamespaceCommand.st
+ Commands/System/DeleteNamespaceCommand.st
Source/SourceFormatter.st
Source/NamespaceHeaderSource.st
Source/NamespaceSource.st
@@ -220,9 +222,9 @@
Source/MethodSource.st
Source/PackageSource.st
Source/BrowserMethodSource.st
- Undo/AddClassUndoCommand.st
- Undo/RenameClassUndoCommand.st
- Undo/DeleteClassUndoCommand.st
+ Commands/System/AddClassCommand.st
+ Commands/System/RenameClassCommand.st
+ Commands/System/DeleteClassCommand.st
AbstractFinder.st
NamespaceFinder.st
ClassFinder.st
@@ -230,9 +232,9 @@
GtkWebBrowser.st
GtkWebView.st
GtkAssistant.st
- Undo/RenameCategoryUndoCommand.st
- Undo/AddMethodUndoCommand.st
- Undo/DeleteMethodUndoCommand.st
+ Commands/System/RenameCategoryCommand.st
+ Commands/System/AddMethodCommand.st
+ Commands/System/DeleteMethodCommand.st
WorkspaceVariableTracker.st
GtkVariableTrackerWidget.st
SyntaxHighlighter.st
@@ -434,9 +436,9 @@
HistoryStack.st
Undo/UndoStack.st
Undo/UndoCommand.st
- Undo/AddNamespaceUndoCommand.st
- Undo/RenameNamespaceUndoCommand.st
- Undo/DeleteNamespaceUndoCommand.st
+ Commands/System/AddNamespaceCommand.st
+ Commands/System/RenameNamespaceCommand.st
+ Commands/System/DeleteNamespaceCommand.st
Source/SourceFormatter.st
Source/NamespaceHeaderSource.st
Source/NamespaceSource.st
@@ -446,20 +448,22 @@
Source/MethodSource.st
Source/PackageSource.st
Source/BrowserMethodSource.st
- Undo/AddClassUndoCommand.st
- Undo/RenameClassUndoCommand.st
- Undo/DeleteClassUndoCommand.st
+ Commands/System/AddClassCommand.st
+ Commands/System/RenameClassCommand.st
+ Commands/System/DeleteClassCommand.st
AbstractFinder.st
NamespaceFinder.st
ClassFinder.st
MethodFinder.st
GtkWebBrowser.st
GtkWebView.st
+ Gtk/GtkEntry.st
+ Gtk/GtkEntryBuffer.st
Extensions.st
GtkAssistant.st
- Undo/RenameCategoryUndoCommand.st
- Undo/AddMethodUndoCommand.st
- Undo/DeleteMethodUndoCommand.st
+ Commands/System/RenameCategoryCommand.st
+ Commands/System/AddMethodCommand.st
+ Commands/System/DeleteMethodCommand.st
WorkspaceVariableTracker.st
GtkVariableTrackerWidget.st
SyntaxHighlighter.st
--
1.8.1.2