Changeset main,80 for main

Timestamp:

12/13/2007 12:47:56 AM (18 years ago)

Author:

David Owen <dsowen@…>

branch-nick:

tui

revision id:

dsowen@fugue88.ws-20071213004756-lr4quvaf0hy1zpub

Message:

Widgets now support validation (#1).

Location:

main

Files:

• form.lisp (modified) (7 diffs)
• widget/textbox.lisp (modified) (3 diffs)

main/form.lisp

@@ -55 +55 @@
 
 (defun make-textbox-def (row column name display-width
-                         &key data-width read-only (validate 'nothing)
+                         &key data-width read-only (validator 'identity)
                          (inactive-background
                           *default-inactive-widget-background*)
@@ -64 +64 @@
                   :display-width ,display-width :data-width ,data-width
                   :read-only ,read-only
-                  :validator ',validate
+                  :validator ',validator
                   :inactive-background (list ,@inactive-background)
                   :active-background (list ,@active-background)))
@@ -70 +70 @@
 (defun make-numberbox-def (row column name display-width
                            &key data-width precision read-only
-                           (validate 'nothing)
+                           (validator 'identity)
                            (inactive-background
                             *default-inactive-widget-background*)
@@ -79 +79 @@
                   :display-width ,display-width :data-width ,data-width
                   :precision ,precision :read-only ,read-only
-                  :validator ',validate
+                  :validator ',validator
                   :inactive-background (list ,@inactive-background)
                   :active-background (list ,@active-background)))
@@ -130 +130 @@
         (create-label window row column text))))
   (:method ((tbd textbox-def) form)
-    (with-slots (row column name display-width inactive-background
+    (with-slots (row column name validator display-width inactive-background
                      active-background) tbd
       (with-slots (data window scroll) form
         (let ((r (make-reflector data name)))
           (create-textbox window (- row scroll) column r display-width
+                          :validator validator
                           :inactive-background inactive-background
                           :active-background active-background)))))
   (:method ((nbd numberbox-def) form)
-    (with-slots (row column name display-width inactive-background
+    (with-slots (row column name validator display-width inactive-background
                      active-background) nbd
       (with-slots (data window scroll) form
         (let ((r (make-reflector data name)))
           (create-numberbox window (- row scroll) column r display-width
+                            :validator validator
                             :inactive-background inactive-background
                             :active-background active-background))))))
@@ -256 +258 @@
         (assert (> n 0) nil "The form has no fields.")
         (labels ((f-idx () (aref focusables focus))
-                 (f-peer () (aref peers (f-idx)))
-                 (f-def () (aref widget-defs (f-idx)))
-                 (validate ()
-                   (let* ((v (slot-value (f-def) 'validator))
-                          (name (slot-value (f-def) 'name))
-                          (text (form-value data name))
-                          (r (funcall v text)))
-                     (when r
-                       (setf (form-value data name) r)))))
+                 (f-peer () (aref peers (f-idx))))
           (loop
              (ensure-widget-visible form (f-idx))
@@ -271 +265 @@
                (case key
                  ((#\Return #\Newline #\Tab :key-down)
-                  #|(setf focus (mod (1+ focus) n))|#
-                  (validate)
                   (incf focus)
                   (boundf focus 0 (1- n)))
                  ((:key-btab :key-up)
-                  #|(setf focus (mod (1- focus) n))|#
-                  (validate)
                   (decf focus)
                   (boundf focus 0 (1- n)))

main/widget/textbox.lisp

@@ -10 +10 @@
 (defclass textbox (widget scroll insertion-point)
   ((data :initarg :data)
+   (validator :initform 'identity :initarg :validator :reader validator)
    (window :initarg :window)
    (active :type boolean :initform nil)))
@@ -63 +64 @@
 
 
-(defun create-textbox (parent-window y x data width &key
+(defun create-textbox (parent-window y x data width &rest args &key validator
                        (inactive-background '(#\Space 0))
                        (active-background '(#\Space 0)))
+  (declare (ignore validator inactive-background active-background))
   (let* ((window (tui-window::create-subwindow parent-window 1 width y x))
-         (inst (make-instance 'textbox
-                              :data data
-                              :window window
-                              :inactive-background inactive-background
-                              :active-background active-background)))
+         (inst (apply 'make-instance 'textbox :data data :window window args)))
     (draw inst)
     inst))
@@ -123 +121 @@
                        (let ((r (funcall key-callback key)))
                          (when r
-                           (setf (insertion-point textbox) 0)
-                           (return-from activate r)))
+                           (let ((q (funcall (validator textbox) (text data))))
+                             (when q
+                               (setf (text data) q)
+                               (setf (insertion-point textbox) 0)
+                               (return-from activate r)))))
                        (multiple-value-bind (left right) (split textbox)
                          (setf (text data)