Escaping special characters

Commands like regexp, glob and others make use of special characters which need to be escaped if you want the argument to be treated as a literal string. The code below comes from Hume Smith's HCLS package. It provides a set of commands for this purpose, e.g., HCLS::quote::regexp.

(Is there license information for the original code?)

Examples

% HCLS::quote::glob {ab*[c%}
ab\*\[c%
% HCLS::quote::match {ab*[c%}
ab\*\[c%
% HCLS::quote::bind {ab*[c%}
ab*[c%%
% HCLS::quote::subst {ab*[c%}
ab*\[c%
% HCLS::quote::regexp {ab*[c%}
ab\*\[c%
% HCLS::quote::regsub {ab*[c%}
ab*[c%

Code

# From Hume Smith's HCLS package
namespace eval HCLS {}

#
# Quoters
#

namespace eval HCLS::quote {
    namespace export {[a-z]*}
}

#
# sigh... of course, some (not all! eg subst, new regsub) of these can be
# done simply by putting \ in front of everything.  but that's somehow not
# as elegent.  It's certainly not as much fun.
#

# 1999-08-26
# - reworked so that Backsolidus-guard creates the procs instead of being
#  called by them... which should speed them up noticeably
# 2018-06-03 dbohdan
# - refactored namespace creation
# - reformatted the code
# - removed support for old REs

if {![catch {string map {} {}}]} {
    # string map
    proc HCLS::quote::Backsolidus-guard {name bag} {
        array set x {\\ \\\\}
        foreach c [split $bag {}] { set x($c) \\$c }
        proc $name str "string map [list [array get x]] \$str"
    }
} elseif {[catch {regexp {[\]} {}}]} {
    # REs
    proc HCLS::quote::Backsolidus-guard {name bag} {
        # crickey... this is getting self-referential :)
        ::regsub -all {[\\\[\]\-\^]} \\$bag {\\&} bag
        proc $name str \
            "[list ::regsub -all \[$bag\]] \$str {\\\\&} str\nset str"
    }
} else {
    error {need [string map] or [regexp] with bracket expressions}
}


# [string match [HCLS::quote::match $str1] $str2] ==
# ![string compare $str1 $str2]
HCLS::quote::Backsolidus-guard match {\*?[}

# it's quite tricky to explain what this does,
# and tildes are probably still a problem
HCLS::quote::Backsolidus-guard glob {\*?[{}}

# regsub x x [HCLS::quote:regsub $str] x; set str
#        equivalent to
# set x $str
HCLS::quote::Backsolidus-guard regsub {\&}

# ![string compare $str1 $str2] == [regexp [HCLS::quote::regexp $str1] $str2]
HCLS::quote::Backsolidus-guard regexp {{$^.?+*\|()[]}}

# 0 == [string compare [subst [subst-quote $str]] $str]
HCLS::quote::Backsolidus-guard subst {[\$}


# dunno how to describe this formally
proc HCLS::quote::bind str { string map {% %%} $str }
if {[catch {HCLS::quote::bind %}]} {
    proc HCLS::quote::bind str {
        ::regsub -all % $str %% str
        set str
    }
}

# tests
namespace eval HCLS::quote {
    proc Assert-equal {actual expected} {
        if {$actual ne $expected} {
            error "expected \"$expected\", but got \"$actual\""
        }
    }

    Assert-equal [glob {ab*[c%}] {ab\*\[c%}
    Assert-equal [match {ab*[c%}] {ab\*\[c%}
    Assert-equal [bind {ab*[c%}] {ab*[c%%}
    Assert-equal [subst {ab*[c%}] {ab*\[c%}
    Assert-equal [regexp {ab*[c%}] {ab\*\[c%}
    Assert-equal [regsub {ab*[c%&}] {ab*[c%\&}
}

# i wonder if i can do one for eval?