scripts/header.tk

   1 # FILE: header.tk
   2 # This file is boilerplate TCL/TK function definitions for 'make xconfig'.
   3 #
   4 # CHANGES
   5 # =======
   6 #
   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
  12 #
  13 # 23 January 1999, Michael Elizabeth Chastain, <mec@shout.net>
  14 # - Shut vfix the hell up.
  15 #
  16 # 24 January 1999, Michael Elizabeth Chastain, <mec@shout.net>
  17 # - Improve the exit message (Jeff Ronne).
  18
  19 #
  20 # This is a handy replacement for ".widget cget" that requires neither tk4
  21 # nor additional source code uglification.
  22 #
  23 proc cget { w option } {
  24         return "[lindex [$w configure $option] 4]"
  25 }
  26
  27 #
  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.
  31 #
  32 proc vfix { var } {
  33         global $var
  34         if [ catch {eval concat $$var} ] {
  35                 set $var 0
  36         }
  37 }
  38
  39 #
  40 # Constant values used by certain dep_tristate commands.
  41 #
  42 set CONSTANT_Y 1
  43 set CONSTANT_M 2
  44 set CONSTANT_N 0
  45
  46 #
  47 # Create a "reference" object to steal colors from.
  48 #
  49 button .ref
  50
  51 #
  52 # On monochrome displays, -disabledforeground is blank by default; that's
  53 # bad.  Fill it with -foreground instead.
  54 #
  55 if { [cget .ref -disabledforeground] == "" } {
  56         .ref configure -disabledforeground [cget .ref -foreground]
  57 }
  58
  59
  60 #
  61 # Define some macros we will need to parse the config.in file.
  62 #
  63
  64 proc mainmenu_name { text } {
  65         wm title . "$text"
  66 }
  67
  68 proc menu_option { w menu_num text } {
  69         global menus_per_column
  70         if { $menu_num <= $menus_per_column } then {
  71             set myframe left
  72         } elseif { $menu_num <= [expr 2 * $menus_per_column] } then {
  73             set myframe middle
  74         } else {
  75             set myframe right
  76         }
  77         button .f0.x$menu_num -anchor w -text "$text" \
  78             -command "$w .$w \"$text\""
  79         pack .f0.x$menu_num -pady 0 -side top -fill x -in .f0.$myframe
  80 }
  81
  82 proc load_configfile { w title func } {
  83         catch {destroy $w}
  84         toplevel $w -class Dialog
  85         global loadfile
  86         frame $w.x
  87         label $w.bm -bitmap questhead
  88         pack  $w.bm -pady 10 -side top -padx 10
  89         label $w.x.l -text "Enter filename:" -relief raised
  90         entry $w.x.x -width 35 -relief sunken -borderwidth 2 \
  91                 -textvariable loadfile
  92         pack $w.x.l $w.x.x -anchor w -side left
  93         pack $w.x -side top -pady 10
  94         wm title $w "$title"
  95
  96         set oldFocus [focus]
  97         frame $w.f
  98         button $w.f.back -text "OK" -width 20 \
  99                 -command "destroy $w; focus $oldFocus;$func .fileio"
 100         button $w.f.canc -text "Cancel" \
 101                 -width 20 -command "destroy $w; focus $oldFocus"
 102         pack $w.f.back $w.f.canc -side left -pady 10 -padx 45
 103         pack $w.f -pady 10 -side bottom -padx 10 -anchor w
 104         focus $w
 105         global winx; global winy
 106         set winx [expr [winfo x .]+30]; set winy [expr [winfo y .]+30]
 107         wm geometry $w +$winx+$winy
 108 }
 109
 110 proc maybe_exit { w } {
 111         catch {destroy $w}
 112         toplevel $w -class Dialog
 113         label $w.bm -bitmap questhead
 114         pack  $w.bm -pady 10 -side top -padx 10
 115         message $w.m -width 400 -aspect 300 \
 116                 -text "Changes will be lost.  Are you sure?" -relief flat
 117         pack  $w.m -pady 10 -side top -padx 10
 118         wm title $w "Are you sure?"
 119
 120         set oldFocus [focus]
 121         frame $w.f
 122         button $w.f.back -text "OK" -width 20 \
 123                 -command "exit"
 124         button $w.f.canc -text "Cancel" \
 125                 -width 20 -command "destroy $w; focus $oldFocus"
 126         pack $w.f.back $w.f.canc -side left -pady 10 -padx 45
 127         pack $w.f -pady 10 -side bottom -padx 10 -anchor w
 128         focus $w
 129         global winx; global winy
 130         set winx [expr [winfo x .]+30]; set winy [expr [winfo y .]+30]
 131         wm geometry $w +$winx+$winy
 132 }
 133
 134 proc read_config_file { w } {
 135         global loadfile
 136         if { [string length $loadfile] != 0 && [file readable $loadfile] == 1 } then {
 137                 read_config $loadfile
 138         } else {
 139                 catch {destroy $w}
 140                 toplevel $w -class Dialog
 141                 message $w.m -width 400 -aspect 300 -text \
 142                         "Unable to read file $loadfile" \
 143                          -relief raised
 144                 label $w.bm -bitmap error
 145                 pack $w.bm $w.m -pady 10 -side top -padx 10
 146                 wm title $w "Xconfig Internal Error"
 147
 148                 set oldFocus [focus]
 149                 frame $w.f
 150                 button $w.f.back -text "Bummer" \
 151                         -width 10 -command "destroy $w; focus $oldFocus"
 152                 pack $w.f.back -side bottom -pady 10 -anchor s
 153                 pack $w.f -pady 10 -side top -padx 10 -anchor s
 154                 focus $w
 155                 global winx; global winy
 156                 set winx [expr [winfo x .]+30]; set winy [expr [winfo y .]+30]
 157                 wm geometry $w +$winx+$winy
 158         }
 159 }
 160
 161 proc write_config_file  { w } {
 162         global loadfile
 163         if { [string length $loadfile] != 0
 164                 && ([file writable $loadfile] == 1 || ([file exists $loadfile] == 0 && [file writable [file dirname $loadfile]] == 1)) } then {
 165                 writeconfig $loadfile /dev/null
 166         } else {
 167                 catch {destroy $w}
 168                 toplevel $w -class Dialog
 169                 message $w.m -width 400 -aspect 300 -text \
 170                         "Unable to write file $loadfile" \
 171                          -relief raised
 172                 label $w.bm -bitmap error
 173                 pack $w.bm $w.m -pady 10 -side top -padx 10
 174                 wm title $w "Xconfig Internal Error"
 175
 176                 set oldFocus [focus]
 177                 frame $w.f
 178                 button $w.f.back -text "OK" \
 179                         -width 10 -command "destroy $w; focus $oldFocus"
 180                 pack $w.f.back -side bottom -pady 10 -anchor s
 181                 pack $w.f -pady 10 -side top -padx 10 -anchor s
 182                 focus $w
 183                 global winx; global winy
 184                 set winx [expr [winfo x .]+30]; set winy [expr [winfo y .]+30]
 185                 wm geometry $w +$winx+$winy
 186         }
 187 }
 188
 189 proc read_config { filename } {
 190         set file1 [open $filename r]
 191         clear_choices
 192         while { [gets $file1 line] >= 0} {
 193                 if [regexp {([0-9A-Za-z_]+)=([ynm])} $line foo var value] {
 194                         if { $value == "y" } then { set cmd "global $var; set $var 1" }
 195                         if { $value == "n" } then { set cmd "global $var; set $var 0" }
 196                         if { $value == "m" } then { set cmd "global $var; set $var 2" }
 197                         eval $cmd
 198                 }
 199                 if [regexp {# ([0-9A-Za-z_]+) is not set} $line foo var] {
 200                         set cmd "global $var; set $var 0"
 201                         eval $cmd
 202                 }
 203                 if [regexp {([0-9A-Za-z_]+)=([0-9A-Fa-f]+)} $line foo var value] {
 204                         set cmd "global $var; set $var $value"
 205                         eval $cmd
 206                 }
 207                 if [regexp {([0-9A-Za-z_]+)="([^"]*)"} $line foo var value] {
 208                         set cmd "global $var; set $var \"$value\""
 209                         eval $cmd
 210                 }
 211         }
 212         close $file1
 213         update_choices
 214         update_mainmenu .rdupd
 215 }
 216 proc write_comment { file1 file2 text } {
 217         puts $file1 ""
 218         puts $file1 "#"
 219         puts $file1 "# $text"
 220         puts $file1 "#"
 221         puts $file2 "/*"
 222         puts $file2 " * $text"
 223         puts $file2 " */"
 224 }
 225
 226 proc write_tristate { file1 file2 varname variable dep } {
 227         if { $variable == 0 } \
 228                 then { puts $file1 "# $varname is not set"; \
 229                        puts $file2 "#undef  $varname"} \
 230         elseif { $variable == 2 || ($dep == 2 && $variable == 1) } \
 231                 then { puts $file1 "$varname=m"; \
 232                        puts $file2 "#undef  $varname"; \
 233                        puts $file2 "#define ${varname}_MODULE 1" } \
 234         elseif { $variable == 1 && $dep != 2 } \
 235                 then { puts $file1 "$varname=y"; \
 236                        puts $file2 "#define $varname 1" } \
 237         else { \
 238             puts stdout "ERROR - Attempting to write value for unconfigured variable ($varname)." \
 239         }
 240 }
 241
 242 proc write_int { file1 file2 varname variable dep } {
 243         if { $dep == 0 } \
 244                 then { puts $file1 "# $varname is not set"; \
 245                        puts $file2 "#undef  $varname"} \
 246         else {
 247                 puts $file1 "$varname=$variable"; \
 248                 puts $file2 "#define $varname $variable"; \
 249         }
 250 }
 251
 252 proc write_hex { file1 file2 varname variable dep } {
 253         if { $dep == 0 } \
 254                 then { puts $file1 "# $varname is not set"; \
 255                        puts $file2 "#undef  $varname"} \
 256         else {
 257                 puts $file1 "$varname=$variable"; \
 258                 puts $file2 "#define $varname 0x$variable"; \
 259         }
 260 }
 261
 262 proc write_string { file1 file2 varname variable dep } {
 263         if { $dep == 0 } \
 264                 then { puts $file1 "# $varname is not set"; \
 265                        puts $file2 "#undef  $varname"} \
 266         else {
 267                 puts $file1 "$varname=\"$variable\""; \
 268                 puts $file2 "#define $varname \"$variable\""; \
 269         }
 270 }
 271
 272 proc option_name {w mnum line text helpidx} {
 273         button $w.x$line.l -text "$text" -relief groove -anchor w
 274         $w.x$line.l configure -activefore [cget $w.x$line.l -fg] \
 275                                 -activeback [cget $w.x$line.l -bg]
 276         button $w.x$line.help -text "Help" -relief raised \
 277                 -command "dohelp .dohelp $helpidx"
 278         pack $w.x$line.help -side right -fill y
 279         pack $w.x$line.l -side right -fill both -expand on
 280 }
 281
 282 proc toggle_switch2 {w mnum line text variable} {
 283         frame $w.x$line -relief sunken
 284         radiobutton $w.x$line.y -text "y" -variable $variable -value 1 \
 285                 -relief groove -width 2 -command "update_menu$mnum .menu$mnum"
 286         radiobutton $w.x$line.m -text "-"  -variable $variable -value 2 \
 287                 -relief groove -width 2 -command "update_menu$mnum .menu$mnum"
 288         radiobutton $w.x$line.n -text "n"  -variable $variable -value 0 \
 289                 -relief groove -width 2 -command "update_menu$mnum .menu$mnum"
 290
 291         option_name $w $mnum $line $text $variable
 292
 293         pack $w.x$line.n $w.x$line.m $w.x$line.y -side right -fill y
 294 }
 295
 296 proc toggle_switch3 {w mnum line text variable} {
 297         frame $w.x$line -relief sunken
 298         radiobutton $w.x$line.y -text "y" -variable $variable -value 1 \
 299                 -relief groove -width 2 -command "update_menu$mnum .menu$mnum"
 300         radiobutton $w.x$line.m -text "m"  -variable $variable -value 2 \
 301                 -relief groove -width 2 -command "update_menu$mnum .menu$mnum"
 302         radiobutton $w.x$line.n -text "n"  -variable $variable -value 0 \
 303                 -relief groove -width 2 -command "update_menu$mnum .menu$mnum"
 304
 305         option_name $w $mnum $line $text $variable
 306
 307         global CONFIG_MODULES
 308         if {($CONFIG_MODULES == 0)} then {
 309                 $w.x$line.m configure -state disabled
 310         }
 311         pack $w.x$line.n $w.x$line.m $w.x$line.y -side right -fill y
 312 }
 313
 314 proc bool {w mnum line text variable} {
 315         toggle_switch2 $w $mnum $line $text $variable
 316         $w.x$line.m configure -state disabled
 317         pack $w.x$line -anchor w -fill both -expand on
 318 }
 319
 320 proc tristate {w mnum line text variable } {
 321         toggle_switch3 $w $mnum $line $text $variable
 322         pack $w.x$line -anchor w -fill both -expand on
 323 }
 324
 325 proc dep_tristate {w mnum line text variable depend } {
 326         tristate $w $mnum $line $text $variable
 327 }
 328
 329 proc int { w mnum line text variable } {
 330         frame $w.x$line
 331         entry $w.x$line.x -width 18 -relief sunken -borderwidth 2 \
 332                 -textvariable $variable
 333         option_name $w $mnum $line $text $variable
 334         pack $w.x$line.x -anchor w -side right -fill y
 335         pack $w.x$line -anchor w -fill both -expand on
 336 }
 337
 338 proc hex { w mnum line text variable } {
 339         int $w $mnum $line $text $variable
 340 }
 341
 342 proc istring { w mnum line text variable } {
 343         frame $w.x$line
 344         entry $w.x$line.x -width 18 -relief sunken -borderwidth 2 \
 345                 -textvariable $variable
 346         option_name $w $mnum $line $text $variable
 347         pack $w.x$line.x -anchor w -side right -fill y
 348         pack $w.x$line -anchor w -fill both -expand on
 349 }
 350
 351 proc minimenu { w mnum line text variable helpidx } {
 352         frame $w.x$line
 353         menubutton $w.x$line.x -textvariable $variable -menu \
 354                 $w.x$line.x.menu -relief raised \
 355                 -anchor w
 356         option_name $w $mnum $line $text $helpidx
 357         pack $w.x$line.x -anchor w -side right -fill y
 358         pack $w.x$line -anchor w -fill both -expand on
 359 }
 360
 361 proc comment {w line text } {
 362 #nothing done for comments now.
 363 }
 364
 365 proc dohelp {w var }  {
 366         catch {destroy $w}
 367         toplevel $w -class Dialog
 368
 369         set filefound 0
 370         set found 0
 371         set lineno 0
 372
 373         if { [file readable Documentation/Configure.help] == 1} then {
 374                 set filefound 1
 375                 # First escape sed regexp special characters in var:
 376                 set var [exec echo "$var" | sed s/\[\]\[\/.^$*\]/\\\\&/g]
 377                 # Now pick out right help text:
 378                 set message [exec sed -n "
 379                         /^$var\[        \]*\$/,\${
 380                                 /^$var\[        \]*\$/c\\
 381 ${var}:\\
 382
 383                                 /^#/b
 384                                 /^\[^   \]/q
 385                                 s/^  //
 386                                 p
 387                         }
 388                         " Documentation/Configure.help]
 389                 set found [expr [string length "$message"] > 0]
 390         }
 391
 392         frame $w.f1
 393
 394         if { $found == 0 } then {
 395                 if { $filefound == 0 } then {
 396                 message $w.f1.m -width 750 -aspect 300 -relief flat -text \
 397                         "No help available - unable to open file Documentation/Configure.help.  This file should have come with your kernel."
 398                 } else {
 399                 message $w.f1.m -width 400 -aspect 300 -relief flat -text \
 400                         "No help available for $var"
 401                 }
 402                 label $w.f1.bm -bitmap error
 403                 wm title $w "RTFM"
 404         } else {
 405                 text $w.f1.m -width 73 -relief flat -wrap word
 406                 $w.f1.m insert 0.0 $message
 407                 $w.f1.m conf -state disabled  -height [$w.f1.m index end]
 408
 409                 label $w.f1.bm -bitmap info
 410                 wm title $w "Configuration help"
 411         }
 412         pack $w.f1.bm $w.f1.m -side left -padx 10
 413         pack $w.f1 -side top
 414         set oldFocus [focus]
 415
 416         # Do the OK button
 417         #
 418         frame $w.f2
 419         button $w.f2.ok -text "OK" \
 420                 -width 10 -command "destroy $w; focus $oldFocus"
 421         pack $w.f2.ok -side bottom -pady 6 -anchor n
 422         pack $w.f2 -side bottom -padx 10 -anchor s
 423
 424         # Finish off the window
 425         #
 426         focus $w
 427         global winx; global winy
 428         set winx [expr [winfo x .]+30]; set winy [expr [winfo y .]+30]
 429         wm geometry $w +$winx+$winy
 430 }
 431
 432 proc wrapup {w }  {
 433         catch {destroy $w}
 434         toplevel $w -class Dialog
 435
 436         global CONFIG_MODVERSIONS; vfix CONFIG_MODVERSIONS
 437         if { ([file exists .hdepend] != 1) || ($CONFIG_MODVERSIONS == 1) } then {
 438             message $w.m -width 400 -aspect 300 -relief raised -text \
 439                 "End of Linux kernel configuration.  Check the top-level Makefile for additional configuration.  Next, you must run 'make dep'."
 440         } else {
 441             message $w.m -width 400 -aspect 300 -relief raised -text \
 442                 "End of Linux kernel configuration.  Check the top-level Makefile for additional configuration.  Next, you may 'make bzImage', 'make bzdisk', or 'make bzlilo.'"
 443         }
 444         label $w.bm -bitmap info
 445         pack $w.bm $w.m -pady 10 -side top -padx 10
 446         wm title $w "Kernel build instructions"
 447
 448         set oldFocus [focus]
 449         frame $w.f
 450         button $w.f.back -text "OK" \
 451                 -width 10 -command "exit"
 452         pack $w.f.back -side bottom -pady 10 -anchor s
 453         pack $w.f -pady 10 -side top -padx 10 -anchor s
 454         focus $w
 455         global winx; global winy
 456         set winx [expr [winfo x .]+30]; set winy [expr [winfo y .]+30]
 457         wm geometry $w +$winx+$winy
 458
 459 }
 460
 461 #
 462 # Next set up the particulars for the top level menu, and define a few
 463 # buttons which we will stick down at the bottom.
 464 #
 465
 466 frame .f0
 467 frame .f0.left
 468 frame .f0.middle
 469 frame .f0.right
 470