; 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" --> "a@b.c" (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 "&#" 1 ";" 'post)) (define ttified-at (ttify (vercripple-string " (at) "))) (define ttified-dot (ttify (vercripple-string " (dot) "))) (define italicized-at (string-append " " (ttify (vercripple-string "(at)")) " ")) (define italicized-at (string-append " " (ttify (vercripple-string "(dot)")) " ")) (define (cripple-address addr) (cook-email-address (ttify (vercripple-string (cook-email-address addr " (at) " " (dot) "))) italicized-at italicized-dot ttified-at ttified-dot))