AboutBox.st
author Stefan Vogel <sv@exept.de>
Fri, 09 May 1997 12:19:10 +0200
changeset 1179 e927f0c09298
parent 879 8582038d1287
child 1592 68d7e59d0c06
permissions -rw-r--r--
Move #isSystemProcess from ProcessorScheduler to Process.
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
708
f89ff543ea18 Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents: 693
diff changeset
    58
    |distributor expiration|
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
    ].
179
f464e3c75104 if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    70
92
claus
parents: 84
diff changeset
    71
    ^
179
f464e3c75104 if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    72
'SmallTalk/X
92
claus
parents: 84
diff changeset
    73
708
f89ff543ea18 Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents: 693
diff changeset
    74
Version ......... ', Smalltalk versionString , '.' , Smalltalk releaseNr printString ,
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    75
                      ' (' , Smalltalk versionDate printString , ')
708
f89ff543ea18 Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents: 693
diff changeset
    76
', distributor, '
f89ff543ea18 Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents: 693
diff changeset
    77
', expiration , '
f89ff543ea18 Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents: 693
diff changeset
    78
Release ID ...... ', Smalltalk releaseIdentification, '
f89ff543ea18 Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents: 693
diff changeset
    79
Configuration ... ', Smalltalk configuration, '
f89ff543ea18 Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents: 693
diff changeset
    80
Running on ...... ', OperatingSystem getHostName, '
92
claus
parents: 84
diff changeset
    81
179
f464e3c75104 if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    82
' , Smalltalk copyrightString , '
f464e3c75104 if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    83
693
29bbbc339107 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 498
diff changeset
    84
'
179
f464e3c75104 if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    85
693
29bbbc339107 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 498
diff changeset
    86
    "Modified: 19.8.1996 / 18:09:39 / cg"
708
f89ff543ea18 Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents: 693
diff changeset
    87
    "Modified: 6.9.1996 / 10:11:08 / stefan"
198
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    88
!
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    89
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    90
defaultIcon
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    91
    "return a smalltalk/X icon.
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    92
     Can be redefined in custom subclasses."
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
    CachedIcon isNil ifTrue:[
879
8582038d1287 use Image instead of Form
Claus Gittinger <cg@exept.de>
parents: 708
diff changeset
    95
        CachedIcon := Image fromFile:'bitmaps/SmalltalkX.xbm' resolution:100.
198
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    96
    ].
2b044adb45a7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 186
diff changeset
    97
    ^ CachedIcon
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    98
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    99
    "Modified: 23.4.1996 / 17:09:48 / cg"
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   100
!
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   101
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   102
defaultLabel
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   103
    "return the boxes default window title."
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   104
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   105
    ^ 'About ...'
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   106
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   107
    "Modified: 23.4.1996 / 17:09:48 / cg"
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   108
    "Created: 23.4.1996 / 17:11:46 / cg"
84
700f3924df1d Initial revision
claus
parents:
diff changeset
   109
! !
700f3924df1d Initial revision
claus
parents:
diff changeset
   110
700f3924df1d Initial revision
claus
parents:
diff changeset
   111
!AboutBox methodsFor:'initialization'!
700f3924df1d Initial revision
claus
parents:
diff changeset
   112
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   113
initialize
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   114
    "setup the box; change all of my components viewBackground
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   115
     to some darkish grey."
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   116
107
claus
parents: 105
diff changeset
   117
    |dark green lbl|
84
700f3924df1d Initial revision
claus
parents:
diff changeset
   118
700f3924df1d Initial revision
claus
parents:
diff changeset
   119
    super initialize.
700f3924df1d Initial revision
claus
parents:
diff changeset
   120
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   121
"/    self label:'About ...'.
84
700f3924df1d Initial revision
claus
parents:
diff changeset
   122
700f3924df1d Initial revision
claus
parents:
diff changeset
   123
    device hasColors ifTrue:[
248
3813e693e329 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 198
diff changeset
   124
        green := (Color red:0 green:80 blue:20) "darkened".
3813e693e329 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 198
diff changeset
   125
        dark := Color grey:10.
84
700f3924df1d Initial revision
claus
parents:
diff changeset
   126
    ] ifFalse:[
248
3813e693e329 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 198
diff changeset
   127
        green := Color white.
3813e693e329 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 198
diff changeset
   128
        dark := Color black.
84
700f3924df1d Initial revision
claus
parents:
diff changeset
   129
    ].
700f3924df1d Initial revision
claus
parents:
diff changeset
   130
452
33ce1b3cd502 oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   131
    self withAllSubViewsDo:[:s | s viewBackground:dark].
248
3813e693e329 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 198
diff changeset
   132
452
33ce1b3cd502 oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   133
    self form:(self class defaultIcon).
33ce1b3cd502 oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   134
    (lbl := self formLabel) viewBackground:dark.
33ce1b3cd502 oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   135
    lbl foregroundColor:green backgroundColor:dark.
33ce1b3cd502 oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   136
    (lbl := self textLabel) viewBackground:dark.
33ce1b3cd502 oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   137
    lbl foregroundColor:White backgroundColor:dark.
33ce1b3cd502 oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   138
33ce1b3cd502 oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   139
    self title:(self class aboutText).
33ce1b3cd502 oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   140
    self okText:'close'.
33ce1b3cd502 oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   141
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   142
    "Modified: 23.4.1996 / 17:11:53 / cg"
84
700f3924df1d Initial revision
claus
parents:
diff changeset
   143
! !
700f3924df1d Initial revision
claus
parents:
diff changeset
   144
700f3924df1d Initial revision
claus
parents:
diff changeset
   145
!AboutBox methodsFor:'show / hide'!
700f3924df1d Initial revision
claus
parents:
diff changeset
   146
700f3924df1d Initial revision
claus
parents:
diff changeset
   147
show
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   148
    "show the box.
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   149
     Redefined to automatically hide myself after some time"
100
claus
parents: 92
diff changeset
   150
708
f89ff543ea18 Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents: 693
diff changeset
   151
    self autoHideAfter:15 with:[].
84
700f3924df1d Initial revision
claus
parents:
diff changeset
   152
    super showAtCenter.
700f3924df1d Initial revision
claus
parents:
diff changeset
   153
700f3924df1d Initial revision
claus
parents:
diff changeset
   154
    "
700f3924df1d Initial revision
claus
parents:
diff changeset
   155
     AboutBox new show
700f3924df1d Initial revision
claus
parents:
diff changeset
   156
    "
498
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   157
382ef0b86b30 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   158
    "Modified: 23.4.1996 / 17:10:03 / cg"
708
f89ff543ea18 Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents: 693
diff changeset
   159
    "Modified: 6.9.1996 / 09:47:10 / stefan"
84
700f3924df1d Initial revision
claus
parents:
diff changeset
   160
! !
700f3924df1d Initial revision
claus
parents:
diff changeset
   161
879
8582038d1287 use Image instead of Form
Claus Gittinger <cg@exept.de>
parents: 708
diff changeset
   162
!AboutBox class methodsFor:'documentation'!
248
3813e693e329 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 198
diff changeset
   163
3813e693e329 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 198
diff changeset
   164
version
879
8582038d1287 use Image instead of Form
Claus Gittinger <cg@exept.de>
parents: 708
diff changeset
   165
    ^ '$Header: /cvs/stx/stx/libtool/AboutBox.st,v 1.19 1996-12-20 11:15:13 cg Exp $'
248
3813e693e329 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 198
diff changeset
   166
! !