mes: Remove copy of make-string.
[mes.git] / mes / module / mes / guile.mes
index ab1e2455438557b058aa731401d6189bd3c0316f..30c9b1dd65a40e7539b587dc2fe3c786e20dc9dc 100644 (file)
 
 (define (drain-input port) (read-string))
 
-(define (make-string n . fill)
-  (list->string (apply make-list n fill)))
+(define (read-line . rest)
+  (let* ((port (if (pair? rest) (car rest) (current-input-port)))
+         (handle-delim (if (and (pair? rest) (pair? (cdr rest))) (cadr rest) 'trim))
+         (c (read-char port)))
+    (if (eof-object? c) c
+        (list->string
+         (let loop ((c c))
+           (if (or (eof-object? c) (eq? c #\newline)) (case handle-delim
+                                                        ((trim) '())
+                                                        ((concat) '(#\newline))
+                                                        (else (error (format #f "not supported: handle-delim=~a" handle-delim))))
+               (cons c (loop (read-char port)))))))))
 
 (define (object->string x . rest)
   (with-output-to-string
           (set-current-output-port save)
           r))))
 
+(define (with-error-to-file file thunk)
+  (let ((port (open-output-file file)))
+    (if (= port -1)
+        (error 'cannot-open file)
+        (let* ((save (current-error-port))
+               (foo (set-current-error-port port))
+               (r (thunk)))
+          (set-current-error-port save)
+          r))))
+
 (define (with-output-to-port port thunk)
   (let* ((save (current-output-port))
          (foo (set-current-output-port port))
     port))
 
 (define (dirname file-name)
-  (let ((lst (filter (negate string-null?) (string-split file-name #\/))))
-    (if (<= (length lst) 1) "."
-        (string-join (list-head lst (1- (length lst))) "/"))))
+  (let* ((lst (string-split file-name #\/))
+         (lst (filter (negate string-null?) lst)))
+    (if (null? lst) (if (string-prefix? "/" file-name) "/" ".")
+        (let ((dir (string-join (list-head lst (1- (length lst))) "/")))
+          (if (string-prefix? "/" file-name) (string-append "/" dir)
+              (if (string-null? dir) "."
+                  dir))))))
 
 ;; FIXME: c&p from display
 (define (with-output-to-string thunk)
     (if destination (simple-format lst rest)
         (with-output-to-string
           (lambda () (simple-format lst rest))))))
+
 (define format simple-format)
+
+(define (file-exists? o)
+  (access? o R_OK))