[Add partially working accept-values-command-button
clinton@unknownlamer.org**20080605164002] {
addfile ./avbutton.lisp
hunk ./avbutton.lisp 1
+(in-package :clim-internals)
+
+;;; Misc
+
+;; change back to presenting continuation on stream, or else setup a
+;; simple structure or similar to contain the continuation ? Need to
+;; make this work with displaying a nested accepting-values
+
+(define-presentation-type av-command-button ()
+  :inherit-from t
+  :options (continuation))
+
+(define-command (com-button-call :command-table accept-values
+				 :name nil)
+    ((button 'av-command-button))
+  (with-presentation-type-options (av-command-button button)
+    (funcall continuation)))
+
+(defgeneric invoke-accept-values-command-button (stream continuation view prompt 
+						 &key
+						 documentation
+						 query-identifier
+						 cache-value
+						 cache-test
+						 resynchronize))
+
+(defmethod invoke-accept-values-command-button
+    (stream continuation (view gadget-dialog-view) prompt
+     &key
+     documentation
+     query-identifier
+     cache-value
+     cache-test
+     resynchronize)
+  (updating-output (stream :unique-id query-identifier
+			   :cache-value cache-value
+			   :cache-test cache-test)
+    (with-output-as-gadget (stream)
+      (with-look-and-feel-realization ((frame-manager *application-frame*)
+				       *application-frame*)
+	(make-pane 'push-button
+		   :label prompt
+		   :activate-callback
+		   (lambda (button)
+		     (throw-highlighted-presentation
+		      (make-instance 'standard-presentation
+				     :object nil
+				     :type `((av-command-button)
+					     :continuation ,continuation)
+				     :single-box t)
+		      *input-context*
+		      (make-instance 'pointer-button-press-event
+				     :sheet stream
+				     :x 0 :y 0 :modifier-state 0
+				     :button +pointer-left-button+))))))))
+
+
+(define-presentation-to-command-translator call-command-button
+    (av-command-button com-button-call accept-values
+      :gesture :select
+      :documentation "Activate command"
+      :pointer-documentation "Activate command"
+      :echo nil)
+    (object)
+  `(,object))
+
+(defmethod invoke-accept-values-command-button
+    (stream continuation (view textual-dialog-view) prompt
+     &key
+     documentation
+     query-identifier
+     cache-value
+     cache-test
+     resynchronize)
+  (updating-output (stream :unique-id query-identifier
+			   :cache-value cache-value
+			   :cache-test cache-test)
+    (with-output-as-presentation (stream continuation
+					 `((av-command-button)
+					   :continuation ,continuation)
+					 
+					 :single-box t)
+      (princ prompt stream))))
+
+(defmacro accept-values-command-button
+    ((&optional stream
+		&key view documentation query-identifier
+		(cache-value t) (cache-test #'eql) resynchronize)
+     prompt
+     &body body)
+  (with-gensyms (stream-name prompt-name)
+    `(let ((,stream-name ,stream)
+	   (,prompt-name ,prompt))
+       (invoke-accept-values-command-button
+	(or ,stream-name *accepting-values-stream*)
+	(lambda () ,@body)
+	(or ,view (stream-default-view ,stream-name))
+	,prompt-name
+	:documentation ,documentation
+	:query-identifier (or ,query-identifier ,prompt-name)
+	:cache-value ,cache-value
+	:cache-test ,cache-test
+	:resynchronize ,resynchronize))))
}