1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
|
##
## $Id: greeting.tcl,v 1.6 1997/06/23 18:50:46 bormotov Exp $
##
## Copyright (C) 1995 The New York Group Theory Cooperative
## See magnus/doc/COPYRIGHT for the full notice.
## Contents: Code supporting the greeting window.
##
## Principal Author: Roger Needham, Dmitry Bormotov
##
## Status: In progress.
##
## Revision History:
##
## 03/96 Dmitry B. made porting to tcl7.4/tk4.0
##
proc makeGreeting {} {
global tcl_path magnus_home
# Put the greeting stuff in the root widget.
wm title . "Magnus"
wm iconname . "Magnus"
#db wm minsize . 450 400
#@rn Test screen size
wm geometry . +10+20
# Put in menu bar
frame .mbar -relief raised -bd 2
menubutton .mbar.file -text File -menu .mbar.file.menu -padx 1m
makeEditMenu .mbar.edit
menubutton .mbar.prefs -text Preferences -menu .mbar.prefs.menu -padx 1m
menubutton .mbar.credits -text Credits -menu .mbar.credits.menu -padx 1m
menubutton .mbar.help -text Help -menu .mbar.help.menu -padx 1m
pack .mbar.file .mbar.edit .mbar.prefs -side left -padx 1m
pack .mbar.help -side right -padx 1m
pack .mbar.credits -side right -padx 1m
menu .mbar.file.menu
.mbar.file.menu add command -label "Open..." -state disabled
.mbar.file.menu add command -label "Save..." -state disabled
.mbar.file.menu add command -label "Save As..." -state disabled
.mbar.file.menu add separator
.mbar.file.menu add command -label "Save Session Log..." \
-command "saveLogToFile .frame3.log"
.mbar.file.menu add separator
#@db .mbar.file.menu add command -label Quit -command fakeQuit
.mbar.file.menu add command -label Quit -command {
eval toSessionManager "\"[get_messageTemplate quit]\""
}
menu .mbar.prefs.menu
.mbar.prefs.menu add checkbutton -label {Novice mode} -variable noviceMode
.mbar.prefs.menu add cascade -label {Font size} -menu .mbar.prefs.menu.fontsz
menu .mbar.prefs.menu.fontsz
addFontSizeMenu Tiny 100 80
addFontSizeMenu Small 120 100
addFontSizeMenu Normal 140 120
addFontSizeMenu Big 180 140
addFontSizeMenu Huge 180 180
addFontSizeMenu Gigantic 240 240
.mbar.prefs.menu add cascade -label {Colors} -menu .mbar.prefs.menu.colors
menu .mbar.prefs.menu.colors
.mbar.prefs.menu.colors add radiobutton -label Barbados \
-value Barbados -variable theColorSet -command switchColors
.mbar.prefs.menu.colors add radiobutton -label Siberia \
-value Siberia -variable theColorSet -command switchColors
.mbar.prefs.menu.colors add radiobutton -label "Custom..." \
-value Custom -variable theColorSet -command colorPicker \
-state disabled
menu .mbar.credits.menu
.mbar.credits.menu add command -label "Contributors" \
-command "showHelp {Contributors::Contributors}"
.mbar.credits.menu add command -label "Acknowledgments" \
-command "showHelp {Acknowledgments::Acknowledgments}"
menu .mbar.help.menu
.mbar.help.menu add command -label "The Manual" -command "showHelp"
.mbar.help.menu add separator
.mbar.help.menu add command -label "About Magnus" \
-command "showHelp {aboutMagnus::About Magnus}"
.mbar.help.menu add command -label "Release Notes" \
-command "showHelp {releaseNotes::Release Notes}"
.mbar.help.menu add separator
.mbar.help.menu add command -label "Show copyright" \
-command "makeHelp $magnus_home/doc/COPYRIGHT Copyright {Copyright}"
.mbar.help.menu add command -label "Show GNU General Public License" \
-command "makeHelp $magnus_home/doc/COPYING GPL \
{GNU General Public License}"
.mbar.help.menu add separator
.mbar.help.menu add command -label "Contacting the Authors" \
-command "showHelp {authors::Contacting the Authors}"
pack .mbar -side top -fill x
# Put in greeting
frame .frame -relief raised -bd 2
if { [file exists "$tcl_path/bitmaps/greeting.xbm"] } {
label .frame.label -bitmap @$tcl_path/bitmaps/greeting.xbm
}
pack .frame.label -side left -ipadx 5m
pack .frame -side top -fill x
# Make the session log
frame .frame3 -relief raised -bd 1
frame .frame3.frame -relief raised -bd 1
label .frame3.frame.label -text "Session Log" -relief flat
text .frame3.log -height 30 -width 50 -relief flat \
-wrap word -yscrollcommand ".frame3.s set" -highlightthickness 0
scrollbar .frame3.s -relief sunken -command ".frame3.log yview"
pack .frame3.frame.label -side left -fill x
pack .frame3.frame -side top -fill x
pack .frame3.s -side right -fill y
pack .frame3.log -fill both -expand 1 -padx 1m -pady 1m
pack .frame3 -side top -fill both -expand 1
frame .frame4 -relief raised -bd 1
button .frame4.goTop -text "Go Top" -command ".frame3.log yview 0"
button .frame4.goBottom -text "Go Bottom" -command ".frame3.log yview end"
button .frame4.search -text "Search" -command editSearch
button .frame4.view -text [logGetViewButtonText .frame3.log] -width 9 \
-command "logChangeViewButton .frame3.log .frame4.view"
pack .frame4.goTop .frame4.goBottom .frame4.search .frame4.view \
-pady 2m -ipadx 5m -ipady 2 -side left -expand 1
pack .frame4 -side top -fill x
wm protocol . WM_DELETE_WINDOW {
alert "Please do not try to delete the session log!"
}
}
proc addFontSizeMenu {label cs hs} {
if {[fontExists -Adobe-Helvetica-Bold-R-Normal-*-$hs-*] == 1 && \
[fontExists *-Courier-medium-r-normal--*-$cs-*-*-*-*-*-*] == 1} {
.mbar.prefs.menu.fontsz add radiobutton -label $label \
-value $label -variable fontSize -command "changeFontSize $cs $hs" \
-font -Adobe-Helvetica-Bold-R-Normal-*-$hs-*
}
}
|