ADDED .fossil-settings/ignore-glob Index: .fossil-settings/ignore-glob ================================================================== --- /dev/null +++ .fossil-settings/ignore-glob @@ -0,0 +1,1 @@ +utils/build/* Index: configf.scm ================================================================== --- configf.scm +++ configf.scm @@ -52,10 +52,47 @@ (define configf:key-sys-pr (regexp "^(\\S+)\\s+\\[system\\s+(\\S+.*)\\]\\s*$")) (define configf:key-val-pr (regexp "^(\\S+)\\s+(.*)$")) (define configf:comment-rx (regexp "^\\s*#.*")) (define configf:cont-ln-rx (regexp "^(\\s+)(\\S+.*)$")) +;; read a line and process any #{ ... } constructs + +(define configf:var-expand-regex (regexp "^(.*)#\\{([^\\}\\{]*)\\}(.*)")) +(define (configf:process-line l) + (let loop ((res l)) + (if (string? res) + (let ((matchdat (string-search configf:var-expand-regex res))) + (if matchdat + (let ((prestr (cadr matchdat)) + (cmd (caddr matchdat)) + (poststr (cadddr matchdat)) + (result #f)) + (with-input-from-string (conc "(" cmd ")") + (lambda () + (set! result (eval (read))))) + (loop (conc prestr result poststr))) + res)) + res))) + +(define (shell cmd) + (let* ((output (cmd-run->list cmd)) + (res (car output)) + (status (cadr output))) + (if (equal? status 0) + (string-intersperse + res + "\n") + (begin + (with-output-to-port (current-error-port) + (print "ERROR: " cmd " returned bad exit code " status)) + "")))) + +(define-inline (configf:read-line p) + (configf:process-line (read-line p))) + +;; read a config file, returns hash table of alists + ;; read a config file, returns hash table of alists ;; adds to ht if given (must be #f otherwise) ;; envion-patt is a regex spec that identifies sections that will be eval'd ;; in the environment on the fly @@ -63,26 +100,26 @@ (debug:print 4 "INFO: read-config " path " allow-system " allow-system " environ-patt " environ-patt) (if (not (file-exists? path)) (if (not ht)(make-hash-table) ht) (let ((inp (open-input-file path)) (res (if (not ht)(make-hash-table) ht))) - (let loop ((inl (read-line inp)) + (let loop ((inl (configf:read-line inp)) ;; (read-line inp)) (curr-section-name "default") (var-flag #f);; turn on for key-var-pr and cont-ln-rx, turn off elsewhere (lead #f)) (if (eof-object? inl) (begin (close-input-port inp) res) (regex-case inl - (configf:comment-rx _ (loop (read-line inp) curr-section-name #f #f)) - (configf:blank-l-rx _ (loop (read-line inp) curr-section-name #f #f)) + (configf:comment-rx _ (loop (configf:read-line inp) curr-section-name #f #f)) + (configf:blank-l-rx _ (loop (configf:read-line inp) curr-section-name #f #f)) (configf:include-rx ( x include-file ) (begin (read-config include-file res allow-system environ-patt: environ-patt) - (loop (read-line inp) curr-section-name #f #f))) - (configf:section-rx ( x section-name ) (loop (read-line inp) section-name #f #f)) + (loop (configf:read-line inp) curr-section-name #f #f))) + (configf:section-rx ( x section-name ) (loop (configf:read-line inp) section-name #f #f)) (configf:key-sys-pr ( x key cmd ) (if allow-system (let ((alist (hash-table-ref/default res curr-section-name '())) (val-proc (lambda () (let* ((cmdres (cmd-run->list cmd)) (status (cadr cmdres)) @@ -99,12 +136,12 @@ key (case allow-system ((return-procs) val-proc) ((return-string) cmd) (else (val-proc))))) - (loop (read-line inp) curr-section-name #f #f)) - (loop (read-line inp) curr-section-name #f #f))) + (loop (configf:read-line inp) curr-section-name #f #f)) + (loop (configf:read-line inp) curr-section-name #f #f))) (configf:key-val-pr ( x key val ) (let* ((alist (hash-table-ref/default res curr-section-name '())) (envar (and environ-patt (string-match (regexp environ-patt) curr-section-name))) (realval (if envar (config:eval-string-in-environment val) val))) @@ -112,11 +149,11 @@ (begin (debug:print 4 "INFO: read-config key=" key ", val=" val ", realval=" realval) (setenv key realval))) (hash-table-set! res curr-section-name (config:assoc-safe-add alist key realval)) - (loop (read-line inp) curr-section-name key #f))) + (loop (configf:read-line inp) curr-section-name key #f))) ;; if a continued line (configf:cont-ln-rx ( x whsp val ) (let ((alist (hash-table-ref/default res curr-section-name '()))) (if var-flag ;; if set to a string then we have a continued var (let ((newval (conc (config-lookup res curr-section-name var-flag) "\n" @@ -126,15 +163,15 @@ "") val))) ;; (print "val: " val "\nnewval: \"" newval "\"\nvarflag: " var-flag) (hash-table-set! res curr-section-name (config:assoc-safe-add alist var-flag newval)) - (loop (read-line inp) curr-section-name var-flag (if lead lead whsp))) - (loop (read-line inp) curr-section-name #f #f)))) + (loop (configf:read-line inp) curr-section-name var-flag (if lead lead whsp))) + (loop (configf:read-line inp) curr-section-name #f #f)))) (else (debug:print 0 "ERROR: problem parsing " path ",\n \"" inl "\"") (set! var-flag #f) - (loop (read-line inp) curr-section-name #f #f)))))))) + (loop (configf:read-line inp) curr-section-name #f #f)))))))) (define (find-and-read-config fname #!key (environ-patt #f)) (let* ((curr-dir (current-directory)) (configinfo (find-config fname)) (toppath (car configinfo)) Index: tests/megatest.config ================================================================== --- tests/megatest.config +++ tests/megatest.config @@ -30,10 +30,11 @@ [env-override] SPECIAL_ENV_VARS overide them here - should be seen at launch and in the runs TESTVAR [system realpath .] DEADVAR [system ls] VARWITHDOLLAR $HOME/.zshrc +WACKYVAR #{system "ls"} # XTERM [system xterm] # RUNDEAD [system exit 56] ## disks are: