Tools__NewSystemBrowser.st
changeset 11524 7abc3f3c2530
parent 11510 38d3ea8cc986
child 11527 e36173071529
--- a/Tools__NewSystemBrowser.st	Tue May 22 18:33:26 2012 +0200
+++ b/Tools__NewSystemBrowser.st	Thu May 24 16:17:43 2012 +0200
@@ -14,38 +14,38 @@
 "{ NameSpace: Tools }"
 
 SystemBrowser subclass:#NewSystemBrowser
-	instanceVariableNames:'navigationState bufferNameList selectedBuffer buffers
-		bufferUsageOrder browserCanvas immediateUpdate showClassPackages
-		lastMethodCategory lastMethodMoveClass browserCanvasType
-		syntaxColoringProcessRunning syntaxColoringProcess
-		methodInfoProcess browsletShowHideLabelHolder browserPageCanvas'
-	classVariableNames:'LastNewProtocols LastProtocolRenames LastCategoryRenames
-		LastCategoryRenameOld LastCategoryRenameNew LastProjectMoves
-		LastNameSpaceMove LastMethodMoveOrCopyTargetClass
-		LastClassFilterBlockString LastMethodFilterBlockString
-		LastBreakPointConditionString LastIndividualChecks
-		LastAcceptPackage LastVariableRenames LastVisitorClassName
-		LastTemporaryVariableName BookMarks FindHistory
-		CheckForInstancesWhenRemovingClasses SynchronousUpdate
-		DoubleClickIsOpenBrowser ShowMethodTemplateWhenProtocolIsSelected
-		DefaultShowMethodTemplate DefaultShowMethodInheritance
-		DefaultEmphasizeUnloadedClasses DefaultImmediateSyntaxColoring
-		DefaultImmediateExplaining DefaultSyntaxColoring
-		DefaultToolBarVisible DefaultCodeInfoVisible
-		DefaultShortNameInTabs DefaultHideUnloadedClasses
-		DefaultMarkApplications DefaultAutoFormat
-		DefaultShowMethodComplexity DefaultShowMethodTypeIcon
-		DefaultShowSpecialResourceEditors SharedMethodCategoryCache
-		LastMethodProcessingBlockString LastLoadedPackages
-		DefaultShortAllClassesInNameSpaceOrganisation LastTag
-		LastBaseVersionTag DefaultShowPseudoProtocols
-		DefaultShowMultitabMode LastRenamedOld LastRenamedNew
-		LastImportedPackage LastLintRules NewNavigationHistory
-		DefaultSortByNameAndInheritance LastLiteralReplacementType
-		LastLiteralReplacementNewName LastLiteralReplacementOldLiteral
-		LastNewProjectType'
-	poolDictionaries:''
-	category:'Interface-Browsers-New'
+        instanceVariableNames:'navigationState bufferNameList selectedBuffer buffers
+                bufferUsageOrder browserCanvas immediateUpdate showClassPackages
+                lastMethodCategory lastMethodMoveClass browserCanvasType
+                syntaxColoringProcessRunning syntaxColoringProcess
+                methodInfoProcess browsletShowHideLabelHolder browserPageCanvas'
+        classVariableNames:'LastNewProtocols LastProtocolRenames LastCategoryRenames
+                LastCategoryRenameOld LastCategoryRenameNew LastProjectMoves
+                LastNameSpaceMove LastMethodMoveOrCopyTargetClass
+                LastClassFilterBlockString LastMethodFilterBlockString
+                LastBreakPointConditionString LastIndividualChecks
+                LastAcceptPackage LastVariableRenames LastVisitorClassName
+                LastTemporaryVariableName BookMarks FindHistory
+                CheckForInstancesWhenRemovingClasses SynchronousUpdate
+                DoubleClickIsOpenBrowser ShowMethodTemplateWhenProtocolIsSelected
+                DefaultShowMethodTemplate DefaultShowMethodInheritance
+                DefaultEmphasizeUnloadedClasses DefaultImmediateSyntaxColoring
+                DefaultImmediateExplaining DefaultSyntaxColoring
+                DefaultToolBarVisible DefaultCodeInfoVisible
+                DefaultShortNameInTabs DefaultHideUnloadedClasses
+                DefaultMarkApplications DefaultAutoFormat
+                DefaultShowMethodComplexity DefaultShowMethodTypeIcon
+                DefaultShowSpecialResourceEditors SharedMethodCategoryCache
+                LastMethodProcessingBlockString LastLoadedPackages
+                DefaultShortAllClassesInNameSpaceOrganisation LastTag
+                LastBaseVersionTag DefaultShowPseudoProtocols
+                DefaultShowMultitabMode LastRenamedOld LastRenamedNew
+                LastImportedPackage LastLintRules NewNavigationHistory
+                DefaultSortByNameAndInheritance LastLiteralReplacementType
+                LastLiteralReplacementNewName LastLiteralReplacementOldLiteral
+                LastNewProjectType'
+        poolDictionaries:''
+        category:'Interface-Browsers-New'
 !
 
 !NewSystemBrowser class methodsFor:'documentation'!
@@ -8070,6 +8070,42 @@
       )
 !
 
+classNewLispClassSlice
+    "This resource specification was automatically generated
+     by the MenuEditor of ST/X."
+
+    "Do not manually edit this!! If it is corrupted,
+     the MenuEditor may not be able to read the specification."
+
+    "
+     MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classNewLispClassSlice
+     (Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classNewLispClassSlice)) startUp
+    "
+
+    <resource: #menu>
+
+    ^ 
+     #(Menu
+        (
+         (MenuItem
+            label: '-'
+            isVisible: isLispMetaclassPresent
+          )
+         (MenuItem
+            enabled: isLispMetaclassPresent
+            label: 'Lisp Pseudo-Class'
+            itemValue: classMenuNewLispClass
+            isVisible: isLispMetaclassPresent                           
+            translateLabel: true
+          )
+         )
+        nil
+        nil
+      )
+
+    "Created: / 13-05-2012 / 12:51:10 / cg"
+!
+
 classNewPLSQLClassSlice
     "This resource specification was automatically generated
      by the MenuEditor of ST/X."
@@ -8204,6 +8240,13 @@
             isMenuSlice: true
           )
          (MenuItem
+            label: 'Lisp Class Slice'
+            nameKey: classNewLispClassSlice
+            translateLabel: true
+            submenuChannel: classNewLispClassSlice
+            isMenuSlice: true
+          )
+         (MenuItem
             label: 'Haskell Class Slice'
             nameKey: classNewHaskellClassSlice
             translateLabel: true
@@ -8231,7 +8274,7 @@
         nil
       )
 
-    "Modified: / 27-01-2012 / 12:41:41 / cg"
+    "Modified: / 13-05-2012 / 12:51:40 / cg"
 !
 
 classNewSmalltalkSlice
@@ -21191,6 +21234,12 @@
     ^ LispEnvironment notNil
 !
 
+isLispMetaclassPresent
+    ^ LispMetaclass notNil and:[LispMetaclass notNil]
+
+    "Created: / 13-05-2012 / 12:52:16 / cg"
+!
+
 isMethodListBrowser
     ^ navigationState isMethodListBrowser
 !
@@ -26623,8 +26672,9 @@
     self withWaitCursorDo:[
         newClass := self doCopyClass:currentClass as:newClassName privateIn:newOwnerClass.
     ].
-
-    "Modified: / 01-03-2007 / 20:50:33 / cg"
+    self selectClass:newClass.
+
+    "Modified: / 24-05-2012 / 15:49:14 / cg"
 !
 
 classMenuDefinition
@@ -27976,6 +28026,14 @@
     self classMenuNewClass:JavaScriptMetaclass
 !
 
+classMenuNewLispClass
+    "create a class-definition template in codeview"
+
+    self classMenuNewClass:LispMetaclass
+
+    "Created: / 13-05-2012 / 12:53:17 / cg"
+!
+
 classMenuNewNotification
     "create a class-definition prototype for an exception class"
 
@@ -29047,11 +29105,13 @@
 !
 
 doCopyClass:aClass as:newClassName privateIn:ownerOrNil
-    self
+    ^ self
         doCopyClass:aClass
         as:newClassName
         privateIn:ownerOrNil
         ignore:(IdentitySet new)
+
+    "Modified: / 24-05-2012 / 15:49:49 / cg"
 !
 
 doCopyClass:aClass as:newClassName privateIn:ownerOrNil ignore:setOfClassesToIgnore
@@ -29077,7 +29137,7 @@
 
     newClass isNil ifTrue:[
         self error:'Internal class-definition error (should not happen)' mayProceed:true.
-        ^ self.
+        ^ nil.
     ].
 
     newMetaclass := newClass class.
@@ -29116,7 +29176,7 @@
     newClass package:(Class packageQuerySignal query).
     ^ newClass
 
-    "Modified: / 22-12-2010 / 18:44:04 / cg"
+    "Modified: / 24-05-2012 / 15:49:59 / cg"
 !
 
 doMoveMethodsOfClass:aClass fromProject:oldProject toProject:newProject
@@ -56395,11 +56455,11 @@
 !NewSystemBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1743 2012-05-15 18:10:45 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1744 2012-05-24 14:17:43 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1743 2012-05-15 18:10:45 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1744 2012-05-24 14:17:43 cg Exp $'
 !
 
 version_SVN