;;; -*- scheme -*-

;;; @@PLEAC@@_NAME
Guile

;;; @@PLEAC@@_WEB
http://www.gnu.org/software/guile/


;;; @@PLEAC@@_1.0

(define string "\\n")                    ; two characters, \ and an n
(define string "\n")                     ; a "newline" character
(define string "Jon \"Maddog\" Orwant")  ; literal double quotes
(define string "Jon 'Maddog' Orwant")    ; literal single quotes

(define a = "
This is a multiline here document
terminated by a closing double quote
")

;;; @@PLEAC@@_1.1

;; Use substring

(substring str start end)
(substring str start)

;; You can fill portions of a string with another string

(substring-move-right! str start end newstring newstart)
(substring-move-left! str start end newstring newstart)

;; Guile has a separate character type, and you can treat strings as a
;; character array.

(string-ref str pos)
(string-set! str pos char)
(string-fill! str char)
(substring-fill! str start end char)

(define s "This is what you have")
(define first (substring s 0 1))                     ; "T"
(define start (substring s 5 7))                     ; "is"
(define rest  (substring s 13))                      ; "you have"
(define last  (substring s (1- (string-length s))))  ; "e"
(define end   (substring s (- (string-length s) 4))) ; "have"
(define piece (let ((len (string-length s)))
                (substring s (- len 8) (- len 5))))  ; "you"


;;; Or use the string library SRFI-13

(use-modules (srfi srfi-13))

(define s "This is what you have")
(define first (string-take s 1))                     ; "T"
(define start (xsubstring s 5 7))                    ; "is"
(define rest  (xsubstring s 13 -1))                  ; "you have"
(define last  (string-take-right s 1))               ; "e"
(define end   (string-take-right s 4))               ; "have"
(define piece (xsubstring s -8 -5))                  ; "you"

;; Mutation of different sized strings is not allowed.  You have to
;; use set! to change the variable.

(set! s (string-replace s "wasn't" 5 7))
;; This wasn't what you have
(set! s (string-replace s "ondrous" 13 25))
;; This wasn't wondrous
(set! s (string-take-right s (1- (string-length s))))
;; his wasn't wondrous
(set! s (string-take s 9))

;;; @@PLEAC@@_1.2

(define a (or b c))
(define a (if (defined? b) b c))
(define a (or (and (defined? b) b) c))

;;; @@PLEAC@@_1.3

;; This doesn't really make sense in Scheme... temporary variables are
;; a natural construct and cheap.  If you want to swap variables in a
;; block without introducing any new variable names, you can use let:

(let ((a b) (b a))
  ;; ...
  )

(let ((alpha beta) (beta production) (production alpha))
  ;; ...
  )

;;; @@PLEAC@@_1.4

(define num (char->integer char))
(define char (integer->char num))

;;; @@PLEAC@@_1.5

;; Convert the string to a list of characters and use map

(map proc
     (string->list str))

(let ((str "an apple a day")
      (d '()))
  (map (lambda (char)
         (set! d (assq-set! d char #t)))
       (string->list str))
  (display "unique chars are:")
  (for-each (lambda (char) (display " ") (display char))
            (sort (map car d) char<?))
  (newline))

;;; Or use string-map/string-for-each from SRFI-13

(use-modules (srfi srfi-1) (srfi srfi-13))

(let ((str "an apple a day")
      (chars '()))
  (string-for-each str
   (lambda (c)
     (set! chars (lset-adjoin eq? chars c))))
  (display (string-append "unique chars are: "
                          (apply string (sort chars char<?)) "\n")))

(let ((str "an apple a day")
      (sum 0))
  (string-for-each str (lambda (c) (set! sum (+ sum (char->integer c)))))
  (display "sum is ") (display sum) (newline))
      

;;; @@PLEAC@@_1.6

(define revbytes (list->string (reverse (string->list str))))

;;; Or from SRFI-13

(define revbytes (string-reverse str))
(string-reverse! str) ; modifies in place

(let ((p (open-input-file "/usr/share/dict/words")))
  (while (not (eof-object? (peek-char p)))
         (let ((word (read-line p)))
           (if (and (> (string-length word) 5)
                    (string=? word (string-reverse word)))
               (write-line word))))
  (close p))

;; A little too verbose on the command line
;; guile --use-srfi=13 -c '(while (not (eof-object? (peek-char))) (let ((word (read-line))) (if (and (> (string-length word) 5) (string=? word (string-reverse word))) (write-line word))))' </usr/share/dict/words

;;; @@PLEAC@@_1.7

;; Use regexp-substitute/global

(regexp-substitute/global
 #f "([^\t]*)(\t+)" str
 (lambda (m)
   (let* ((pre-string (match:substring m 1))
          (pre-len (string-length pre-string))
          (match-len (- (match:end m 2) (match:start m 2))))
     (string-append
      pre-string
      (make-string
       (- (* match-len 8)
          (modulo pre-len 8))
       #\space))))
 'post)

;;; @@PLEAC@@_1.8

(regexp-substitute/global
 #f "\\$(\\w+)" str
 'pre
 (lambda (m)
   (eval (string->symbol (match:substring m 1)) (current-module)))
 'post)

;;; @@PLEAC@@_1.9

(use-modules (srfi srfi-13))

(string-upcase "bo beep")     ; BO PEEP
(string-downcase "JOHN")      ; john
(string-titlecase "bo")       ; Bo
(string-titlecase "JOHN")     ; John

(string-titlecase "thIS is a loNG liNE")  ; This Is A Long Line

;;; @@PLEAC@@_1.10

(use-modules (ice-9 format))

(format #f "I have ~D guanacos." n)

;;; @@PLEAC@@_1.11

(define var "
        your text
        goes here")

(set! var (regexp-substitute/global #f "\n +" var 'pre "\n" 'post))

;;; @@PLEAC@@_1.12

(use-modules (srfi srfi-13))

(define text "Folding and splicing is the work of an editor,
not a mere collection of silicon
and
mobile electrons!")

(define (wrap str max-col)
  (let* ((words (string-tokenize str))
         (all '())
         (first (car words))
         (col (string-length first))
         (line (list first)))
    (for-each
     (lambda (x)
       (let* ((len (string-length x))
              (new-col (+ col len 1)))
         (cond ((> new-col max-col)
                (set! all (cons (string-join (reverse! line) " ") all))
                (set! line (list x))
                (set! col len))
               (else
                (set! line (cons x line))
                (set! col new-col)))))
     (cdr words))
    (set! all (cons (string-join (reverse! line) " ") all))
    (string-join (reverse! all) "\n")))

(display (wrap text 20))

;;; @@PLEAC@@_1.13

(define str "Mom said, \"Don't do that.\"")
(set! str (regexp-substitute/global #f "(['\"])" var 'pre "\\"
                                    (lambda (x) (match:substring x 1))
                                    'post))
(set! str (regexp-substitute/global #f "([^A-Z])" var 'pre "\\"
                                    (lambda (x) (match:substring x 1))
                                    'post))
(set! str (string-append "this "
                         (regexp-substitute/global
                          #f "(\W)" "is a test!" 'pre "\\"
                          (lambda (x) (match:substring x 1))
                          'post)))

;;; @@PLEAC@@_1.14

(use-modules (srfi srfi-13))

(define str "  space  ")
(string-trim str)          ; "space  "
(string-trim-right str)    ; "  space"
(string-trim-both str)     ; "space"


;;; @@PLEAC@@_1.15

(use-modules (srfi srfi-2) (srfi srfi-13) (ice-9 format))

(define parse-csv
  (let* ((csv-match (string-join '("\"([^\"\\\\]*(\\\\.[^\"\\\\]*)*)\",?"
                                   "([^,]+),?"
                                   ",")
                                 "|"))
         (csv-rx (make-regexp csv-match)))
    (lambda (text)
      (let ((start 0)
            (result '()))
        (let loop ((start 0))
          (and-let* ((m (regexp-exec csv-rx text start)))
            (set! result (cons (or (match:substring m 1)
                                   (match:substring m 3))
                               result))
            (loop (match:end m))))
        (reverse result)))))

(define line "XYZZY,\"\",\"O'Reilly, Inc\",\"Wall, Larry\",\"a \\\"glug\\\" bit,\",5,\"Error, Core Dumped\"")

(do ((i 0 (1+ i))
     (fields (parse-csv line) (cdr fields)))
    ((null? fields))
  (format (current-output-port) "~D : ~A\n" i (car fields)))

;;; @@PLEAC@@_1.17

#!/usr/local/bin/guile -s
!#

(use-modules (srfi srfi-13)
             (srfi srfi-14)
             (ice-9 rw)
             (ice-9 regex))

(define data "analysed        => analyzed
built-in        => builtin
chastized       => chastised
commandline     => command-line
de-allocate     => deallocate
dropin          => drop-in
hardcode        => hard-code
meta-data       => metadata
multicharacter  => multi-character
multiway        => multi-way
non-empty       => nonempty
non-profit      => nonprofit
non-trappable   => nontrappable
pre-define      => predefine
preextend       => pre-extend
re-compiling    => recompiling
reenter         => re-enter
turnkey         => turn-key")

(define input (if (null? (cdr (command-line)))
                (current-input-port)
                (open-input-file (cadr (command-line)))))

(let* ((newline-char-set (string->char-set "\n"))
       (assoc-char-set (string->char-set " =>"))
       (dict (map
              (lambda (line)
                (string-tokenize line assoc-char-set))
              (string-tokenize data newline-char-set)))
       (dict-match (string-join (map car dict) "|")))
  (let loop ((line (read-line input)))
    (cond ((not (eof-object? line))
           (regexp-substitute/global
            (current-output-port) dict-match line
            'pre
            (lambda (x)
              (cadr (assoc (match:substring x 0) dict)))
            'post)
           (loop (read-line input 'concat))))))

(close-port input)