Changeset main,45 for main

Timestamp:

11/09/2007 12:29:19 AM (19 years ago)

Author:

David Owen <dsowen@…>

branch-nick:

tui-new

revision id:

dsowen@fugue88.ws-20071109002919-u3q6f17xwbxvy3b0

Message:

Added numberbox support to forms.
Fixed indentation of defform and added documentation.
Fix: Labels weren't being pushed to the screen.
Fix: (activate label) should return something useful to the form.

Location:

main

Files:

• form-test.lisp (modified) (2 diffs)
• form.lisp (modified) (5 diffs)
• widget/generic.lisp (modified) (1 diff)
• widget/label.lisp (modified) (1 diff)

main/form-test.lisp

@@ -7 +7 @@
 
 
-(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)))
+(defform test ((:label 0 0 "Family name:")
+               (:textbox 0 13 family-name 16)
+               (:label 1 0 " Given name:")
+               (:textbox 1 13 given-name 16)
+               (:label 2 0 "        Age:")
+               (:numberbox 2 13 age 2)))
 
 (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!")))
 
 
@@ -39 +26 @@
   (with-slots (table) test
     (setf (gethash name table) value)))
+
+
 
 (defun test ()

main/form.lisp

@@ -70 +70 @@
 (defvar *form-definitions* (make-hash-table :test #'eq ))
 
-(defmacro defform (name (&rest widgets))
+(defmacro defform (name (&body widgets))
+  "Each widget is one of:
+- (: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)"
   (with-gensyms (elements)
     `(let ((,elements (list ,@(mapcar 'parse-widget-form widgets))))
@@ -82 +86 @@
    (name :initarg :name)))
 
+(defun make-reflector (data name)
+  (make-instance 'reflector :data data :name name))
+
 (defmethod text ((r reflector))
   (with-slots (data name) r
@@ -93 +100 @@
 
 (defgeneric create-peer (widget-def form)
+  (:method ((ld label-def) form)
+    (with-slots (row column text) ld
+      (with-slots (window) form
+        (create-label window row column text))))
   (:method ((tbd textbox-def) form)
     (with-slots (row column name display-width) tbd
       (with-slots (data window scroll) form
-        (let ((r (make-instance 'reflector :data data :name name)))
-          (create-textbox window (- row scroll) column r display-width))))))
+        (let ((r (make-reflector data name)))
+          (create-textbox window (- row scroll) column r display-width)))))
+  (:method ((nbd numberbox-def) form)
+    (with-slots (row column name display-width) nbd
+      (with-slots (data window scroll) form
+        (let ((r (make-reflector data name)))
+          (create-numberbox window (- row scroll) column r display-width))))))
 
 
@@ -108 +124 @@
    (peers :type vector :initarg :peers)
    (scroll :type (integer 0) :accessor scroll)))
+
+(defmethod refresh ((form form))
+  (with-slots (window) form
+    (refresh window)))
 
 (defun max-scroll (form)
@@ -189 +209 @@
         (loop
            (ensure-widget-visible form focus)
+           (refresh form)
            (let ((key (activate (aref peers focus) #'callback)))
              (case key

main/widget/generic.lisp

@@ -1 +1 @@
 (defpackage #:tui-widget-generic
   (:use #:cl)
-  (:export #:text #:widget #:scroll #:insertion-point #:destroy #:draw
-           #:activate))
+  (:export #:text #:widget #:parent-window #:column #:row #:scroll
+           #:insertion-point #:destroy #:draw #:activate))
 
 (in-package #:tui-widget-generic)

main/widget/label.lisp

@@ -19 +19 @@
   (when raw-text
     (setf text (enquote text)))
-  (make-instance 'label
-                 :parent-window parent-window :row row :column column
-                 :text text))
+  (let ((inst (make-instance 'label
+                             :parent-window parent-window
+                             :row row
+                             :column column
+                             :text text)))
+    (draw inst)
+    inst))
 
 (defmethod destroy ((label label)))
 
-(defmethod activate ((label label) &optional callback))
+(defmethod activate ((label label) &optional callback)
+  #\Tab)