Changeset main,87 for main/form.lisp

Timestamp:

02/23/2008 12:27:43 AM (18 years ago)

Author:

David Owen <dsowen@…>

branch-nick:

tui

revision id:

dsowen@fugue88.ws-20080223002743-09u28trz6kvjtdpo

Message:

• Integrate checkboxes into forms.
• Fixed checkbox display glitches.
• Added keystrokes to checkbox.
• Fixed package symbols.

File:

• main/form.lisp (modified) (5 diffs)

main/form.lisp

@@ -41 +41 @@
    (precision :initarg :precision)
    (inactive-background :initarg :inactive-background)
+   (active-background :initarg :active-background)))
+
+(defclass checkbox-def (value-widget-def)
+  ((inactive-background :initarg :inactive-background)
    (active-background :initarg :active-background)))
 
@@ -83 +87 @@
                   :active-background (list ,@active-background)))
 
+(defun make-checkbox-def (row column name &key read-only
+                          (inactive-background
+                           *default-inactive-widget-background*)
+                          (active-background
+                           *default-active-widget-background*))
+  `(make-instance 'checkbox-def
+                  :row ,row :column ,column :name ,name :read-only ,read-only
+                  :inactive-background (list ,@inactive-background)
+                  :active-background (list ,@active-background)))
+
 (defun parse-widget-form (widget-form)
   (destructuring-bind (type &rest args) widget-form
@@ -88 +102 @@
              (:label 'make-label-def)
              (:textbox 'make-textbox-def)
-             (:numberbox 'make-numberbox-def))
+             (:numberbox 'make-numberbox-def)
+             (:checkbox 'make-checkbox-def))
            args)))
 
@@ -97 +112 @@
 * (:label row column text)
 * (:textbox row column name display-width &key data-width read-only)
-* (:numberbox row column name display-width &key data-width precision read-only)"
+* (:numberbox row column name display-width &key data-width precision read-only)
+* (:checkbox row column name)"
   (destructuring-bind (&key ((:inactive-widget-background *default-inactive-widget-background*) '(#\Nul 0))
                             ((:active-widget-background *default-active-widget-background*) '(#\Nul 0)))
@@ -146 +162 @@
                             :validator validator
                             :inactive-background inactive-background
-                            :active-background active-background))))))
+                            :active-background active-background)))))
+  (:method ((cbd checkbox-def) form)
+    (with-slots (row column name inactive-background active-background) cbd
+      (with-slots (data window scroll) form
+        (let ((r (make-reflector data name)))
+          (create-widget 'db-checkbox window (- row scroll) column
+                         :data r
+                         :inactive-background inactive-background
+                         :active-background active-background))))))