Import 2.3.99pre10-1
[davej-history.git] / scripts / header.tk
blobf2189e239925190749d53038a85c7f59a5405d2a
1 # FILE: header.tk
2 # This file is boilerplate TCL/TK function definitions for 'make xconfig'.
4 # CHANGES
5 # =======
7 # 8 January 1999, Michael Elizabeth Chastain, <mec@shout.net>
8 # - Remove unused do_cmd function (part of the 2.0 sound support).
9 # - Arrange buttons in three columns for better screen fitting.
10 # - Add CONSTANT_Y, CONSTANT_M, CONSTANT_N for commands like:
11 #     dep_tristate 'foo' CONFIG_FOO m
13 # 23 January 1999, Michael Elizabeth Chastain, <mec@shout.net>
14 # - Shut vfix the hell up.
16 # 24 January 1999, Michael Elizabeth Chastain, <mec@shout.net>
17 # - Improve the exit message (Jeff Ronne).
20 # This is a handy replacement for ".widget cget" that requires neither tk4
21 # nor additional source code uglification.
23 proc cget { w option } {
24         return "[lindex [$w configure $option] 4]"
28 # Function to compensate for broken config.in scripts like the sound driver,
29 # which make dependencies on variables that are never even conditionally
30 # defined.
32 proc vfix { var } {
33         global $var
34         if [ catch {eval concat $$var} ] {
35                 set $var 4
36         }
40 # Constant values used by certain dep_tristate commands.
42 set CONSTANT_Y 1
43 set CONSTANT_M 2
44 set CONSTANT_N 0
45 set CONSTANT_E 4
48 # Create a "reference" object to steal colors from.
50 button .ref
53 # On monochrome displays, -disabledforeground is blank by default; that's
54 # bad.  Fill it with -foreground instead.
56 if { [cget .ref -disabledforeground] == "" } {
57         .ref configure -disabledforeground [cget .ref -foreground]
62 # Define some macros we will need to parse the config.in file.
65 proc mainmenu_name { text } {
66         wm title . "$text"
69 proc menu_option { w menu_num text } {
70         global menus_per_column
71         global processed_top_level
72         set processed_top_level [expr $processed_top_level + 1]
73         if { $processed_top_level <= $menus_per_column } then {
74             set myframe left
75         } elseif { $processed_top_level <= [expr 2 * $menus_per_column] } then {
76             set myframe middle
77         } else {
78             set myframe right
79         } 
80         button .f0.x$menu_num -anchor w -text "$text" \
81             -command "$w .$w \"$text\""
82         pack .f0.x$menu_num -pady 0 -side top -fill x -in .f0.$myframe
85 proc load_configfile { w title func } {
86         catch {destroy $w}
87         toplevel $w -class Dialog
88         global loadfile
89         frame $w.x
90         label $w.bm -bitmap questhead
91         pack  $w.bm -pady 10 -side top -padx 10
92         label $w.x.l -text "Enter filename:" -relief raised
93         entry $w.x.x -width 35 -relief sunken -borderwidth 2 \
94                 -textvariable loadfile
95         pack $w.x.l $w.x.x -anchor w -side left
96         pack $w.x -side top -pady 10
97         wm title $w "$title" 
99         set oldFocus [focus]
100         frame $w.f
101         button $w.f.back -text "OK" -width 20 \
102                 -command "destroy $w; focus $oldFocus;$func .fileio"
103         button $w.f.canc -text "Cancel" \
104                 -width 20 -command "destroy $w; focus $oldFocus"
105         pack $w.f.back $w.f.canc -side left -pady 10 -padx 45
106         pack $w.f -pady 10 -side bottom -padx 10 -anchor w
107         focus $w
108         global winx; global winy
109         set winx [expr [winfo x .]+30]; set winy [expr [winfo y .]+30]
110         wm geometry $w +$winx+$winy
113 proc maybe_exit { w } {
114         catch {destroy $w}
115         toplevel $w -class Dialog
116         label $w.bm -bitmap questhead
117         pack  $w.bm -pady 10 -side top -padx 10
118         message $w.m -width 400 -aspect 300 \
119                 -text "Changes will be lost.  Are you sure?" -relief flat
120         pack  $w.m -pady 10 -side top -padx 10
121         wm title $w "Are you sure?" 
123         set oldFocus [focus]
124         frame $w.f
125         button $w.f.back -text "OK" -width 20 \
126                 -command "exit"
127         button $w.f.canc -text "Cancel" \
128                 -width 20 -command "destroy $w; focus $oldFocus"
129         pack $w.f.back $w.f.canc -side left -pady 10 -padx 45
130         pack $w.f -pady 10 -side bottom -padx 10 -anchor w
131         focus $w
132         global winx; global winy
133         set winx [expr [winfo x .]+30]; set winy [expr [winfo y .]+30]
134         wm geometry $w +$winx+$winy
137 proc read_config_file { w } {
138         global loadfile
139         if { [string length $loadfile] != 0 && [file readable $loadfile] == 1 } then {
140                 read_config $loadfile
141         } else {
142                 catch {destroy $w}
143                 toplevel $w -class Dialog
144                 message $w.m -width 400 -aspect 300 -text \
145                         "Unable to read file $loadfile" \
146                          -relief raised 
147                 label $w.bm -bitmap error
148                 pack $w.bm $w.m -pady 10 -side top -padx 10
149                 wm title $w "Xconfig Internal Error" 
151                 set oldFocus [focus]
152                 frame $w.f
153                 button $w.f.back -text "Bummer" \
154                         -width 10 -command "destroy $w; focus $oldFocus"
155                 pack $w.f.back -side bottom -pady 10 -anchor s
156                 pack $w.f -pady 10 -side top -padx 10 -anchor s
157                 focus $w
158                 global winx; global winy
159                 set winx [expr [winfo x .]+30]; set winy [expr [winfo y .]+30]
160                 wm geometry $w +$winx+$winy
161         }
164 proc write_config_file  { w } {
165         global loadfile
166         if { [string length $loadfile] != 0 
167                 && ([file writable $loadfile] == 1 || ([file exists $loadfile] == 0 && [file writable [file dirname $loadfile]] == 1)) } then {
168                 writeconfig $loadfile /dev/null
169         } else {
170                 catch {destroy $w}
171                 toplevel $w -class Dialog
172                 message $w.m -width 400 -aspect 300 -text \
173                         "Unable to write file $loadfile" \
174                          -relief raised 
175                 label $w.bm -bitmap error
176                 pack $w.bm $w.m -pady 10 -side top -padx 10
177                 wm title $w "Xconfig Internal Error" 
179                 set oldFocus [focus]
180                 frame $w.f
181                 button $w.f.back -text "OK" \
182                         -width 10 -command "destroy $w; focus $oldFocus"
183                 pack $w.f.back -side bottom -pady 10 -anchor s
184                 pack $w.f -pady 10 -side top -padx 10 -anchor s
185                 focus $w
186                 global winx; global winy
187                 set winx [expr [winfo x .]+30]; set winy [expr [winfo y .]+30]
188                 wm geometry $w +$winx+$winy
189         }
192 proc read_config { filename } {
193         set file1 [open $filename r]
194         clear_choices
195         while { [gets $file1 line] >= 0} {
196                 if [regexp {([0-9A-Za-z_]+)=([ynm])} $line foo var value] {
197                         if { $value == "y" } then { set cmd "global $var; set $var 1" }
198                         if { $value == "n" } then { set cmd "global $var; set $var 0" }
199                         if { $value == "m" } then { set cmd "global $var; set $var 2" }
200                         eval $cmd
201                 }
202                 if [regexp {# ([0-9A-Za-z_]+) is not set} $line foo var] {
203                         set cmd "global $var; set $var 0"
204                         eval $cmd
205                 }
206                 if [regexp {([0-9A-Za-z_]+)=([0-9A-Fa-f]+)} $line foo var value] {
207                         set cmd "global $var; set $var $value"
208                         eval $cmd
209                 }
210                 if [regexp {([0-9A-Za-z_]+)="([^"]*)"} $line foo var value] {
211                         set cmd "global $var; set $var \"$value\""
212                         eval $cmd
213                 }
214         }
215         close $file1
216         update_choices
217         update_mainmenu
219 proc write_comment { file1 file2 text } {
220         puts $file1 ""
221         puts $file1 "#"
222         puts $file1 "# $text"
223         puts $file1 "#"
224         puts $file2 "/*"
225         puts $file2 " * $text"
226         puts $file2 " */"
229 proc effective_dep { deplist } {
230         global CONFIG_MODULES
231         set depend 1
232         foreach i $deplist {
233                 if {$i == 0} then {set depend 0}
234                 if {$i == 2 && $depend == 1} then {set depend 2}
235         }
236         if {$depend == 2 && $CONFIG_MODULES == 0} then {set depend 0}
237         return $depend
240 proc sync_tristate { var dep } {
241         global CONFIG_MODULES
242         if {$dep == 0 && ($var == 1 || $var == 2)} then {
243                 set var 0
244         } elseif {$dep == 2 && $var == 1} then {
245                 set var 2
246         } elseif {$var == 2 && $CONFIG_MODULES == 0} then {
247                 if {$dep == 1} then {set var 1} else {set var 0}
248         }
249         return $var
252 proc sync_bool { var dep modset } {
253         set var [sync_tristate $var $dep]
254         if {$dep == 2 && $var == 2} then {
255                 set var $modset
256         }
257         return $var
260 proc write_tristate { file1 file2 varname variable deplist modset } {
261         set variable [sync_tristate $variable [effective_dep $deplist]]
262         if { $variable == 2 } \
263                 then { set variable $modset }
264         if { $variable == 1 } \
265                 then { puts $file1 "$varname=y"; \
266                        puts $file2 "#define $varname 1" } \
267         elseif { $variable == 2 } \
268                 then { puts $file1 "$varname=m"; \
269                        puts $file2 "#undef  $varname"; \
270                        puts $file2 "#define ${varname}_MODULE 1" } \
271         elseif { $variable == 0 } \
272                 then { puts $file1 "# $varname is not set"; \
273                        puts $file2 "#undef  $varname"} \
274         else { \
275             puts stdout "ERROR - Attempting to write value for unconfigured variable ($varname)." \
276         }
279 proc write_int { file1 file2 varname variable dep } {
280         if { $dep == 0 } \
281                 then { puts $file1 "# $varname is not set"; \
282                        puts $file2 "#undef  $varname"} \
283         else {
284                 puts $file1 "$varname=$variable"; \
285                 puts $file2 "#define $varname ($variable)"; \
286         }
289 proc write_hex { file1 file2 varname variable dep } {
290         if { $dep == 0 } \
291                 then { puts $file1 "# $varname is not set"; \
292                        puts $file2 "#undef  $varname"} \
293         else {
294                 puts $file1 "$varname=$variable"; \
295                 puts -nonewline $file2 "#define $varname 0x"; \
296                 puts $file2 [exec echo $variable | sed s/^0\[xX\]//]; \
297         }
300 proc write_string { file1 file2 varname variable dep } {
301         if { $dep == 0 } \
302                 then { puts $file1 "# $varname is not set"; \
303                        puts $file2 "#undef  $varname"} \
304         else {
305                 puts $file1 "$varname=\"$variable\""; \
306                 puts $file2 "#define $varname \"$variable\""; \
307         }
310 proc option_name {w mnum line text helpidx} {
311         button $w.x$line.l -text "$text" -relief groove -anchor w
312         $w.x$line.l configure -activefore [cget $w.x$line.l -fg] \
313                                 -activeback [cget $w.x$line.l -bg]
314         button $w.x$line.help -text "Help" -relief raised \
315                 -command "dohelp .dohelp $helpidx .menu$mnum"
316         pack $w.x$line.help -side right -fill y
317         pack $w.x$line.l -side right -fill both -expand on
320 proc toggle_switch2 {w mnum line text variable} {
321         frame $w.x$line -relief sunken
322         radiobutton $w.x$line.y -text "y" -variable $variable -value 1 \
323                 -relief groove -width 2 -command "update_active"
324         radiobutton $w.x$line.m -text "-"  -variable $variable -value 2 \
325                 -relief groove -width 2 -command "update_active"
326         radiobutton $w.x$line.n -text "n"  -variable $variable -value 0 \
327                 -relief groove -width 2 -command "update_active"
329         option_name $w $mnum $line $text $variable
331         pack $w.x$line.n $w.x$line.m $w.x$line.y -side right -fill y
334 proc toggle_switch3 {w mnum line text variable} {
335         frame $w.x$line -relief sunken
336         radiobutton $w.x$line.y -text "y" -variable $variable -value 1 \
337                 -relief groove -width 2 -command "update_active"
338         radiobutton $w.x$line.m -text "m"  -variable $variable -value 2 \
339                 -relief groove -width 2 -command "update_active"
340         radiobutton $w.x$line.n -text "n"  -variable $variable -value 0 \
341                 -relief groove -width 2 -command "update_active"
343         option_name $w $mnum $line $text $variable
345         global CONFIG_MODULES
346         if {($CONFIG_MODULES == 0)} then {
347                 $w.x$line.m configure -state disabled
348         }
349         pack $w.x$line.n $w.x$line.m $w.x$line.y -side right -fill y
352 proc bool {w mnum line text variable} {
353         toggle_switch2 $w $mnum $line $text $variable
354         $w.x$line.m configure -state disabled
355         pack $w.x$line -anchor w -fill both -expand on
358 proc tristate {w mnum line text variable } {
359         toggle_switch3 $w $mnum $line $text $variable
360         pack $w.x$line -anchor w -fill both -expand on
363 proc dep_tristate {w mnum line text variable } {
364         tristate $w $mnum $line $text $variable
367 proc dep_bool {w mnum line text variable } {
368         bool $w $mnum $line $text $variable
371 proc int { w mnum line text variable } {
372         frame $w.x$line
373         entry $w.x$line.x -width 18 -relief sunken -borderwidth 2 \
374                 -textvariable $variable
375         option_name $w $mnum $line $text $variable
376         pack $w.x$line.x -anchor w -side right -fill y
377         pack $w.x$line -anchor w -fill both -expand on
380 proc hex { w mnum line text variable } {
381         int $w $mnum $line $text $variable
384 proc istring { w mnum line text variable } {
385         frame $w.x$line
386         entry $w.x$line.x -width 18 -relief sunken -borderwidth 2 \
387                 -textvariable $variable
388         option_name $w $mnum $line $text $variable
389         pack $w.x$line.x -anchor w -side right -fill y
390         pack $w.x$line -anchor w -fill both -expand on
393 proc minimenu { w mnum line text variable helpidx } {
394         frame $w.x$line
395         menubutton $w.x$line.x -textvariable $variable -menu \
396                 $w.x$line.x.menu -relief raised \
397                 -anchor w
398         option_name $w $mnum $line $text $helpidx
399         pack $w.x$line.x -anchor w -side right -fill y
400         pack $w.x$line -anchor w -fill both -expand on
403 proc menusplit {w m n} {
404         if { $n > 2 } then {
405                 set menuoptsize [expr [$m yposition 2] - [$m yposition 1]]   
406                 set maxsize [winfo screenheight $w]
407                 set splitpoint [expr $maxsize * 4 / 5 / $menuoptsize - 1]
408                 for {set i [expr $splitpoint + 1]} {$i <= $n} {incr i $splitpoint} {
409                         $m entryconfigure $i -columnbreak 1
410                 }
411         }
414 proc submenu { w mnum line text subnum } {
415         frame $w.x$line
416         button $w.x$line.l -text "" -width 15 -relief groove
417         $w.x$line.l configure -activefore [cget $w.x$line.l -fg] \
418                 -activeback [cget $w.x$line.l -bg] -state disabled
419         button $w.x$line.m -text "$text" -relief raised -anchor w \
420                 -command "catch {destroy .menu$subnum}; menu$subnum .menu$subnum \"$text\""
421         pack $w.x$line.l -side left -fill both
422         pack $w.x$line.m -anchor w -side right -fill both -expand on
423         pack $w.x$line -anchor w -fill both -expand on
426 proc comment {w mnum line text } {
427         frame $w.x$line
428         button $w.x$line.l -text "" -width 15 -relief groove
429         $w.x$line.l configure -activefore [cget $w.x$line.l -fg] \
430                 -activeback [cget $w.x$line.l -bg] -state disabled
431         button $w.x$line.m -text "$text" -relief groove -anchor w
432         $w.x$line.m configure -activefore [cget $w.x$line.m -fg] \
433                 -activeback [cget $w.x$line.m -bg]
434         pack $w.x$line.l -side left -fill both
435         pack $w.x$line.m -anchor w -side right -fill both -expand on
436         pack $w.x$line -anchor w -fill both -expand on
439 proc dohelp {w var parent}  {
440         catch {destroy $w}
441         toplevel $w -class Dialog
443         set filefound 0
444         set found 0
445         set lineno 0
447         if { [file readable Documentation/Configure.help] == 1} then {
448                 set filefound 1
449                 # First escape sed regexp special characters in var:
450                 set var [exec echo "$var" | sed s/\[\]\[\/.^$*\]/\\\\&/g]
451                 # Now pick out right help text:
452                 set message [exec sed -n "
453                         /^$var\[        \]*\$/,\${
454                                 /^$var\[        \]*\$/c\\
455 ${var}:\\
457                                 /^#/b
458                                 /^\[^   \]/q
459                                 s/^  //
460                                 p
461                         }
462                         " Documentation/Configure.help]
463                 set found [expr [string length "$message"] > 0]
464         }
466         frame $w.f1
467         pack $w.f1 -fill both -expand on
469         # Do the OK button
470         #
471         set oldFocus [focus]
472         frame $w.f2
473         button $w.f2.ok -text "OK" \
474                 -width 10 -command "destroy $w; catch {focus $oldFocus}"
475         pack $w.f2.ok -side bottom -pady 6 -anchor n
476         pack $w.f2 -side bottom -padx 10 -anchor s
478         scrollbar $w.f1.vscroll -command "$w.f1.canvas yview"
479         pack $w.f1.vscroll -side right -fill y
481         canvas $w.f1.canvas -relief flat -borderwidth 0 \
482                 -yscrollcommand "$w.f1.vscroll set"
483         frame $w.f1.f
484         pack $w.f1.canvas -side right -fill y -expand on
486         if { $found == 0 } then {
487                 if { $filefound == 0 } then {
488                 message $w.f1.f.m -width 750 -aspect 300 -relief flat -text \
489                         "No help available - unable to open file Documentation/Configure.help.  This file should have come with your kernel."
490                 } else {
491                 message $w.f1.f.m -width 400 -aspect 300 -relief flat -text \
492                         "No help available for $var"
493                 }
494                 label $w.f1.bm -bitmap error
495                 wm title $w "RTFM"
496         } else {
497                 text $w.f1.f.m -width 73 -relief flat -wrap word
498                 $w.f1.f.m insert 0.0 $message
499                 $w.f1.f.m conf -state disabled -height [$w.f1.f.m index end]
501                 label $w.f1.bm -bitmap info
502                 wm title $w "Configuration help" 
503         }
504         pack $w.f1.f.m -side left
505         pack $w.f1.bm $w.f1.f -side left -padx 10
507         focus $w
508         set winx [expr [winfo x $parent]+20]
509         set winy [expr [winfo y $parent]+20]
510         wm geometry $w +$winx+$winy
511         set sizok [expr [winfo reqheight $w.f2.ok] + 12]
512         set maxy [expr [winfo screenheight .] * 3 / 4]
513         set canvtotal [winfo reqheight $w.f1.f.m]
514         if [expr $sizok + $canvtotal < $maxy] {
515                 set sizy $canvtotal
516         } else {
517                 set sizy [expr $maxy - $sizok]
518         }
519         $w.f1.canvas configure -height $sizy -width [winfo reqwidth $w.f1.f.m] \
520                 -scrollregion "0 0 [winfo reqwidth $w.f1.f.m] \
521                         [winfo reqheight $w.f1.f.m]"
522         $w.f1.canvas create window 0 0 -anchor nw -window $w.f1.f
523         update idletasks
525         set maxy [winfo screenheight .]
526         if [expr $sizok + $canvtotal < $maxy] {
527                 set sizy [expr $sizok + $canvtotal]
528         } else {
529                 set sizy $maxy
530         }
531         wm maxsize $w [winfo width $w] $sizy
534 proc wrapup {w }  {
535         catch {destroy $w}
536         toplevel $w -class Dialog
538         global CONFIG_MODVERSIONS; vfix CONFIG_MODVERSIONS
539         if { ([file exists .hdepend] != 1) || ($CONFIG_MODVERSIONS == 1) } then {
540             message $w.m -width 400 -aspect 300 -relief raised -text \
541                 "End of Linux kernel configuration.  Check the top-level Makefile for additional configuration.  Next, you must run 'make dep'."
542         } else {
543             message $w.m -width 400 -aspect 300 -relief raised -text \
544                 "End of Linux kernel configuration.  Check the top-level Makefile for additional configuration.  Next, you may 'make bzImage', 'make bzdisk', or 'make bzlilo.'"
545         }
546         label $w.bm -bitmap info
547         pack $w.bm $w.m -pady 10 -side top -padx 10
548         wm title $w "Kernel build instructions" 
550         set oldFocus [focus]
551         frame $w.f
552         button $w.f.back -text "OK" \
553                 -width 10 -command "exit"
554         pack $w.f.back -side bottom -pady 10 -anchor s
555         pack $w.f -pady 10 -side top -padx 10 -anchor s
556         focus $w
557         global winx; global winy
558         set winx [expr [winfo x .]+30]; set winy [expr [winfo y .]+30]
559         wm geometry $w +$winx+$winy
563 proc unregister_active {num} {
564         global active_menus
565         set index [lsearch -exact $active_menus $num]
566         if {$index != -1} then {set active_menus [lreplace $active_menus $index $index]}
569 proc update_active {} {
570         global active_menus total_menus
571         set max 0
572         if {[llength $active_menus] > 0} then {
573                 set max [lindex $active_menus end]
574                 update_define [toplevel_menu [lindex $active_menus 0]] $max 0
575         }
576         foreach i $active_menus {
577                 if {[winfo exists .menu$i] == 0} then {
578                         unregister_active $i
579                 } else {
580                         update_menu$i
581                 }
582         }
583         update_define [expr $max + 1] $total_menus 1
584         update_mainmenu
587 proc configure_entry {w option items} {
588         foreach i $items {
589                 $w.$i configure -state $option
590         }
593 proc validate_int {name val default} {
594         if {([exec echo $val | sed s/^-//g | tr -d \[:digit:\] ] != "")} then {
595                 global $name; set $name $default
596         }
599 proc validate_hex {name val default} {
600         if {([exec echo $val | tr -d \[:xdigit:\] ] != "")} then {
601                 global $name; set $name $default
602         }
605 proc update_define {first last allow_update} {
606         for {set i $first} {$i <= $last} {incr i} {
607                 update_define_menu$i
608                 if {$allow_update == 1} then update
609         }
613 # Next set up the particulars for the top level menu, and define a few
614 # buttons which we will stick down at the bottom.
617 frame .f0 
618 frame .f0.left
619 frame .f0.middle
620 frame .f0.right
622 set active_menus [list]
623 set processed_top_level 0