Added file-mode library from S48.

NEWS

@@ -1,5 +1,6 @@
 version 0.6
 *
+New scsh libraries: file-mode
 
 version 0.5 2003-11-19
 * New s48 libraries: procedure-tables.

scsh/file-mode/AUTHORS

@@ -0,0 +1,2 @@
+Richard Kelsey (port to sunterlib by Martin Gasbichler)
+

scsh/file-mode/BLURB

@@ -0,0 +1 @@
+file-mode: Data type for file mode (copied from Scheme 48)

scsh/file-mode/README

@@ -0,0 +1,55 @@
+The structure FILE-MODE implements a data type for file modes. The
+code is copied verbatim from Scheme 48 0.57.
+
+
+A file mode is a boxed integer representing a file protection mask.
+
+    * (file-mode permission-name ...) -> file-mode 	syntax
+    * (file-mode? x) -> boolean 
+    * (file-mode+ file-mode ...) -> file-mode 
+    * (file-mode- file-mode0 file-mode1) -> file-mode  
+
+FILE-MODE is syntax for creating file modes. The mode-names are listed
+below. FILE-MODE? is a predicate for file modes. FILE-MODE+ returns a
+mode that contains all of permissions of its arguments. FILE-MODE-
+returns a mode that has all of the permissions of FILE-MODE0 that are
+not in FILE-MODE1.
+
+    * (file-mode=? file-mode0 file-mode1) -> boolean 
+    * (file-mode<=? file-mode0 file-mode1) -> boolean 
+    * (file-mode>=? file-mode0 file-mode1) -> boolean  
+
+FILE-MODE=? returns true if the two modes are exactly the
+same. FILE-MODE<=? returns true if FILE-MODE0 has a subset of the
+permissions of FILE-MODE1. FILE-MODE>=? is FILE-MODE<=? with the
+arguments reversed.
+
+    * (file-mode->integer file-mode) -> integer 
+    * (integer->file-mode integer) -> file-mode  
+
+INTEGER->FILE-MODE and FILE-MODE->INTEGER translate file modes to and
+from the classic Unix file mode masks. These may not be the masks used
+by the underlying OS.
+
+    Permission name 	Bit mask
+    set-uid 	#o4000 	set user id when executing
+    set-gid 	#o2000 	set group id when executing
+    owner-read 	#o0400 	read by owner
+    owner-write 	#o0200 	write by owner
+    owner-exec 	#o0100 	execute (or search) by owner
+    group-read 	#o0040 	read by group
+    group-write 	#o0020 	write by group
+    group-exec 	#o0010 	execute (or search) by group
+    other-read 	#o0004 	read by others
+    other-write 	#o0002 	write by others
+    other-exec 	#o0001 	execute (or search) by others
+
+    Names for sets of permissions
+    owner 	#o0700 	read, write, and execute by owner
+    group 	#o0070 	read, write, and execute by group
+    other 	#o0007 	read, write, and execute by others
+    read 	#o0444 	read by anyone
+    write 	#o0222 	write by anyone
+    exec 	#o0111 	execute by anyone
+    all 	#o0777 	anything by anyone
+

scsh/file-mode/file-mode.scm

@@ -0,0 +1,100 @@
+; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
+
+
+(define-record-type file-mode :file-mode
+  (really-make-file-mode value)
+  file-mode?
+  (value file-mode->integer))
+
+(define-record-discloser :file-mode
+  (lambda (file-mode)
+    (list 'file-mode
+	  (string-append "0"
+			 (number->string (file-mode->integer file-mode)
+					 8)))))
+
+
+; STUFF can be a number (#o644), a string ("rwxr--r--"), or ???
+; Or should there be another macro?
+;
+; For now it has to be a number
+
+(define (integer->file-mode stuff)
+  (cond ((and (integer? stuff)
+	      (<= 0 stuff)
+	      (<= stuff #o7777))
+	 (really-make-file-mode stuff))
+	(else
+	 (error "invalid argument to integer->file-mode" stuff))))
+
+; Arithmetic
+
+(define (file-mode+ . modes)
+  (do ((i 0 (bitwise-ior i (file-mode->integer (car modes))))
+       (modes modes (cdr modes)))
+      ((null? modes)
+       (integer->file-mode i))))
+
+(define (file-mode- mode1 mode2)
+  (integer->file-mode (bitwise-and (file-mode->integer mode1)
+				   (bitwise-not (file-mode->integer mode2)))))
+
+; Comparisons
+
+(define (file-mode=? mode1 mode2)
+  (= (file-mode->integer mode1)
+     (file-mode->integer mode2)))
+
+(define (file-mode<=? mode1 mode2)
+  (= 0 (bitwise-and (file-mode->integer mode1)
+		    (bitwise-not (file-mode->integer mode2)))))
+
+(define (file-mode>=? mode1 mode2)
+  (file-mode<=? mode2 mode1))
+
+; Names for various permissions
+
+(define-syntax file-mode
+  (lambda (e r c)
+    (let* ((names '((set-uid     . #o4000)
+		    (set-gid     . #o2000)
+
+		    (owner-read  . #o0400)
+		    (owner-write . #o0200)
+		    (owner-exec  . #o0100)
+		    (owner       . #o0700)
+
+		    (group-read  . #o0040)
+		    (group-write . #o0020)
+		    (group-exec  . #o0010)
+		    (group       . #o0070)
+
+		    (other-read  . #o0004)
+		    (other-write . #o0002)
+		    (other-exec  . #o0001)
+		    (other       . #o0007)
+
+		    (read        . #o0444)
+		    (write       . #o0222)
+		    (exec        . #o0111)
+		    (all	 . #o0777)))
+	   (lookup (lambda (name)
+		     (let loop ((names names))
+		       (cond ((null? names)
+			      #f)
+			     ((c name (caar names))
+			      (cdar names))
+			     (else
+			      (loop (cdr names))))))))
+      (if (or (null? (cdr e))
+	      (not (pair? (cdr e))))
+	  e
+	  (let loop ((todo (cdr e)) (mask 0))
+	    (cond ((null? todo)
+		   `(,(r 'integer->file-mode) ,mask))
+		  ((and (pair? todo)
+			(lookup (car todo)))
+		   => (lambda (i)
+			(loop (cdr todo) (bitwise-ior i mask))))
+		  (else
+		   e)))))))

scsh/file-mode/interfaces.scm

@@ -0,0 +1,6 @@
+(define-interface file-modes-interface
+  (export file-mode?
+	  (file-mode :syntax)
+	  file-mode+ file-mode-
+	  file-mode=? file-mode<=? file-mode>=?
+	  file-mode->integer integer->file-mode))

scsh/file-mode/packages.scm

@@ -0,0 +1,7 @@
+(define-structure file-modes file-modes-interface
+  (open scheme
+	define-record-types
+	signals
+	bitwise)
+  (for-syntax (open scheme bitwise))
+  (files file-mode))