AboutBox.st
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--
added implementorsOf and sendersOf menu functions
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
84
700f3924df1d Initial revision
claus
parents:
diff changeset
     1
"
700f3924df1d Initial revision
claus
parents:
diff changeset
     2
 COPYRIGHT (c) 1995 by Claus Gittinger
92
claus
parents: 84
diff changeset
     3
	      All Rights Reserved
84
700f3924df1d Initial revision
claus
parents:
diff changeset
     4
700f3924df1d Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
700f3924df1d Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
700f3924df1d Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
700f3924df1d Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
700f3924df1d Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
700f3924df1d Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
700f3924df1d Initial revision
claus
parents:
diff changeset
    11
"
700f3924df1d Initial revision
claus
parents:
diff changeset
    12
700f3924df1d Initial revision
claus
parents:
diff changeset
    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
700f3924df1d Initial revision
claus
parents:
diff changeset
    18
!
700f3924df1d Initial revision
claus
parents:
diff changeset
    19
879
8582038d1287 use Image instead of Form
Claus Gittinger <cg@exept.de>
parents: 708
diff changeset
    20
!AboutBox class methodsFor:'documentation'!
84
700f3924df1d Initial revision
claus
parents:
diff changeset
    21
198
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    22
copyright
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    23
"
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    24
 COPYRIGHT (c) 1995 by Claus Gittinger
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    25
	      All Rights Reserved
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    26
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    27
 This software is furnished under a license and may be used
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    28
 only in accordance with the terms of that license and with the
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    29
 inclusion of the above copyright notice.   This software may not
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    30
 be provided or otherwise made available to, or used by, any
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    31
 other person.  No title to or ownership of the software is
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    32
 hereby transferred.
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    33
"
84
700f3924df1d Initial revision
claus
parents:
diff changeset
    34
!
700f3924df1d Initial revision
claus
parents:
diff changeset
    35
700f3924df1d Initial revision
claus
parents:
diff changeset
    36
documentation
700f3924df1d Initial revision
claus
parents:
diff changeset
    37
"
700f3924df1d Initial revision
claus
parents:
diff changeset
    38
    A box specialized to show the ST/X about information.
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    39
    As a speciality, this box automatically closes if left
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    40
    alone for a while.
84
700f3924df1d Initial revision
claus
parents:
diff changeset
    41
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    42
    Can be subclasses for your own aboutBoxes; to do so, redefine
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    43
    #defaultIcon and #aboutText.
92
claus
parents: 84
diff changeset
    44
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    45
    examples:
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    46
        AboutBox new open
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    47
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    48
        AboutBox new showAtPointer
84
700f3924df1d Initial revision
claus
parents:
diff changeset
    49
"
700f3924df1d Initial revision
claus
parents:
diff changeset
    50
! !
700f3924df1d Initial revision
claus
parents:
diff changeset
    51
879
8582038d1287 use Image instead of Form
Claus Gittinger <cg@exept.de>
parents: 708
diff changeset
    52
!AboutBox class methodsFor:'defaults'!
84
700f3924df1d Initial revision
claus
parents:
diff changeset
    53
92
claus
parents: 84
diff changeset
    54
aboutText
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    55
    "return a string to be shown in the box.
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    56
     Can be redefined in custom subclasses."
125
claus
parents: 111
diff changeset
    57
1797
9435a66ce32a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1592
diff changeset
    58
    |distributor expiration machine info|
179
f464e3c75104 if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    59
693
29bbbc339107 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 498
diff changeset
    60
    distributor := Smalltalk distributorString.
29bbbc339107 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 498
diff changeset
    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
29bbbc339107 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 498
diff changeset
    69
    ].
1797
9435a66ce32a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1592
diff changeset
    70
    machine := OperatingSystem getHostName.
9435a66ce32a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1592
diff changeset
    71
    info := OperatingSystem getSystemInfo.
9435a66ce32a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1592
diff changeset
    72
    (info includesKey:#machine) ifTrue:[
9435a66ce32a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1592
diff changeset
    73
        machine := machine , ' (' , (info at:#machine) , ')'
9435a66ce32a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1592
diff changeset
    74
    ].
179
f464e3c75104 if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    75
92
claus
parents: 84
diff changeset
    76
    ^
179
f464e3c75104 if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    77
'SmallTalk/X
92
claus
parents: 84
diff changeset
    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
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    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
9435a66ce32a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1592
diff changeset
    85
Running on ...... ', machine, '
92
claus
parents: 84
diff changeset
    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
29bbbc339107 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 498
diff changeset
    89
'
179
f464e3c75104 if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    90
1797
9435a66ce32a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1592
diff changeset
    91
    "Modified: / 6.9.1996 / 10:11:08 / stefan"
9435a66ce32a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1592
diff changeset
    92
    "Modified: / 4.8.1998 / 02:28:29 / cg"
198
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    93
!
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    94
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    95
defaultIcon
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    96
    "return a smalltalk/X icon.
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    97
     Can be redefined in custom subclasses."
198
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    98
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    99
    CachedIcon isNil ifTrue:[
2169
4059c2a4e407 changed the defaultIcon
Claus Gittinger <cg@exept.de>
parents: 1797
diff changeset
   100
        CachedIcon := Icon stxIcon.
4059c2a4e407 changed the defaultIcon
Claus Gittinger <cg@exept.de>
parents: 1797
diff changeset
   101
        CachedIcon isNil ifTrue:[
2477
cfb8a4d7b557 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2455
diff changeset
   102
            CachedIcon := Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool'
2169
4059c2a4e407 changed the defaultIcon
Claus Gittinger <cg@exept.de>
parents: 1797
diff changeset
   103
        ]
198
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
   104
    ].
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
   105
    ^ CachedIcon
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   106
2169
4059c2a4e407 changed the defaultIcon
Claus Gittinger <cg@exept.de>
parents: 1797
diff changeset
   107
    "Modified: / 25.5.1999 / 15:44:48 / cg"
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   108
!
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   109
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   110
defaultLabel
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   111
    "return the boxes default window title."
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   112
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   113
    ^ 'About ...'
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   114
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   115
    "Modified: 23.4.1996 / 17:09:48 / cg"
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   116
    "Created: 23.4.1996 / 17:11:46 / cg"
84
700f3924df1d Initial revision
claus
parents:
diff changeset
   117
! !
700f3924df1d Initial revision
claus
parents:
diff changeset
   118
700f3924df1d Initial revision
claus
parents:
diff changeset
   119
!AboutBox methodsFor:'initialization'!
700f3924df1d Initial revision
claus
parents:
diff changeset
   120
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   121
initialize
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   122
    "setup the box; change all of my components viewBackground
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   123
     to some darkish grey."
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   124
107
claus
parents: 105
diff changeset
   125
    |dark green lbl|
84
700f3924df1d Initial revision
claus
parents:
diff changeset
   126
700f3924df1d Initial revision
claus
parents:
diff changeset
   127
    super initialize.
700f3924df1d Initial revision
claus
parents:
diff changeset
   128
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   129
"/    self label:'About ...'.
84
700f3924df1d Initial revision
claus
parents:
diff changeset
   130
700f3924df1d Initial revision
claus
parents:
diff changeset
   131
    device hasColors ifTrue:[
248
3813e693e329 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 198
diff changeset
   132
        green := (Color red:0 green:80 blue:20) "darkened".
3813e693e329 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 198
diff changeset
   133
        dark := Color grey:10.
84
700f3924df1d Initial revision
claus
parents:
diff changeset
   134
    ] ifFalse:[
248
3813e693e329 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 198
diff changeset
   135
        green := Color white.
3813e693e329 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 198
diff changeset
   136
        dark := Color black.
84
700f3924df1d Initial revision
claus
parents:
diff changeset
   137
    ].
700f3924df1d Initial revision
claus
parents:
diff changeset
   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
3813e693e329 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 198
diff changeset
   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
68d7e59d0c06 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 879
diff changeset
   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
68d7e59d0c06 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 879
diff changeset
   150
    "Modified: / 12.6.1998 / 11:48:23 / cg"
84
700f3924df1d Initial revision
claus
parents:
diff changeset
   151
! !
700f3924df1d Initial revision
claus
parents:
diff changeset
   152
700f3924df1d Initial revision
claus
parents:
diff changeset
   153
!AboutBox methodsFor:'show / hide'!
700f3924df1d Initial revision
claus
parents:
diff changeset
   154
700f3924df1d Initial revision
claus
parents:
diff changeset
   155
show
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   156
    "show the box.
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   157
     Redefined to automatically hide myself after some time"
100
claus
parents: 92
diff changeset
   158
708
f89ff543ea18 Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents: 693
diff changeset
   159
    self autoHideAfter:15 with:[].
84
700f3924df1d Initial revision
claus
parents:
diff changeset
   160
    super showAtCenter.
700f3924df1d Initial revision
claus
parents:
diff changeset
   161
700f3924df1d Initial revision
claus
parents:
diff changeset
   162
    "
700f3924df1d Initial revision
claus
parents:
diff changeset
   163
     AboutBox new show
700f3924df1d Initial revision
claus
parents:
diff changeset
   164
    "
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   165
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   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
700f3924df1d Initial revision
claus
parents:
diff changeset
   168
! !
700f3924df1d Initial revision
claus
parents:
diff changeset
   169
879
8582038d1287 use Image instead of Form
Claus Gittinger <cg@exept.de>
parents: 708
diff changeset
   170
!AboutBox class methodsFor:'documentation'!
248
3813e693e329 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 198
diff changeset
   171
3813e693e329 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 198
diff changeset
   172
version
2477
cfb8a4d7b557 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2455
diff changeset
   173
    ^ '$Header: /cvs/stx/stx/libtool/AboutBox.st,v 1.24 1999-12-09 11:19:35 cg Exp $'
248
3813e693e329 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 198
diff changeset
   174
! !