;
; $Id: widutil.pro,v 1.8 1994/06/01 23:08:48 ali Exp $
;
;  WidUtil
;   Miscellaneous Utility functions and procedures
;
; Copyright (c) 1993, Research Systems, Inc.  All rights reserved.
;   Unauthorized reproduction prohibited.
;
; MODIFICATION HISTORY
;       Written by:     Joshua Goldstein,       12/93
;
;



;
;  Event handler loop for Error dialog box
;
PRO ErrorEvent, Event

    ; The only event possible is a 'Done' so we don't bother
    ; to check, just bring the dialog down

    WIDGET_CONTROL, Event.top, /DESTROY
END


;
;  ErrorDialog
;       Create a dialog box and put an error message in it
;   Message can be a string or an array of strings
;
PRO ErrorDialog, Parent, Msg

    ;   Position the error dialog on top of its parent

    WIDGET_CONTROL, Parent, TLB_GET_OFFSET=Off
    Base    = WIDGET_BASE(/COLUMN, TITLE='ERROR!', $
                        XOFFSET=Off(0)+50, YOFFSET=Off(1)+50)

    ;   Add a label(line) for each line of the message
    FOR I=1,N_ELEMENTS(Msg) DO BEGIN
        Label   = WIDGET_LABEL(base,VALUE=Msg(I-1))
    ENDFOR

    ;   Make an acknowledge button for the user to press
    ;   We move it over (looks better).  Of course the fixed
    ;   offset stuff is not the best solution but seems to work
    Ok      = WIDGET_BUTTON(Base, VALUE='  OK  ', XOFF=70)  ; Bad?

    WIDGET_CONTROL, Base, /REALIZE
    XMANAGER, 'WidError', Base, /MODAL, EVENT_HANDLER='ErrorEvent'
END

;
;  Qstring(String)
;   Return a string which can be included in single quotes. That is.
;   double every single quote. E.g. QString("Do's 'n Don'ts") returns
;   Do''s ''n Don''ts.  Note that there is a bug in the IDL parser
;   which barfs on leading single quotes: '''' is a syntax error
;
;   Side Effect: Due to the nature of IDL variable passing, if
;   the string passed in is a named variable it will be altered
;
FUNCTION Qstring, String

    Len         = STRLEN(String)+1                  ; Starting length
    PrevQuote   = 0                                 ; Previous quote pos
    Quote       = STRPOS(String, "'", PrevQuote)    ; Current quote pos

    WHILE Quote NE -1 DO BEGIN                          ; given xx'yy
        Front       = STRMID(String,0,Quote+1)          ;   Front = xx'
        Back        = STRMID(String,Quote, Len - Quote) ;-) Back  = 'yy
        String      = Front + Back                      ; xx' + 'yy
        Len         = Len + 1                           ; string got longer

        PrevQuote   = Quote + 2                         ; quote is not previous quote
        Quote       = STRPOS(String, "'", PrevQuote)
    ENDWHILE
    RETURN, String
END


;
;  ClearVar
;   Reset a variable to <UNDEFINED> if it isn't already.
;
PRO ClearVar, Var
    IF N_ELEMENTS(Var) NE 0 THEN Dummy  = TEMPORARY(Var)
END


;
;  DoList
;       Given the pointer to a list of objects, perform a FIXED
;   function on each object in the list of the form:
;               Procstr,Ptr
;
PRO DoList, Ptr, ProcStr

    WHILE Ptr NE 0L DO BEGIN
        Next    = NextPtr(Ptr)
        Dummy   = EXECUTE(ProcStr + ",Ptr")
        Ptr     = Next
    ENDWHILE
END

;
;  DoFList
;       Given the pointer to a list of objects, perform an I/O
;   function on each object in the list of the form:
;               Procstr,Unit,Ptr
;
PRO DoFList, Ptr, ProcStr, Unit

    WHILE Ptr NE 0L DO BEGIN
        Next    = NextPtr(Ptr)
        Dummy   = EXECUTE(ProcStr + ",Unit,Ptr")
        Ptr     = Next
    ENDWHILE
END

;
;  DoFList2
;       Given the pointer to a list of objects, perform an I/O
;   function on each object in the list of the form:
;               Procstr,Unit1,Unit2,Ptr
;
PRO DoFList2, Ptr, ProcStr, Unit1, Unit2

    WHILE Ptr NE 0L DO BEGIN
        Next    = NextPtr(Ptr)
        Dummy   = EXECUTE(ProcStr + ",Unit1,Unit2,Ptr")
        Ptr     = Next
    ENDWHILE
END


;
;  GetType
;   Get the Type field out of an object.
;
PRO GetType, Ptr, Type
    Ptr2Obj, Ptr, Obj
    Type    = Obj.Type
    Obj2Ptr, Obj, Ptr
END


;
;  SetTag
;       Set an arbitrary field in an object given a pointer
;       to the object, the tag and its new value
;
PRO SetTag, Ptr, Tag, Value
    Ptr2Obj, Ptr, Obj
    Dummy       = EXECUTE("Obj."+ Tag + "= Value")
    Obj2Ptr, Obj, Ptr
END


;
;  NewId
;   Create a new name for an object
;
FUNCTION NewId

  COMMON WidEd_Comm

    New         = STRTRIM(LastId,2)
    LastId      = LastId + 1
    RETURN, New
END


;
;  VarId
;   Return the logical name of an object
;
FUNCTION VarId, Ptr
    Ptr2Obj, Ptr, Obj
    VarName = Obj.Type + Obj.Id
    Obj2Ptr, Obj, Ptr
    RETURN, VarName
END


;
;  GetId
;   Return what we think would be the best symbolic name for an object
;   This is either: the name the user gave it, its value(title) or its
;   logical name
;
FUNCTION GetId, Ptr

  COMMON WidEd_Comm

    IF Ptr EQ TopPtr THEN RETURN, 'Top Base'

    Ptr2Obj, Ptr, Obj

    IF Obj.Name NE '' THEN BEGIN
        Id  = Obj.Name
        Obj2Ptr, Obj, Ptr
        RETURN, Id
    ENDIF

    IF (Obj.Type EQ 'LABEL' OR Obj.Type EQ 'BUTTON') THEN BEGIN
        IF Obj.Value NE '' THEN BEGIN
            Id  = Obj.Value
            Obj2Ptr, Obj, Ptr
            RETURN, Id
        ENDIF
    ENDIF

    IF Obj.Type EQ 'FIELD' OR Obj.Type EQ 'SLIDER' OR $
       Obj.Type EQ 'FSLID' THEN BEGIN

        IF Obj.Title NE '' THEN BEGIN
            Id  = Obj.Title
            Obj2Ptr, Obj, Ptr
            RETURN, Id
        ENDIF
    ENDIF

    IF Obj.UValue NE '' THEN    Id = Obj.UValue $
    ELSE                        Id = Obj.Type + Obj.Id
    Obj2Ptr, Obj, Ptr
    RETURN, Id
END


;
;  UValue
;   If the user has not provided a UVALUE for an object we do so that
;   we can write an event handler.
;
FUNCTION UValue, Obj, Ptr
    IF Obj.UValue NE '' THEN RETURN, Obj.UValue
    RETURN, Obj.Type + Obj.Id
END


;
;  HasChildren
;   Returns TRUE if the object has children or is a base object
;   and has no children but thats OK. Otherwise return FALSE.
;
FUNCTION HasChildren, Ptr, NONE_OK=NoneOk

    ;   Bad pointers don't have children
    IF WIDGET_INFO(Ptr, /VALID_ID) EQ 0 THEN RETURN, 0

    Ptr2Obj, Ptr, Obj
    Name    = TAG_NAMES(Obj, /STRUCTURE)

    ;   Only Base objects can have children (so far)
    IF Name EQ 'WE_BASE' THEN BEGIN

        ; Actually has children or could have children but thats enough?
        IF Obj.Children NE 0 OR KEYWORD_SET(NoneOk) THEN BEGIN
            Obj2Ptr, Obj, Ptr
            RETURN, 1
        ENDIF
    ENDIF

    ;   Have a base object but it has no children and NoneOk is false

    Obj2Ptr, Obj, Ptr
    RETURN, 0
END


;
;  Dirty_Event
;   Event handler for the asking the user Dirty dialog (see below)
;
PRO Dirty_Event, Event

COMMON  WidDirty_Comm, DoCall

    WIDGET_CONTROL, Event.Id, GET_UVALUE=Ev

    ;   Save First?
    IF Ev EQ "Yes" THEN FileSave

    ;   Do we want to do whatever it is that we were asking about
    ;   saving before doing? We do for Yes or No but not Cancel
    DoCall  = (Ev NE "Cancel")

    ;   Done
    WIDGET_CONTROL, Event.Top, /DESTROY
END


;
;  Dirty
;   Give a user a chance to save changes before destroying the
;   object tree.  A 'Do you want to save the object tree before
;   doing XXX?' failsafe.
;
;   The way this works might be a tad confusing.
;   Run the widget builder, add some widget and hit 'Quit'.
;   That will make this a lot more understandable.
;
PRO Dirty, Parent, Thing, Call

COMMON  WidDirty_Comm, DoCall

  COMMON WidEd_Comm    

    ;   If there is no chance of loosing data then just do it

    IF Dirty EQ 0 THEN Dummy=EXECUTE(Call) $
    ELSE BEGIN

        ;   Position the 'Wanna do <Thing>?' dialog on top of parent
        WIDGET_CONTROL, Parent, TLB_GET_OFFSET=Off
        Base    = WIDGET_BASE(/COLUMN, XOFFSET=Off(0)+50, YOFFSET=Off(1)+50)

        ;   Build question
        Label   = WIDGET_LABEL(Base, VALUE="Save changes before");
        Label   = WIDGET_LABEL(Base, VALUE=Thing+"?");

        ;   Build possible answers
        Base1   = WIDGET_BASE(Base, /ROW)
        Btn     = WIDGET_BUTTON(Base1, VALUE="  Yes  ", UVALUE="Yes")
        Btn     = WIDGET_BUTTON(Base1, VALUE="   No  ", UVALUE="No")
        Btn     = WIDGET_BUTTON(Base1, VALUE=" Cancel", UVALUE="Cancel")

        ;   Wait for user to answer your question
        WIDGET_CONTROL, Base, /REALIZE
        XMANAGER, 'WidError', Base, /MODAL, EVENT_HANDLER='Dirty_Event'

        ;   Event handler will set DoCall to TRUE if the user wants
        ;   to do whatever it is (Call).  Have to do this here to prevent
        ;   XMANAGER MODAL looping bug.

        IF DoCall THEN Dummy = EXECUTE(Call)
    ENDELSE
END


;
;  SAddCmd
;   Append a string keyword to a command string. Only append
;   keyword if value is not the null string ('') or the FORCE
;   keyword is set
;
;   E.g.
;       Cmd='WidCre(XXX' & SAddCmd, Cmd, "Hello", "VALUE"
;       HELP,Cmd
;   CMD STRING  = "WidCre(XXX,VALUE='Hello'"
;
PRO SAddCmd, Cmd, Value, Keyword, FORCE=Force
    IF Value NE '' OR KEYWORD_SET(FORCE) THEN $
        Cmd = Cmd + ',' + Keyword + "='" + QString(Value) + "'"
END


;
;  IAddCmd
;   Same as SAddCmd but for integer values. Only appends keyword
;   if value is non-zero or FORCE keyword set.
;
PRO IAddCmd, Cmd, Value, Keyword, FORCE=Force
    IF Value NE 0 OR KEYWORD_SET(FORCE) THEN $
        Cmd = Cmd + ',' + Keyword + '=' + STRTRIM(Value,2)
END


;
;  SetFocus
;   Set the focus to the given widget.  Id should be either:
;   a TEXT widget or a compound widget (base) whose first text object
;   in it is what should receive the keyboard focus
;
PRO SetFocus, Id

    IF WIDGET_INFO(Id, /TYPE) EQ 3 THEN BEGIN   ; Text Widget?
        TextId  = Id
    ENDIF ELSE BEGIN
        TextId  = WIDGET_INFO(Id, /CHILD)       ; Assume Base

        ;   Hunt through children looking for first text widget
        WHILE TextId NE 0 AND WIDGET_INFO(TextId,/TYPE) NE 3 DO BEGIN
            TextId  = WIDGET_INFO(TextId, /SIBLING)
        ENDWHILE
    ENDELSE

    WIDGET_CONTROL, TextId, /INPUT_FOCUS        ; Set keyboard focus
END


;
;  SetNextFocus
;   If the user has hit <CR> (event.update will be TRUE) and we
;   can find the current focus then determine the next focus and
;   give it the keyboard focus.
;
PRO SetNextFocus, Binfo, Event

    ;   Look for the current id in our list of known foci

    Current        = WHERE(BInfo.Foci EQ Event.Id, Count)
    IF Count EQ 1 THEN BEGIN

        ;   Did user hit <CR>? Goto next focus if they did
        IF Event.Update THEN BEGIN
            ;   Next is a relative term (wrap from last to first)
            Current = (Current(0) + 1) MOD N_ELEMENTS(BInfo.Foci)
            SetFocus, BInfo.Foci(Current)
        ENDIF
    ENDIF
END


;
;  GetValue
;   Given an object with an text field for a value (STRARR)
;   get that value.  If the value is nil then use the default (NoName)
;   value instead: Returning <UNDEFINED> is not good.
;
PRO GetValue, Obj, Names, NoName

;   (c.f. BuildEdit in widbuild.pro)

;   IF Obj.ValueType EQ 0 THEN BEGIN

        Ptr2Obj, Obj.Value1, Names, /COPY
        IF N_ELEMENTS(Names) EQ 0 THEN Names=NoName

;   ENDIF ELSE BEGIN
;       Unsupportable.
;       Names = '<User Code>'
;   ENDELSE
END

PRO WidUtil
END