How can we accommodate arbitrary Unicode characters in symbol names?

Question

I understand why Mathematica doesn't the support the [ character in symbol names, but it should be escapable in some way, like non-printable characters are in strings using \. A bigger problem is that a large number of Unicode characters are also not allowed in symbol names, and some of them for no obvious reason.

Is there a good way to escape such characters? Ideally, it should be broadly usable in arbitrary Mathematica code without requiring further special handling of the escaped symbol names.

I'm thinking something like the following:

Replace[a$multiply$[b[c, d]], 
 head_[x___] :> $[
        StringReplace[ToString@head, {"$multiply$" :> "*"}]][x], {0, 
  Infinity}]

Answer 1

The following is in the right direction if you include the answer to invalid Symbol characters also.

opts = {"$divide$" :> "/", "$backslash$" :> "\\", "$period$" :> ".", 
   "$tilde$" :> "~", "$backtick$" :> "`", "$exclaim$" :> "!", 
   "$at$" :> "@", "$number$" :> "#", "$dollar$" :> "$", 
   "$percent$" :> "%", "$caret$" :> "^", "$amp$" :> "&", 
   "$multiply$" :> "*", "$parenleft$" :> "(", "$parenright$" :> ")", 
   "$underscore$" :> "_", "$dash$" :> "-", "$plus$" :> "+", 
   "$equal$" :> "=", "$barleft$" :> "[", "$barright$" :> "]", 
   "$bracketleft$" :> "{", "$bracketright$" :> "}", "$colon$" :> ":", 
   "$semicolon$" :> ";", "$singlequote$" :> "'", 
   "$doublequote$" :> "\"", "$lessthan$" :> "<", "$comma$" :> ",", 
   "$period$" :> ".", "$slash$" :> "/", "$question$" :> "?", 
   "$space$" :> " ", "$n$" :> "\n", "$r$" :> "\r"};
opts = Join[
   Drop[Quiet[
     Cases[Symbol[FromCharacterCode[#]] & /@ Range[0, 16^4 - 1], 
      Symbol[z__] -> (StringJoin@
          Flatten@Join[{"$", IntegerString[ToCharacterCode[z], 16, 4],
              "$"}] -> z)]], 1], opts];
Replace[a$multiply$[b$underscore$[c, d]], 
 head_[x___] :> $[StringReplace[ToString@head, opts]][x], {0, 
  Infinity}]

If you would like to display it in a pretty form you can do the following.

ReplaceRepeated[
 ToBoxes[FullForm@Ti$at$mes[{a}, Rational[1, -2], "test"]][[1, 
   1]], {RowBox[{b_String, "[", x___String, "]"}] :> 
   StringJoin[{StringReplace[b, opts], "[", x, "]"}], 
  RowBox[{b___String}] :> StringJoin[{b}]}]