lkml.org 
[lkml]   [2001]   [May]   [17]   [last100]   RSS Feed
Views: [wrap][no wrap]   [headers]  [forward] 
 
Messages in this thread
Patch in this message
/
From
Date
Subjectmake xconfig with tcl/tk 8.3 - the patches
Re my previous message on this subject, the patch files are attached.

They can also be found at my web site:

http://homepage.ntlworld.com/whiteowl/kernel


Simon Geard
*** tail.tk.ori Fri May 11 09:18:42 2001
--- tail.tk Fri May 11 09:38:06 2001
***************
*** 7,13 ****
# 8 January 1998, Michael Elizabeth Chastain, <mec@shout.net>
# Arrange buttons in three columns for better screen fitting.
#
!
#
# Read the user's settings from .config. These will override whatever is
# in config.in. Don't do this if the user specified a -D to force
--- 7,17 ----
# 8 January 1998, Michael Elizabeth Chastain, <mec@shout.net>
# Arrange buttons in three columns for better screen fitting.
#
! # 29 April 2001, Simon Geard, <simon.geard@ntlworld.com>
! # - Added call to load the help-file on startup (see header.tk)
! # - Replaced os call to copy a file with the native Tcl one
! #
! # =============================================================================
#
# Read the user's settings from .config. These will override whatever is
# in config.in. Don't do this if the user specified a -D to force
***************
*** 29,39 ****
read_config $defaults
}

update_define 1 $total_menus 0
update_mainmenu

! button .f0.right.save -anchor w -text "Save and Exit" -underline 0\
! -command { catch {exec cp -f .config .config.old}; \
writeconfig .config include/linux/autoconf.h; wrapup .wrap }

button .f0.right.quit -anchor w -text "Quit Without Saving" -underline 0\
--- 33,46 ----
read_config $defaults
}

+ # Read the help file
+ read_help Documentation/Configure.help
+
update_define 1 $total_menus 0
update_mainmenu

! button .f0.right.save -anchor w -text "Save and Exit" \
! -command { catch {file copy -force .config .config.old}; \
writeconfig .config include/linux/autoconf.h; wrapup .wrap }

button .f0.right.quit -anchor w -text "Quit Without Saving" -underline 0\
***************
*** 87,89 ****
--- 94,100 ----
.f0.right.save configure -state disabled
}
}
+
+ # Local Variables:
+ # mode: tcl
+ # End:
--- tail.tk.ori Sun Apr 29 20:25:38 2001
+++ tail.tk Mon Apr 30 00:31:25 2001
@@ -7,7 +7,11 @@
# 8 January 1998, Michael Elizabeth Chastain, <mec@shout.net>
# Arrange buttons in three columns for better screen fitting.
#
-
+# 29 April 2001, Simon Geard, <simon.geard@ntlworld.com>
+# - Added call to load the help-file on startup (see header.tk)
+# - Replaced os call to copy a file with the native Tcl one
+#
+# =============================================================================
#
# Read the user's settings from .config. These will override whatever is
# in config.in. Don't do this if the user specified a -D to force
@@ -29,11 +33,14 @@
read_config $defaults
}

+# Read the help file
+read_help Documentation/Configure.help
+
update_define 1 $total_menus 0
update_mainmenu

button .f0.right.save -anchor w -text "Save and Exit" \
- -command { catch {exec cp -f .config .config.old}; \
+ -command { catch {file copy -force .config .config.old}; \
writeconfig .config include/linux/autoconf.h; wrapup .wrap }

button .f0.right.quit -anchor w -text "Quit Without Saving" \
@@ -87,3 +94,7 @@
.f0.right.save configure -state disabled
}
}
+
+# Local Variables:
+# mode: tcl
+# End:*** 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:
+
+
\
 
 \ /
  Last update: 2005-03-22 12:53    [W:0.050 / U:0.024 seconds]
©2003-2020 Jasper Spaans|hosted at Digital Ocean and TransIP|Read the blog|Advertise on this site