author | Claus Gittinger <cg@exept.de> |
Wed, 02 Feb 2000 20:35:59 +0100 | |
changeset 2577 | 14b7cc070a6b |
parent 2477 | cfb8a4d7b557 |
child 2700 | 854f2402bc08 |
permissions | -rw-r--r-- |
84 | 1 |
" |
2 |
COPYRIGHT (c) 1995 by Claus Gittinger |
|
92 | 3 |
All Rights Reserved |
84 | 4 |
|
5 |
This software is furnished under a license and may be used |
|
6 |
only in accordance with the terms of that license and with the |
|
7 |
inclusion of the above copyright notice. This software may not |
|
8 |
be provided or otherwise made available to, or used by, any |
|
9 |
other person. No title to or ownership of the software is |
|
10 |
hereby transferred. |
|
11 |
" |
|
12 |
||
13 |
InfoBox subclass:#AboutBox |
|
451
35d5ba59ee0e
added access method for background color
Claus Gittinger <cg@exept.de>
parents:
248
diff
changeset
|
14 |
instanceVariableNames:'' |
35d5ba59ee0e
added access method for background color
Claus Gittinger <cg@exept.de>
parents:
248
diff
changeset
|
15 |
classVariableNames:'CachedIcon' |
35d5ba59ee0e
added access method for background color
Claus Gittinger <cg@exept.de>
parents:
248
diff
changeset
|
16 |
poolDictionaries:'' |
35d5ba59ee0e
added access method for background color
Claus Gittinger <cg@exept.de>
parents:
248
diff
changeset
|
17 |
category:'Views-DialogBoxes' |
84 | 18 |
! |
19 |
||
879 | 20 |
!AboutBox class methodsFor:'documentation'! |
84 | 21 |
|
198 | 22 |
copyright |
23 |
" |
|
24 |
COPYRIGHT (c) 1995 by Claus Gittinger |
|
25 |
All Rights Reserved |
|
26 |
||
27 |
This software is furnished under a license and may be used |
|
28 |
only in accordance with the terms of that license and with the |
|
29 |
inclusion of the above copyright notice. This software may not |
|
30 |
be provided or otherwise made available to, or used by, any |
|
31 |
other person. No title to or ownership of the software is |
|
32 |
hereby transferred. |
|
33 |
" |
|
84 | 34 |
! |
35 |
||
36 |
documentation |
|
37 |
" |
|
38 |
A box specialized to show the ST/X about information. |
|
498 | 39 |
As a speciality, this box automatically closes if left |
40 |
alone for a while. |
|
84 | 41 |
|
498 | 42 |
Can be subclasses for your own aboutBoxes; to do so, redefine |
43 |
#defaultIcon and #aboutText. |
|
92 | 44 |
|
498 | 45 |
examples: |
46 |
AboutBox new open |
|
47 |
||
48 |
AboutBox new showAtPointer |
|
84 | 49 |
" |
50 |
! ! |
|
51 |
||
879 | 52 |
!AboutBox class methodsFor:'defaults'! |
84 | 53 |
|
92 | 54 |
aboutText |
498 | 55 |
"return a string to be shown in the box. |
56 |
Can be redefined in custom subclasses." |
|
125 | 57 |
|
1797 | 58 |
|distributor expiration machine info| |
179
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
59 |
|
693 | 60 |
distributor := Smalltalk distributorString. |
61 |
distributor notEmpty ifTrue:[ |
|
708
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
62 |
distributor := 'Distributor ...... ', distributor |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
63 |
]. |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
64 |
expiration := Smalltalk expirationTime. |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
65 |
expiration notNil ifTrue:[ |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
66 |
expiration := 'Expires ........... ', expiration printString |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
67 |
] ifFalse:[ |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
68 |
expiration := ''. |
693 | 69 |
]. |
1797 | 70 |
machine := OperatingSystem getHostName. |
71 |
info := OperatingSystem getSystemInfo. |
|
72 |
(info includesKey:#machine) ifTrue:[ |
|
73 |
machine := machine , ' (' , (info at:#machine) , ')' |
|
74 |
]. |
|
179
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
75 |
|
92 | 76 |
^ |
179
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
77 |
'SmallTalk/X |
92 | 78 |
|
708
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
79 |
Version ......... ', Smalltalk versionString , '.' , Smalltalk releaseNr printString , |
498 | 80 |
' (' , Smalltalk versionDate printString , ') |
708
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
81 |
', distributor, ' |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
82 |
', expiration , ' |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
83 |
Release ID ...... ', Smalltalk releaseIdentification, ' |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
84 |
Configuration ... ', Smalltalk configuration, ' |
1797 | 85 |
Running on ...... ', machine, ' |
92 | 86 |
|
179
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
87 |
' , Smalltalk copyrightString , ' |
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
88 |
|
693 | 89 |
' |
179
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
90 |
|
1797 | 91 |
"Modified: / 6.9.1996 / 10:11:08 / stefan" |
92 |
"Modified: / 4.8.1998 / 02:28:29 / cg" |
|
198 | 93 |
! |
94 |
||
95 |
defaultIcon |
|
498 | 96 |
"return a smalltalk/X icon. |
97 |
Can be redefined in custom subclasses." |
|
198 | 98 |
|
99 |
CachedIcon isNil ifTrue:[ |
|
2169 | 100 |
CachedIcon := Icon stxIcon. |
101 |
CachedIcon isNil ifTrue:[ |
|
2477 | 102 |
CachedIcon := Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool' |
2169 | 103 |
] |
198 | 104 |
]. |
105 |
^ CachedIcon |
|
498 | 106 |
|
2169 | 107 |
"Modified: / 25.5.1999 / 15:44:48 / cg" |
498 | 108 |
! |
109 |
||
110 |
defaultLabel |
|
111 |
"return the boxes default window title." |
|
112 |
||
113 |
^ 'About ...' |
|
114 |
||
115 |
"Modified: 23.4.1996 / 17:09:48 / cg" |
|
116 |
"Created: 23.4.1996 / 17:11:46 / cg" |
|
84 | 117 |
! ! |
118 |
||
119 |
!AboutBox methodsFor:'initialization'! |
|
120 |
||
498 | 121 |
initialize |
122 |
"setup the box; change all of my components viewBackground |
|
123 |
to some darkish grey." |
|
124 |
||
107 | 125 |
|dark green lbl| |
84 | 126 |
|
127 |
super initialize. |
|
128 |
||
498 | 129 |
"/ self label:'About ...'. |
84 | 130 |
|
131 |
device hasColors ifTrue:[ |
|
248 | 132 |
green := (Color red:0 green:80 blue:20) "darkened". |
133 |
dark := Color grey:10. |
|
84 | 134 |
] ifFalse:[ |
248 | 135 |
green := Color white. |
136 |
dark := Color black. |
|
84 | 137 |
]. |
138 |
||
452
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
139 |
self withAllSubViewsDo:[:s | s viewBackground:dark]. |
248 | 140 |
|
452
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
141 |
self form:(self class defaultIcon). |
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
142 |
(lbl := self formLabel) viewBackground:dark. |
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
143 |
lbl foregroundColor:green backgroundColor:dark. |
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
144 |
(lbl := self textLabel) viewBackground:dark. |
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
145 |
lbl foregroundColor:White backgroundColor:dark. |
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
146 |
|
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
147 |
self title:(self class aboutText). |
1592 | 148 |
self okText:(resources string:'close'). |
452
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
149 |
|
1592 | 150 |
"Modified: / 12.6.1998 / 11:48:23 / cg" |
84 | 151 |
! ! |
152 |
||
153 |
!AboutBox methodsFor:'show / hide'! |
|
154 |
||
155 |
show |
|
498 | 156 |
"show the box. |
157 |
Redefined to automatically hide myself after some time" |
|
100 | 158 |
|
708
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
159 |
self autoHideAfter:15 with:[]. |
84 | 160 |
super showAtCenter. |
161 |
||
162 |
" |
|
163 |
AboutBox new show |
|
164 |
" |
|
498 | 165 |
|
166 |
"Modified: 23.4.1996 / 17:10:03 / cg" |
|
708
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
167 |
"Modified: 6.9.1996 / 09:47:10 / stefan" |
84 | 168 |
! ! |
169 |
||
879 | 170 |
!AboutBox class methodsFor:'documentation'! |
248 | 171 |
|
172 |
version |
|
2477 | 173 |
^ '$Header: /cvs/stx/stx/libtool/AboutBox.st,v 1.24 1999-12-09 11:19:35 cg Exp $' |
248 | 174 |
! ! |