Artifact
15c6fe90f1b76955591a85e9b08be7d9c5557504:
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 33 2c right 2006-2013,
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 64 65 63 ==========..(dec
01e0: 6c 61 72 65 20 28 75 6e 69 74 20 65 6e 76 29 29 lare (unit env))
01f0: 0a 0a 28 75 73 65 20 73 71 6c 2d 64 65 2d 6c 69 ..(use sql-de-li
0200: 74 65 29 20 3b 3b 20 73 72 66 69 2d 31 20 70 6f te) ;; srfi-1 po
0210: 73 69 78 20 72 65 67 65 78 20 72 65 67 65 78 2d six regex regex-
0220: 63 61 73 65 20 73 72 66 69 2d 36 39 20 6e 61 6e case srfi-69 nan
0230: 6f 6d 73 67 20 73 72 66 69 2d 31 38 20 63 61 6c omsg srfi-18 cal
0240: 6c 2d 77 69 74 68 2d 65 6e 76 69 72 6f 6e 6d 65 l-with-environme
0250: 6e 74 2d 76 61 72 69 61 62 6c 65 73 29 0a 0a 28 nt-variables)..(
0260: 64 65 66 69 6e 65 20 28 65 6e 76 3a 6f 70 65 6e define (env:open
0270: 2d 64 62 20 66 6e 61 6d 65 29 0a 20 20 28 6c 65 -db fname). (le
0280: 74 2a 20 28 28 64 62 2d 65 78 69 73 74 73 20 28 t* ((db-exists (
0290: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 6e 61 file-exists? fna
02a0: 6d 65 29 29 0a 09 20 28 64 62 20 20 20 20 20 20 me)).. (db
02b0: 20 20 28 6f 70 65 6e 2d 64 61 74 61 62 61 73 65 (open-database
02c0: 20 66 6e 61 6d 65 29 29 29 0a 20 20 20 20 28 69 fname))). (i
02d0: 66 20 28 6e 6f 74 20 64 62 2d 65 78 69 73 74 73 f (not db-exists
02e0: 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 65 78 )..(begin.. (ex
02f0: 65 63 20 28 73 71 6c 20 64 62 20 22 43 52 45 41 ec (sql db "CREA
0300: 54 45 20 54 41 42 4c 45 20 65 6e 76 76 61 72 73 TE TABLE envvars
0310: 20 28 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 (.
0320: 20 20 20 20 20 20 20 69 64 20 49 4e 54 45 47 45 id INTEGE
0330: 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 R PRIMARY KEY,.
0340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0350: 20 20 20 63 6f 6e 74 65 78 74 20 54 45 58 54 20 context TEXT
0360: 4e 4f 54 20 4e 55 4c 4c 2c 0a 20 20 20 20 20 20 NOT NULL,.
0370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 76 61 va
0380: 72 20 54 45 58 54 20 4e 4f 54 20 4e 55 4c 4c 2c r TEXT NOT NULL,
0390: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
03a0: 20 20 20 20 20 76 61 6c 20 54 45 58 54 20 4e 4f val TEXT NO
03b0: 54 20 4e 55 4c 4c 2c 0a 20 20 20 20 20 20 20 20 T NULL,.
03c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 43 C
03d0: 4f 4e 53 54 52 41 49 4e 54 20 65 6e 76 76 61 72 ONSTRAINT envvar
03e0: 73 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 s_constraint UNI
03f0: 51 55 45 20 28 63 6f 6e 74 65 78 74 2c 76 61 72 QUE (context,var
0400: 29 29 22 29 29 29 29 0a 20 20 20 20 28 73 65 74 ))")))). (set
0410: 2d 62 75 73 79 2d 68 61 6e 64 6c 65 72 21 20 64 -busy-handler! d
0420: 62 20 28 62 75 73 79 2d 74 69 6d 65 6f 75 74 20 b (busy-timeout
0430: 31 30 30 30 30 29 29 0a 20 20 20 20 64 62 29 29 10000)). db))
0440: 0a 0a 3b 3b 20 73 61 76 65 20 76 61 72 73 20 69 ..;; save vars i
0450: 6e 20 67 69 76 65 6e 20 63 6f 6e 74 65 78 74 2c n given context,
0460: 20 74 68 69 73 20 69 73 20 4e 4f 54 20 69 6e 63 this is NOT inc
0470: 72 65 6d 65 6e 74 61 6c 20 62 79 20 64 65 66 61 remental by defa
0480: 75 6c 74 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 ult.;;.(define (
0490: 65 6e 76 3a 73 61 76 65 2d 65 6e 76 2d 76 61 72 env:save-env-var
04a0: 73 20 64 62 20 63 6f 6e 74 65 78 74 20 23 21 6b s db context #!k
04b0: 65 79 20 28 69 6e 63 72 65 6d 65 6e 74 61 6c 20 ey (incremental
04c0: 23 66 29 28 76 61 72 64 61 74 20 23 66 29 29 0a #f)(vardat #f)).
04d0: 20 20 28 77 69 74 68 2d 74 72 61 6e 73 61 63 74 (with-transact
04e0: 69 6f 6e 0a 20 20 20 64 62 0a 20 20 20 28 6c 61 ion. db. (la
04f0: 6d 62 64 61 20 28 29 0a 20 20 20 20 20 3b 3b 20 mbda (). ;;
0500: 66 69 72 73 74 20 63 6c 65 61 72 20 6f 75 74 20 first clear out
0510: 61 6e 79 20 76 61 72 73 20 66 6f 72 20 74 68 69 any vars for thi
0520: 73 20 63 6f 6e 74 65 78 74 0a 20 20 20 20 20 28 s context. (
0530: 69 66 20 28 6e 6f 74 20 69 6e 63 72 65 6d 65 6e if (not incremen
0540: 74 61 6c 29 28 65 78 65 63 20 28 73 71 6c 20 64 tal)(exec (sql d
0550: 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 65 b "DELETE FROM e
0560: 6e 76 76 61 72 73 20 57 48 45 52 45 20 63 6f 6e nvvars WHERE con
0570: 74 65 78 74 3d 3f 22 29 20 63 6f 6e 74 65 78 74 text=?") context
0580: 29 29 0a 20 20 20 20 20 28 66 6f 72 2d 65 61 63 )). (for-eac
0590: 68 0a 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 h. (lambda
05a0: 28 76 61 72 76 61 6c 29 0a 09 28 6c 65 74 20 28 (varval)..(let (
05b0: 28 76 61 72 20 28 63 61 72 20 76 61 72 76 61 6c (var (car varval
05c0: 29 29 0a 09 20 20 20 20 20 20 28 76 61 6c 20 28 )).. (val (
05d0: 63 64 72 20 76 61 72 76 61 6c 29 29 29 0a 09 20 cdr varval)))..
05e0: 20 28 69 66 20 69 6e 63 72 65 6d 65 6e 74 61 6c (if incremental
05f0: 20 28 65 78 65 63 20 28 73 71 6c 20 64 62 20 22 (exec (sql db "
0600: 44 45 4c 45 54 45 20 46 52 4f 4d 20 65 6e 76 76 DELETE FROM envv
0610: 61 72 73 20 57 48 45 52 45 20 63 6f 6e 74 65 78 ars WHERE contex
0620: 74 3d 3f 20 41 4e 44 20 76 61 72 3d 3f 22 29 20 t=? AND var=?")
0630: 63 6f 6e 74 65 78 74 20 76 61 72 29 29 0a 09 20 context var))..
0640: 20 28 65 78 65 63 20 28 73 71 6c 20 64 62 20 22 (exec (sql db "
0650: 49 4e 53 45 52 54 20 49 4e 54 4f 20 65 6e 76 76 INSERT INTO envv
0660: 61 72 73 20 28 63 6f 6e 74 65 78 74 2c 76 61 72 ars (context,var
0670: 2c 76 61 6c 29 20 56 41 4c 55 45 53 20 28 3f 2c ,val) VALUES (?,
0680: 3f 2c 3f 29 22 29 20 63 6f 6e 74 65 78 74 20 76 ?,?)") context v
0690: 61 72 20 76 61 6c 29 29 29 0a 09 28 69 66 20 76 ar val)))..(if v
06a0: 61 72 64 61 74 0a 09 20 20 20 20 28 68 61 73 68 ardat.. (hash
06b0: 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 76 61 -table->alist va
06c0: 72 64 61 74 29 0a 09 20 20 20 20 28 67 65 74 2d rdat).. (get-
06d0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
06e0: 61 62 6c 65 73 29 29 29 29 29 29 0a 0a 3b 3b 20 ables))))))..;;
06f0: 6d 65 72 67 65 20 63 6f 6e 74 65 78 74 73 20 69 merge contexts i
0700: 6e 20 74 68 65 20 6f 72 64 65 72 20 67 69 76 65 n the order give
0710: 6e 0a 3b 3b 20 20 2d 20 65 61 63 68 20 63 6f 6e n.;; - each con
0720: 74 65 78 74 20 69 73 20 61 70 70 6c 69 65 64 20 text is applied
0730: 69 6e 20 74 68 65 20 67 69 76 65 6e 20 6f 72 64 in the given ord
0740: 65 72 0a 3b 3b 20 20 2d 20 76 61 72 69 61 62 6c er.;; - variabl
0750: 65 73 20 69 6e 20 74 68 65 20 70 61 74 68 73 20 es in the paths
0760: 6c 69 73 74 20 61 72 65 20 73 70 6c 69 74 20 6f list are split o
0770: 6e 20 74 68 65 20 73 65 70 61 72 61 74 6f 72 20 n the separator
0780: 61 6e 64 20 74 68 65 20 63 6f 6d 70 6f 6e 65 6e and the componen
0790: 74 73 0a 3b 3b 20 20 20 20 6d 65 72 67 65 64 20 ts.;; merged
07a0: 75 73 69 6e 67 20 73 69 6d 70 6c 65 20 64 65 6c using simple del
07b0: 74 61 20 61 64 64 69 74 69 6f 6e 0a 3b 3b 20 20 ta addition.;;
07c0: 20 20 72 65 74 75 72 6e 73 20 61 20 68 61 73 68 returns a hash
07d0: 20 6f 66 20 74 68 65 20 6d 65 72 67 65 64 20 76 of the merged v
07e0: 61 72 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 ars.;;.(define (
07f0: 65 6e 76 3a 6d 65 72 67 65 2d 63 6f 6e 74 65 78 env:merge-contex
0800: 74 73 20 64 62 20 62 61 73 65 63 6f 6e 74 65 78 ts db basecontex
0810: 74 20 63 6f 6e 74 65 78 74 73 20 70 61 74 68 73 t contexts paths
0820: 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 75 6c ). (let ((resul
0830: 74 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 t (make-hash-tab
0840: 6c 65 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 le))). (for-e
0850: 61 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 ach. (lambda
0860: 20 28 63 6f 6e 74 65 78 74 29 0a 20 20 20 20 20 (context).
0870: 20 20 28 71 75 65 72 79 0a 09 28 66 6f 72 2d 65 (query..(for-e
0880: 61 63 68 2d 72 6f 77 0a 09 20 28 6c 61 6d 62 64 ach-row.. (lambd
0890: 61 20 28 72 6f 77 29 0a 09 20 20 20 28 6c 65 74 a (row).. (let
08a0: 20 28 28 76 61 72 20 20 28 63 61 72 20 72 6f 77 ((var (car row
08b0: 29 29 0a 09 09 20 28 76 61 6c 20 20 28 63 61 64 ))... (val (cad
08c0: 72 20 72 6f 77 29 29 29 0a 09 20 20 20 20 20 28 r row))).. (
08d0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
08e0: 72 65 73 75 6c 74 20 76 61 72 20 0a 09 09 09 20 result var ....
08f0: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 68 (if (and (h
0900: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
0910: 66 61 75 6c 74 20 72 65 73 75 6c 74 73 20 76 61 fault results va
0920: 72 20 23 66 29 0a 09 09 09 09 20 20 20 20 20 20 r #f).....
0930: 20 28 61 73 73 6f 63 20 76 61 72 20 70 61 74 68 (assoc var path
0940: 73 29 29 20 3b 3b 20 74 68 69 73 20 76 61 72 20 s)) ;; this var
0950: 69 73 20 61 20 70 61 74 68 20 61 6e 64 20 74 68 is a path and th
0960: 65 72 65 20 69 73 20 61 20 70 72 65 76 69 6f 75 ere is a previou
0970: 73 20 70 61 74 68 0a 09 09 09 09 20 20 28 6c 65 s path..... (le
0980: 74 20 28 28 73 65 70 20 28 63 61 64 72 20 28 61 t ((sep (cadr (a
0990: 73 73 6f 63 20 76 61 72 20 70 61 74 68 73 29 29 ssoc var paths))
09a0: 29 29 0a 09 09 09 09 20 20 20 20 28 65 6e 76 3a ))..... (env:
09b0: 6d 65 72 67 65 2d 70 61 74 68 2d 65 6e 76 76 61 merge-path-envva
09c0: 72 20 73 65 70 20 28 68 61 73 68 2d 74 61 62 6c r sep (hash-tabl
09d0: 65 2d 72 65 66 20 72 65 73 75 6c 74 73 20 76 61 e-ref results va
09e0: 72 29 20 76 61 6c 62 29 29 0a 09 09 09 09 20 20 r) valb)).....
09f0: 76 61 6c 62 29 29 29 29 29 0a 09 28 73 71 6c 20 valb)))))..(sql
0a00: 64 62 20 22 53 45 4c 45 43 54 20 76 61 72 2c 76 db "SELECT var,v
0a10: 61 6c 20 46 52 4f 4d 20 65 6e 76 76 61 72 73 20 al FROM envvars
0a20: 57 48 45 52 45 20 63 6f 6e 74 65 78 74 3d 3f 22 WHERE context=?"
0a30: 29 0a 09 63 6f 6e 74 65 78 74 29 29 0a 20 20 20 )..context)).
0a40: 20 20 63 6f 6e 74 65 78 74 73 29 0a 20 20 20 20 contexts).
0a50: 72 65 73 75 6c 74 29 29 0a 0a 3b 3b 20 20 67 65 result))..;; ge
0a60: 74 20 6c 69 73 74 20 6f 66 20 72 65 6d 6f 76 65 t list of remove
0a70: 64 20 76 61 72 69 61 62 6c 65 73 20 62 65 74 77 d variables betw
0a80: 65 65 6e 20 74 77 6f 20 63 6f 6e 74 65 78 74 73 een two contexts
0a90: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 65 6e 76 .;;.(define (env
0aa0: 3a 67 65 74 2d 72 65 6d 6f 76 65 64 20 64 62 20 :get-removed db
0ab0: 63 6f 6e 74 65 78 74 61 20 63 6f 6e 74 65 78 74 contexta context
0ac0: 62 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 75 b). (let ((resu
0ad0: 6c 74 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 lt (make-hash-ta
0ae0: 62 6c 65 29 29 29 0a 20 20 20 20 28 71 75 65 72 ble))). (quer
0af0: 79 0a 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 y. (for-each
0b00: 2d 72 6f 77 0a 20 20 20 20 20 20 28 6c 61 6d 62 -row. (lamb
0b10: 64 61 20 28 72 6f 77 29 0a 09 28 6c 65 74 20 28 da (row)..(let (
0b20: 28 76 61 72 20 20 28 63 61 72 20 72 6f 77 29 29 (var (car row))
0b30: 0a 09 20 20 20 20 20 20 28 76 61 6c 20 20 28 63 .. (val (c
0b40: 61 64 72 20 72 6f 77 29 29 29 0a 09 20 20 28 68 adr row))).. (h
0b50: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 ash-table-set! r
0b60: 65 73 75 6c 74 20 76 61 72 20 76 61 6c 29 29 29 esult var val)))
0b70: 29 0a 20 20 20 20 20 28 73 71 6c 20 64 62 20 22 ). (sql db "
0b80: 53 45 4c 45 43 54 20 76 61 72 2c 76 61 6c 20 46 SELECT var,val F
0b90: 52 4f 4d 20 65 6e 76 76 61 72 73 20 57 48 45 52 ROM envvars WHER
0ba0: 45 20 63 6f 6e 74 65 78 74 3d 3f 20 41 4e 44 20 E context=? AND
0bb0: 76 61 72 20 4e 4f 54 20 49 4e 20 28 53 45 4c 45 var NOT IN (SELE
0bc0: 43 54 20 76 61 72 20 46 52 4f 4d 20 65 6e 76 76 CT var FROM envv
0bd0: 61 72 73 20 57 48 45 52 45 20 63 6f 6e 74 65 78 ars WHERE contex
0be0: 74 3d 3f 29 22 29 0a 20 20 20 20 20 63 6f 6e 74 t=?)"). cont
0bf0: 65 78 74 61 20 63 6f 6e 74 65 78 74 62 29 0a 20 exta contextb).
0c00: 20 20 20 72 65 73 75 6c 74 29 29 0a 0a 3b 3b 20 result))..;;
0c10: 20 67 65 74 20 6c 69 73 74 20 6f 66 20 76 61 72 get list of var
0c20: 69 61 62 6c 65 73 20 61 64 64 65 64 20 74 6f 20 iables added to
0c30: 63 6f 6e 74 65 78 74 62 20 66 72 6f 6d 20 63 6f contextb from co
0c40: 6e 74 65 78 74 61 0a 3b 3b 0a 28 64 65 66 69 6e ntexta.;;.(defin
0c50: 65 20 28 65 6e 76 3a 67 65 74 2d 61 64 64 65 64 e (env:get-added
0c60: 20 64 62 20 63 6f 6e 74 65 78 74 61 20 63 6f 6e db contexta con
0c70: 74 65 78 74 62 29 0a 20 20 28 6c 65 74 20 28 28 textb). (let ((
0c80: 72 65 73 75 6c 74 20 28 6d 61 6b 65 2d 68 61 73 result (make-has
0c90: 68 2d 74 61 62 6c 65 29 29 29 0a 20 20 20 20 28 h-table))). (
0ca0: 71 75 65 72 79 0a 20 20 20 20 20 28 66 6f 72 2d query. (for-
0cb0: 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 20 28 each-row. (
0cc0: 6c 61 6d 62 64 61 20 28 72 6f 77 29 0a 09 28 6c lambda (row)..(l
0cd0: 65 74 20 28 28 76 61 72 20 20 28 63 61 72 20 72 et ((var (car r
0ce0: 6f 77 29 29 0a 09 20 20 20 20 20 20 28 76 61 6c ow)).. (val
0cf0: 20 20 28 63 61 64 72 20 72 6f 77 29 29 29 0a 09 (cadr row)))..
0d00: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
0d10: 74 21 20 72 65 73 75 6c 74 20 76 61 72 20 76 61 t! result var va
0d20: 6c 29 29 29 29 0a 20 20 20 20 20 28 73 71 6c 20 l)))). (sql
0d30: 64 62 20 22 53 45 4c 45 43 54 20 76 61 72 2c 76 db "SELECT var,v
0d40: 61 6c 20 46 52 4f 4d 20 65 6e 76 76 61 72 73 20 al FROM envvars
0d50: 57 48 45 52 45 20 63 6f 6e 74 65 78 74 3d 3f 20 WHERE context=?
0d60: 41 4e 44 20 76 61 72 20 4e 4f 54 20 49 4e 20 28 AND var NOT IN (
0d70: 53 45 4c 45 43 54 20 76 61 72 20 46 52 4f 4d 20 SELECT var FROM
0d80: 65 6e 76 76 61 72 73 20 57 48 45 52 45 20 63 6f envvars WHERE co
0d90: 6e 74 65 78 74 3d 3f 29 22 29 0a 20 20 20 20 20 ntext=?)").
0da0: 63 6f 6e 74 65 78 74 62 20 63 6f 6e 74 65 78 74 contextb context
0db0: 61 29 0a 20 20 20 20 72 65 73 75 6c 74 29 29 0a a). result)).
0dc0: 0a 3b 3b 20 20 67 65 74 20 6c 69 73 74 20 6f 66 .;; get list of
0dd0: 20 76 61 72 69 61 62 6c 65 73 20 69 6e 20 62 6f variables in bo
0de0: 74 68 20 63 6f 6e 74 65 78 74 61 20 61 6e 64 20 th contexta and
0df0: 63 6f 6e 74 65 78 62 20 74 68 61 74 20 68 61 76 contexb that hav
0e00: 65 20 62 65 65 6e 20 63 68 61 6e 67 65 64 0a 3b e been changed.;
0e10: 3b 0a 28 64 65 66 69 6e 65 20 28 65 6e 76 3a 67 ;.(define (env:g
0e20: 65 74 2d 63 68 61 6e 67 65 64 20 64 62 20 63 6f et-changed db co
0e30: 6e 74 65 78 74 61 20 63 6f 6e 74 65 78 74 62 29 ntexta contextb)
0e40: 0a 20 20 28 6c 65 74 20 28 28 72 65 73 75 6c 74 . (let ((result
0e50: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
0e60: 65 29 29 29 0a 20 20 20 20 28 71 75 65 72 79 0a e))). (query.
0e70: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 2d 72 (for-each-r
0e80: 6f 77 0a 20 20 20 20 20 20 28 6c 61 6d 62 64 61 ow. (lambda
0e90: 20 28 72 6f 77 29 0a 09 28 6c 65 74 20 28 28 76 (row)..(let ((v
0ea0: 61 72 20 20 28 63 61 72 20 72 6f 77 29 29 0a 09 ar (car row))..
0eb0: 20 20 20 20 20 20 28 76 61 6c 20 20 28 63 61 64 (val (cad
0ec0: 72 20 72 6f 77 29 29 29 0a 09 20 20 28 68 61 73 r row))).. (has
0ed0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 h-table-set! res
0ee0: 75 6c 74 20 76 61 72 20 76 61 6c 29 29 29 29 0a ult var val)))).
0ef0: 20 20 20 20 20 28 73 71 6c 20 64 62 20 22 53 45 (sql db "SE
0f00: 4c 45 43 54 20 76 61 72 2c 76 61 6c 20 46 52 4f LECT var,val FRO
0f10: 4d 20 65 6e 76 76 61 72 73 20 41 53 20 61 20 57 M envvars AS a W
0f20: 48 45 52 45 20 63 6f 6e 74 65 78 74 3d 3f 20 41 HERE context=? A
0f30: 4e 44 20 76 61 6c 20 21 3d 20 28 53 45 4c 45 43 ND val != (SELEC
0f40: 54 20 76 61 6c 20 46 52 4f 4d 20 65 6e 76 76 61 T val FROM envva
0f50: 72 73 20 57 48 45 52 45 20 76 61 72 3d 61 2e 76 rs WHERE var=a.v
0f60: 61 72 20 41 4e 44 20 63 6f 6e 74 65 78 74 3d 3f ar AND context=?
0f70: 29 22 29 0a 20 20 20 20 20 63 6f 6e 74 65 78 74 )"). context
0f80: 61 20 63 6f 6e 74 65 78 74 62 29 0a 20 20 20 20 a contextb).
0f90: 72 65 73 75 6c 74 29 29 0a 0a 3b 3b 0a 28 64 65 result))..;;.(de
0fa0: 66 69 6e 65 20 28 65 6e 76 3a 62 6c 69 6e 64 2d fine (env:blind-
0fb0: 6d 65 72 67 65 20 6c 31 20 6c 32 29 0a 20 20 28 merge l1 l2). (
0fc0: 69 66 20 28 6e 75 6c 6c 3f 20 6c 31 29 20 6c 32 if (null? l1) l2
0fd0: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c . (if (null
0fe0: 3f 20 6c 32 29 20 6c 31 0a 09 20 20 28 63 6f 6e ? l2) l1.. (con
0ff0: 73 20 28 63 61 72 20 6c 31 29 20 28 63 6f 6e 73 s (car l1) (cons
1000: 20 28 63 61 72 20 6c 32 29 20 28 65 6e 76 3a 62 (car l2) (env:b
1010: 6c 69 6e 64 2d 6d 65 72 67 65 20 28 63 64 72 20 lind-merge (cdr
1020: 6c 31 29 20 28 63 64 72 20 6c 32 29 29 29 29 29 l1) (cdr l2)))))
1030: 29 29 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 62 ))..;; given a b
1040: 65 66 6f 72 65 20 61 6e 64 20 61 6e 20 61 66 74 efore and an aft
1050: 65 72 20 65 6e 76 76 61 72 20 63 61 6c 63 75 6c er envvar calcul
1060: 61 74 65 20 61 20 6e 65 77 20 6d 65 72 67 65 64 ate a new merged
1070: 20 70 61 74 68 0a 3b 3b 0a 28 64 65 66 69 6e 65 path.;;.(define
1080: 20 28 65 6e 76 3a 6d 65 72 67 65 2d 70 61 74 68 (env:merge-path
1090: 2d 65 6e 76 76 61 72 20 73 65 70 61 72 61 74 6f -envvar separato
10a0: 72 20 70 61 74 68 61 20 70 61 74 68 62 29 0a 20 r patha pathb).
10b0: 20 28 6c 65 74 2a 20 28 28 70 61 74 68 61 2d 70 (let* ((patha-p
10c0: 61 72 74 73 20 20 28 73 74 72 69 6e 67 2d 73 70 arts (string-sp
10d0: 6c 69 74 20 70 61 74 68 61 20 73 65 70 61 72 61 lit patha separa
10e0: 74 6f 72 29 29 0a 09 20 28 70 61 74 68 62 2d 70 tor)).. (pathb-p
10f0: 61 72 74 73 20 20 28 73 74 72 69 6e 67 2d 73 70 arts (string-sp
1100: 6c 69 74 20 70 61 74 68 62 20 73 65 70 61 72 61 lit pathb separa
1110: 74 6f 72 29 29 0a 09 20 28 63 6f 6d 6d 6f 6e 2d tor)).. (common-
1120: 70 61 72 74 73 20 28 6c 73 65 74 2d 69 6e 74 65 parts (lset-inte
1130: 72 73 65 63 74 69 6f 6e 20 65 71 75 61 6c 3f 20 rsection equal?
1140: 70 61 74 68 61 2d 70 61 72 74 73 20 70 61 74 68 patha-parts path
1150: 62 2d 70 61 72 74 73 29 29 0a 09 20 28 66 69 6e b-parts)).. (fin
1160: 61 6c 20 20 20 20 20 20 20 20 28 64 65 6c 65 74 al (delet
1170: 65 2d 64 75 70 6c 69 63 61 74 65 73 20 3b 3b 20 e-duplicates ;;
1180: 65 6e 76 3a 62 6c 69 6e 64 2d 6d 65 72 67 65 20 env:blind-merge
1190: 0a 09 09 09 28 61 70 70 65 6e 64 20 70 61 74 68 ....(append path
11a0: 62 2d 70 61 72 74 73 20 63 6f 6d 6d 6f 6e 2d 70 b-parts common-p
11b0: 61 72 74 73 20 70 61 74 68 61 2d 70 61 72 74 73 arts patha-parts
11c0: 29 29 29 29 0a 3b 3b 20 20 20 20 20 28 70 72 69 )))).;; (pri
11d0: 6e 74 20 22 42 45 46 4f 52 45 3a 20 20 20 22 20 nt "BEFORE: "
11e0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
11f0: 72 73 65 20 70 61 74 68 61 2d 70 61 72 74 73 20 rse patha-parts
1200: 20 22 5c 6e 20 20 20 20 20 20 20 22 29 29 0a 3b "\n ")).;
1210: 3b 20 20 20 20 20 28 70 72 69 6e 74 20 22 41 46 ; (print "AF
1220: 54 45 52 3a 20 20 20 20 22 20 28 73 74 72 69 6e TER: " (strin
1230: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 70 61 g-intersperse pa
1240: 74 68 62 2d 70 61 72 74 73 20 20 22 5c 6e 20 20 thb-parts "\n
1250: 20 20 20 20 20 22 29 29 0a 3b 3b 20 20 20 20 20 ")).;;
1260: 28 70 72 69 6e 74 20 22 43 4f 4d 4d 4f 4e 3a 20 (print "COMMON:
1270: 20 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 " (string-inte
1280: 72 73 70 65 72 73 65 20 63 6f 6d 6d 6f 6e 2d 70 rsperse common-p
1290: 61 72 74 73 20 22 5c 6e 20 20 20 20 20 20 20 22 arts "\n "
12a0: 29 29 0a 20 20 20 20 28 73 74 72 69 6e 67 2d 69 )). (string-i
12b0: 6e 74 65 72 73 70 65 72 73 65 20 66 69 6e 61 6c ntersperse final
12c0: 20 73 65 70 61 72 61 74 6f 72 29 29 29 0a 0a 28 separator)))..(
12d0: 64 65 66 69 6e 65 20 28 65 6e 76 3a 70 72 6f 63 define (env:proc
12e0: 65 73 73 2d 70 61 74 68 2d 65 6e 76 76 61 72 20 ess-path-envvar
12f0: 76 61 72 6e 61 6d 65 20 73 65 70 61 72 61 74 6f varname separato
1300: 72 20 70 61 74 68 61 20 70 61 74 68 62 29 0a 20 r patha pathb).
1310: 20 28 6c 65 74 20 28 28 6e 65 77 70 61 74 68 20 (let ((newpath
1320: 28 65 6e 76 3a 6d 65 72 67 65 2d 70 61 74 68 2d (env:merge-path-
1330: 65 6e 76 76 61 72 20 73 65 70 61 72 61 74 6f 72 envvar separator
1340: 20 70 61 74 68 61 20 70 61 74 68 62 29 29 29 0a patha pathb))).
1350: 20 20 20 20 28 73 65 74 65 6e 76 20 76 61 72 6e (setenv varn
1360: 61 6d 65 20 6e 65 77 70 61 74 68 29 29 29 0a 0a ame newpath)))..
1370: 28 64 65 66 69 6e 65 20 28 65 6e 76 3a 68 61 76 (define (env:hav
1380: 65 2d 63 6f 6e 74 65 78 74 20 64 62 20 63 6f 6e e-context db con
1390: 74 65 78 74 29 0a 20 20 28 3e 20 28 71 75 65 72 text). (> (quer
13a0: 79 20 66 65 74 63 68 2d 76 61 6c 75 65 20 28 73 y fetch-value (s
13b0: 71 6c 20 64 62 20 22 53 45 4c 45 43 54 20 63 6f ql db "SELECT co
13c0: 75 6e 74 28 69 64 29 20 46 52 4f 4d 20 65 6e 76 unt(id) FROM env
13d0: 76 61 72 73 20 57 48 45 52 45 20 63 6f 6e 74 65 vars WHERE conte
13e0: 78 74 3d 3f 22 29 20 63 6f 6e 74 65 78 74 29 0a xt=?") context).
13f0: 20 20 20 20 20 30 29 29 0a 0a 3b 3b 20 74 68 69 0))..;; thi
1400: 73 20 69 73 20 73 6f 20 74 68 65 20 63 61 6c 6c s is so the call
1410: 69 6e 67 20 62 6c 6f 63 6b 20 64 6f 65 73 20 6e ing block does n
1420: 6f 74 20 6e 65 65 64 20 74 6f 20 69 6d 70 6f 72 ot need to impor
1430: 74 20 73 71 6c 2d 64 65 2d 6c 69 74 65 0a 28 64 t sql-de-lite.(d
1440: 65 66 69 6e 65 20 28 65 6e 76 3a 63 6c 6f 73 65 efine (env:close
1450: 2d 64 61 74 61 62 61 73 65 20 64 62 29 0a 20 20 -database db).
1460: 28 63 6c 6f 73 65 2d 64 61 74 61 62 61 73 65 20 (close-database
1470: 64 62 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 65 db))..(define (e
1480: 6e 76 3a 6c 61 7a 79 2d 68 61 73 68 2d 74 61 62 nv:lazy-hash-tab
1490: 6c 65 2d 3e 61 6c 69 73 74 20 69 6e 64 61 74 29 le->alist indat)
14a0: 0a 20 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 . (if (hash-tab
14b0: 6c 65 3f 20 69 6e 64 61 74 29 0a 20 20 20 20 20 le? indat).
14c0: 20 28 6c 65 74 20 28 28 64 61 74 20 28 68 61 73 (let ((dat (has
14d0: 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 69 h-table->alist i
14e0: 6e 64 61 74 29 29 29 0a 09 28 69 66 20 28 6e 75 ndat)))..(if (nu
14f0: 6c 6c 3f 20 64 61 74 29 0a 09 20 20 20 20 23 66 ll? dat).. #f
1500: 20 0a 09 20 20 20 20 64 61 74 29 29 0a 20 20 20 .. dat)).
1510: 20 20 20 23 66 29 29 0a 0a 28 64 65 66 69 6e 65 #f))..(define
1520: 20 28 65 6e 76 3a 70 72 69 6e 74 20 61 64 64 65 (env:print adde
1530: 64 20 72 65 6d 6f 76 65 64 20 63 68 61 6e 67 65 d removed change
1540: 64 29 0a 20 20 28 6c 65 74 20 28 28 61 20 20 28 d). (let ((a (
1550: 65 6e 76 3a 6c 61 7a 79 2d 68 61 73 68 2d 74 61 env:lazy-hash-ta
1560: 62 6c 65 2d 3e 61 6c 69 73 74 20 61 64 64 65 64 ble->alist added
1570: 29 29 0a 09 28 72 20 20 28 65 6e 76 3a 6c 61 7a ))..(r (env:laz
1580: 79 2d 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c y-hash-table->al
1590: 69 73 74 20 72 65 6d 6f 76 65 64 29 29 0a 09 28 ist removed))..(
15a0: 63 20 20 28 65 6e 76 3a 6c 61 7a 79 2d 68 61 73 c (env:lazy-has
15b0: 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 63 h-table->alist c
15c0: 68 61 6e 67 65 64 29 29 29 0a 20 20 20 20 28 63 hanged))). (c
15d0: 61 73 65 20 28 69 66 20 28 61 72 67 73 3a 67 65 ase (if (args:ge
15e0: 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 t-arg "-dumpmode
15f0: 22 29 0a 09 20 20 20 20 20 20 28 73 74 72 69 6e ").. (strin
1600: 67 2d 3e 73 79 6d 62 6f 6c 20 28 61 72 67 73 3a g->symbol (args:
1610: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
1620: 64 65 22 29 29 0a 09 20 20 20 20 20 20 27 62 61 de")).. 'ba
1630: 73 68 29 0a 20 20 20 20 20 20 28 28 62 61 73 68 sh). ((bash
1640: 29 0a 20 20 20 20 20 20 20 28 69 66 20 61 0a 09 ). (if a..
1650: 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 (begin..
1660: 28 70 72 69 6e 74 20 22 23 20 41 64 64 65 64 20 (print "# Added
1670: 76 61 72 73 22 29 0a 09 20 20 20 20 20 28 6d 61 vars").. (ma
1680: 70 20 28 6c 61 6d 62 64 61 20 28 64 61 74 29 28 p (lambda (dat)(
1690: 70 72 69 6e 74 20 22 65 78 70 6f 72 74 20 22 20 print "export "
16a0: 28 63 61 72 20 64 61 74 29 20 22 3d 22 20 28 63 (car dat) "=" (c
16b0: 64 72 20 64 61 74 29 29 29 0a 09 09 20 20 28 68 dr dat)))... (h
16c0: 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 ash-table->alist
16d0: 20 61 64 64 65 64 29 29 29 29 0a 20 20 20 20 20 added)))).
16e0: 20 20 28 69 66 20 72 0a 09 20 20 20 28 62 65 67 (if r.. (beg
16f0: 69 6e 0a 09 20 20 20 20 20 28 70 72 69 6e 74 20 in.. (print
1700: 22 23 20 52 65 6d 6f 76 65 64 20 76 61 72 73 22 "# Removed vars"
1710: 29 0a 09 20 20 20 20 20 28 6d 61 70 20 28 6c 61 ).. (map (la
1720: 6d 62 64 61 20 28 64 61 74 29 28 70 72 69 6e 74 mbda (dat)(print
1730: 20 22 75 6e 73 65 74 20 22 20 28 63 61 72 20 64 "unset " (car d
1740: 61 74 29 29 29 0a 09 09 20 20 28 68 61 73 68 2d at)))... (hash-
1750: 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 72 65 6d table->alist rem
1760: 6f 76 65 64 29 29 29 29 0a 20 20 20 20 20 20 20 oved)))).
1770: 28 69 66 20 63 0a 09 20 20 20 28 62 65 67 69 6e (if c.. (begin
1780: 0a 09 20 20 20 20 20 28 70 72 69 6e 74 20 22 23 .. (print "#
1790: 20 43 68 61 6e 67 65 64 20 76 61 72 73 22 29 0a Changed vars").
17a0: 09 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 . (map (lamb
17b0: 64 61 20 28 64 61 74 29 28 70 72 69 6e 74 20 22 da (dat)(print "
17c0: 65 78 70 6f 72 74 20 22 20 28 63 61 72 20 64 61 export " (car da
17d0: 74 29 20 22 3d 22 20 28 63 64 72 20 64 61 74 29 t) "=" (cdr dat)
17e0: 29 29 0a 09 09 20 20 28 68 61 73 68 2d 74 61 62 ))... (hash-tab
17f0: 6c 65 2d 3e 61 6c 69 73 74 20 63 68 61 6e 67 65 le->alist change
1800: 64 29 29 29 29 29 0a 20 20 20 20 20 20 28 28 63 d))))). ((c
1810: 73 68 29 0a 20 20 20 20 20 20 20 28 69 66 20 61 sh). (if a
1820: 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 .. (begin..
1830: 20 20 28 70 72 69 6e 74 20 22 23 20 41 64 64 65 (print "# Adde
1840: 64 20 76 61 72 73 22 29 0a 09 20 20 20 20 20 28 d vars").. (
1850: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 64 61 74 map (lambda (dat
1860: 29 28 70 72 69 6e 74 20 22 73 65 74 65 6e 76 20 )(print "setenv
1870: 22 20 28 63 61 72 20 64 61 74 29 20 22 20 22 20 " (car dat) " "
1880: 28 63 64 72 20 64 61 74 29 29 29 0a 09 09 20 20 (cdr dat)))...
1890: 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 (hash-table->ali
18a0: 73 74 20 61 64 64 65 64 29 29 29 29 0a 20 20 20 st added)))).
18b0: 20 20 20 20 28 69 66 20 72 0a 09 20 20 20 28 62 (if r.. (b
18c0: 65 67 69 6e 0a 09 20 20 20 20 20 28 70 72 69 6e egin.. (prin
18d0: 74 20 22 23 20 52 65 6d 6f 76 65 64 20 76 61 72 t "# Removed var
18e0: 73 22 29 0a 09 20 20 20 20 20 28 6d 61 70 20 28 s").. (map (
18f0: 6c 61 6d 62 64 61 20 28 64 61 74 29 28 70 72 69 lambda (dat)(pri
1900: 6e 74 20 22 75 6e 73 65 74 65 6e 76 20 22 20 28 nt "unsetenv " (
1910: 63 61 72 20 64 61 74 29 29 29 0a 09 09 20 20 28 car dat)))... (
1920: 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 hash-table->alis
1930: 74 20 72 65 6d 6f 76 65 64 29 29 29 29 0a 20 20 t removed)))).
1940: 20 20 20 20 20 28 69 66 20 63 0a 09 20 20 20 28 (if c.. (
1950: 62 65 67 69 6e 0a 09 20 20 20 20 20 28 70 72 69 begin.. (pri
1960: 6e 74 20 22 23 20 43 68 61 6e 67 65 64 20 76 61 nt "# Changed va
1970: 72 73 22 29 0a 09 20 20 20 20 20 28 6d 61 70 20 rs").. (map
1980: 28 6c 61 6d 62 64 61 20 28 64 61 74 29 28 70 72 (lambda (dat)(pr
1990: 69 6e 74 20 22 73 65 74 65 6e 76 20 22 20 28 63 int "setenv " (c
19a0: 61 72 20 64 61 74 29 20 22 20 22 20 28 63 64 72 ar dat) " " (cdr
19b0: 20 64 61 74 29 29 29 0a 09 09 20 20 28 68 61 73 dat)))... (has
19c0: 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 63 h-table->alist c
19d0: 68 61 6e 67 65 64 29 29 29 29 29 0a 20 20 20 20 hanged))))).
19e0: 20 20 28 28 63 6f 6e 66 69 67 20 69 6e 69 29 0a ((config ini).
19f0: 20 20 20 20 20 20 20 28 69 66 20 61 0a 09 20 20 (if a..
1a00: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 70 (begin.. (p
1a10: 72 69 6e 74 20 22 23 20 41 64 64 65 64 20 76 61 rint "# Added va
1a20: 72 73 22 29 0a 09 20 20 20 20 20 28 6d 61 70 20 rs").. (map
1a30: 28 6c 61 6d 62 64 61 20 28 64 61 74 29 28 70 72 (lambda (dat)(pr
1a40: 69 6e 74 20 28 63 61 72 20 64 61 74 29 20 22 20 int (car dat) "
1a50: 22 20 28 63 64 72 20 64 61 74 29 29 29 0a 09 09 " (cdr dat)))...
1a60: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 (hash-table->a
1a70: 6c 69 73 74 20 61 64 64 65 64 29 29 29 29 0a 20 list added)))).
1a80: 20 20 20 20 20 20 28 69 66 20 72 0a 09 20 20 20 (if r..
1a90: 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 70 72 (begin.. (pr
1aa0: 69 6e 74 20 22 23 20 52 65 6d 6f 76 65 64 20 76 int "# Removed v
1ab0: 61 72 73 22 29 0a 09 20 20 20 20 20 28 6d 61 70 ars").. (map
1ac0: 20 28 6c 61 6d 62 64 61 20 28 64 61 74 29 28 70 (lambda (dat)(p
1ad0: 72 69 6e 74 20 22 23 7b 73 63 68 65 6d 65 20 28 rint "#{scheme (
1ae0: 75 6e 73 65 74 65 6e 76 20 5c 22 22 20 28 63 61 unsetenv \"" (ca
1af0: 72 20 64 61 74 29 20 22 5c 22 29 7d 22 29 29 0a r dat) "\")}")).
1b00: 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d .. (hash-table-
1b10: 3e 61 6c 69 73 74 20 72 65 6d 6f 76 65 64 29 29 >alist removed))
1b20: 29 29 0a 20 20 20 20 20 20 20 28 69 66 20 63 0a )). (if c.
1b30: 09 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 . (begin..
1b40: 20 28 70 72 69 6e 74 20 22 23 20 43 68 61 6e 67 (print "# Chang
1b50: 65 64 20 76 61 72 73 22 29 0a 09 20 20 20 20 20 ed vars")..
1b60: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 64 61 (map (lambda (da
1b70: 74 29 28 70 72 69 6e 74 20 28 63 61 72 20 64 61 t)(print (car da
1b80: 74 29 20 22 20 22 20 28 63 64 72 20 64 61 74 29 t) " " (cdr dat)
1b90: 29 29 0a 09 09 20 20 28 68 61 73 68 2d 74 61 62 ))... (hash-tab
1ba0: 6c 65 2d 3e 61 6c 69 73 74 20 63 68 61 6e 67 65 le->alist change
1bb0: 64 29 29 29 29 29 0a 20 20 20 20 20 20 28 65 6c d))))). (el
1bc0: 73 65 0a 20 20 20 20 20 20 20 28 64 65 62 75 67 se. (debug
1bd0: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
1be0: 20 4e 6f 20 64 75 6d 70 6d 6f 64 65 20 73 70 65 No dumpmode spe
1bf0: 63 69 66 69 65 64 2c 20 75 73 65 20 2d 64 75 6d cified, use -dum
1c00: 70 6d 6f 64 65 20 5b 62 61 73 68 7c 63 73 68 7c pmode [bash|csh|
1c10: 63 6f 6e 66 69 67 5d 22 29 29 29 29 29 0a config]"))))).