1. Stephen Compall
  2. weblocks-dev


Stephen Compall  committed 2442ca1

Rename valid-widget to widget-designator [#35 state:resolved]

Also remove the ability to extend the widget-designator type directly. Test for all of this.

  • Participants
  • Parent commits 063970c
  • Branches default

Comments (0)

Files changed (4)

File src/widgets/composite.lisp

View file
         (assert (cons-in-list-p place (composite-widgets composite)))
-            (check-type callee valid-widget
+            (check-type callee widget-designator
                         "a potential member of a composite")
             (rplaca place callee)
             (setf (widget-parent callee) composite)

File src/widgets/selector-mixin.lisp

View file
     (lambda (&optional (callee nil callee-supplied-p))
       (assert (find place (selector-mixin-panes selector)))
       (cond (callee-supplied-p
-	     (check-type callee valid-widget
+	     (check-type callee widget-designator
 			 "a potential pane of a selector-mixin")
 	     (rplacd place callee)
 	     (setf (widget-parent callee) selector)

File src/widgets/widget/widget.lisp

View file
       (error "Widget ~a already has a parent." obj)
       (setf (slot-value obj 'parent) val)))
-(deftype valid-widget ()
+(deftype widget-designator ()
   "The supertype of all widgets.  Check against this type instead of
 `widget' unless you know what you're doing."
-  '(satisfies valid-widget-p))
+  '(or widget (and symbol (not null)) string function))
-(defgeneric valid-widget-p (widget)
-  (:documentation "Returns t when widget is a valid, renderable widget;
-   this includes strings, function, etc.")
-  (:method ((obj widget)) t)
-  (:method ((obj symbol)) t)
-  (:method ((obj function)) t)
-  (:method ((obj string)) t)
-  (:method ((obj null)) nil)
-  (:method (obj) nil))
+(defun widget-designator-p (widget)
+  "Returns t when widget is a valid, renderable widget; this includes
+strings, function, etc."
+  (identity (typep widget 'widget-designator)))
 ;;; Define widget-rendered-p for objects that don't derive from
 ;;; 'widget'

File test/widgets/widget/widget.lisp

View file
     (widget-name 'identity)
-;;; valid-widget typechecking
+;;; widget-designator typechecking
 (addtest nil-is-not-valid
-  (ensure-null (weblocks::valid-widget-p nil)))
+  (ensure-same (typep nil 'weblocks::widget-designator)
+	       (values nil t))
+  (ensure-null (weblocks::widget-designator-p nil)))
-(addtest valid-widget-export-status-same
-  (ensure-same (symbol-status 'weblocks::valid-widget)
-	       (symbol-status 'weblocks::valid-widget-p)))
+(addtest widget-designator-export-status-same
+  (ensure-same (symbol-status 'weblocks::widget-designator)
+	       (symbol-status 'weblocks::widget-designator-p)))
+(addtest widget-designator-type-not-extensible
+  (ensure-null
+   (typep #'weblocks::widget-designator-p 'generic-function)))
 ;;; test composite-widgets specialization for widgets
 (deftest composite-widgets-1