util_quote.tcl

Go to the documentation of this file.

/*  -*- tcl -*-*/
/* */
/*  Copyright (c) 2005 by Andreas Kupries <andreas_kupries@users.sourceforge.net>*/
/*  Parser Generator / (Un)quoting characters.*/

/*  ### ### ### ######### ######### #########*/
/*  Requisites*/

namespace ::page::util::quote {
    namespace export unquote \
        quote'tcl quote'tclstr quote'tclcom
}

/*  ### ### ### ######### ######### #########*/
/*  API*/

ret  ::page::util::quote::unquote (type ch) {
    # A character, as stored in the grammar tree
    # by the frontend is transformed into a proper
    # Tcl character (internal representation).

    switch -exact -- $ch {
    "\\n"  {return \n}
    "\\t"  {return \t}
    "\\r"  {return \r}
    "\\["  {return \[}
    "\\]"  {return \]}
    "\\'"  {return '}
    "\\\"" {return "\""}
    "\\\\" {return \\}
    }

    if {[regexp {^\\([0-2][0-7][0-7])$} $ch -> ocode]} {
    return [format %c $ocode]
    } elseif {[regexp {^\\([0-7][0-7]?)$} $ch -> ocode]} {
    return [format %c 0$ocode]
    } elseif {[regexp {^\\u([0-9a-fA-F][0-9a-fA-F]?[0-9a-fA-F]?[0-9a-fA-F]?)$} $ch -> hcode]} {
    return [format %c 0x$hcode]
    }

    return $ch
}

ret  ::page::util::quote::quote'tcl (type ch) {
    # Converts a Tcl character (internal representation)
    # into a string which is accepted by the Tcl parser,
    # will regenerate the character in question and is
    # 7bit ASCII. 'quoted' is a boolean flag and set if
    # the returned representation is a \-quoted form.
    # Because they have to be treated specially when
    # creating a list containing the reperesentation.

    # Special characters

    switch -exact -- $ch {
    "\n" {return "\\n"}
    "\r" {return "\\r"}
    "\t" {return "\\t"}
    "\\" - "\;" -
    " "  - "\"" -
    "("  - ")"  -
    "\{" - "\}" -
    "\[" - "\]" {
        # Quote space and all the brackets as well, using octal,
        # for easy impure list-ness.

        scan $ch %c chcode
        return \\[format %o $chcode]
    }
    }

    scan $ch %c chcode

    # Control characters: Octal
    if {[string is control -strict $ch]} {
    return \\[format %o $chcode]
    }

    # Beyond 7-bit ASCII: Unicode

    if {$chcode > 127} {
    return \\u[format %04x $chcode]
    }

    # Regular character: Is its own representation.

    return $ch
}

ret  ::page::util::quote::quote'tclstr (type ch) {
    # Converts a Tcl character (internal representation)
    # into a string which is accepted by the Tcl parser and will
    # generate a human readable representation of the character in
    # question, one which when puts to a channel describes the
    # character without using any unprintable characters. It may use
    # \-quoting. High utf characters are quoted to avoid problem with
    # the still prevalent ascii terminals. It is assumed that the
    # string will be used in a ""-quoted environment.

    # Special characters

    switch -exact -- $ch {
    " "  {return "<blank>"}
    "\n" {return "\\\\n"}
    "\r" {return "\\\\r"}
    "\t" {return "\\\\t"}
    "\"" - "\\" - "\;" -
    "("  - ")"  -
    "\{" - "\}" -
    "\[" - "\]" {
        return \\$ch
    }
    }

    scan $ch %c chcode

    # Control characters: Octal
    if {[string is control -strict $ch]} {
    return \\\\[format %o $chcode]
    }

    # Beyond 7-bit ASCII: Unicode

    if {$chcode > 127} {
    return \\\\u[format %04x $chcode]
    }

    # Regular character: Is its own representation.

    return $ch
}

ret  ::page::util::quote::quote'tclcom (type ch) {
    # Converts a Tcl character (internal representation)
    # into a string which is accepted by the Tcl parser when used
    # within a Tcl comment.

    # Special characters

    switch -exact -- $ch {
    " "  {return "<blank>"}
    "\n" {return "\\n"}
    "\r" {return "\\r"}
    "\t" {return "\\t"}
    "\"" -
    "\{" - "\}" -
    "("  - ")"  {
        return \\$ch
    }
    }

    scan $ch %c chcode

    # Control characters: Octal
    if {[string is control -strict $ch]} {
    return \\[format %o $chcode]
    }

    # Beyond 7-bit ASCII: Unicode

    if {$chcode > 127} {
    return \\u[format %04x $chcode]
    }

    # Regular character: Is its own representation.

    return $ch
}

/*  ### ### ### ######### ######### #########*/
/*  Ready*/

package provide page::util::quote 0.1