Cook Email Address

  ; works with scsh 0.6.4

  ;; takes: s0 [at [dot]], returns: s1
  ;; s0, s1, at, dot : string;  defaults: at = " at ", dot = " "
  ;; Return new string S1 equal to S0 with the first "@" replaced by AT
  ;; and all subsequent dots "." each replaced by DOT.
  ;; Examples:
  ;;   (cook-email-address "kitana@mulaw.xxx") ==> "kitana at mulaw xxx"
  ;;   (cook-email-address "St.James@zop.gov" ":" "*") ==>  "St.James:zop*gov"
  (define (cook-email-address s0 . opts)
    (let-optionals opts ((at " at ")
                         (dot " "))
      (regexp-substitute/global
       #f (rx (: "@" (submatch (* any)))) s0
       'pre at (lambda (m)
                 (regexp-substitute/global
                  #f (rx ".") (match:substring m 1)
                  'pre dot 'post)))))

Hey, wait, COOK-EMAIL-ADDRESS should be able to uncook it as well:

  (define (cook-email-address addr . opts)
    (let-optionals opts ((new-at " at ")
                         (new-dot " ")
                         (orig-at "@")
                         (orig-dot "."))
      (regexp-substitute/global
       #f (rx (: ,orig-at (submatch (* any)))) addr
       'pre new-at
       (lambda (m)
         (regexp-substitute/global
          #f (rx ,orig-dot) (match:substring m 1)
          'pre new-dot 'post)))))

More address disfiguration:

  ;; string -> string
  ;; Return sgml-equivalent string with numeric references instead of
  ;; (ascii) chars.  (Numbers according to Iso 10646 or so, no particular
  ;; encoding.  The first 255 code points correspond to Latin-1.  With
  ;; Ascii, we are going safe & easy.  Even a web browser mistakenly
  ;; interpreting the numbers wrt the char encoding of the document
  ;; cannot get it wrong -- if the encoding extends Ascii.)
  ;; Uses srfi-14 and ascii.
  ;; E.g. "a@b.c" --> "&#97;&#64;&#98;&#46;&#99;"
  (define (vercripple-string s)
    (let ((op (make-string-output-port))
          (len (string-length s))
          (ascii char-set:ascii))
      (do ((i 0 (+ i 1)))
          ((= i len)
           (string-output-port-output op))
        (if (char-set-contains? ascii (string-ref s i))
            (format op "&#~a;" (char->ascii (string-ref s i)))
            (display (string-ref s i) op)))))

  ;; Yet more crippling: use VERCRIPPLE-STRING, put each character
  ;; into its own TT element (maybe this should be extended to work
  ;; with any element), surround the (at) and (dot)s (after being crippled
  ;; with VERCRIPPLE-STRING and surrounded by TT elements) with
  ;; I elements:
  (define (ttify s)
    (regexp-substitute/global
     #f  (rx (: #\& #\# (submatch (* numeric)) #\;)) s
     'pre "<tt>&#" 1 ";</tt>" 'post))

  (define ttified-at
    (ttify (vercripple-string " (at) ")))

  (define ttified-dot
    (ttify (vercripple-string " (dot) ")))

  (define italicized-at
    (string-append "<tt>&#32;</tt><i>"
                   (ttify (vercripple-string "(at)"))
                   "</i><tt>&#32;</tt>"))

  (define italicized-at
    (string-append "<tt>&#32;</tt><i>"
                   (ttify (vercripple-string "(dot)"))
                   "</i><tt>&#32;</tt>"))

  (define (cripple-address addr)
    (cook-email-address
     (ttify
      (vercripple-string
       (cook-email-address addr " (at) " " (dot) ")))
     italicized-at italicized-dot ttified-at ttified-dot))

CookEmailAddress - raw wiki source | code snippets archive