*** header.tk.ori	Sun Apr 29 20:24:19 2001
--- header.tk	Fri May 11 09:50:47 2001
***************
*** 15,21 ****
  #
  # 24 January 1999, Michael Elizabeth Chastain, <mec@shout.net>
  # - Improve the exit message (Jeff Ronne).
! 
  #
  # This is a handy replacement for ".widget cget" that requires neither tk4
  # nor additional source code uglification.
--- 15,28 ----
  #
  # 24 January 1999, Michael Elizabeth Chastain, <mec@shout.net>
  # - Improve the exit message (Jeff Ronne).
! #
! # 29 April 2001, Simon Geard, <simon.geard@ntlworld.com>
! # - Cached help info so that
! #       1) help arrives quickly
! #       2) help buttons are enabled/disabled accordingly
! # - Replaced all calls to the os utilities with native Tcl
! #
! # ============================================================================= 
  #
  # This is a handy replacement for ".widget cget" that requires neither tk4
  # nor additional source code uglification.
***************
*** 134,139 ****
--- 141,205 ----
  	wm geometry $w +$winx+$winy
  }
  
+ # Read and cache the help - puts the help info into the ::help_data array
+ proc read_help {helpfile} {
+     if {! [file isfile $helpfile]} {
+ 	return -code error "could not find help file $helpfile"
+     }
+     set hfid [open $helpfile]
+     set lc 0
+     set new_section 0
+     puts -nonewline "Caching help file ... "; flush stdout
+     foreach hline [split [read -nonewline $hfid] \n] {
+ 	incr lc
+ 
+ 	# Skip comment lines (but mark as out-of-section)
+ 	if {[regexp -- {^\#} $hline]} {
+ 	    set new_section 0
+ 	    continue
+ 	}
+ 
+ 	# Skip blank lines that are not inside a section
+ 	if {$new_section == 0 && [regexp -- {^[[:space:]]*$} $hline]} {
+ 	    continue
+ 	}
+ 
+ 	# Read the variable name
+ 	if {$new_section == 1} {
+ 	    if {! [regexp -- {^([^[:space:]].+)$} $hline dum var]} {
+ 		puts stderr "Bad format in help file $helpfile line $lc - section skipped"
+ 		set new_section 0
+ 		continue
+ 	    }
+ 	    set ::help_data($var,description) $desc
+ 	    incr new_section
+ 	    continue
+ 	}
+ 
+ 	# Start of a new section - a non-space first character
+ 	if {[regexp -- {^[^[:space:]]} $hline]} {
+ 	    set desc $hline
+ 	    set new_section 1
+ 	    continue
+ 	}
+ 
+ 	# Skip blank lines at the beginning of a section
+ 	if {$new_section == 2 && [regexp -- {^[[:space:]]*$} $hline]} {
+ 	    continue
+ 	}
+ 
+ 	# Load this section (stripping off the leading 2 spaces)
+ 	if {$new_section > 1} {
+ 	    incr new_section
+ 	    regsub {^  } $hline {} hline
+ 	    append ::help_data($var,text) "\n$hline"
+ 	}
+ 	    
+     }
+     close $hfid
+     puts "done."
+ }
+ 
  proc read_config_file { w } {
  	global loadfile
  	if { [string length $loadfile] != 0 && [file readable $loadfile] == 1 } then {
***************
*** 192,213 ****
  proc read_config { filename } {
  	set file1 [open $filename r]
  	clear_choices
  	while { [gets $file1 line] >= 0} {
  		if [regexp {([0-9A-Za-z_]+)=([ynm])} $line foo var value] {
! 			if { $value == "y" } then { set cmd "global $var; set $var 1" }
! 			if { $value == "n" } then { set cmd "global $var; set $var 0" }
! 			if { $value == "m" } then { set cmd "global $var; set $var 2" }
! 			eval $cmd
  		}
  		if [regexp {# ([0-9A-Za-z_]+) is not set} $line foo var] {
  			set cmd "global $var; set $var 0"
  			eval $cmd
  		}
! 		if [regexp {([0-9A-Za-z_]+)=([0-9A-Fa-f]+)} $line foo var value] {
  			set cmd "global $var; set $var $value"
  			eval $cmd
  		}
! 		if [regexp {([0-9A-Za-z_]+)="([^"]*)"} $line foo var value] {
  			set cmd "global $var; set $var \"$value\""
  			eval $cmd
  		}
--- 258,278 ----
  proc read_config { filename } {
  	set file1 [open $filename r]
  	clear_choices
+         array set reply {n 0 y 1 m 2}
  	while { [gets $file1 line] >= 0} {
  		if [regexp {([0-9A-Za-z_]+)=([ynm])} $line foo var value] {
! 		    set cmd "global $var; set $var $reply($value)"
! 		    eval $cmd
  		}
  		if [regexp {# ([0-9A-Za-z_]+) is not set} $line foo var] {
  			set cmd "global $var; set $var 0"
  			eval $cmd
  		}
! 		    if [regexp {([0-9A-Za-z_]+)=([[:xdigit:]]+)} $line foo var value] {
  			set cmd "global $var; set $var $value"
  			eval $cmd
  		}
! 		if [regexp {([0-9A-Za-z_]+)="(.*?)"} $line foo var value] {
  			set cmd "global $var; set $var \"$value\""
  			eval $cmd
  		}
***************
*** 287,299 ****
  }
  
  proc write_hex { file1 file2 varname variable dep } {
! 	if { $dep == 0 } \
! 		then { puts $file1 "# $varname is not set"; \
! 		       puts $file2 "#undef  $varname"} \
! 	else {
! 		puts $file1 "$varname=$variable"; \
! 		puts -nonewline $file2 "#define $varname 0x"; \
! 		puts $file2 [exec echo $variable | sed s/^0\[xX\]//]; \
  	}
  }
  
--- 352,365 ----
  }
  
  proc write_hex { file1 file2 varname variable dep } {
! 	if { $dep == 0 } { 
! 	    puts $file1 "# $varname is not set"
! 	    puts $file2 "#undef  $varname"
! 	} else {
! 	    puts $file1 "$varname=$variable"
! 	    puts -nonewline $file2 "#define $varname 0x"
! 	    regsub -- {^0[xX]} $variable {} variable
! 	    puts $file2 "$variable"
  	}
  }
  
***************
*** 311,318 ****
--- 377,390 ----
  	button $w.x$line.l -text "$text" -relief groove -anchor w
  	$w.x$line.l configure -activefore [cget $w.x$line.l -fg] \
  				-activeback [cget $w.x$line.l -bg]
+     # Enable the button only if there is some help
+     if {[info exists ::help_data($helpidx,description)]} {
  	button $w.x$line.help -text "Help" -relief raised \
  		-command "dohelp .dohelp $helpidx .menu$mnum"
+     } else {
+ 	button $w.x$line.help -text "Help" -relief raised \
+ 		-state disabled
+     }
  	pack $w.x$line.help -side right -fill y
  	pack $w.x$line.l -side right -fill both -expand on
  }
***************
*** 445,473 ****
  	catch {destroy $w}
  	toplevel $w -class Dialog
  
- 	set filefound 0
- 	set found 0
- 	set lineno 0
- 
- 	if { [file readable Documentation/Configure.help] == 1} then {
- 		set filefound 1
- 		# First escape sed regexp special characters in var:
- 		set var [exec echo "$var" | sed s/\[\]\[\/.^$*\]/\\\\&/g]
- 		# Now pick out right help text:
- 		set message [exec sed -n "
- 			/^$var\[ 	\]*\$/,\${
- 				/^$var\[ 	\]*\$/c\\
- ${var}:\\
- 
- 				/^#/b
- 				/^\[^ 	\]/q
- 				s/^  //
- 				p
- 			}
- 			" Documentation/Configure.help]
- 		set found [expr [string length "$message"] > 0]
- 	}
- 
  	frame $w.f1
  	pack $w.f1 -fill both -expand on
  
--- 517,522 ----
***************
*** 488,512 ****
  	frame $w.f1.f
  	pack $w.f1.canvas -side right -fill y -expand on
  
! 	if { $found == 0 } then {
! 		if { $filefound == 0 } then {
! 		message $w.f1.f.m -width 750 -aspect 300 -relief flat -text \
! 			"No help available - unable to open file Documentation/Configure.help.  This file should have come with your kernel."
! 		} else {
! 		message $w.f1.f.m -width 400 -aspect 300 -relief flat -text \
! 			"No help available for $var"
! 		}
! 		label $w.f1.bm -bitmap error
! 		wm title $w "RTFM"
! 	} else {
! 		text $w.f1.f.m -width 73 -relief flat -wrap word
! 		$w.f1.f.m insert 0.0 $message
! 		$w.f1.f.m conf -state disabled -height [$w.f1.f.m index end]
  
! 		label $w.f1.bm -bitmap info
! 		wm title $w "Configuration help" 
! 	}
! 	pack $w.f1.f.m -side left
  	pack $w.f1.bm $w.f1.f -side left -padx 10
  
  	focus $w
--- 537,556 ----
  	frame $w.f1.f
  	pack $w.f1.canvas -side right -fill y -expand on
  
!     set txwid [text $w.f1.f.m -width 73 -relief flat -wrap word]
!     $txwid tag configure title -foreground blue -underline true
!     $txwid tag configure nohelp -foreground green4
!     $txwid insert end "$::help_data($var,description)\n" title
!     if {[info exists ::help_data($var,text)]} {
!         $txwid insert end $::help_data($var,text)
!     } else {
! 	$txwid insert end "\nSorry - no help yet." nohelp
!     }
!         $txwid conf -state disabled -height [$txwid index end]
!         label $w.f1.bm -bitmap info
!         wm title $w "Configuration help" 
  
! 	pack $txwid -side left
  	pack $w.f1.bm $w.f1.f -side left -padx 10
  
  	focus $w
***************
*** 596,615 ****
  }
  
  proc validate_int {name val default} {
! 	if {([exec echo $val | sed s/^-//g | tr -d \[:digit:\] ] != "")} then {
! 		global $name; set $name $default
! 	}
  }
  
  proc validate_hex {name val default} {
! 	if {([exec echo $val | tr -d \[:xdigit:\] ] != "")} then {
! 		global $name; set $name $default
! 	}
  }
  
  proc update_define {first last allow_update} {
  	for {set i $first} {$i <= $last} {incr i} {
! 		update_define_menu$i
  		if {$allow_update == 1} then update
  	}
  }
--- 640,659 ----
  }
  
  proc validate_int {name val default} {
!     if {[regexp -- {[^-?[:digit:]]+$} $val]} {
! 	global $name; set $name $default
!     }
  }
  
  proc validate_hex {name val default} {
!     if {[regexp -- {[^-?[:xdigit:]]+$} $val]} {
! 	global $name; set $name $default
!     }
  }
  
  proc update_define {first last allow_update} {
  	for {set i $first} {$i <= $last} {incr i} {
!  		update_define_menu$i
  		if {$allow_update == 1} then update
  	}
  }
***************
*** 626,628 ****
--- 670,678 ----
  
  set active_menus [list]
  set processed_top_level 0
+ 
+ # Local Variables:
+ # mode: tcl
+ # End:
+ 
+