>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