Changeset main,80 for main/widget/textbox.lisp

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).

File:

• main/widget/textbox.lisp (modified) (3 diffs)

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)