Rename MOD.

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

4 files changed, 190 insertions, 189 deletions

diff --git a/examples/mod-translator.asd b/examples/mod-translator.asd
index dc399e99a..b3de035bf 100644
--- a/examples/mod-translator.asd
+++ b/examples/mod-translator.asd
@@ -13,4 +13,5 @@
   :license "GPL v3.0"
   :description "Translator that watches for changes in the underlying node."
   :depends-on (:tree-translator)
-  :components ((:file "mod")))
+  :components ((:file "mod-translator")))
+
diff --git a/examples/mod-translator.lisp b/examples/mod-translator.lisp
new file mode 100644
index 000000000..51631953c
--- /dev/null
+++ b/examples/mod-translator.lisp
@@ -0,0 +1,182 @@
+
+(defpackage :mod-translator
+  (:use :cl :hurd-common :mach
+        :hurd :hurd-translator
+        :hurd-tree-translator))
+
+(in-package :mod-translator)
+
+(defconstant +file+ (first ext:*args*))
+
+(defclass mod-translator (tree-translator)
+  ((file-stat :initarg :file-stat
+              :initform nil
+              :accessor file-stat)
+   (dir-stat :initarg :dir-stat
+             :initform nil
+             :accessor dir-stat)
+   (timestamp :initform nil
+              :accessor timestamp
+              :initarg :timestamp)))
+
+(defclass dirty-entry ()
+  ((dirty :initform nil
+          :accessor dirty)))
+
+(defclass mod-entry (dirty-entry entry)
+  ((contents :initarg :data
+             :initform nil
+             :accessor data)))
+
+(defclass mod-dir-entry (dirty-entry dir-entry) ())
+
+(defun %create-data-array (size contents)
+  (make-array size
+              :initial-contents contents
+              :adjustable nil
+              :element-type '(unsigned-byte 8)))
+
+(define-callback allow-open-p mod-translator
+                 (node user flags is-new-p)
+  (declare (ignore is-new-p))
+  (when (flag-is-p flags :write)
+    (return-from allow-open-p nil))
+  (when (flag-is-p flags :read)
+    (unless (has-access-p node user :read)
+      (return-from allow-open-p nil)))
+  t)
+
+(define-callback read-file mod-translator
+                 (node user start amount stream)
+  (when (has-access-p node user :read)
+    (let* ((size (stat-get (stat node) 'st-size))
+           (size-res (- size start)))
+      (unless (plusp size-res)
+        (return-from read-file t))
+      (let* ((total (min size-res amount))
+             (end (+ start total)))
+        (write-sequence (subseq (data node) start end)
+                        stream)
+        ; Also write newline.
+        (write-byte #x0A stream)
+        t))))
+
+(define-callback refresh-node mod-translator
+                 (node user)
+  (declare (ignore node user))
+  (with-port-deallocate (port (file-name-lookup +file+ :flags '(:read :notrans)))
+    (let* ((stat (io-stat port))
+           (new-timestamp (stat-get stat 'st-mtime)))
+      (when (time-value-newer-p new-timestamp (timestamp translator))
+        ; Mark every node as un-visited.
+        (iterate-entries-deep (root translator)
+                              (lambda (name node)
+                                (declare (ignore name))
+                                (setf (dirty node) nil)
+                                t))
+        (%update-data translator
+                      (with-open-file (s +file+) (read s))
+                      (root translator))
+        ; Now remove the nodes we have not visited during the update.
+        (iterate-entries-deep (root translator)
+                              (lambda (name node)
+                                (cond
+                                  ((dirty node) t) ; Keep going down there
+                                  (t
+                                    (remove-dir-entry (parent node)
+                                                      name)
+                                    nil))))
+        (setf (timestamp translator) new-timestamp)))))
+
+(defun %update-data (translator ls node)
+  (let* ((type (first ls))
+         (name (second ls))
+         (args (rest (rest ls)))
+         (found (get-entry node name)))
+    (case type
+      (:dir
+        (when (or (and found
+                       (typep found 'mod-entry))
+                  (not found))
+          (when found
+            (remove-dir-entry node name))
+          (setf found
+                (make-instance 'mod-dir-entry
+                               :stat (make-stat (dir-stat translator))
+                               :parent node))
+          (add-entry node found name))
+        (loop for item in args
+              do (%update-data translator item found)))
+      (:file
+        (let ((data (first args)))
+          (when (or (and found
+                         (typep found 'mod-dir-entry))
+                    (not found))
+            (when found
+              (remove-dir-entry node name))
+            (setf found
+                  (make-instance 'mod-entry
+                                 :stat (make-stat
+                                         (file-stat translator))
+                                 :parent node))
+            (add-entry node found name))
+          ; Update file size.
+          (setf (stat-get (stat found) 'st-size) (length data))
+          ; Update byte array.
+          (setf (data found) (%read-file-data data)))))
+    ; Flag this node as visited.
+    (setf (dirty found) t)))
+
+(defun %read-file-data (str)
+  (%create-data-array (length str)
+                      (loop for char across str
+                            collect (char-code char))))
+
+(defun %fill-node (translator ls node)
+  (let ((type (first ls))
+        (name (second ls))
+        (args (rest (rest ls))))
+    (case type
+      (:dir
+        (let ((dir (make-instance 'mod-dir-entry
+                                  :stat (make-stat (dir-stat translator))
+                                  :parent node)))
+          (add-entry node dir name)
+          (loop for item in args
+                do (%fill-node translator item dir))))
+      (:file
+        (let* ((data (first args))
+               (file (make-instance 'mod-entry
+                                    :stat (make-stat
+                                            (file-stat translator)
+                                            :size (length data))
+                                    :parent node
+                                    :data (%read-file-data data))))
+          (add-entry node file name))))))
+
+(define-callback fill-root-node mod-translator
+                 ((node dir-entry))
+  (setf (file-stat translator)
+        (make-stat (stat node)
+                   :mode (make-mode :perms '((:owner :read)
+                                             (:group :read)))
+                   :type :reg)
+        (dir-stat translator)
+        (make-stat (stat node)
+                   :mode (make-mode :perms '((:owner :read :exec)
+                                             (:group :read :exec)))
+                   :type :dir))
+  (%fill-node translator
+              (with-open-file (s +file+) (read s))
+              node))
+
+(defun main ()
+  (with-port-deallocate (port (file-name-lookup +file+ :flags '(:read)))
+    (let ((translator
+            (make-instance 'mod-translator
+                           :timestamp (stat-get (io-stat port) 'st-mtime)
+                           :name "mod-translator")))
+      (run-translator translator))))
+
+(main)
+
diff --git a/examples/mod.lisp b/examples/mod.lisp
index 51631953c..7d4e041f8 100644..100755
--- a/examples/mod.lisp
+++ b/examples/mod.lisp
@@ -1,182 +1,10 @@
+#!/usr/bin/run-lisp-trans
 
-(defpackage :mod-translator
-  (:use :cl :hurd-common :mach
-        :hurd :hurd-translator
-        :hurd-tree-translator))
+; settrans -ac foo ./mod.lisp spec-file.lisp
+;
 
-(in-package :mod-translator)
+(unless (= (length ext:*args*) 1)
+  (error "You must pass the spec file as an argument."))
 
-(defconstant +file+ (first ext:*args*))
-
-(defclass mod-translator (tree-translator)
-  ((file-stat :initarg :file-stat
-              :initform nil
-              :accessor file-stat)
-   (dir-stat :initarg :dir-stat
-             :initform nil
-             :accessor dir-stat)
-   (timestamp :initform nil
-              :accessor timestamp
-              :initarg :timestamp)))
-
-(defclass dirty-entry ()
-  ((dirty :initform nil
-          :accessor dirty)))
-
-(defclass mod-entry (dirty-entry entry)
-  ((contents :initarg :data
-             :initform nil
-             :accessor data)))
-
-(defclass mod-dir-entry (dirty-entry dir-entry) ())
-
-(defun %create-data-array (size contents)
-  (make-array size
-              :initial-contents contents
-              :adjustable nil
-              :element-type '(unsigned-byte 8)))
-
-(define-callback allow-open-p mod-translator
-                 (node user flags is-new-p)
-  (declare (ignore is-new-p))
-  (when (flag-is-p flags :write)
-    (return-from allow-open-p nil))
-  (when (flag-is-p flags :read)
-    (unless (has-access-p node user :read)
-      (return-from allow-open-p nil)))
-  t)
-
-(define-callback read-file mod-translator
-                 (node user start amount stream)
-  (when (has-access-p node user :read)
-    (let* ((size (stat-get (stat node) 'st-size))
-           (size-res (- size start)))
-      (unless (plusp size-res)
-        (return-from read-file t))
-      (let* ((total (min size-res amount))
-             (end (+ start total)))
-        (write-sequence (subseq (data node) start end)
-                        stream)
-        ; Also write newline.
-        (write-byte #x0A stream)
-        t))))
-
-(define-callback refresh-node mod-translator
-                 (node user)
-  (declare (ignore node user))
-  (with-port-deallocate (port (file-name-lookup +file+ :flags '(:read :notrans)))
-    (let* ((stat (io-stat port))
-           (new-timestamp (stat-get stat 'st-mtime)))
-      (when (time-value-newer-p new-timestamp (timestamp translator))
-        ; Mark every node as un-visited.
-        (iterate-entries-deep (root translator)
-                              (lambda (name node)
-                                (declare (ignore name))
-                                (setf (dirty node) nil)
-                                t))
-        (%update-data translator
-                      (with-open-file (s +file+) (read s))
-                      (root translator))
-        ; Now remove the nodes we have not visited during the update.
-        (iterate-entries-deep (root translator)
-                              (lambda (name node)
-                                (cond
-                                  ((dirty node) t) ; Keep going down there
-                                  (t
-                                    (remove-dir-entry (parent node)
-                                                      name)
-                                    nil))))
-        (setf (timestamp translator) new-timestamp)))))
-
-(defun %update-data (translator ls node)
-  (let* ((type (first ls))
-         (name (second ls))
-         (args (rest (rest ls)))
-         (found (get-entry node name)))
-    (case type
-      (:dir
-        (when (or (and found
-                       (typep found 'mod-entry))
-                  (not found))
-          (when found
-            (remove-dir-entry node name))
-          (setf found
-                (make-instance 'mod-dir-entry
-                               :stat (make-stat (dir-stat translator))
-                               :parent node))
-          (add-entry node found name))
-        (loop for item in args
-              do (%update-data translator item found)))
-      (:file
-        (let ((data (first args)))
-          (when (or (and found
-                         (typep found 'mod-dir-entry))
-                    (not found))
-            (when found
-              (remove-dir-entry node name))
-            (setf found
-                  (make-instance 'mod-entry
-                                 :stat (make-stat
-                                         (file-stat translator))
-                                 :parent node))
-            (add-entry node found name))
-          ; Update file size.
-          (setf (stat-get (stat found) 'st-size) (length data))
-          ; Update byte array.
-          (setf (data found) (%read-file-data data)))))
-    ; Flag this node as visited.
-    (setf (dirty found) t)))
-
-(defun %read-file-data (str)
-  (%create-data-array (length str)
-                      (loop for char across str
-                            collect (char-code char))))
-
-(defun %fill-node (translator ls node)
-  (let ((type (first ls))
-        (name (second ls))
-        (args (rest (rest ls))))
-    (case type
-      (:dir
-        (let ((dir (make-instance 'mod-dir-entry
-                                  :stat (make-stat (dir-stat translator))
-                                  :parent node)))
-          (add-entry node dir name)
-          (loop for item in args
-                do (%fill-node translator item dir))))
-      (:file
-        (let* ((data (first args))
-               (file (make-instance 'mod-entry
-                                    :stat (make-stat
-                                            (file-stat translator)
-                                            :size (length data))
-                                    :parent node
-                                    :data (%read-file-data data))))
-          (add-entry node file name))))))
-
-(define-callback fill-root-node mod-translator
-                 ((node dir-entry))
-  (setf (file-stat translator)
-        (make-stat (stat node)
-                   :mode (make-mode :perms '((:owner :read)
-                                             (:group :read)))
-                   :type :reg)
-        (dir-stat translator)
-        (make-stat (stat node)
-                   :mode (make-mode :perms '((:owner :read :exec)
-                                             (:group :read :exec)))
-                   :type :dir))
-  (%fill-node translator
-              (with-open-file (s +file+) (read s))
-              node))
-
-(defun main ()
-  (with-port-deallocate (port (file-name-lookup +file+ :flags '(:read)))
-    (let ((translator
-            (make-instance 'mod-translator
-                           :timestamp (stat-get (io-stat port) 'st-mtime)
-                           :name "mod-translator")))
-      (run-translator translator))))
-
-(main)
+(asdf:operate 'asdf:load-op 'mod-translator)
 
diff --git a/examples/run-mod.lisp b/examples/run-mod.lisp
deleted file mode 100755
index f7dc81531..000000000
--- a/examples/run-mod.lisp
+++ /dev/null
@@ -1,10 +0,0 @@
-#!/usr/bin/run-lisp-trans
-
-; settrans -ac foo ./run-mod.lisp spec-file.lisp
-;
-
-(unless (= (length ext:*args*) 1)
-  (error "You must pass the spec file as an argument."))
-
-(asdf:operate 'asdf:load-op 'mod-translator)
-