ToolApplicationModel.st
changeset 800 b98050cf7a43
parent 799 b67166ad461e
child 802 c863da8d04d3
--- a/ToolApplicationModel.st	Sun Feb 01 14:12:29 1998 +0100
+++ b/ToolApplicationModel.st	Sun Feb 01 16:00:39 1998 +0100
@@ -65,15 +65,57 @@
     "Modified: #menuAbout / 30.1.1998 / 00:03:11 / cg"
     "Modified: #menuHelp / 30.1.1998 / 00:03:59 / cg"
     "Modified: #menuSettings / 30.1.1998 / 00:04:14 / cg"
+    "Modified: #author / 1.2.1998 / 15:30:00 / cg"
+    "Modified: #author / 1.2.1998 / 15:35:48 / cg"
+    "Modified: #author / 1.2.1998 / 15:36:07 / cg"
+    "Modified: #openAboutThisApplication / 1.2.1998 / 15:38:38 / cg"
+    "Modified: #openAboutThisApplication / 1.2.1998 / 15:40:11 / cg"
+    "Created: #authorLinesForAboutBox / 1.2.1998 / 15:41:43 / cg"
+    "Modified: #openAboutThisApplication / 1.2.1998 / 15:42:11 / cg"
+    "Modified: #authorLinesForAboutBox / 1.2.1998 / 15:42:48 / cg"
+    "Modified: #authorLinesForAboutBox / 1.2.1998 / 15:44:36 / cg"
+    "Modified: #authorLinesForAboutBox / 1.2.1998 / 15:56:17 / cg"
+    "Deleted: #author / 1.2.1998 / 15:57:08 / cg"
+    "Modified: #authorLinesForAboutBox / 1.2.1998 / 15:57:27 / cg"
+    "Modified: #openAboutThisApplication / 1.2.1998 / 15:58:05 / cg"
+    "Modified: #authorLinesForAboutBox / 1.2.1998 / 15:59:11 / cg"
+    "Modified: #openAboutThisApplication / 1.2.1998 / 15:59:59 / cg"
 ! !
 
 !ToolApplicationModel class methodsFor:'accessing'!
 
-author
+authorLinesForAboutBox
+    "extract the author(s) from the documentation method."
+
+    |firstClassWithDocumentation src s line lines|
 
-    ^((((self class withAllSuperclasses detect: [:metacls| metacls implements:#documentation]))
-        compiledMethodAt: #documentation) source readStream upToAll: '[author:]'; nextLine; nextLine) trimBlanks
-  
+    firstClassWithDocumentation := self class withAllSuperclasses detect:[:metacls| metacls implements:#documentation].
+    firstClassWithDocumentation notNil ifTrue:[
+        (firstClassWithDocumentation inheritsFrom:ToolApplicationModel class) ifTrue:[
+            src := (firstClassWithDocumentation compiledMethodAt:#documentation) source.
+            src notNil ifTrue:[
+                s := src readStream.
+                s upToAll:'[author:]'.
+                s nextLine.   "/ skip to end
+                line := s nextLine.   "/ line after [author:]
+                lines := OrderedCollection new.
+                [line notNil and:[line notEmpty]] whileTrue:[
+                    line := line trimBlanks.
+                    line size > 1 ifTrue:[
+                        lines add:line trimBlanks.
+                        line := s nextLine.
+                    ] ifFalse:[
+                        line := nil
+                    ]
+                ].
+                ^ lines.
+            ]
+        ]
+    ].
+    ^ #('unnown')
+
+    "Created: / 1.2.1998 / 15:41:43 / cg"
+    "Modified: / 1.2.1998 / 15:59:10 / cg"
 !
 
 label
@@ -810,13 +852,17 @@
     rev := ''.
     self class revision notNil ifTrue: [rev := '  (rev: ', self class revision printString, ')'].
     box := AboutBox title:
-        '\The application\\' withCRs,
-        (Text string: self class label emphasis: #bold), rev,
-        '\\has been designed and implemented by \' withCRs,self class author,', eXept Software AG, Germany.  \\' withCRs.
+        '\The application\\' withCRs
+        , (Text string: self class name emphasis: #bold), rev
+        , '\\has been designed and implemented by \' withCRs
+        , ((self class authorLinesForAboutBox collect:[:l | '  ' , l]) asStringWith:$\) withCRs
+        , '\\' withCRs.
 
      box   label:'About This Application'.
      box   autoHideAfter:10 with:[].
      box   showAtCenter.
+
+    "Modified: / 1.2.1998 / 15:59:58 / cg"
 !
 
 openClassDocumentation
@@ -1055,5 +1101,5 @@
 !ToolApplicationModel class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview2/ToolApplicationModel.st,v 1.26 1998-02-01 13:12:29 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview2/ToolApplicationModel.st,v 1.27 1998-02-01 15:00:39 cg Exp $'
 ! !