Index: ducttape/ducttape-lib.scm ================================================================== --- ducttape/ducttape-lib.scm +++ ducttape/ducttape-lib.scm @@ -18,11 +18,11 @@ ; launch-repl keyword-skim skim-cmdline-opts-noarg-by-regex skim-cmdline-opts-withargs-by-regex concat-lists - process-command-line + ducttape-process-command-line ducttape-append-logfile ducttape-activate-logfile isys do-or-die counter-maker @@ -46,11 +46,14 @@ current-isodate ) (import scheme chicken extras ports data-structures ) - (use posix regex ansi-escape-sequences test srfi-1 irregex slice srfi-13 rfc3339 scsh-process directory-utils uuid-lib filepath srfi-19 ) ; linenoise + (use posix regex ansi-escape-sequences test srfi-1 irregex slice srfi-13 rfc3339) + ;;scsh-process ;; dropping scsh-process, it was clobbering posix's process and process* + (use directory-utils uuid-lib filepath srfi-19 ) ; linenoise + (include "mimetypes.scm") ; provides ext->mimetype (include "workweekdate.scm") (define ducttape-lib-version 1.00) (define (toplevel-command sym proc) (lambda () #f)) ;;;; utility procedures @@ -182,23 +185,10 @@ (if (equal? 0 exit-code) stdout-str (begin (ierr (conc "Command > " command " " "< failed with " exit-code " because: \n" stderr-str) ) (if nodie #f (exit exit-code)))))) - - - - - ;; this is broken. one day i will fix it and thus understand run/collecting... don't use isys-broken. - (define (isys-broken command-list) - - (let-values ( ( (rv outport errport) (run/collecting (1 2) ("ls" "-l") ) ) ) - (print "rv is " rv) - (print "op is " outport) - (print "ep is " errport) - (values rv (port->string outport) (port->string errport)))) - ;; runs-ok: evaluate expression while suppressing exceptions. ; on caught exception, returns #f ; otherwise, returns expression value @@ -341,23 +331,19 @@ (begin (ducttape-log-file logfile) (setenv "DUCTTAPE_LOG_FILE" (ducttape-log-file)))) (ducttape-append-logfile 'note (format #f "START - pid=~A ppid=~A argv=(~A) pwd=~A user=~A host=~A" pid ppid argv pwd user host) #t))) - ;; immediately activate logfile (will be noop if logfile disabled) - (ducttape-activate-logfile) ;; log exit code - (define (set-exit-handler) + (define (set-ducttape-log-exit-handler) (let ((orig-exit-handler (exit-handler))) (exit-handler (lambda (exitcode) (ducttape-append-logfile 'note (format #f "Exit ~A by sys.exit" exitcode) #t) (orig-exit-handler exitcode))))) - (set-exit-handler) - - ;; TODO: hook exception handler so we can log exception before we sign off. + (define (idbg first-message . rest-args) (let* ((debug-level-threshold (if (> (length rest-args) 0) (car rest-args) 1)) (message-list @@ -615,71 +601,10 @@ (if (file-execute-access? candidate) candidate (loop next-rest))))))) - - - ;; (define (launch-repl ) - ;; (use linenoise) - ;; (current-input-port (make-linenoise-port)) - - ;; (let ((histfile (conc (or (get-environment-variable "HOME") ".") "/." (script-name) "-hist"))) - - ;; (set-history-length! 30000) - - ;; (load-history-from-file histfile) - - ;; (let loop ((l (linenoise "> "))) - ;; (cond ((equal? l "bye") - ;; (save-history-to-file histfile) - ;; "Bye!") - ;; ((eof-object? l) - ;; (save-history-to-file histfile) - ;; (exit)) - ;; (else - ;; (display l) - ;; (handle-exceptions exn - ;; ;;(print-call-chain (current-error-port)) - ;; (let ((message ((condition-property-accessor 'exn 'message) exn))) - ;; (print "exn> " message ) - ;; ;;(pp (condition->list exn)) - ;; ;;(exit) - ;; ;;(display "Went wrong") - ;; (newline)) - ;; (print (eval l))))) - ;; (newline) - ;; (history-add l) - ;; (loop (linenoise "> "))))) - - ;; (define (launch-repl2 ) - ;; (use readline) - ;; (use apropos) - ;; (use trace) - ;; ;(import csi) - ;; (current-input-port (make-readline-port (conc (script-name) "> ") "... ")) - ;; ; (install-history-file #f (conc (or (get-environment-variable "HOME") ".") "/." (script-name) "_history")) - ;; (parse-and-bind "set editing-mode emacs") - ;; (install-history-file) - ;; (let loop ((foo #f)) - - ;; (let ((expr (read))) - ;; (cond - ;; ((eof-object? expr) (exit)) - ;; (else - ;; (handle-exceptions exn - ;; ;;(print-call-chain (current-error-port)) - ;; (let ((message ((condition-property-accessor 'exn 'message) exn))) - ;; (print "exn> " message ) - ;; ;;(pp (condition->list exn)) - ;; ;;(exit) - ;; ;;(display "Went wrong") - ;; (newline)) - ;; (print (eval expr)))))) - ;; (loop #f)) - ;; ) - ;;;; process command line options ;; get command line switches (have no subsequent arg; eg. [-foo]) ;; assumes these are switches without arguments ;; will return list of matches @@ -739,11 +664,13 @@ ;; recognize ducttape-lib command line switches (--quiet, --silent, --color, -d.., -dp.., -logfile) ;; - reset parameters; reset DUCTTAPE_* env vars to match user specified intent ;; - mutate (command-line-arguments) parameter to subtract these recognized and handled switches ;; * beware -- now (argv) and (command-line-arguments) are inconsistent... cannot mutate (argv) alas. Use (command-line-arguments) - (define (process-command-line) + ;; WARNING: this defines command line arguments that may clash with your program. Only call this if you + ;; are sure they can coexist. + (define (ducttape-process-command-line) ;; --quiet (let ((quiet-opts (skim-cmdline-opts-noarg-by-regex "--?quiet"))) (if (not (null? quiet-opts)) (begin @@ -803,10 +730,18 @@ (if (not (null? debugpat-opts)) (begin (ducttape-debug-regex-filter (string-join debugpat-opts "|")) (setenv "DUCTTAPE_DEBUG_PATTERN" (ducttape-debug-regex-filter)))))) + + ;;; following code commented out; side effects not wanted on startup + ;; immediately activate logfile (will be noop if logfile disabled) + ;;(ducttape-activate-logfile) + ;;(set-ducttape-log-exit-handler) + + ;; TODO: hook exception handler so we can log exception before we sign off. + ;; handle command line immediately; - (process-command-line) + ;;(process-command-line) ) ; end module Index: ducttape/test_ducttape.scm ================================================================== --- ducttape/test_ducttape.scm +++ ducttape/test_ducttape.scm @@ -30,11 +30,11 @@ (define (reset-ducttape-with-cmdline-list cmdline-list) (reset-ducttape) (command-line-arguments cmdline-list) - (process-command-line) + (ducttape-process-command-line) ) (define (direct-iputs-test) (ducttape-color-mode #f) @@ -134,11 +134,11 @@ (let ((expected-code (if (equal? systype "Darwin") 1 2)) (expected-err (if (equal? systype "Darwin") "ls: /zzzzz: No such file or directory" - "/bin/ls: cannot access /zzzzz: No such file or directory")) + "/bin/ls: .* /zzzzz: No such file or directory")) ) (test "isys: /bin/ls /zzzzz should have exit code 2" expected-code ec) (test "isys: /bin/ls /zzzzz should have empty stdout" "" o) (test