Rename MUX.

--HG--
rename : examples/mux.lisp => examples/mux-translator.lisp
rename : examples/run-mux.lisp => examples/mux.lisp

4 files changed, 182 insertions, 181 deletions

diff --git a/examples/mux-translator.asd b/examples/mux-translator.asd
index 0292ad61a..2a2259a29 100644
--- a/examples/mux-translator.asd
+++ b/examples/mux-translator.asd
@@ -13,4 +13,5 @@
   :license "GPL v3.0"
   :description "A multiplexer translator."
   :depends-on (:tree-translator :split-sequence :trivial-garbage)
-  :components ((:file "mux")))
+  :components ((:file "mux-translator")))
+
diff --git a/examples/mux-translator.lisp b/examples/mux-translator.lisp
new file mode 100644
index 000000000..498846a5f
--- /dev/null
+++ b/examples/mux-translator.lisp
@@ -0,0 +1,173 @@
+
+(defpackage :mux-translator
+  (:use :cl :hurd-common :mach
+        :hurd :hurd-translator
+        :hurd-tree-translator
+        :split-sequence))
+
+(in-package :mux-translator)
+
+(defconstant +file-list+ (first ext:*args*))
+(defconstant +class-command+ (second ext:*args*))
+
+(defclass mux-translator (tree-translator)
+  ((timestamp :initform nil
+              :initarg :timestamp
+              :accessor timestamp)))
+
+(defclass mux-entry (entry)
+  ((port :initarg :port
+         :initform nil
+         :accessor port)))
+
+(define-callback read-file mux-translator
+                 (node user start amount stream)
+  (when (has-access-p node user :read)
+    (let ((data (io-read (port node)
+                         :amount amount
+                         :offset start)))
+      (when data
+        (write-sequence data stream))
+      t)))
+
+(define-callback write-file mux-translator
+                 (node user offset stream amount)
+  (unless (has-access-p node user :write)
+    (return-from write-file nil))
+  (when (is-dir-p (stat node))
+    (return-from write-file :is-a-directory))
+  (let ((arr (make-array amount :element-type '(unsigned-byte 8))))
+    (read-sequence arr stream)
+    (let ((ret (io-write (port node)
+                         arr
+                         :offset offset)))
+      (cond
+        ((numberp ret)
+         (setf (stat node) (io-stat (port node)))
+         t)
+        (t ret)))))
+
+(define-callback file-change-size mux-translator
+                 (node user new-size)
+  (when (is-dir-p (stat node))
+    (return-from file-change-size :is-a-directory))
+  (unless (has-access-p node user :write)
+    (return-from file-change-size :operation-denied))
+  (let ((err (file-set-size (port node) new-size)))
+    (when (eq err t)
+      (setf (stat node) (io-stat (port node))))
+    err))
+
+(define-callback create-directory mux-translator
+                 (node user name mode)
+  (declare (ignore node user name mode))
+  nil)
+
+(define-callback remove-directory-entry mux-translator
+				 (node user name)
+  (declare (ignore node user name))
+  nil)
+
+(define-callback create-hard-link mux-translator
+                 (dir user file name)
+  (declare (ignore dir user file name))
+  nil)
+
+(define-callback file-rename mux-translator
+                 (user old-dir old-name new-dir new-name)
+  (declare (ignore user old-dir old-name new-dir new-name))
+  nil)
+
+(define-callback allow-link-p mux-translator
+                 (node user)
+  (declare (ignore node user))
+  nil)
+
+(define-callback create-symlink mux-translator
+                 (node user target)
+  (declare (ignore node user target))
+  nil)
+
+(define-callback refresh-node mux-translator
+                 (node user)
+  (declare (ignore node user))
+  (let ((new-timestamp (get-timestamp)))
+    (when (time-value-newer-p new-timestamp (timestamp translator))
+      (let ((root (root *translator*)))
+        (clear-dir root)
+        (mirror-file-list root)
+        (setf (timestamp *translator*) new-timestamp)
+        t))))
+
+(defun read-file-lines (file)
+  "Return a list of lines in file 'file'."
+  (with-open-file (stream file)
+    (loop for line = (read-line stream nil)
+          while line
+          collect line)))
+
+(defun classify-node (file)
+  (let ((cmd (concatenate-string +class-command+ " " file)))
+    (with-stream (stream
+                   (ext:make-pipe-input-stream cmd))
+      (split-sequence #\/ (read-line stream nil)))))
+
+(defun file-basename (file)
+  (first (last
+           (split-sequence #\/ file))))
+
+(defun mirror-file (node dir-list full-name name port)
+  (let ((last-p (null dir-list)))
+    (cond
+      (last-p
+        (let ((file-stat (io-stat port)))
+          (let ((entry (make-instance 'mux-entry
+                                      :stat file-stat
+                                      :parent node
+                                      :port port)))
+            (tg:finalize entry (lambda () (port-deallocate port)))
+            (add-entry node entry name))))
+      (t
+        (let ((dir-name (first dir-list))
+              (rest-dir-name (rest dir-list)))
+          (let ((found (get-entry node dir-name)))
+            (cond
+              ((and found
+                    (not (is-dir-p (stat found))))
+               (warn "~s could not be classified" full-name)
+               (port-deallocate port)
+               (return-from mirror-file nil))
+              ((not found)
+               (setf found (make-instance 'dir-entry
+                                          :parent node
+                                          :stat (make-stat (stat node))))
+               (add-entry node found dir-name)))
+            (mirror-file found rest-dir-name full-name name port)))))))
+
+(defun mirror-file-list (node)
+  (loop for file in (read-file-lines +file-list+)
+        do (let ((port (file-name-lookup file
+                                         :flags '(:read :write :exec))))
+             (when (port-valid-p port)
+               (mirror-file node
+                            (classify-node file)
+                            file
+                            (file-basename file)
+                            port)))))
+
+(define-callback fill-root-node mux-translator
+                 ((node dir-entry))
+  (mirror-file-list node))
+
+(defun get-timestamp ()
+  (with-port-deallocate (port (file-name-lookup +file-list+ :flags '(:read :notrans)))
+    (stat-get (io-stat port) 'st-mtime)))
+
+(defun main ()
+  (let ((translator (make-instance 'mux-translator
+                                   :name "mux-translator"
+                                   :timestamp (get-timestamp))))
+    (run-translator translator)))
+
+(main)
+
diff --git a/examples/mux.lisp b/examples/mux.lisp
index 498846a5f..0ffb32427 100644..100755
--- a/examples/mux.lisp
+++ b/examples/mux.lisp
@@ -1,173 +1,10 @@
+#!/usr/bin/run-lisp-trans
+;
+; settrans -ac foo ./mux.lisp file-list command
+;
 
-(defpackage :mux-translator
-  (:use :cl :hurd-common :mach
-        :hurd :hurd-translator
-        :hurd-tree-translator
-        :split-sequence))
+(unless (= (length ext:*args*) 2)
+  (error "Argument syntax: <file list> <classification command>"))
 
-(in-package :mux-translator)
-
-(defconstant +file-list+ (first ext:*args*))
-(defconstant +class-command+ (second ext:*args*))
-
-(defclass mux-translator (tree-translator)
-  ((timestamp :initform nil
-              :initarg :timestamp
-              :accessor timestamp)))
-
-(defclass mux-entry (entry)
-  ((port :initarg :port
-         :initform nil
-         :accessor port)))
-
-(define-callback read-file mux-translator
-                 (node user start amount stream)
-  (when (has-access-p node user :read)
-    (let ((data (io-read (port node)
-                         :amount amount
-                         :offset start)))
-      (when data
-        (write-sequence data stream))
-      t)))
-
-(define-callback write-file mux-translator
-                 (node user offset stream amount)
-  (unless (has-access-p node user :write)
-    (return-from write-file nil))
-  (when (is-dir-p (stat node))
-    (return-from write-file :is-a-directory))
-  (let ((arr (make-array amount :element-type '(unsigned-byte 8))))
-    (read-sequence arr stream)
-    (let ((ret (io-write (port node)
-                         arr
-                         :offset offset)))
-      (cond
-        ((numberp ret)
-         (setf (stat node) (io-stat (port node)))
-         t)
-        (t ret)))))
-
-(define-callback file-change-size mux-translator
-                 (node user new-size)
-  (when (is-dir-p (stat node))
-    (return-from file-change-size :is-a-directory))
-  (unless (has-access-p node user :write)
-    (return-from file-change-size :operation-denied))
-  (let ((err (file-set-size (port node) new-size)))
-    (when (eq err t)
-      (setf (stat node) (io-stat (port node))))
-    err))
-
-(define-callback create-directory mux-translator
-                 (node user name mode)
-  (declare (ignore node user name mode))
-  nil)
-
-(define-callback remove-directory-entry mux-translator
-				 (node user name)
-  (declare (ignore node user name))
-  nil)
-
-(define-callback create-hard-link mux-translator
-                 (dir user file name)
-  (declare (ignore dir user file name))
-  nil)
-
-(define-callback file-rename mux-translator
-                 (user old-dir old-name new-dir new-name)
-  (declare (ignore user old-dir old-name new-dir new-name))
-  nil)
-
-(define-callback allow-link-p mux-translator
-                 (node user)
-  (declare (ignore node user))
-  nil)
-
-(define-callback create-symlink mux-translator
-                 (node user target)
-  (declare (ignore node user target))
-  nil)
-
-(define-callback refresh-node mux-translator
-                 (node user)
-  (declare (ignore node user))
-  (let ((new-timestamp (get-timestamp)))
-    (when (time-value-newer-p new-timestamp (timestamp translator))
-      (let ((root (root *translator*)))
-        (clear-dir root)
-        (mirror-file-list root)
-        (setf (timestamp *translator*) new-timestamp)
-        t))))
-
-(defun read-file-lines (file)
-  "Return a list of lines in file 'file'."
-  (with-open-file (stream file)
-    (loop for line = (read-line stream nil)
-          while line
-          collect line)))
-
-(defun classify-node (file)
-  (let ((cmd (concatenate-string +class-command+ " " file)))
-    (with-stream (stream
-                   (ext:make-pipe-input-stream cmd))
-      (split-sequence #\/ (read-line stream nil)))))
-
-(defun file-basename (file)
-  (first (last
-           (split-sequence #\/ file))))
-
-(defun mirror-file (node dir-list full-name name port)
-  (let ((last-p (null dir-list)))
-    (cond
-      (last-p
-        (let ((file-stat (io-stat port)))
-          (let ((entry (make-instance 'mux-entry
-                                      :stat file-stat
-                                      :parent node
-                                      :port port)))
-            (tg:finalize entry (lambda () (port-deallocate port)))
-            (add-entry node entry name))))
-      (t
-        (let ((dir-name (first dir-list))
-              (rest-dir-name (rest dir-list)))
-          (let ((found (get-entry node dir-name)))
-            (cond
-              ((and found
-                    (not (is-dir-p (stat found))))
-               (warn "~s could not be classified" full-name)
-               (port-deallocate port)
-               (return-from mirror-file nil))
-              ((not found)
-               (setf found (make-instance 'dir-entry
-                                          :parent node
-                                          :stat (make-stat (stat node))))
-               (add-entry node found dir-name)))
-            (mirror-file found rest-dir-name full-name name port)))))))
-
-(defun mirror-file-list (node)
-  (loop for file in (read-file-lines +file-list+)
-        do (let ((port (file-name-lookup file
-                                         :flags '(:read :write :exec))))
-             (when (port-valid-p port)
-               (mirror-file node
-                            (classify-node file)
-                            file
-                            (file-basename file)
-                            port)))))
-
-(define-callback fill-root-node mux-translator
-                 ((node dir-entry))
-  (mirror-file-list node))
-
-(defun get-timestamp ()
-  (with-port-deallocate (port (file-name-lookup +file-list+ :flags '(:read :notrans)))
-    (stat-get (io-stat port) 'st-mtime)))
-
-(defun main ()
-  (let ((translator (make-instance 'mux-translator
-                                   :name "mux-translator"
-                                   :timestamp (get-timestamp))))
-    (run-translator translator)))
-
-(main)
+(asdf:operate 'asdf:load-op 'mux-translator)
 
diff --git a/examples/run-mux.lisp b/examples/run-mux.lisp
deleted file mode 100755
index a6b84bb48..000000000
--- a/examples/run-mux.lisp
+++ /dev/null
@@ -1,10 +0,0 @@
-#!/usr/bin/run-lisp-trans
-;
-; settrans -ac foo ./run-mux.lisp file-list command
-;
-
-(unless (= (length ext:*args*) 2)
-  (error "Argument syntax: <file list> <classification command>"))
-
-(asdf:operate 'asdf:load-op 'mux-translator)
-