Last Modified: Thu Oct 5 11:49:37 2006
| ||
; Convert a list of scheme objects into mooix's string representation ; numbers, strings, mooix objects, ?? are OK (define (scheme->mooix-string slist) (display ; map the elements of slist into a list of newline-terminated mooix strings, which we then output (map (lambda (x) (cond ((string? x) (string-join x "\n") ((number? x) (string-join (number->string x) "\n") ; If x is a procedure, then either it's a mooix object or an error ((procedure? x) (let ((dir (x "dir"))) (if (directory? dir) (string-join "mooix:" dir "\n") (and (display "Procedure which is not a mooix object not a legal return value." (current-error-port)) #f) ) ) ) ) ) slist ) ) ) ; Convert a mooix string representation to a list of Scheme objects - numbers, strings, mooix-obj, ?? (define (mooix-string->scheme mstring) ; Read all STDIN lines, and map each into a Scheme object, returning the resulting list (map (lambda (x) (let ( (num (string->number x)) (mobj (string-prefix? "mooix:" x))) (cond ((not (equal? num #f)) num ) (mobj (mooix-obj (string-copy x 7) ) ) ; Return all others as strings (else x) ) ) ) (read-string) ) ; Retrieve or set a file-based field (define (file-field this method args) (let ( (num (length args)) (file (this "fieldfile" (list method))) ) ; Behaviour is based on number of arguments; zero means return the file, one means set it, more is an error (cond ((= num 0) (read-string file) ) ((= num 1) (display (car args) (open-output-file file)) ) (else (and (display "Non-method field " method " on object mooix:" (make-absolute-pathname (this "dir")) " passed more than one argument.\n" (current-error-port)) #f)) ) ) ; ********** ; Regular dispatch table methods follow ; ********** ; Returns #t iff the first argument is in the built-in mooix object method list (that is, in dispatch-table), else returns #f (define (can-dispatch this args) (if (equal? #f (assoc (car args) dispatch-table)) #f #t ) ) (define (get this args) (mooix-obj (car args)) ) (define (hybridgetfield this args) (let* ( (field (car args)) (file (this "fieldfile" args)) (dot (string-prefix? "." field)) ; True if not a symlink or dir (reg (regular-file? file)) (exe (file-execute-access? file)) (hybrid (this "test" (list (string-join "." field "-hybrid")))) ) (and file dot reg (or (not exe) (and exe hybrid)) ; NB: this relies on file fields and methods never being able to return #f as *data* - if that changes (and it seems a piss-poor idea to change it) this will need to be looked at again (this (car args)) ) ) ) ; Get the field named and return a boolean based on treating its value as Perl/C true/false (TODO: empty string, no such file, and 0 are false, else true) (define (test this args) (let ( (file (this "fieldfile" args)) ) (cond ((equal? file "") #f) ((not (file-exists? file)) #f) (else (let* ( (string (this (car args))) (num (string->number string)) ) (cond ((and num (= 1 num)) #t) ((not (equal? string "")) #t) (else #f) ) )) ) ) ) |
||