scheme shell
about
download
support
resources
docu
links
 
scsh.net

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" --> "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 "<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