[Add accepting-values gadget demo
clinton@unknownlamer.org**20080605162339] {
addfile ./avg-demo.lisp
hunk ./avg-demo.lisp 1
-
+(in-package :clim-user)
+
+(define-application-frame hello ()
+  ()
+  (:panes
+   (main-area :application :display-time nil
+			   :height 250 :width 600
+			   :text-style (make-text-style :fix :roman :very-small))
+   (interactor :interactor :height 550))
+  (:layouts
+   (default (vertically ()
+	      main-area
+	      interactor))))
+
+(define-hello-command (com-moo :name t) ((who 'string))
+  (format t "Moo ~A!~%" who))
+
+(define-hello-command (com-foo :name t) ()
+  (let (foo)
+    (setf (climi::frame-manager-dialog-view
+	   (frame-manager *application-frame*))
+	  +textual-dialog-view+)
+    (format
+     t "RETURNED ~S~%"
+     (accepting-values (*standard-input* :align-prompts :right
+					 :exit-boxes '((:exit "All Done Here")
+						       (:abort "Abort Abort!")))
+      
+       (setf foo
+	     (list (accept '(float 20.0 100.0)
+			   :view '(slider-view
+				   :show-value-p t
+				   :orientation :horizontal)
+			   :query-identifier 'foo)
+		   (accept '(subset foo bar baz quux)
+			   :default '(foo baz)
+			   :view 'check-box-view
+			   :query-identifier 'bar)
+		   (accept '(member-alist (("one" . eins)
+					   ("two" . zwei)
+					   ("three" . drei)
+					   ("four" . vier)
+					   ("five" . fünf)))
+			   :default 'zwei
+			   :view '(option-pane-view :width 100)
+			   :prompt "Deutsch macht Spaß"
+			   :query-identifier 'bar-1)
+		   (accept '(subset eins zwei drei vier fünf)
+			   :default '(zwei)
+			   :view '(list-pane-view :width 100)
+			   :prompt "Numbers")
+		   (accept 'string :prompt "string"
+			   :view 'text-field-view
+			   :default "Hello there")
+		   (accept 'boolean
+			   :view 'toggle-button-view :query-identifier 'baz)
+ 		   (accept 'boolean
+ 			   :default t
+ 			   :view 'option-pane-view :query-identifier 'baz-1)))))
+    (format t "FOO ~S~%" foo)))
+
+(define-hello-command (com-foo-1 :name t) ((dview `(member
+						   ,+gadget-dialog-view+
+						   ,+textual-dialog-view+)
+						  :default +gadget-dialog-view+))
+  (setf (climi::frame-manager-dialog-view
+	 (frame-manager *application-frame*))
+	dview)
+  (let (foo)
+    (accepting-values (*standard-input* :align-prompts :right
+					:own-window nil
+					:resynchronize-every-pass nil)
+      (setf foo
+	    (list (accept '(float 10.0 400.0)
+			  :query-identifier 'foo
+			  ;:view '(slider-view :orientation :horizontal)
+			  )
+		  (accept '(subset foo bar baz quux)
+			  :default '(foo baz)
+			  :query-identifier 'bar)
+		  (accept '(member-alist (("one" . eins)
+					  ("two" . zwei)
+					  ("three" . drei)
+					  ("four" . vier)
+					  ("five" . fünf)))
+			  :default 'zwei
+			  :prompt "Deutsch macht Spaß"
+			  :query-identifier 'bar-1)
+		  (accept '(subset eins zwei drei vier fünf)
+			  :default '(zwei)
+			  :prompt "Numbers")
+		  (accept 'string :prompt "string"
+				  :default "Hello There")
+		  (accept 'boolean
+			  :query-identifier 'baz)
+		  (accept 'boolean
+			  :query-identifier 'baz-1
+			  :view +option-pane-view+
+			  :default nil))))
+    (format t "RETURNED ~S~%" foo)))
+
+(define-hello-command (com-resync :name t) ()
+  (let ((min -1.0)
+	(max 1.0))
+    (accepting-values (*standard-input* :align-prompts :right
+					:resynchronize-every-pass t)
+      (setf min (accept 'real :default min :prompt "min"))
+      (setf max (accept 'real :default max :prompt "max"))
+      (when (< max min)
+	(rotatef min max)))
+    (format t "(~A ~A)~%" min max)))
+
+
+(define-presentation-type test-button ()
+  :inherit-from t)
+
+(define-presentation-method accept-present-default
+    ((type test-button) stream view
+     default default-supplied-p present-p query-identifier)
+  (updating-output (stream :unique-id query-identifier
+			   :cache-value default)
+    (accept-values-command-button
+     (nil :view +textual-dialog-view+) "compound test"
+     (let (foo bar)
+       (accepting-values (stream :align-prompts :right)
+	 (setf foo (accept 'integer :default 10 :prompt "ni"
+			   :query-identifier 'bar))
+	 (setf bar (accept 'boolean :default t :prompt "nb"
+			   :query-identifier 'baz))
+	 )
+       (break "afterf")
+       (list foo bar)))))
+
+(define-presentation-type test-compound ()
+  :inherit-from t)
+
+(define-presentation-method accept-present-default
+    ((type test-compound) stream (view gadget-dialog-view)
+     default default-supplied-p present-p query-identifier)
+  (updating-output (stream :unique-id query-identifier
+			   :cache-value default)
+    (let (foo bar)
+      (accepting-values (stream :align-prompts :right)
+	(setf foo (accept 'integer :default 10 :prompt "ni"
+			  :query-identifier 'bar))
+	(setf bar (accept 'boolean :default t :prompt "nb"
+			  :query-identifier 'baz)))
+      (list foo bar))
+;;     (let (foo bar)
+;;       (funcall-presentation-generic-function
+;;        accept-present-default
+;;        'integer stream view 5 t present-p 'i-1)
+;;       (terpri)
+;;       (funcall-presentation-generic-function
+;;        accept-present-default
+;;        'boolean stream view nil t present-p 'b-1)
+;;       (list foo bar))
+    ))
+
+(define-hello-command (com-compound-accept :name t) ()
+  (let (foo)
+    (accepting-values (*standard-input* :align-prompts :right)
+      (setf (climi::frame-manager-dialog-view
+	     (frame-manager *application-frame*))
+	    +gadget-dialog-view+)
+      (setf foo (accept 'test-compound :prompt "compound"
+			:query-identifier 'foo)))
+    (format t "RETURNED ~S~%" foo)))
+
+(defun run-hello ()
+  (run-frame-top-level (make-application-frame 'hello)))
}