Posted to tcl by jnc at Mon Oct 17 15:26:32 GMT 2011view raw

  1. proc ::mime::qp_decode {string {encoded_word 0}} {
  2. # 8.1+ improved string manipulation routines used.
  3. # Special processing for encoded words (RFC 2047)
  4.  
  5. if {$encoded_word} {
  6. # _ == \x20, even if SPACE occupies a different code position
  7. set string [string map [list _ \u0020] $string]
  8. }
  9.  
  10. # smash the white-space at the ends of lines since that must've been
  11. # generated by an MUA.
  12.  
  13. regsub -all -- {[ \t]+\n} $string "\n" string
  14. set string [string trimright $string " \t"]
  15.  
  16. # Protect the backslash for later subst and
  17. # smash soft newlines, has to occur after white-space smash
  18. # and any encoded word modification.
  19.  
  20. set string [string map [list "\\" "\\\\" "=\n" ""] $string]
  21.  
  22. # Decode specials
  23.  
  24. regsub -all -nocase {=([a-f0-9][a-f0-9])} $string {\\u00\1} string
  25.  
  26. # process \u unicode mapped chars
  27.  
  28. return [subst -novar -nocommand $string]
  29. }