Re: Some thoughts about documentation

[Ariel Rios]

On 12 Apr 2001 15:59:50 +0200, Martin Grabmueller wrote:

> Examples are a good way for preventing the manual to be too dry.  Just
> post your examples and we'll see if they fit in.  Personally, I would
> really like to include them.
They are general purposes almost useless hacks to demonstrate how to use
things. I have more in another computer that's out of my reach at this
moment...

ariel

;; POSIX File System

;; Print the stat of a given file
;;(stat-print file)

(define (stat-print file)
  (if (access? file R_OK)
      (let ((s (stat file)))
        (display "Device: ") (display (stat:dev s)) (newline) 
        (display "Serial Number: ") (display (stat:ino s)) (newline)
        (display "Hard Links: ") (display (stat:nlink s)) (newline)
        (display "UID: ") (display (stat:uid s)) (newline)
        (display "GID: ") (display (stat:uid s)) (newline)
        (display "Size: ") (display (stat:size s)) (newline)
        (display "Type: ") (display (stat:type s)) (newline)
        (display "Permissions: ") (display (stat:perms s)) (newline))
      (display "File not found\n"))) 

;; Lists the contents of a directory
;; (get-dir-files arg)

(define (get-dir-files arg)
  (call-with-current-continuation
   (lambda (break)
     (if (not (access? arg R_OK))
         (break '()))
   (let ((dir (opendir arg)))
     (letrec ((director
               (lambda (ls)
                 (let ((obj (readdir dir)))
                   (cond
                    ((eof-object? obj) (closedir dir) ls)
                    (else (director (cons obj ls))))))))
       (director '()))))))

;; Delete files from a directory
;; Yes we can do directly delete-file
;; but we do not know if any of the files
;; exist.

;; A first version using the previous function:

(define (delete-files-from-dir dir files)
  ((lambda (d)
     (for-each (lambda (f) (if (member d f) (delete-file d))) files))
   (get-dir-files dir)))

;; A more clean version:
;; (delete-files '(file1 file2 file3))

(define (delete-files files)
  (for-each (lambda (f) (if (access? f W_OK) (delete-file f))) files))

;; The final version that enables
;; us to do (delete-files file1 file2 file3)

(define (delete-files . files)
  (for-each (lambda (f) (if (access? f W_OK) (delete-file f))) files))


;;;;;;;;;;;Sockets;;;;;;;;;;;

;; Example of a qod client 
;; (qod-client host)

(define (qod-client host)
  (let ((sk (socket AF_INET SOCK_STREAM 0)))
    (connect sk AF_INET (car (array-ref (gethostbyname host) 4)) 6666)
    (for-each display `(,(read-line sk) "\n" ,(read-line sk) "\n"))))
;; Qod server

;; (qod-server)

(define (qod-server)
(define qotd-header "Guile QUOTE OF THE DAY")
(define qotd-quotes '("(lambda(x)(car x))"
                      "(define 1 2)"))
  (let ((lfd (socket AF_INET SOCK_STREAM 0)))
    (bind lfd AF_INET INADDR_ANY 6666)
    (listen lfd 5)
    (letrec ((func
              (lambda ()
                (let ((cfd (accept lfd)))
                  (for-each display `("Connection from: " ,(cdr cfd) "\n"))
                  (write-line qotd-header (car cfd))
                  (write-line (list-ref qotd-quotes (random (length 
qotd-quotes))) (car cfd))
                  (close (car cfd))
                  (func)))))
      (func))))

;; Matrix Implementation
;; Use of vectors examples

(define (matrix? x) (and (vector? x) (> (vector-length x) 0) (vector? 
(vector-ref x 0))))
(define (make-matrix . ls) (list->vector (map list->vector ls)))
(define (matrix-ref m i j) (vector-ref (vector-ref m i) j))
(define (matrix-add m1 m2) 
  (apply make-matrix 
   (map (lambda (a b) (map + a b)) (matrix->list m1) (matrix->list m2))))

(define (matrix-scalar m s) 
   (apply make-matrix (map (lambda (x) (map (lambda (x) (* x s)) x)) 
(matrix->list m))))