File
common.scm
— part of check-in
[42b834da20]
at
2011-08-02 17:56:08
on branch trunk
— Partial implemenation of rolling up item results
(user:
mrwellan
size: 4329)
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 31 2c right 2006-2011,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 ==========..(use
01e0: 20 73 71 6c 69 74 65 33 20 73 72 66 69 2d 31 20 sqlite3 srfi-1
01f0: 70 6f 73 69 78 20 72 65 67 65 78 2d 63 61 73 65 posix regex-case
0200: 20 62 61 73 65 36 34 20 66 6f 72 6d 61 74 20 64 base64 format d
0210: 6f 74 2d 6c 6f 63 6b 69 6e 67 29 0a 28 72 65 71 ot-locking).(req
0220: 75 69 72 65 2d 65 78 74 65 6e 73 69 6f 6e 20 73 uire-extension s
0230: 71 6c 69 74 65 33 20 72 65 67 65 78 20 70 6f 73 qlite3 regex pos
0240: 69 78 29 0a 0a 28 69 6d 70 6f 72 74 20 28 70 72 ix)..(import (pr
0250: 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 6c efix sqlite3 sql
0260: 69 74 65 33 3a 29 29 0a 28 69 6d 70 6f 72 74 20 ite3:)).(import
0270: 28 70 72 65 66 69 78 20 62 61 73 65 36 34 20 62 (prefix base64 b
0280: 61 73 65 36 34 3a 29 29 0a 0a 3b 3b 20 28 72 65 ase64:))..;; (re
0290: 71 75 69 72 65 2d 6c 69 62 72 61 72 79 20 6d 61 quire-library ma
02a0: 72 67 73 29 0a 28 69 6e 63 6c 75 64 65 20 22 6d rgs).(include "m
02b0: 61 72 67 73 2e 73 63 6d 22 29 0a 0a 28 64 65 66 args.scm")..(def
02c0: 69 6e 65 20 67 65 74 65 6e 76 20 67 65 74 2d 65 ine getenv get-e
02d0: 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
02e0: 62 6c 65 29 0a 0a 28 64 65 66 69 6e 65 20 68 6f ble)..(define ho
02f0: 6d 65 20 28 67 65 74 65 6e 76 20 22 48 4f 4d 45 me (getenv "HOME
0300: 22 29 29 0a 28 64 65 66 69 6e 65 20 75 73 65 72 ")).(define user
0310: 20 28 67 65 74 65 6e 76 20 22 55 53 45 52 22 29 (getenv "USER")
0320: 29 0a 0a 3b 3b 20 67 6c 6f 62 61 6c 20 67 6c 65 )..;; global gle
0330: 74 63 68 65 73 0a 28 64 65 66 69 6e 65 20 2a 63 tches.(define *c
0340: 6f 6e 66 69 67 69 6e 66 6f 2a 20 23 66 29 0a 28 onfiginfo* #f).(
0350: 64 65 66 69 6e 65 20 2a 63 6f 6e 66 69 67 64 61 define *configda
0360: 74 2a 20 20 23 66 29 0a 28 64 65 66 69 6e 65 20 t* #f).(define
0370: 2a 74 6f 70 70 61 74 68 2a 20 20 20 20 23 66 29 *toppath* #f)
0380: 0a 28 64 65 66 69 6e 65 20 2a 61 6c 72 65 61 64 .(define *alread
0390: 79 2d 73 65 65 6e 2d 72 75 6e 63 6f 6e 66 69 67 y-seen-runconfig
03a0: 2d 69 6e 66 6f 2a 20 23 66 29 0a 28 64 65 66 69 -info* #f).(defi
03b0: 6e 65 20 2a 77 61 69 74 69 6e 67 2d 71 75 65 75 ne *waiting-queu
03c0: 65 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 e* (make-hash-ta
03d0: 62 6c 65 29 29 0a 28 64 65 66 69 6e 65 20 2a 67 ble)).(define *g
03e0: 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a lobalexitstatus*
03f0: 20 30 29 20 3b 3b 20 61 74 74 65 6d 70 74 20 74 0) ;; attempt t
0400: 6f 20 77 6f 72 6b 20 61 72 6f 75 6e 64 20 70 6f o work around po
0410: 73 73 69 62 6c 65 20 74 68 72 65 61 64 20 69 73 ssible thread is
0420: 73 75 65 73 0a 28 64 65 66 69 6e 65 20 2a 70 61 sues.(define *pa
0430: 73 73 6e 75 6d 2a 20 20 20 20 20 30 29 20 3b 3b ssnum* 0) ;;
0440: 20 77 68 65 6e 20 72 75 6e 6e 69 6e 67 20 74 72 when running tr
0450: 61 63 6b 20 63 61 6c 6c 73 20 74 6f 20 72 75 6e ack calls to run
0460: 2d 74 65 73 74 73 20 6f 72 20 73 69 6d 69 6c 61 -tests or simila
0470: 72 0a 28 64 65 66 69 6e 65 20 2a 76 65 72 62 6f r.(define *verbo
0480: 73 69 74 79 2a 20 20 20 31 29 0a 0a 28 64 65 66 sity* 1)..(def
0490: 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 67 65 74 2d ine-inline (get-
04a0: 77 69 74 68 2d 64 65 66 61 75 6c 74 20 76 61 6c with-default val
04b0: 20 64 65 66 61 75 6c 74 29 0a 20 20 28 6c 65 74 default). (let
04c0: 20 28 28 76 61 6c 20 28 61 72 67 73 3a 67 65 74 ((val (args:get
04d0: 2d 61 72 67 20 76 61 6c 29 29 29 0a 20 20 20 20 -arg val))).
04e0: 28 69 66 20 76 61 6c 20 76 61 6c 20 64 65 66 61 (if val val defa
04f0: 75 6c 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 2d ult)))..(define-
0500: 69 6e 6c 69 6e 65 20 28 61 73 73 6f 63 2f 64 65 inline (assoc/de
0510: 66 61 75 6c 74 20 6b 65 79 20 6c 73 74 20 2e 20 fault key lst .
0520: 64 65 66 61 75 6c 74 29 0a 20 20 28 6c 65 74 20 default). (let
0530: 28 28 72 65 73 20 28 61 73 73 6f 63 20 6b 65 79 ((res (assoc key
0540: 20 6c 73 74 29 29 29 0a 20 20 20 20 28 69 66 20 lst))). (if
0550: 72 65 73 20 28 63 61 64 72 20 72 65 73 29 28 69 res (cadr res)(i
0560: 66 20 28 6e 75 6c 6c 3f 20 64 65 66 61 75 6c 74 f (null? default
0570: 29 20 23 66 20 28 63 61 72 20 64 65 66 61 75 6c ) #f (car defaul
0580: 74 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d t)))))..;;======
0590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05d0: 0a 3b 3b 20 4d 69 73 63 20 75 74 69 6c 73 0a 3b .;; Misc utils.;
05e0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
05f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0620: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 =======..(define
0630: 2d 69 6e 6c 69 6e 65 20 28 64 65 62 75 67 3a 70 -inline (debug:p
0640: 72 69 6e 74 20 6e 20 2e 20 70 61 72 61 6d 73 29 rint n . params)
0650: 0a 20 20 28 69 66 20 28 3c 3d 20 6e 20 2a 76 65 . (if (<= n *ve
0660: 72 62 6f 73 69 74 79 2a 29 0a 20 20 20 20 20 20 rbosity*).
0670: 28 61 70 70 6c 79 20 70 72 69 6e 74 20 70 61 72 (apply print par
0680: 61 6d 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ams)))..(define
0690: 28 67 65 74 2d 64 66 20 70 61 74 68 29 0a 20 20 (get-df path).
06a0: 28 6c 65 74 2a 20 28 28 64 66 2d 72 65 73 75 6c (let* ((df-resul
06b0: 74 73 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 ts (cmd-run->lis
06c0: 74 20 28 63 6f 6e 63 20 22 64 66 20 22 20 70 61 t (conc "df " pa
06d0: 74 68 29 29 29 0a 09 20 28 73 70 61 63 65 2d 72 th))).. (space-r
06e0: 78 20 20 20 28 72 65 67 65 78 70 20 22 28 5b 30 x (regexp "([0
06f0: 2d 39 5d 2b 29 5c 5c 73 2b 28 5b 30 2d 39 5d 2b -9]+)\\s+([0-9]+
0700: 29 25 22 29 29 0a 09 20 28 66 72 65 65 73 70 63 )%")).. (freespc
0710: 20 20 20 20 23 66 29 29 0a 20 20 20 20 3b 3b 20 #f)). ;;
0720: 28 77 72 69 74 65 20 64 66 2d 72 65 73 75 6c 74 (write df-result
0730: 73 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 s). (for-each
0740: 20 28 6c 61 6d 62 64 61 20 28 6c 29 0a 09 09 28 (lambda (l)...(
0750: 6c 65 74 20 28 28 6d 61 74 63 68 20 28 73 74 72 let ((match (str
0760: 69 6e 67 2d 73 65 61 72 63 68 20 73 70 61 63 65 ing-search space
0770: 2d 72 78 20 6c 29 29 29 0a 09 09 20 20 28 69 66 -rx l)))... (if
0780: 20 6d 61 74 63 68 20 0a 09 09 20 20 20 20 20 20 match ...
0790: 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 28 73 (let ((newval (s
07a0: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 tring->number (c
07b0: 61 64 72 20 6d 61 74 63 68 29 29 29 29 0a 09 09 adr match))))...
07c0: 09 28 69 66 20 28 6e 75 6d 62 65 72 3f 20 6e 65 .(if (number? ne
07d0: 77 76 61 6c 29 0a 09 09 09 20 20 20 20 28 73 65 wval).... (se
07e0: 74 21 20 66 72 65 65 73 70 63 20 6e 65 77 76 61 t! freespc newva
07f0: 6c 29 29 29 29 29 29 0a 09 20 20 20 20 20 20 28 l)))))).. (
0800: 63 61 72 20 64 66 2d 72 65 73 75 6c 74 73 29 29 car df-results))
0810: 0a 20 20 20 20 66 72 65 65 73 70 63 29 29 0a 20 . freespc)).
0820: 20 0a 28 64 65 66 69 6e 65 20 28 67 65 74 2d 63 .(define (get-c
0830: 70 75 2d 6c 6f 61 64 29 0a 20 20 28 6c 65 74 2a pu-load). (let*
0840: 20 28 28 6c 6f 61 64 2d 72 65 73 20 28 63 6d 64 ((load-res (cmd
0850: 2d 72 75 6e 2d 3e 6c 69 73 74 20 22 75 70 74 69 -run->list "upti
0860: 6d 65 22 29 29 0a 09 20 28 6c 6f 61 64 2d 72 78 me")).. (load-rx
0870: 20 20 28 72 65 67 65 78 70 20 22 6c 6f 61 64 20 (regexp "load
0880: 61 76 65 72 61 67 65 3a 5c 5c 73 2b 28 5c 5c 64 average:\\s+(\\d
0890: 2b 29 22 29 29 0a 09 20 28 63 70 75 2d 6c 6f 61 +)")).. (cpu-loa
08a0: 64 20 23 66 29 29 0a 20 20 20 20 28 66 6f 72 2d d #f)). (for-
08b0: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6c 29 each (lambda (l)
08c0: 0a 09 09 28 6c 65 74 20 28 28 6d 61 74 63 68 20 ...(let ((match
08d0: 28 73 74 72 69 6e 67 2d 73 65 61 72 63 68 20 6c (string-search l
08e0: 6f 61 64 2d 72 78 20 6c 29 29 29 0a 09 09 20 20 oad-rx l)))...
08f0: 28 69 66 20 6d 61 74 63 68 0a 09 09 20 20 20 20 (if match...
0900: 20 20 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 (let ((newval
0910: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
0920: 28 63 61 64 72 20 6d 61 74 63 68 29 29 29 29 0a (cadr match)))).
0930: 09 09 09 28 69 66 20 28 6e 75 6d 62 65 72 3f 20 ...(if (number?
0940: 6e 65 77 76 61 6c 29 0a 09 09 09 20 20 20 20 28 newval).... (
0950: 73 65 74 21 20 63 70 75 2d 6c 6f 61 64 20 6e 65 set! cpu-load ne
0960: 77 76 61 6c 29 29 29 29 29 29 0a 09 20 20 20 20 wval))))))..
0970: 20 20 28 63 61 72 20 6c 6f 61 64 2d 72 65 73 29 (car load-res)
0980: 29 0a 20 20 20 20 63 70 75 2d 6c 6f 61 64 29 29 ). cpu-load))
0990: 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 74 2d 75 ..(define (get-u
09a0: 6e 61 6d 65 20 2e 20 70 61 72 61 6d 73 29 0a 20 name . params).
09b0: 20 28 6c 65 74 2a 20 28 28 75 6e 61 6d 65 2d 72 (let* ((uname-r
09c0: 65 73 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 es (cmd-run->lis
09d0: 74 20 28 63 6f 6e 63 20 22 75 6e 61 6d 65 20 22 t (conc "uname "
09e0: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 70 61 72 61 (if (null? para
09f0: 6d 73 29 20 22 2d 61 22 20 28 63 61 72 20 70 61 ms) "-a" (car pa
0a00: 72 61 6d 73 29 29 29 29 29 0a 09 20 28 75 6e 61 rams))))).. (una
0a10: 6d 65 20 23 66 29 29 0a 20 20 20 20 28 69 66 20 me #f)). (if
0a20: 28 6e 75 6c 6c 3f 20 28 63 61 72 20 75 6e 61 6d (null? (car unam
0a30: 65 2d 72 65 73 29 29 0a 09 22 75 6e 6b 6e 6f 77 e-res)).."unknow
0a40: 6e 22 0a 09 28 63 61 61 72 20 75 6e 61 6d 65 2d n"..(caar uname-
0a50: 72 65 73 29 29 29 29 0a 09 20 20 20 20 20 20 0a res)))).. .
0a60: 28 64 65 66 69 6e 65 20 28 73 61 76 65 2d 65 6e (define (save-en
0a70: 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c vironment-as-fil
0a80: 65 73 20 66 6e 61 6d 65 29 0a 20 20 28 6c 65 74 es fname). (let
0a90: 20 28 28 65 6e 76 76 61 72 73 20 28 67 65 74 2d ((envvars (get-
0aa0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
0ab0: 61 62 6c 65 73 29 29 0a 20 20 20 20 20 20 20 20 ables)).
0ac0: 28 77 68 69 74 65 73 70 20 28 72 65 67 65 78 70 (whitesp (regexp
0ad0: 20 22 5b 5e 61 2d 7a 41 2d 5a 30 2d 39 5f 5c 5c "[^a-zA-Z0-9_\\
0ae0: 2d 3a 3b 2c 2e 5c 5c 2f 25 5d 22 29 29 29 0a 20 -:;,.\\/%]"))).
0af0: 20 20 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 (with-output
0b00: 2d 74 6f 2d 66 69 6c 65 20 28 63 6f 6e 63 20 66 -to-file (conc f
0b10: 6e 61 6d 65 20 22 2e 63 73 68 22 29 0a 20 20 20 name ".csh").
0b20: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 (lambda ().
0b30: 20 20 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 (for-ea
0b40: 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 ch (lambda (key)
0b50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0b60: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 76 (let* ((v
0b70: 61 6c 20 28 63 64 72 20 6b 65 79 29 29 0a 20 20 al (cdr key)).
0b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b90: 20 20 20 20 20 20 20 20 20 20 20 28 73 76 61 6c (sval
0ba0: 20 28 69 66 20 28 73 74 72 69 6e 67 2d 73 65 61 (if (string-sea
0bb0: 72 63 68 20 77 68 69 74 65 73 70 20 76 61 6c 29 rch whitesp val)
0bc0: 28 63 6f 6e 63 20 22 27 22 20 76 61 6c 20 22 27 (conc "'" val "'
0bd0: 22 29 20 76 61 6c 29 29 29 0a 20 20 20 20 20 20 ") val))).
0be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0bf0: 20 20 28 70 72 69 6e 74 20 22 73 65 74 65 6e 76 (print "setenv
0c00: 20 22 20 28 63 61 72 20 6b 65 79 29 20 22 20 22 " (car key) " "
0c10: 20 73 76 61 6c 29 29 29 0a 20 20 20 20 20 20 20 sval))).
0c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 65 6e en
0c30: 76 76 61 72 73 29 29 29 0a 20 20 20 20 20 28 77 vvars))). (w
0c40: 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 ith-output-to-fi
0c50: 6c 65 20 28 63 6f 6e 63 20 66 6e 61 6d 65 20 22 le (conc fname "
0c60: 2e 73 68 22 29 0a 20 20 20 20 20 20 20 28 6c 61 .sh"). (la
0c70: 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 mbda ().
0c80: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
0c90: 62 64 61 20 28 6b 65 79 29 0a 20 20 20 20 20 20 bda (key).
0ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0cb0: 28 6c 65 74 2a 20 28 28 76 61 6c 20 28 63 64 72 (let* ((val (cdr
0cc0: 20 6b 65 79 29 29 0a 20 20 20 20 20 20 20 20 20 key)).
0cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ce0: 20 20 20 20 28 73 76 61 6c 20 28 69 66 20 28 73 (sval (if (s
0cf0: 74 72 69 6e 67 2d 73 65 61 72 63 68 20 77 68 69 tring-search whi
0d00: 74 65 73 70 20 76 61 6c 29 28 63 6f 6e 63 20 22 tesp val)(conc "
0d10: 27 22 20 76 61 6c 20 22 27 22 29 20 76 61 6c 29 '" val "'") val)
0d20: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
0d30: 20 20 20 20 20 20 20 20 20 20 20 20 28 70 72 69 (pri
0d40: 6e 74 20 22 65 78 70 6f 72 74 20 22 20 28 63 61 nt "export " (ca
0d50: 72 20 6b 65 79 29 20 22 3d 22 20 73 76 61 6c 29 r key) "=" sval)
0d60: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
0d70: 20 20 20 20 20 20 20 65 6e 76 76 61 72 73 29 29 envvars))
0d80: 29 29 29 0a 0a 3b 3b 20 73 65 74 20 73 6f 6d 65 )))..;; set some
0d90: 20 65 6e 76 20 76 61 72 73 20 66 72 6f 6d 20 61 env vars from a
0da0: 6e 20 61 6c 69 73 74 2c 20 72 65 74 75 72 6e 20 n alist, return
0db0: 61 6e 20 61 6c 69 73 74 20 77 69 74 68 20 6f 72 an alist with or
0dc0: 69 67 69 6e 61 6c 20 76 61 6c 75 65 73 0a 3b 3b iginal values.;;
0dd0: 20 28 28 22 56 41 52 22 20 22 76 61 6c 75 65 22 (("VAR" "value"
0de0: 29 20 2e 2e 2e 29 0a 28 64 65 66 69 6e 65 20 28 ) ...).(define (
0df0: 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 alist->env-vars
0e00: 6c 73 74 29 0a 20 20 28 69 66 20 28 6c 69 73 74 lst). (if (list
0e10: 3f 20 6c 73 74 29 0a 20 20 20 20 20 20 28 6c 65 ? lst). (le
0e20: 74 20 28 28 72 65 73 20 27 28 29 29 29 0a 09 28 t ((res '()))..(
0e30: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
0e40: 20 28 70 29 0a 09 09 20 20 20 20 28 6c 65 74 2a (p)... (let*
0e50: 20 28 28 76 61 72 20 28 63 61 72 20 20 70 29 29 ((var (car p))
0e60: 0a 09 09 09 20 20 20 28 76 61 6c 20 28 63 61 64 .... (val (cad
0e70: 72 20 70 29 29 0a 09 09 09 20 20 20 28 70 72 76 r p)).... (prv
0e80: 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e (get-environmen
0e90: 74 2d 76 61 72 69 61 62 6c 65 20 76 61 72 29 29 t-variable var))
0ea0: 29 0a 09 09 20 20 20 20 20 20 28 73 65 74 21 20 )... (set!
0eb0: 72 65 73 20 28 63 6f 6e 73 20 28 6c 69 73 74 20 res (cons (list
0ec0: 76 61 72 20 70 72 76 29 20 72 65 73 29 29 0a 09 var prv) res))..
0ed0: 09 20 20 20 20 20 20 28 69 66 20 76 61 6c 20 0a . (if val .
0ee0: 09 09 09 20 20 28 73 65 74 65 6e 76 20 76 61 72 ... (setenv var
0ef0: 20 28 2d 3e 73 74 72 69 6e 67 20 76 61 6c 29 29 (->string val))
0f00: 0a 09 09 09 20 20 28 75 6e 73 65 74 65 6e 76 20 .... (unsetenv
0f10: 76 61 72 29 29 29 29 0a 09 09 20 20 6c 73 74 29 var))))... lst)
0f20: 0a 09 72 65 73 29 0a 20 20 20 20 20 20 27 28 29 ..res). '()
0f30: 29 29 0a 09 09 20 20 0a 3b 3b 3d 3d 3d 3d 3d 3d ))... .;;======
0f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f80: 0a 3b 3b 20 74 69 6d 65 20 61 6e 64 20 64 61 74 .;; time and dat
0f90: 65 20 6e 69 63 65 20 74 6f 20 68 61 76 65 20 73 e nice to have s
0fa0: 74 75 66 66 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d tuff.;;=========
0fb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0fc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
0ff0: 64 65 66 69 6e 65 20 28 73 65 63 6f 6e 64 73 2d define (seconds-
1000: 3e 68 72 2d 6d 69 6e 2d 73 65 63 20 73 65 63 73 >hr-min-sec secs
1010: 29 0a 20 20 28 6c 65 74 2a 20 28 28 68 72 73 20 ). (let* ((hrs
1020: 28 71 75 6f 74 69 65 6e 74 20 73 65 63 73 20 33 (quotient secs 3
1030: 36 30 30 29 29 0a 09 20 28 6d 69 6e 20 28 71 75 600)).. (min (qu
1040: 6f 74 69 65 6e 74 20 28 2d 20 73 65 63 73 20 28 otient (- secs (
1050: 2a 20 68 72 73 20 33 36 30 30 29 29 20 36 30 29 * hrs 3600)) 60)
1060: 29 0a 09 20 28 73 65 63 20 28 2d 20 73 65 63 73 ).. (sec (- secs
1070: 20 28 2a 20 68 72 73 20 33 36 30 30 29 28 2a 20 (* hrs 3600)(*
1080: 6d 69 6e 20 36 30 29 29 29 29 0a 20 20 20 20 28 min 60)))). (
1090: 63 6f 6e 63 20 28 69 66 20 28 3e 20 68 72 73 20 conc (if (> hrs
10a0: 30 29 28 63 6f 6e 63 20 68 72 73 20 22 68 72 20 0)(conc hrs "hr
10b0: 22 29 20 22 22 29 0a 09 20 20 28 69 66 20 28 3e ") "").. (if (>
10c0: 20 6d 69 6e 20 30 29 28 63 6f 6e 63 20 6d 69 6e min 0)(conc min
10d0: 20 22 6d 20 22 29 20 20 22 22 29 0a 09 20 20 73 "m ") "").. s
10e0: 65 63 20 22 73 22 29 29 29 ec "s")))