Artifact
88e7c2b7155c7e7c6458a3dcb78f519c046f1f5c:
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 69 6e 63 2d 70 61 74 68 20 70 (env:inc-path p
1530: 61 74 68 29 0a 20 20 28 70 72 69 6e 74 20 22 50 ath). (print "P
1540: 41 54 48 20 22 0a 09 20 28 63 6f 6e 63 20 22 23 ATH ".. (conc "#
1550: 7b 73 63 68 65 6d 65 20 28 65 6e 76 3a 6d 69 6e {scheme (env:min
1560: 2d 70 61 74 68 20 5c 22 22 20 70 61 74 68 20 22 -path \"" path "
1570: 5c 22 20 5c 22 23 7b 67 65 74 65 6e 76 20 50 41 \" \"#{getenv PA
1580: 54 48 7d 5c 22 29 7d 22 29 29 29 0a 3b 3b 20 09 TH}\")}"))).;; .
1590: 20 28 63 6f 6e 63 0a 3b 3b 20 09 20 20 22 23 7b (conc.;; . "#{
15a0: 73 63 68 65 6d 65 20 28 73 74 72 69 6e 67 2d 69 scheme (string-i
15b0: 6e 74 65 72 73 70 65 72 73 65 20 22 0a 3b 3b 20 ntersperse ".;;
15c0: 09 20 20 22 28 64 65 6c 65 74 65 2d 64 75 70 6c . "(delete-dupl
15d0: 69 63 61 74 65 73 20 22 0a 3b 3b 20 09 20 20 22 icates ".;; . "
15e0: 28 61 70 70 65 6e 64 20 28 73 74 72 69 6e 67 2d (append (string-
15f0: 73 70 6c 69 74 20 5c 22 22 20 70 61 74 68 20 22 split \"" path "
1600: 5c 22 20 5c 22 3a 5c 22 29 20 22 0a 3b 3b 20 09 \" \":\") ".;; .
1610: 20 20 22 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 "(string-split
1620: 20 5c 22 23 7b 67 65 74 65 6e 76 20 50 41 54 48 \"#{getenv PATH
1630: 7d 5c 22 20 5c 22 3a 5c 22 29 29 29 22 0a 3b 3b }\" \":\")))".;;
1640: 20 09 20 20 22 20 5c 22 3a 5c 22 29 7d 22 29 29 . " \":\")}"))
1650: 29 0a 0a 28 64 65 66 69 6e 65 20 28 65 6e 76 3a )..(define (env:
1660: 6d 69 6e 2d 70 61 74 68 20 70 61 74 68 31 20 70 min-path path1 p
1670: 61 74 68 32 29 0a 20 20 28 73 74 72 69 6e 67 2d ath2). (string-
1680: 69 6e 74 65 72 73 70 65 72 73 65 0a 20 20 20 28 intersperse. (
1690: 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 delete-duplicate
16a0: 73 0a 20 20 20 20 28 61 70 70 65 6e 64 0a 20 20 s. (append.
16b0: 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 (string-split
16c0: 20 70 61 74 68 31 20 22 3a 22 29 0a 20 20 20 20 path1 ":").
16d0: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 70 (string-split p
16e0: 61 74 68 32 20 22 3a 22 29 29 29 0a 20 20 20 22 ath2 ":"))). "
16f0: 3a 22 29 29 0a 0a 3b 3b 20 69 6e 63 20 70 61 74 :"))..;; inc pat
1700: 68 20 77 69 6c 6c 20 73 65 74 20 61 20 50 41 54 h will set a PAT
1710: 48 20 74 68 61 74 20 69 73 20 69 6e 63 72 65 6d H that is increm
1720: 65 6e 74 61 6c 6c 79 20 6d 6f 64 69 66 69 65 64 entally modified
1730: 20 77 68 65 6e 20 72 65 61 64 20 2d 20 63 6f 6e when read - con
1740: 66 69 67 20 6d 6f 64 65 20 6f 6e 6c 79 0a 3b 3b fig mode only.;;
1750: 0a 28 64 65 66 69 6e 65 20 28 65 6e 76 3a 70 72 .(define (env:pr
1760: 69 6e 74 20 61 64 64 65 64 20 72 65 6d 6f 76 65 int added remove
1770: 64 20 63 68 61 6e 67 65 64 20 23 21 6b 65 79 20 d changed #!key
1780: 28 69 6e 63 2d 70 61 74 68 20 23 74 29 29 0a 20 (inc-path #t)).
1790: 20 28 6c 65 74 20 28 28 61 20 20 28 65 6e 76 3a (let ((a (env:
17a0: 6c 61 7a 79 2d 68 61 73 68 2d 74 61 62 6c 65 2d lazy-hash-table-
17b0: 3e 61 6c 69 73 74 20 61 64 64 65 64 29 29 0a 09 >alist added))..
17c0: 28 72 20 20 28 65 6e 76 3a 6c 61 7a 79 2d 68 61 (r (env:lazy-ha
17d0: 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 sh-table->alist
17e0: 72 65 6d 6f 76 65 64 29 29 0a 09 28 63 20 20 28 removed))..(c (
17f0: 65 6e 76 3a 6c 61 7a 79 2d 68 61 73 68 2d 74 61 env:lazy-hash-ta
1800: 62 6c 65 2d 3e 61 6c 69 73 74 20 63 68 61 6e 67 ble->alist chang
1810: 65 64 29 29 29 0a 20 20 20 20 28 63 61 73 65 20 ed))). (case
1820: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
1830: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 0a 09 g "-dumpmode")..
1840: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 73 (string->s
1850: 79 6d 62 6f 6c 20 28 61 72 67 73 3a 67 65 74 2d ymbol (args:get-
1860: 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 arg "-dumpmode")
1870: 29 0a 09 20 20 20 20 20 20 27 62 61 73 68 29 0a ).. 'bash).
1880: 20 20 20 20 20 20 28 28 62 61 73 68 29 0a 20 20 ((bash).
1890: 20 20 20 20 20 28 69 66 20 61 0a 09 20 20 20 28 (if a.. (
18a0: 62 65 67 69 6e 0a 09 20 20 20 20 20 28 70 72 69 begin.. (pri
18b0: 6e 74 20 22 23 20 41 64 64 65 64 20 76 61 72 73 nt "# Added vars
18c0: 22 29 0a 09 20 20 20 20 20 28 6d 61 70 20 28 6c ").. (map (l
18d0: 61 6d 62 64 61 20 28 64 61 74 29 28 70 72 69 6e ambda (dat)(prin
18e0: 74 20 22 65 78 70 6f 72 74 20 22 20 28 63 61 72 t "export " (car
18f0: 20 64 61 74 29 20 22 3d 22 20 28 63 64 72 20 64 dat) "=" (cdr d
1900: 61 74 29 29 29 0a 09 09 20 20 28 68 61 73 68 2d at)))... (hash-
1910: 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 61 64 64 table->alist add
1920: 65 64 29 29 29 29 0a 20 20 20 20 20 20 20 28 69 ed)))). (i
1930: 66 20 72 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 f r.. (begin..
1940: 20 20 20 20 20 28 70 72 69 6e 74 20 22 23 20 52 (print "# R
1950: 65 6d 6f 76 65 64 20 76 61 72 73 22 29 0a 09 20 emoved vars")..
1960: 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 (map (lambda
1970: 20 28 64 61 74 29 28 70 72 69 6e 74 20 22 75 6e (dat)(print "un
1980: 73 65 74 20 22 20 28 63 61 72 20 64 61 74 29 29 set " (car dat))
1990: 29 0a 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c )... (hash-tabl
19a0: 65 2d 3e 61 6c 69 73 74 20 72 65 6d 6f 76 65 64 e->alist removed
19b0: 29 29 29 29 0a 20 20 20 20 20 20 20 28 69 66 20 )))). (if
19c0: 63 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 20 20 c.. (begin..
19d0: 20 20 20 28 70 72 69 6e 74 20 22 23 20 43 68 61 (print "# Cha
19e0: 6e 67 65 64 20 76 61 72 73 22 29 0a 09 20 20 20 nged vars")..
19f0: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda (
1a00: 64 61 74 29 28 70 72 69 6e 74 20 22 65 78 70 6f dat)(print "expo
1a10: 72 74 20 22 20 28 63 61 72 20 64 61 74 29 20 22 rt " (car dat) "
1a20: 3d 22 20 28 63 64 72 20 64 61 74 29 29 29 0a 09 =" (cdr dat)))..
1a30: 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e . (hash-table->
1a40: 61 6c 69 73 74 20 63 68 61 6e 67 65 64 29 29 29 alist changed)))
1a50: 29 29 0a 20 20 20 20 20 20 28 28 63 73 68 29 0a )). ((csh).
1a60: 20 20 20 20 20 20 20 28 69 66 20 61 0a 09 20 20 (if a..
1a70: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 70 (begin.. (p
1a80: 72 69 6e 74 20 22 23 20 41 64 64 65 64 20 76 61 rint "# Added va
1a90: 72 73 22 29 0a 09 20 20 20 20 20 28 6d 61 70 20 rs").. (map
1aa0: 28 6c 61 6d 62 64 61 20 28 64 61 74 29 28 70 72 (lambda (dat)(pr
1ab0: 69 6e 74 20 22 73 65 74 65 6e 76 20 22 20 28 63 int "setenv " (c
1ac0: 61 72 20 64 61 74 29 20 22 20 22 20 28 63 64 72 ar dat) " " (cdr
1ad0: 20 64 61 74 29 29 29 0a 09 09 20 20 28 68 61 73 dat)))... (has
1ae0: 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 61 h-table->alist a
1af0: 64 64 65 64 29 29 29 29 0a 20 20 20 20 20 20 20 dded)))).
1b00: 28 69 66 20 72 0a 09 20 20 20 28 62 65 67 69 6e (if r.. (begin
1b10: 0a 09 20 20 20 20 20 28 70 72 69 6e 74 20 22 23 .. (print "#
1b20: 20 52 65 6d 6f 76 65 64 20 76 61 72 73 22 29 0a Removed vars").
1b30: 09 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 . (map (lamb
1b40: 64 61 20 28 64 61 74 29 28 70 72 69 6e 74 20 22 da (dat)(print "
1b50: 75 6e 73 65 74 65 6e 76 20 22 20 28 63 61 72 20 unsetenv " (car
1b60: 64 61 74 29 29 29 0a 09 09 20 20 28 68 61 73 68 dat)))... (hash
1b70: 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 72 65 -table->alist re
1b80: 6d 6f 76 65 64 29 29 29 29 0a 20 20 20 20 20 20 moved)))).
1b90: 20 28 69 66 20 63 0a 09 20 20 20 28 62 65 67 69 (if c.. (begi
1ba0: 6e 0a 09 20 20 20 20 20 28 70 72 69 6e 74 20 22 n.. (print "
1bb0: 23 20 43 68 61 6e 67 65 64 20 76 61 72 73 22 29 # Changed vars")
1bc0: 0a 09 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d .. (map (lam
1bd0: 62 64 61 20 28 64 61 74 29 28 70 72 69 6e 74 20 bda (dat)(print
1be0: 22 73 65 74 65 6e 76 20 22 20 28 63 61 72 20 64 "setenv " (car d
1bf0: 61 74 29 20 22 20 22 20 28 63 64 72 20 64 61 74 at) " " (cdr dat
1c00: 29 29 29 0a 09 09 20 20 28 68 61 73 68 2d 74 61 )))... (hash-ta
1c10: 62 6c 65 2d 3e 61 6c 69 73 74 20 63 68 61 6e 67 ble->alist chang
1c20: 65 64 29 29 29 29 29 0a 20 20 20 20 20 20 28 28 ed))))). ((
1c30: 63 6f 6e 66 69 67 20 69 6e 69 29 0a 20 20 20 20 config ini).
1c40: 20 20 20 28 69 66 20 61 0a 09 20 20 20 28 62 65 (if a.. (be
1c50: 67 69 6e 0a 09 20 20 20 20 20 28 70 72 69 6e 74 gin.. (print
1c60: 20 22 23 20 41 64 64 65 64 20 76 61 72 73 22 29 "# Added vars")
1c70: 0a 09 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d .. (map (lam
1c80: 62 64 61 20 28 64 61 74 29 0a 09 09 20 20 20 20 bda (dat)...
1c90: 28 6c 65 74 20 28 28 76 61 72 20 28 63 61 72 20 (let ((var (car
1ca0: 64 61 74 29 29 0a 09 09 09 20 20 28 76 61 6c 20 dat)).... (val
1cb0: 28 63 64 72 20 64 61 74 29 29 29 0a 09 09 20 20 (cdr dat)))...
1cc0: 20 20 20 20 28 69 66 20 28 61 6e 64 20 69 6e 63 (if (and inc
1cd0: 2d 70 61 74 68 0a 09 09 09 20 20 20 20 20 20 20 -path....
1ce0: 28 65 71 75 61 6c 3f 20 76 61 72 20 22 50 41 54 (equal? var "PAT
1cf0: 48 22 29 29 0a 09 09 09 20 20 28 65 6e 76 3a 69 H")).... (env:i
1d00: 6e 63 2d 70 61 74 68 20 76 61 6c 29 0a 09 09 09 nc-path val)....
1d10: 20 20 28 70 72 69 6e 74 20 76 61 72 20 22 20 22 (print var " "
1d20: 20 76 61 6c 29 29 29 29 0a 09 09 20 20 28 68 61 val))))... (ha
1d30: 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 sh-table->alist
1d40: 61 64 64 65 64 29 29 29 29 0a 20 20 20 20 20 20 added)))).
1d50: 20 28 69 66 20 72 0a 09 20 20 20 28 62 65 67 69 (if r.. (begi
1d60: 6e 0a 09 20 20 20 20 20 28 70 72 69 6e 74 20 22 n.. (print "
1d70: 23 20 52 65 6d 6f 76 65 64 20 76 61 72 73 22 29 # Removed vars")
1d80: 0a 09 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d .. (map (lam
1d90: 62 64 61 20 28 64 61 74 29 28 70 72 69 6e 74 20 bda (dat)(print
1da0: 22 23 7b 73 63 68 65 6d 65 20 28 75 6e 73 65 74 "#{scheme (unset
1db0: 65 6e 76 20 5c 22 22 20 28 63 61 72 20 64 61 74 env \"" (car dat
1dc0: 29 20 22 5c 22 29 7d 22 29 29 0a 09 09 20 20 28 ) "\")}"))... (
1dd0: 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 hash-table->alis
1de0: 74 20 72 65 6d 6f 76 65 64 29 29 29 29 0a 20 20 t removed)))).
1df0: 20 20 20 20 20 28 69 66 20 63 0a 09 20 20 20 28 (if c.. (
1e00: 62 65 67 69 6e 0a 09 20 20 20 20 20 28 70 72 69 begin.. (pri
1e10: 6e 74 20 22 23 20 43 68 61 6e 67 65 64 20 76 61 nt "# Changed va
1e20: 72 73 22 29 0a 09 20 20 20 20 20 28 6d 61 70 20 rs").. (map
1e30: 28 6c 61 6d 62 64 61 20 28 64 61 74 29 0a 09 09 (lambda (dat)...
1e40: 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 20 28 (let ((var (
1e50: 63 61 72 20 64 61 74 29 29 0a 09 09 09 20 20 28 car dat)).... (
1e60: 76 61 6c 20 28 63 64 72 20 64 61 74 29 29 29 0a val (cdr dat))).
1e70: 09 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 .. (if (and
1e80: 20 69 6e 63 2d 70 61 74 68 0a 09 09 09 20 20 20 inc-path....
1e90: 20 20 20 20 28 65 71 75 61 6c 3f 20 76 61 72 20 (equal? var
1ea0: 22 50 41 54 48 22 29 29 0a 09 09 09 20 20 28 65 "PATH")).... (e
1eb0: 6e 76 3a 69 6e 63 2d 70 61 74 68 20 76 61 6c 29 nv:inc-path val)
1ec0: 0a 09 09 09 20 20 28 70 72 69 6e 74 20 76 61 72 .... (print var
1ed0: 20 22 20 22 20 76 61 6c 29 29 29 29 0a 09 09 20 " " val))))...
1ee0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c (hash-table->al
1ef0: 69 73 74 20 63 68 61 6e 67 65 64 29 29 29 29 29 ist changed)))))
1f00: 0a 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 . (else.
1f10: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
1f20: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
1f30: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f 20 t-log-port* "No
1f40: 64 75 6d 70 6d 6f 64 65 20 73 70 65 63 69 66 69 dumpmode specifi
1f50: 65 64 2c 20 75 73 65 20 2d 64 75 6d 70 6d 6f 64 ed, use -dumpmod
1f60: 65 20 5b 62 61 73 68 7c 63 73 68 7c 63 6f 6e 66 e [bash|csh|conf
1f70: 69 67 5d 22 29 29 29 29 29 0a ig]"))))).