source: trunk/SRC/ToBeReviewed/WIDGET/xquestion.pro @ 288

;+
;
; @file_comments
;
; @categories
;
; @param EVENT
;
; @returns
;
; @uses
;
; @restrictions
;
; @examples
;
; @history
;
; @version
; $Id$
;-
;
PRO xquestion_event, event
;
  compile_opt idl2, strictarrsubs
;
; we get the answer
   widget_control, widget_info(event.top, find_by_uname = 'text') $
    , get_value = answer & answer = answer[0]
; now we give the answer to xquestion.pro by using the pointer uvalue
   widget_control, event.top, get_uvalue = ptranswer
   *ptranswer = answer
; we destroy the widget
   widget_control, event.top, /destroy
   return
end
;
;+
;
; @file_comments
; A small widget who ask a question and give an answer.
;   WARNING: For a binary question with yes/no, answer use
;   <proidl>DIALOG_MESSAGE</proidl>.
;
; @categories
; Widget
;
; @param QUESTION {type=A scalar string or a array of string}
; If this argument is set to :
;      - an array of strings: each array element is
;        displayed as a separate line of text.
;      - a scalar string: we are looking for the "separate line
;        character" '!C'
;
; @param PROPOSEDANSWER {type=string}
; proposing a answer
;
; @keyword CHKWIDGET
; Active this keyword if you want that <pro>xquestion</pro>
; check if managed widget are present. If not, <pro>xquestion</pro> do not
; open a widget but print the question in the IDL window.
;
; @keyword _EXTRA
; Used to pass keywords
;
; @returns
; answer: a string
;
; @restrictions
; The function does not return to its caller until the user
; press "Enter" key in the widget.
;
; @examples
; IDL> help, xquestion('Postscript name')
; <Expression>    STRING    = 'toto.ps'
;
; @history
; Sebastien Masson (smasson\@lodyc.jussieu.fr)
;                      13/10/1999
;
; @version
; $Id$
;
;-
;
FUNCTION xquestion, question, proposedanswer, CHKWIDGET = chkwidget, _EXTRA = ex ;
;
  compile_opt idl2, strictarrsubs
;
; is separate line a scalar? we must cut it into pieces?
   if n_elements(question) EQ 1 then question = str_sep(question, '!C', /trim)
; is a widget necessary?
   if keyword_set(chkwidget) then BEGIN
      if (widget_info(/managed))[0] EQ 0 then BEGIN
         if n_elements(proposedanswer) EQ 0 then BEGIN
            proposedanswer = ''
            answer = ''
            complete = ''
         ENDIF ELSE BEGIN
            answer = proposedanswer
            complete = '(default answer is '+proposedanswer+') '
         ENDELSE
         if n_elements(question) GT 1 THEN $
          for i = 0, n_elements(question)-2 do print,question[i]
         read, question[n_elements(question)-1]+' '+complete , answer
         if keyword_set(answer) EQ 0 then answer = proposedanswer
         return, answer
      endif
   endif
; definition of the widget
   BaseId = widget_base(/column, title = 'Question', _extra = ex)
   screensize = get_screen_size()
   widget_control, BaseId, tlb_set_xoffset = screensize[0]/2.2, tlb_set_yoffset = screensize[1]/2.2
   for i = 0,  n_elements(question)-1 DO trash = widget_label(BaseId, value = question[i], /align_left)
   if n_elements(proposedanswer) EQ 0 then answer = '' ELSE answer = proposedanswer
   trash = widget_text(BaseId, value = answer, /editable, _extra = ex, uname = 'text')
   trash = widget_button(BaseId, value = 'ok')
   ptranswer = ptr_new(/allocate_heap)
   widget_control, BaseId, set_uvalue = ptranswer
; we realize the widget and wait for an answer
   widget_control,BaseId,/realize
   xmanager,'xquestion',BaseId
; we get the answer
   answer = *ptranswer
; we freeing the pointer
   ptr_free, ptranswer
;
   return, answer
end