;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT -*-
;;;_____________________________________________________________________________
;;;
;;;                       System: XIT
;;;                       Module: Dialog Windows
;;;                       Version: 1.0
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Juergen Herczeg
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/kernel/dialog-windows.lisp
;;; File Creation Date: 06/24/92 13:49:41
;;; Last Modification Time: 10/06/92 10:14:04
;;; Last Modification By: Juergen Herczeg
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;;_____________________________________________________________________________

(in-package :xit)

;;; Dialog windows are used for modal interaction, e.g., notification, 
;;; confirmation, prompting, and menu selection.
;;; The following functional interface has been provided:
;;; 
;;;  (notify <string>)
;;;
;;;  (confirm <string> &optional :reject <reject-label> :accept <accept-label>)
;;;  returns t or nil
;;;
;;;  (prompt <string> &optional :default <default-string>)
;;;  returns a string or nil
;;;
;;;  (single-select <string> :entries <text-value-pairs>)
;;;  returns a value or :cancel
;;;
;;;  (multiple-select <string> :entries <text-value-pairs>)
;;;  returns a list of values or :cancel

#||
;;Examples:

(notify "File does not exists!")

(confirm "Remove file test.lisp?")
(confirm "Remove file test.lisp?" :reject "No" :accept "Yes")

(prompt "Enter file name:")
(prompt "Enter file name:" :default "test.lisp")

(single-select "Schriftarten:"
		 :entries '(("Helvetica" . :helv)
			    ("Times Roman" . :tmsrmn)
			    ("Courier" . :courier)
			    ("Modern" . :modern)
			    ("School Book" . :school))
		 :default '(:modern))

(multiple-select "Belege Sandwich mit:"
		 :entries '(("Tomaten" . :tomaten)
			    ("Schinken" . :schinken)
			    ("Salami" . :salami)
			    ("Kaese" . :kaese)
			    ("Gurken" . :gurken)
			    ("Zwiebeln" . :zwiebeln)
			    ("Salat" . :salat)
			    ("Senf" . :senf)
			    ("Ketchup" . :ketchup))
		 :default '(:tomaten :kaese))

||#


(defcontact dialog-window (shadow-borders-mixin focus-mixin
			   popup-window paned-window)
   ((name :initform :dialog-window)
    (hide-on-mouse-exit? :initform nil))
   (:resources
    (background :initform "white")
    (inside-border :initform 10)))

(defun make-notify-dialog (message)
   (make-window 'dialog-window
       :name :notify-dialog
       :parts
        `((:class text-dispel
           :name :message
	   :text ,message
	   :font (:face :bold))
          (:class soft-button
           :name :notify-button
           :action ((call :part-of destroy)
                    (call :synchronize-event nil))
	   :action-docu "Confirm"
           :text-part (:text "OK")))
        :layouter
         '(pane-layouter
	   :configurations
           ((configuration1
            ((:message :ask)
	     (empty 10)
	     (button-strip (:ask :notify-button) :h
			   (empty :rest)
			   (:notify-button :ask)
					;(empty :rest)
			   )))))))

(defun make-confirm-dialog (message reject-string accept-string)
   (make-window 'dialog-window
       :name :confirm-dialog
       :parts
        `((:class text-dispel
           :name :message
           :text ,message
	   :font (:face :bold))
          (:class soft-button
           :name :left-confirm-button
           :action ((call :part-of destroy)
                    (call :synchronize-event nil))
           :text-part (:text ,reject-string))
          (:class soft-button
           :name :right-confirm-button
           :action ((call :part-of destroy)
                    (call :synchronize-event t))
           :text-part (:text ,accept-string)))
       :layouter
        '(pane-layouter
          :configurations
           ((configuration-1
            ((:message :ask)
	     (empty 10)
	     (button-strip (:ask :left-confirm-button) :h
					;(empty :even)
			   (:left-confirm-button :ask)
			   (empty :even)
			   (:right-confirm-button :ask)
					;(emtpy :even)
			   )))))))

(defun make-prompt-dialog (message default)
   (make-window 'dialog-window
       :name :prompt-dialog
       :reactivity-entries '((:part-event
			      (call :self destroy)
			      (call :synchronize-event *part-value*)))
       :parts
        `((:class text-dispel
           :name :message
	   :text ,message
	   :font (:face :bold))
          (:class text-dispel 
           :name :input
           :border-width 1
           :cursor "bottom_side"
           :text ,default
           :edit? :context)
          (:class soft-button
           :name :cancel-button
           :action ((call :part-of destroy)
                    (call :synchronize-event nil))
           :text-part (:text "Cancel"))
          (:class soft-button
           :name :ok-button
           :action ((call :part-of destroy)
                    (call :synchronize-event  
                          (text (part (part-of *self*) :input))))
           :text-part (:text "OK")))
       :layouter
        '(pane-layouter
          :configurations
           ((configuration-1
	     ((:message :ask)
	      (empty 10)
	      (:input :ask)
	      (empty 10)
	      (button-strip (:ask :cancel-button) :h
					;(emtpy :even)
			    (:cancel-button :ask)
			    (empty :even)
			    (:ok-button :ask)
					;(empty :even)
			    )))))))

(defun make-single-select-dialog (message entries default)
  (let* ((single-select-dialog
	 (make-window 'dialog-window
		      :name :single-select-dialog
		      :parts
		      `((:class text-dispel
			 :name :message
			 :text ,message
			 :font (:face :bold))
			(:class single-choice-box-menu
			 :name :selection-box
			 :border-width 1)
			(:class soft-button
			 :name :ok-button
                         :text-part (:text "OK")
			 :action 
			 ((call :part-of destroy)
			  (call :synchronize-event (selection 
						    (part (part-of *self*) 
							  :selection-box)))))
			(:class soft-button
			 :name :cancel-button
			 :text-part (:text "Cancel")
			 :action 
			 ((call :part-of destroy)
			  (call :synchronize-event :cancel))))
		      :layouter
		      '(pane-layouter
			:configurations
			((configuration-1
			  ((:message :ask)
			   (empty 10)
			   (:selection-box :ask)
			   (empty 10)
			   (button-strip (:ask :cancel-button) :h
					 ;;(empty :even)
					 (:cancel-button :ask)
					 (empty :rest)
					 (:ok-button :ask)
					 ;;(empty :even)
					 )))))))
	 (selection-box (part single-select-dialog :selection-box)))
    (dolist (entry entries)
      (let* ((listp (listp entry))
	     (text (if listp (car entry) (convert-to-string entry)))
	     (view-of (if listp (cdr entry) entry)))
	(add-part selection-box
		  :text text
		  :view-of view-of)))
    (setf (selection selection-box) default)
     single-select-dialog))

(defun make-multiple-select-dialog (message entries default)
  (let* ((multiple-select-dialog
	  (make-window 'dialog-window
                     :name :multiple-select-dialog
                     :parts
                     `((:class text-dispel
			:name :message
			:display-position :left-center
			:text ,message
			:font (:face :bold))
		       (:class multiple-choice-box-menu
			:name :selection-box
			:border-width 1)
		       (:class soft-button
			:name :ok-button
                        :text-part (:text "OK")
			:action
			((call :part-of destroy)
			 (call  :synchronize-event (selection
						    (part (part-of *self*) 
							  :selection-box)))))
		       (:class soft-button
			:name :cancel-button
                        :text-part (:text "Cancel")
			:action
			((call :part-of destroy)
			 (call :synchronize-event :cancel))))
                     :layouter
                      '(pane-layouter
		        :configurations
		         ((configuration-1
			   ((:message :ask)
			    (empty 10)
			    (:selection-box :ask)
			    (empty 10)
			    (button-strip (:ask :ok-button) :h
					  ;(empty :even)
					  (:cancel-button :ask)
					  (empty :rest)
					  (:ok-button :ask)
					  ;(empty :even)
					  )))))))
	 (selection-box (part multiple-select-dialog :selection-box)))
    (dolist (entry entries)
      (let* ((listp (listp entry))
	     (text (if listp (car entry) (convert-to-string entry)))
	     (view-of (if listp (cdr entry) entry)))
	(add-part selection-box
		  :text text
		  :view-of view-of)))
    (setf (selection selection-box) default)
    multiple-select-dialog))
  

(defun notify (message)
    (let ((notify-dialog (make-notify-dialog message)))
      (with-synchronous-mode (notify-dialog)
	(popup notify-dialog))))

(defun confirm (message &key (reject "Cancel") (accept "OK"))
    (let ((confirm-dialog (make-confirm-dialog message reject accept)))
      (with-synchronous-mode (confirm-dialog)
	(popup confirm-dialog))))

(defun prompt (message &key (default ""))
    (let ((prompt-dialog (make-prompt-dialog message default)))
      (with-synchronous-mode (prompt-dialog)
	(popup prompt-dialog))))

(defun single-select (message &key entries default)
  (let ((single-select-dialog (make-single-select-dialog message entries default)))
    (with-synchronous-mode (single-select-dialog)
      (popup single-select-dialog))))

(defun multiple-select (message &key entries default)
  (let ((multiple-select-dialog (make-multiple-select-dialog message entries default)))
    (with-synchronous-mode (multiple-select-dialog)
      (popup multiple-select-dialog))))
