Index: main/form-test.lisp
===================================================================
--- main/form-test.lisp	(revision main,42)
+++ main/form-test.lisp	(revision main,42)
@@ -0,0 +1,49 @@
+(defpackage #:tui-form-test
+  (:use #:cl #:tui-form #:tui-window)
+  (:export #:test))
+
+(in-package #:tui-form-test)
+
+
+
+(defform test
+    ((:textbox 0 0 tb0 8)
+     (:textbox 1 0 tb1 8)
+     (:textbox 2 0 tb2 8)
+     (:textbox 3 0 tb3 8)
+     (:textbox 4 0 tb4 8)
+     (:textbox 5 0 tb5 8)
+     (:textbox 6 0 tb6 8)
+     (:textbox 7 0 tb7 8)))
+
+(defclass test ()
+  ((table :type hash-table :initform (make-hash-table :test #'equal))))
+
+(defmethod initialize-instance :after ((test test) &key &allow-other-keys)
+  (with-slots (table) test
+    (setf (gethash 'tb0 table) "Now")
+    (setf (gethash 'tb1 table) "is")
+    (setf (gethash 'tb2 table) "the")
+    (setf (gethash 'tb3 table) "time")
+    (setf (gethash 'tb4 table) "for")
+    (setf (gethash 'tb5 table) "all")
+    (setf (gethash 'tb6 table) "good")
+    (setf (gethash 'tb7 table) "men!")))
+
+
+(defmethod form-value ((test test) name)
+  (with-slots (table) test
+    (gethash name table)))
+
+(defmethod (setf form-value) (value (test test) name)
+  (with-slots (table) test
+    (setf (gethash name table) value)))
+
+(defun test ()
+  (with-screen (s)
+    (with-subwindow (w s 5 80 0 0)
+      (let ((form (create-form 'test (make-instance 'test) w)))
+        (unwind-protect
+             (progn
+               (tui-input:read-key w))
+          (destroy-form form))))))
Index: main/form.lisp
===================================================================
--- main/form.lisp	(revision main,42)
+++ main/form.lisp	(revision main,42)
@@ -0,0 +1,168 @@
+;;;; Validation.  Formatting.  Justification.
+
+(defpackage #:tui-form
+  (:use #:cl #:dso-util #:tui-input #:tui-widget #:tui-window)
+  (:export #:form-value #:defform #:create-form #:destroy-form))
+
+(in-package #:tui-form)
+
+
+
+(defgeneric form-value (data name))
+
+(defgeneric (setf form-value) (value data name))
+
+
+
+(defclass widget-def ()
+  ((row :type (integer 0) :initarg :row)
+   (column :type (integer 0) :initarg :column)))
+
+(defclass value-widget-def (widget-def)
+  ((name :initarg :name)
+   (read-only :type boolean :initarg :read-only)))
+
+
+
+(defclass label-def (widget-def)
+  ((text :type string :initarg :text)))
+
+(defclass textbox-def (value-widget-def)
+  ((display-width :initarg :display-width)
+   (data-width :initarg :data-width)))
+
+(defclass numberbox-def (value-widget-def)
+  ((display-width :initarg :display-width)
+   (data-width :initarg :data-width)
+   (precision :initarg :precision)))
+
+(defclass form-def ()
+  ((elements :type vector :initarg :elements)))
+
+
+
+(defun make-label-def (row column text)
+  `(make-instance 'label-def :row ,row :column ,column :text ,text))
+
+(defun make-textbox-def (row column name display-width
+                         &key data-width read-only)
+  `(make-instance 'textbox-def
+                  :row ,row :column ,column :name ',name
+                  :display-width ,display-width :data-width ,data-width
+                  :read-only ,read-only))
+
+(defun make-numberbox-def (row column name display-width
+                           &key data-width precision read-only)
+  `(make-instance 'numberbox-def
+                  :row ,row :column ,column :name ',name
+                  :display-width ,display-width :data-width ,data-width
+                  :precision ,precision :read-only ,read-only))
+
+(defun parse-widget-form (widget-form)
+  (destructuring-bind (type &rest args) widget-form
+    (apply (ecase type
+             (:label 'make-label-def)
+             (:textbox 'make-textbox-def)
+             (:numberbox 'make-numberbox-def))
+           args)))
+
+(defvar *form-definitions* (make-hash-table :test #'eq ))
+
+(defmacro defform (name (&rest widgets))
+  (with-gensyms (elements)
+    `(let ((,elements (list ,@(mapcar 'parse-widget-form widgets))))
+       (setf (gethash ',name *form-definitions*)
+             (make-instance 'form-def :elements (coerce ,elements 'vector))))))
+
+
+
+(defclass reflector ()
+  ((data :initarg :data)
+   (name :initarg :name)))
+
+(defmethod text ((r reflector))
+  (with-slots (data name) r
+    (form-value data name)))
+
+(defmethod (setf text) (text (r reflector))
+  (with-slots (data name) r
+    (setf (form-value data name) r)))
+
+
+
+(defgeneric create-peer (widget-def form)
+  (:method ((tbd textbox-def) form)
+    (with-slots (row column name display-width) tbd
+      (with-slots (data window) form
+        (let ((r (make-instance 'reflector :data data :name name)))
+          (create-textbox window row column r display-width))))))
+
+
+
+(defclass form ()
+  ((widget-defs :type vector :initarg :widget-defs)
+   (data :initarg :data)
+   (read-only :type boolean :initform t :accessor read-only)
+   (window :initarg :window)
+   (peers :type vector :initarg :peers)
+   (scroll :type (integer 0) :accessor scroll)))
+
+(defun max-scroll (form)
+  (with-slots (widget-defs window) form
+    (let ((lowest (reduce #'max (map 'list #'slot-value widget-defs (inflist 'row))))
+          (max (1- (size window))))
+      (min 0 (- lowest max)))))
+
+(defun percent-scroll (form)
+  (with-slots (scroll) form
+    (/ (1+ scroll) (1+ (max-scroll form)))))
+
+(defun widget-visible-p (form widget)
+  (with-slots (widgets window scroll) form
+    (when (integerp widget)
+      (setf widget (aref widgets widget)))
+    (with-slots (row) widget
+        (<= scroll row (1- (size window))))))
+
+(defmethod (setf scroll) :around (i (form form))
+  (with-slots (widget-defs peers) form
+    (let ((r (call-next-method (bound i 0 (max-scroll form)) form)))
+      (dotimes (i (length widget-defs))
+        (let ((widget (aref widget-defs i))
+              (peer (aref peers i)))
+          (when (and peer (not (widget-visible-p form widget)))
+            (destroy peer)
+            (setf (aref peers i) nil))
+          (when (and (not peer) (widget-visible-p form widget))
+            (setf (aref peers i) (create-peer widget form)))))
+      r)))
+
+
+
+(define-condition form-not-defined (error)
+  ((name :initarg :name :reader name))
+  (:report (lambda (c out)
+             (format out "Form '~A' has not been defined." (name c)))))
+
+(defun create-form (name data-table window)
+  (let ((form-def (gethash name *form-definitions*)))
+    (unless form-def
+      (error 'form-not-defined :name name))
+    (with-slots (elements) form-def
+      (let* ((peers (make-sequence 'vector
+                                   (length elements)
+                                   :initial-element nil))
+             (form (make-instance 'form
+                                  :widget-defs elements
+                                  :data data-table
+                                  :window window
+                                  :peers peers)))
+        (setf (scroll form) 0)
+        form))))
+
+(defun destroy-form (form)
+  (with-slots (peers) form
+    (dotimes (i (length peers))
+      (when (aref peers i)
+        (destroy (aref peers i))
+        (setf (aref peers i) nil)))))
Index: main/tui.asd
===================================================================
--- main/tui.asd	(revision main,40)
+++ main/tui.asd	(revision main,42)
@@ -18,5 +18,9 @@
                       :depends-on ("cdk" "input"))
                (:module "widget"
-                        :depends-on ("cursor" "input" "output" "window")
+                        :depends-on ("cursor"
+                                     "display-string"
+                                     "input"
+                                     "output"
+                                     "window")
                         :components ((:file "generic")
                                      (:file "label"
@@ -30,4 +34,6 @@
                                                    "textbox"
                                                    "numberbox"))))
+               (:file "form"
+                      :depends-on ("widget" "window"))
                (:module "grid"
                         :depends-on ("cdk" "display-string")