(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))))