Re: Patch: preferences fixes

[Fernando Nasser <fnasser at cygnus dot com>]

Tom Tromey wrote:
> 
> This patch fixes a couple of Insight PRs which I submitted.
> 
> First, it makes the encoding of .gdbtkinit smarter.  It now uses URL
> encoding instead of the previous ad-hoc encoding.  The new encoding
> has the nice property of being round-trip capable -- no matter what
> you feed into it, the result you get back from decoding should be the
> same.  The old encoding failed with certain (unlikely, admittedly)
> strings.
> 
> Second, this patch adds versioning to .gdbtkinit.  A version string is
> written to the file and recognized when the file is read back in.
> This lets us change the encoding or the file format in the future and
> still be able to read existing .gdbtkinit files.
> 
> Third, this patch allows keys with more `/'s than the old code
> allowed.
> 
> The new code can read old .gdbtkinit files correctly.
> 
> This patch does include a minor change in preparation for my session
> patch (it adds the `session' key).  This doesn't hurt but I can remove
> it before committing if you really want.
> 
> Ok to commit?
> 

Yes, please.

Thanks!

Fernando


> 2000-11-30  Tom Tromey  <tromey@cygnus.com>
> 
>         * prefs.tcl (pref_save): Put version number into file.  Added
>         `session' to list of top-level keys.  Allow keys with many `/'s.
>         (pref_read): Recognize version number.
>         (escape_value): Generate URL-style encoding.
>         (unescape_value): Added `version' argument.  Handle URL decoding.
> 
> Tom
> 
> Index: prefs.tcl
> ===================================================================
> RCS file: /cvs/src/src/gdb/gdbtk/library/prefs.tcl,v
> retrieving revision 1.3
> diff -u -r1.3 prefs.tcl
> --- prefs.tcl   2000/04/04 00:17:47     1.3
> +++ prefs.tcl   2000/11/30 19:05:28
> @@ -72,10 +72,15 @@
> 
>      if {$file_opened == "1"} {
>        set section gdb
> +      set version 0
>        while {[gets $fd line] >= 0} {
>         switch -regexp -- $line {
>           {^[ \t\n]*#.*} {
> -           ;# comment; ignore it
> +           # Comment.  We recognize one magic comment that includes
> +           # the version number.
> +           if {[regexp -- "^GDBtkInitVersion: (\[0-9\]+)\$" $line v]} {
> +             set version $v
> +           }
>           }
> 
>           {^[ \t\n]*$} {
> @@ -94,7 +99,7 @@
>           default {
>             regexp "\[ \t\n\]*\(.+\)=\(.+\)" $line a name val
>             # Must unescape equal signs in val
> -           set val [unescape_value $val]
> +           set val [unescape_value $val $version]
>             if {$section == "gdb"} {
>               pref setd gdb/$name $val
>             } elseif {$section == "global" && [regexp "^font/" $name]} {
> @@ -141,6 +146,7 @@
>      }
> 
>      puts $fd "\# GDBtk Init file"
> +    puts $fd "\# GDBtkInitVersion: 1"
> 
>      set plist [pref list]
>      # write out global options
> @@ -170,16 +176,18 @@
>        }
>      }
> 
> -    #now loop through all sections writing out values
> +    # now loop through all sections writing out values
> +    # FIXME: this is broken.  We should discover the list
> +    # dynamically.
>      lappend secs load console src reg stack locals watch bp search \
> -      process geometry help browser kod window
> +      process geometry help browser kod window session
> 
>      foreach section $secs {
>        puts $fd "\[$section\]"
>        foreach var $plist {
>         set t [split $var /]
>         if {[lindex $t 0] == "gdb" && [lindex $t 1] == $section} {
> -       set x [lindex $t 2]
> +         set x [join [lrange $t 2 end] /]
>           set v [escape_value [pref get $var]]
>           if {$x != "" && $v != ""} {
>             puts $fd "\t$x=$v"
> @@ -200,22 +208,40 @@
>  #         prefs to a file
>  # -------------------------------------------------------
>  proc escape_value {val} {
> -
> -  if {[regsub -all -- = $val {!%} newval]} {
> -    return $newval
> -  }
> -
> -  return $val
> +  # We use a URL-style quoting.  We encode `=', `%', the `[]'
> +  # characters and newlines.  We use a cute trick here: we regsub in
> +  # command expressions which we then expand using subst.
> +  regsub -all -- "(\[\]\[=%\n\])" $val \
> +    {[format "%%%02x" [scan {\1} %c x; set x]]} newval
> +  return [subst -nobackslashes -novariables $newval]
>  }
> 
>  # -------------------------------------------------------
>  #  PROC: unescape_value - unescape all equal signs for
> -#         reading prefs from a file
> +#         reading prefs from a file.  VERSION is the version
> +#         number of the encoding.
> +#  version 0 only encoded `='.
> +#  version 1 correctly encoded more values
>  # -------------------------------------------------------
> -proc unescape_value {val} {
> +proc unescape_value {val version} {
> +  switch -exact -- $version {
> +    0 {
> +      # Old-style encoding.
> +      if {[regsub -all -- {!%} $val = newval]} {
> +       return $newval
> +      }
> +    }
> +
> +    1 {
> +      # Version 1 uses URL encoding.
> +      regsub -all -- "%(..)" $val \
> +       {[format %c 0x\1]} newval
> +      return [subst -nobackslashes -novariables $newval]
> +    }
> 
> -  if {[regsub -all -- {!%} $val = newval]} {
> -    return $newval
> +    default {
> +      error "Unknown encoding version $version"
> +    }
>    }
> 
>    return $val

-- 
Fernando Nasser
Red Hat Canada Ltd.                     E-Mail:  fnasser@redhat.com
2323 Yonge Street, Suite #300
Toronto, Ontario   M4P 2C9