cat: Support multiple arguments, support "-"

* gash/bournish-commands.scm (cat-implementation): Support multiple
  arguments, support "-".
  (wrap-command): New function.

gash/bournish-commands.scm

@@ -36,6 +36,7 @@
             rm-command
             wc-command
             which-command
+            wrap-command
             ))
 
 ;;; Commentary:
@@ -49,13 +50,13 @@
 ;;;
 ;;; Code:
 
-(define (expand-variable str)
+(define (wrap-command command name)
-  "Return STR or code to obtain the value of the environment variable STR
+  (lambda args
-refers to."
+    (catch #t
-  ;; XXX: No support for "${VAR}".
+      (cut apply command args)
-  (if (string-prefix? "$" str)
+      (lambda (key . args)
-      `(or (getenv ,(string-drop str 1)) "")
+        (format (current-error-port) "~a: ~a ~a\n" name key args)
-      str))
+        1))))
 
 (define* (display-tabulated lst
                             #:key
@@ -125,30 +126,30 @@ TERMINAL-WIDTH.  Use COLUMN-GAP spaces between two subsequent columns."
                               files)))
        (display-tabulated files)))))
 
-(define (ls-command . files)
+(define ls-command (wrap-command ls-command-implementation "ls"))
-  (apply ls-command-implementation files))
 
 (define (which-command program . rest)
   (stdout (search-path (executable-path) program)))
 
-(define (cat-command file . rest)
+(define (cat-command-implementation . args)
-  (call-with-input-file file
+  (fold (lambda (file p)
-    (lambda (port)
+          (if (string=? file "-") (dump-port (current-input-port) (current-output-port))
-      (dump-port port (current-output-port))
+            (call-with-input-file file
-      *unspecified*)))
+              (lambda (port)
+                (dump-port port (current-output-port))))))
+        0 args))
 
-(define (rm-command . args)
+(define cat-command (wrap-command cat-command-implementation "cat"))
+
+(define (rm-command-implementation . args)
   "Emit code for the 'rm' command."
-  (catch #t
+  (cond ((member "-r" args)
-       (lambda _
+         (for-each delete-file-recursively
-         (cond ((member "-r" args)
+                   (apply delete (cons "-r" args))))
-                (for-each delete-file-recursively
+        (else
-                          (apply delete (cons "-r" args))))
+         (for-each delete-file args))))
-               (else
+
-                (for-each delete-file args))))
+(define rm-command (wrap-command rm-command-implementation "rm"))
-    (lambda (key . args)
-      (format (current-error-port) "rm: ~a ~a\n" key args)
-      1)))
 
 (define (lines+chars port)
   "Return the number of lines and number of chars read from PORT."

gash/gash.scm

@@ -257,14 +257,10 @@ mostly works, pipes work, some redirections work.
     (display "\nIt features the following, somewhat naive builtin commands\n")
     (display-tabulated (map car %commands))))
 
-(define (cp-command source dest . rest)
+(define (cp-command-implementation source dest . rest)
-  (catch #t
+  (copy-file source dest))
-    (lambda _
+
-      (copy-file source dest)
+(define cp-command (wrap-command cp-command-implementation "cp"))
-      0)
-    (lambda (key . args)
-      (format (current-error-port) "cp: ~a ~a\n" key args)
-      1)))
 
 (define (set-shell-opt! name set?)
   (let* ((shell-opts (assoc-ref global-variables "SHELLOPTS"))