Random Bits of Open Code

Check-in [48bff81ed5]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:adjusted evaled calls to mtconfig methods to properly reflect namespace
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:48bff81ed557d001abb9f1a8adc274d427fdc429
User & Date: bjbarcla 2018-12-21 01:03:34
Context
2019-01-02
04:38
fixed couple dumb bugs in geolib check-in: 7fea4e7d8b user: matt tags: trunk
2018-12-27
01:29
Create new branch named "modularize-debug" check-in: aa1ce47e23 user: bjbarcla tags: modularize-debug
2018-12-21
01:03
adjusted evaled calls to mtconfig methods to properly reflect namespace check-in: 48bff81ed5 user: bjbarcla tags: trunk
2018-12-19
01:12
added "add-eval-string" to mtconfigf, which allows mtconfig consumer to add things like "(use my-module)" to import apis to #{scheme ..} and the like check-in: c358d9e639 user: bjbarcla tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to mtutils/mtconfigf/mtconfigf.scm.

342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373

374
375
376
377
378
379
380
		     (cmdsym  (string->symbol cmdtype))
		     (libpath (conc *common:this-exe-dir* "/../../eggs/lib/chicken/7"))
		     (allsnip (conc "(define getenv get-environment-variable)"
                                    (if (and (not (get-environment-variable "CHICKEN_REPOSITORY"))
                                             (directory-exists? libpath))
                                        (conc "(repository-path \""libpath"\") ")
                                        "")
                                    "(use mtconfigf)"
				    ;;                ../../eggs/lib/chicken/7/mtconfigf.so
				    "(import mtconfigf)"
                                    *eval-string*
                                    )) ;; (import mtconfigf)")
		     (fullcmd (case cmdsym
				((scheme scm) (conc "(lambda (ht)" allsnip "" cmd ")"))
				((system)     (conc "(lambda (ht)" allsnip "(configf:system ht \"" cmd "\"))"))
				((shell sh)   (conc "(lambda (ht)" allsnip "(string-translate (shell \""  cmd "\") \"\n\" \" \"))"))
				((realpath rp)(conc "(lambda (ht)" allsnip "(nice-path \"" cmd "\"))"))
				((getenv gv)  (conc "(lambda (ht)" allsnip "(get-environment-variable \"" cmd "\"))"))
				((mtrah)      (conc "(lambda (ht)" allsnip
                                                    "  (let ((extra \"" cmd "\"))"
						    "     (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))"
						    "        (if (string-null? extra) \"\" \"/\")"
						    "     extra)))"))
				((get g)   
				 (let* ((parts (string-split cmd))
					(sect  (car parts))
					(var   (cadr parts)))
				   (conc "(lambda (ht)" allsnip " (lookup ht \"" sect "\" \"" var "\"))")))
				((runconfigs-get rget) (conc "(lambda (ht)" allsnip "(runconfigs-get ht \"" cmd "\"))"))
				;; ((rget)           (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
				(else "(lambda (ht)(print \"ERROR\") \"ERROR\")"))))
		;; (print "fullcmd=" fullcmd)

		(handle-exceptions
		    exn
		    (let ((arguments ((condition-property-accessor 'exn 'arguments) exn))
			  (message    ((condition-property-accessor 'exn 'message) exn)))
		      (debug:print 0 *default-log-port* "WARNING: failed to process config input \"" l "\"")
		      (debug:print 0 *default-log-port* " message: " message 
				   (if arguments







|
<
<
|
<


|
|
|










|
|
<

<
>







342
343
344
345
346
347
348
349


350

351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367

368

369
370
371
372
373
374
375
376
		     (cmdsym  (string->symbol cmdtype))
		     (libpath (conc *common:this-exe-dir* "/../../eggs/lib/chicken/7"))
		     (allsnip (conc "(define getenv get-environment-variable)"
                                    (if (and (not (get-environment-variable "CHICKEN_REPOSITORY"))
                                             (directory-exists? libpath))
                                        (conc "(repository-path \""libpath"\") ")
                                        "")
                                    "(use (prefix mtconfigf configf:))"


                                    *eval-string*)) 

		     (fullcmd (case cmdsym
				((scheme scm) (conc "(lambda (ht)" allsnip "" cmd ")"))
				((system)     (conc "(lambda (ht)" allsnip "(configf:configf:system ht \"" cmd "\"))"))
				((shell sh)   (conc "(lambda (ht)" allsnip "(string-translate (configf:shell \""  cmd "\") \"\n\" \" \"))"))
				((realpath rp)(conc "(lambda (ht)" allsnip "(configf:nice-path \"" cmd "\"))"))
				((getenv gv)  (conc "(lambda (ht)" allsnip "(get-environment-variable \"" cmd "\"))"))
				((mtrah)      (conc "(lambda (ht)" allsnip
                                                    "  (let ((extra \"" cmd "\"))"
						    "     (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))"
						    "        (if (string-null? extra) \"\" \"/\")"
						    "     extra)))"))
				((get g)   
				 (let* ((parts (string-split cmd))
					(sect  (car parts))
					(var   (cadr parts)))
				   (conc "(lambda (ht)" allsnip " (configf:lookup ht \"" sect "\" \"" var "\"))")))
				((runconfigs-get rget) (conc "(lambda (ht)" allsnip "(configf:runconfigs-get ht \"" cmd "\"))"))

				(else "(lambda (ht)(print \"ERROR\") \"ERROR\")"))))


		(handle-exceptions
		    exn
		    (let ((arguments ((condition-property-accessor 'exn 'arguments) exn))
			  (message    ((condition-property-accessor 'exn 'message) exn)))
		      (debug:print 0 *default-log-port* "WARNING: failed to process config input \"" l "\"")
		      (debug:print 0 *default-log-port* " message: " message 
				   (if arguments