touch: New builtin.

* gash/commands/touch.scm: New file.
* build-aux/build-guile.sh: Compile it.
* configure: Create script.
* gash/bournish-commands.scm (touch-command): New variable.
(%bournish-commands): Add it.

build-aux/build-guile.sh

@@ -62,6 +62,7 @@ ${srcdest}gash/commands/rm.scm
 ${srcdest}gash/commands/rmdir.scm
 ${srcdest}gash/commands/sed.scm
 ${srcdest}gash/commands/tar.scm
+${srcdest}gash/commands/touch.scm
 ${srcdest}gash/commands/wc.scm
 ${srcdest}gash/commands/which.scm
 
@@ -82,6 +83,7 @@ ${srcdest}bin/rm
 ${srcdest}bin/rmdir
 ${srcdest}bin/sed
 ${srcdest}bin/tar
+${srcdest}bin/touch
 ${srcdest}bin/wc
 ${srcdest}bin/which
 "

configure

@@ -102,6 +102,7 @@ rm
 rmdir
 sed
 tar
+touch
 wc 
 which
 "

gash/bournish-commands.scm

@@ -41,6 +41,7 @@
   #:use-module (gash commands rm)
   #:use-module (gash commands sed)
   #:use-module (gash commands tar)
+  #:use-module (gash commands touch)
   #:use-module (gash commands wc)
   #:use-module (gash commands which)
 
@@ -83,6 +84,7 @@
 (define rmdir-command (wrap-command "rmdir" rmdir))
 (define sed-command (wrap-command "sed" sed))
 (define tar-command (wrap-command "tar" tar))
+(define touch-command (wrap-command "touch" touch))
 (define wc-command (wrap-command "wc" wc))
 (define which-command (wrap-command "which" which))
 
@@ -100,6 +102,7 @@
     ("rmdir"    . ,rmdir-command)
     ("sed"      . ,sed-command)
     ("tar"      . ,tar-command)
+    ("touch"    . ,touch-command)
     ("wc"       . ,wc-command)
     ("which"    . ,which-command)
     ))

gash/commands/chmod.scm

@@ -49,7 +49,6 @@
             (executable (single-char #\x))
             (xecutable (single-char #\X))))
 	 (options (getopt-long args option-spec))
-	 (files (option-ref options '() '()))
 	 (help? (option-ref options 'help #f))
          (version? (option-ref options 'version #f))
          (files (option-ref options '() '()))
@@ -74,7 +73,7 @@ With --reference, change the mode of each FILE to that of RFILE.
 Options:
       --help              display this help and exit
   -R, --recursive         change files and directories recursively
-      --reference=RFILE   use RFILE's mode instead of MODE values
+      --reference=FILE    use FILE's mode instead of MODE values
       --version           output version information and exit
 
 Each MODE is of the form '[ugoa]*([-+=]([rwxXst]*|[ugo]))+|[-+=][0-7]+'.

gash/commands/touch.scm

@@ -0,0 +1,85 @@
+;;; Gash -- Guile As SHell
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Gash.
+;;;
+;;; Gash is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Gash is distributed in the hope that it will be useful, but WITHOUT ANY
+;;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+;;; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
+;;; details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Gash.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(define-module (gash commands touch)
+  #:use-module (ice-9 getopt-long)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 regex)
+
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-26)
+
+  #:use-module (gash config)
+  #:use-module (gash guix-utils)
+  #:use-module (gash shell-utils)
+
+  #:export (
+            touch
+            ))
+
+(define (create-or-touch file time)
+  (let ((exists? (file-exists? file)))
+    (when (not exists?) (with-output-to-file file (cut display "")))
+    (cond (time (utime file time time))
+          (exists? (let ((time (current-time)))
+                     (utime file time time))))))
+
+(define (parse-date string)
+  (if (string-prefix? "@" string)
+      (string->number (substring string 1))
+      (error (format #f "touch: cannot parse date:~a\n" string))))
+
+(define (touch . args)
+  (let* ((option-spec
+	  '((date (single-char #\d) (value #t))
+            (help (single-char #\h))
+            (reference (single-char #\r) (value #t))
+            (version (single-char #\V))))
+	 (options (getopt-long args option-spec))
+	 (help? (option-ref options 'help #f))
+         (version? (option-ref options 'version #f))
+         (date (option-ref options 'date #f))
+         (reference (option-ref options 'reference #f))
+	 (files (option-ref options '() '()))
+         (usage? (and (not help?) (null? files))))
+    (cond (version? (format #t "touch (GASH) ~a\n" %version) (exit 0))
+          ((or help? usage?) (format (if usage? (current-error-port) #t)
+                                     "\
+Usage: touch [OPTION]... FILE...
+Update the access and modification times of each FILE to the current time.
+
+Options:
+  -d, --date=DATE         parse DATE and use it instead of current time
+      --help              display this help and exit
+  -r, --reference=FILE    use FILE's times instead of current time
+      --version           output version information and exit
+
+Each MODE is of the form '[ugoa]*([-+=]([rwxXst]*|[ugo]))+|[-+=][0-7]+'.
+")
+           (exit (if usage? 2 0)))
+          (else
+           (let ((time (and=> date parse-date)))
+             (for-each (cut create-or-touch <> time) files))))))
+
+(define main touch)