;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT -*-
;;;_____________________________________________________________________________
;;;
;;;                       System: XAM
;;;                       Module: timers
;;;                       Version: 1.0
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Juergen Herczeg
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/xam/timer-meta.lisp
;;; File Creation Date: 07/21/92 10:01:47
;;; Last Modification Time: 07/31/92 11:07:51
;;; Last Modification By: Juergen Herczeg
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;;_____________________________________________________________________________

(in-package :xit)

(defmethod select-meta-timer-sheet (object)
  (declare (ignore object))
  nil)

(defmethod select-meta-timer-sheet ((self timer-mixin))
  (declare (special *meta-pool*))
  (let ((sheet (get-pool-window *meta-pool* :meta-timer-sheet)))
    (setf (view-of sheet) self)
    (popup sheet)))

(defmethod make-meta-sheet-named ((key (eql :meta-timer-sheet)))
  (create-meta-property-sheet
   nil
   :title "Timer Options"
   :name :meta-timer-sheet
   :parts
   '((:class text-property-field
      :name :name
      :view-of :default
      :label "name"
      :read-function identity
      :reactivity-entries ((:part-event (call :write))
			   (:write-event
			    (call :eval (setf (view-of *self*)
					    (convert-from-string
					     (text (part *self* :value)))))
			    (call :part-of read-from-application)))
      :read-initially? nil
      :value-part
      (:reactivity-entries ((:menu "Select timer from menu"
			     (call :eval
			       (let*
				   ((timer-names
				     (remove-duplicates
				      (cons :default
					    (timer-names
					     (view-of (part-of *self* 2))))))
				    (selected-name
				     (single-select "Select timer"
						    :entries timer-names
						    :default :default)))
				 (unless (eq selected-name :cancel)
				   (setf (text *self*)
				       (convert-to-readable-string selected-name))
				   (send-part-event *self*))))))))
     (:class text-property-field
      :name :interval
      :label "interval"
      :read-function (lambda (view-of)
			 (timer-interval view-of
			  (view-of (part (part-of *self*) :name))))
      :read-transformation convert-nil-to-empty-string
      :write-function (lambda (view-of value)
			  (setf (timer-interval view-of
				  (view-of (part (part-of *self*) :name)))
			      value))
      :write-transformation convert-from-string
      :read-initially? nil)
     
     (:class text-property-field
      :name :value
      :label "value"
      :read-function (lambda (view-of)
			 (timer-value view-of
			  (view-of (part (part-of *self*) :name))))
      :read-transformation convert-nil-to-empty-string
      :write-function (lambda (view-of value)
			  (setf (timer-value view-of
				  (view-of (part (part-of *self*) :name)))
			      value))
      :write-transformation convert-from-string
      :read-initially? nil)
     (:label "status"
      :read-function (lambda (view-of)
			 (timer view-of
			  (view-of (part (part-of *self*) :name))))
      :read-transformation convert-from-boolean
      :write-function (lambda (view-of value)
			  (if value
			      (add-timer view-of
					 (view-of (part (part-of *self*) :name))
					 (value
					  (part (part-of *self*) :interval))
					 (value
					  (part (part-of *self*) :value)))
			    (progn
			      (delete-timer view-of
				       (view-of (part (part-of *self*) :name)))
			      (setf (view-of (part (part-of *self*) :name))
				  :default))))
      :write-transformation convert-to-boolean
      :reactivity-entries ((:part-event
			    (call :write)
			    (call :part-of read-from-application)))
      :read-initially? nil
      :value-part
      (:class single-choice-text-menu
       :layouter (distance-layouter :orientation :right)
       :parts ((:view-of :no
		:action-docu "Remove timer"
		:text "Inactive")
	       (:view-of :yes
		:action-docu "Add timer"
		:text "Active"))))
     (:class text-property-field
      :label "action"
      :read-function (lambda (view-of)
		       (let ((actions (reactivity-actions-for view-of :timer)))
			 (unless (eq actions t) actions)))
      :read-transformation convert-to-readable-string-from-list
      :write-function (lambda (view-of value)
		       (apply #'change-reactivity view-of :timer value))
      :write-transformation convert-from-string-to-list
      :read-initially? nil
      ))))
    