FUNCTION def_widget_error_message, message, $ TRACEBACK = traceback, $ NONAME = noname, $ _EXTRA = extra ON_ERROR, 2 ; Check for presence and type of message. IF N_ELEMENTS (message) EQ 0 THEN message = !Error_State.Msg ; Make sure that we have a string message s = SIZE (message) type = s [s[0] + 1] IF type NE 7 THEN BEGIN MESSAGE, "The message parameter must be a string.", _EXTRA = extra ENDIF ; Get the call stack and the calling routine's name. HELP, CALL = callstack calledby = (STR_SEP (STRCOMPRESS (callstack [1]), " ")) [0] IF KEYWORD_SET (noname) THEN BEGIN xack, message, MODAL = 0, _EXTRA = extra ENDIF ELSE BEGIN IF STRUPCASE (calledby) EQ "$MAIN$" THEN BEGIN xack = DIALOG_MESSAGE (message, _EXTRA = extra) ENDIF ELSE BEGIN answer = DIALOG_MESSAGE (STRUPCASE (calledby) + ": " + message, _EXTRA = extra ) ENDELSE ENDELSE ; Provide traceback information if requested. IF KEYWORD_SET (traceback) THEN BEGIN HELP, /LAST_MESSAGE, OUTPUT = traceback PRINT,'' PRINT, 'Traceback Report from ' + STRUPCASE (calledby) + ':' PRINT, '' FOR j=0, N_ELEMENTS (traceback) - 1 DO PRINT, " " + traceback[j] ENDIF RETURN, 1 END ; ------------------------------------------------------------------------------------------------ FUNCTION def_widget_obj::getlabelid ; This method returns the ID of the text widget of the compound widget. RETURN, self.lbl_id END ; ------------------------------------------------------------------------------------------------ FUNCTION def_widget_obj::getdebug ; This method returns the debug flag from the compound widget. RETURN, self.debug END ; ------------------------------------------------------------------------------------------------ FUNCTION def_widget_obj::getid ; This method returns the ID of the top-level base of the compound widget. RETURN, self.tlb END ; ------------------------------------------------------------------------------------------------ PRO def_widget_obj::map, REALIZE = realize ; This method causes the widget to display itself. ; Check if we are not currently realized. If not, then the user may ; be asking us to realize the widgit as well. IF self.realized EQ 0 THEN BEGIN ; OK, not realized yet. Is the REALIZE keyword set? IF KEYWORD_SET (realize) THEN BEGIN ; OK, go ahead and realize the widget. Also set the property REALIZED ; to 1 (TRUE) to indicate our new status. WIDGET_CONTROL, self.tlb, /REALIZE self.realized = 1 ENDIF ENDIF ; Make sure we are mapped. WIDGET_CONTROL, self.tlb, MAP = 1 END ; ------------------------------------------------------------------------------------------------ PRO def_widget_obj::unmap ; This method causes the widget to display itself. WIDGET_CONTROL, self.tlb, MAP = 0 END ; ------------------------------------------------------------------------------------------------ FUNCTION def_widget_obj::geometry ; This method returns the geometry of the compound widget. RETURN, WIDGET_INFO (self.tlb, /GEOMETRY) END ; ------------------------------------------------------------------------------------------------ FUNCTION def_widget_obj::get_value ; This is just a stub procedure wich returns the undefined value. RETURN, *self.undefined END ; ------------------------------------------------------------------------------------------------ PRO def_widget_obj::manage_widget, JUST_REG = just_reg, $ NO_BLOCK = no_block, $ MODAL = modal, $ EVENT_HANDLER = event_handler, $ REALIZE = realize ; Start the xmanager to manage this widget. It is assumed that ; xmanager will be started with the /JUST_REG keyword. This is the ; default, although the user can override this behavior. ; Set some defaults. IF N_ELEMENTS (just_reg) EQ 0 THEN just_reg = 0 IF N_ELEMENTS (modal) EQ 0 THEN modal = 1 IF N_ELEMENTS (no_block) EQ 0 THEN no_block = 1 ; Check if the realize flag is set. If it is then call the map method in ; order to realize this widget. IF KEYWORD_SET (realize) THEN self->map, /REALIZE ; Check if the EVENT_HANDLER keyword was passed to us. IF it was, ; then set the pass_ext_events flag. IF KEYWORD_SET (event_handler) THEN self.pass_ext_events = 1 ; Go call xmanager. XMANAGER, self.name, $ self.tlb, $ JUST_REG = just_reg, $ EVENT_HANDLER = event_handler, $ NO_BLOCK = no_block, $ GROUP_LEADER = self.group_leader, $ MODAL = modal RETURN END ; ------------------------------------------------------------------------------------------------ PRO def_widget_obj::getproperty, $ ; ; This method allows you to obtain various properties of ; the compound widget via output keywords. ; EVENT_FUNC = event_func, $ ; Set this keyword to the name of an Event Function. EVENT_PRO = event_pro, $ ; Set this keyword to the name of an Event Procedure. NAME = Name, $ ; The name of the object. NONSENSITIVE = nonsensitive, $ ; Setting this keywords makes the text widget non-sensitive. UVALUE = uvalue, $ ; A user value for any purpose. UNDEFINED = undefined, $ ; Set to the "value" of undefined value. FLDFONT = fieldfont, $ ; The font name for the text in the Text Widget. LBLFONT = labelfont, $ ; The font name for the text in the Label Widget. BTNFONT = buttonfnt, $ ; The font name for the text in the Button Widgets. COLUMN = column, $ ; Hint to the object that the widget should align in columns. ROW = row, $ ; Hint to the object that the widget should align in rows. DOE = doe, $ ; Set to 1 if the widget should be killed during cleanup. REALIZED = realized, $ ; True if widget has been realized by using the MAP() method. DEBUG = debug ; Debug flag. If TRUE (1) then print debug info. ; Error Handling. Catch, theError IF theError NE 0 THEN BEGIN CATCH, /CANCEL ok = def_widget_error_message (/TRACEBACK) RETURN ENDIF ; Get the properties. event_func = self.event_func event_pro = self.event_pro name = self.name nonsensitive = self.nonsensitive debug = self.debug undefined = *self.undefined row = self.row doe = self.doe column = self.column fieldfont = self.fieldfont labelfont = self.labelfont buttonfnt = self.buttonfnt realized = self.realized WIDGET_CONTROL, self.tlb, GET_UVALUE = uvalue END ; ------------------------------------------------------------------------------------------------ PRO def_widget_obj::setproperty, $ ; ; This method allows you to set various properties of the compound widget. ; EVENT_FUNC = event_func, $ ; Set this keyword to the name of an Event Function. EVENT_PRO = event_pro, $ ; Set this keyword to the name of an Event Procedure. NAME = name, $ ; A scalar string name for the object. NONSENSITIVE = nonsensitive, $ ; Setting this keywords makes the text widget non-sensitive. DATABASE = database, $ ; Name of the database to interogate. DOE = doe, $ ; Set to 1 if the widget should be killed during cleanup. UNDEFINED = undefined, $ ; Set to "value" of undefined value. UVALUE = uvalue ; A user value for any purpose. ; Error Handling. Catch, theError IF theError NE 0 THEN BEGIN Catch, /Cancel ok = def_widget_error_message (/Traceback) RETURN ENDIF ; Set the properties, if needed. IF N_ELEMENTS (event_func) NE 0 THEN self.event_func = event_func IF N_ELEMENTS (event_pro) NE 0 THEN self.event_pro = event_pro IF N_ELEMENTS (uvalue) NE 0 THEN WIDGET_CONTROL, self.tlb, SET_UVALUE = uvalue If N_ELEMENTS (name) NE 0 Then self.name = STRING (name[0]) IF N_ELEMENTS (nonsensitive) THEN BEGIN self.nonsensitive = KEYWORD_SET (nonsensitive) ENDIF IF N_ELEMENTS (doe) THEN BEGIN self.doe = KEYWORD_SET (doe) ENDIF IF N_ELEMENTS (undefined) THEN BEGIN IF PTR_VALID (self.undefined) THEN PTR_FREE, self.undefined self.undefined = PTR_NEW (undefined) ENDIF RETURN END ; ------------------------------------------------------------------------------------------------ PRO def_widget_obj::setsensitive, value ; Error Handling. CATCH, theError IF theError NE 0 THEN BEGIN CATCH, /Cancel ok = def_widget_error_message (/Traceback) RETURN ENDIF IF N_ELEMENTS (value) EQ 0 THEN value = 1 self.nonsensitive = value END ; ------------------------------------------------------------------------------------------------ FUNCTION def_widget_obj::init, $ ; The compound widget DEF_WIDGET_OBJ INIT method.. parent, $ ; The parent widget. Required for all compound widgets. EVENT_FUNC = event_func, $ ; Set this keyword to the name of an Event Function. EVENT_PRO = event_pro, $ ; Set this keyword to the name of an Event Procedure. _EXTRA = extra, $ ; Passes along extra keywords to the widget. FRAME = frame, $ ; Set this keyword to put a frame around the widget. NAME = name, $ ; A scalar string name for the object. FLDFONT = fieldfont, $ ; The font name for the text in the Text Widget. LBLFONT = labelfont, $ ; The font name for the text in the Label Widget. BTNFONT = buttonfnt, $ ; The font name for the text in the Button Widgets. NONSENSITIVE = nonsensitive, $ ; Setting this keywords makes the text widget non-sensitive. TITLE = title, $ ; The text to go on the Label Widget. DOE = doe, $ ; Die on exit flag. MENU_BAR = menu_bar, $ ; DEBUG = debug, $ ; Debug flag. If TRUE (1) then print debug info. COLUMN = column, $ ; Hint to the object that the widget should align in columns. ROW = row, $ ; Hint to the object that the widget should align in rows. UNDEFINED = undefined, $ ; Set to the value for "undefined" field values. INIT_ERR_MSG = init_err_msg, $ ; Initialization error message. MODAL = modal, $ ; Creates a modal widget -- group leader must be specified. GROUP_LEADER = group_leader, $ ; Group leader for the widget. UVALUE = uvalue ; A user value for any purpose. ; Error Handling. Catch, theError IF theError NE 0 THEN BEGIN CATCH, /CANCEL ok = def_widget_error_message (/TRACEBACK) RETURN, 0 ENDIF ; Set the pass_ext_events flag if either the event_func or event_pro ; keywords were passed. pass_ext_events = KEYWORD_SET (event_func) || KEYWORD_SET (event_pro) ; Check keyword values. IF N_ELEMENTS (event_func) EQ 0 THEN event_func = "" IF N_ELEMENTS (event_pro) EQ 0 THEN event_pro = "" IF N_ELEMENTS (frame) EQ 0 THEN frame = 0 IF N_ELEMENTS (labelfont) EQ 0 THEN labelfont = "" IF N_ELEMENTS (fieldfont) EQ 0 THEN fieldfont = "" IF N_ELEMENTS (buttonfnt) EQ 0 THEN buttonfnt = "" IF N_ELEMENTS (name) EQ 0 THEN name = "" nonsensitive = KEYWORD_SET (nonsensitive) debug = KEYWORD_SET (debug) row = KEYWORD_SET (row) column = KEYWORD_SET (column) IF N_ELEMENTS (doe) EQ 0 THEN doe = 1 IF N_ELEMENTS (title) EQ 0 THEN title = "" IF N_ELEMENTS (modal) EQ 0 THEN modal = 0 IF N_ELEMENTS (uvalue) EQ 0 THEN uvalue = "" IF N_ELEMENTS (group_leader) EQ 0 THEN group_leader = 0 IF N_ELEMENTS (undefined) EQ 0 THEN undefined = !VALUES.F_NAN ; Make sure that name and title are string values. name = STRING (name [0]) title = STRING (title [0]) ; Set the orphan flag to 0 (FALSE). If no parent is defined, then it will be reset. orphan = 0 ; Check if a parent value was passed to us. IF N_ELEMENTS (parent) EQ 0 THEN BEGIN IF debug THEN PRINT, 'WARNING: Widget Object is being called without a PARENT arguement.' orphan = 1 ENDIF ; Print a warning message if DEBUG has been defined. IF debug THEN PRINT, 'WARNING: DEBUG is enabled for ' + name + ' ' + title + ' widget.' ; Populate the object. IF NOT orphan THEN self.parent = parent ELSE self.parent = -1 self.event_pro = event_pro self.event_func = event_func self.nonsensitive = nonsensitive self.debug = debug self.labelfont = labelfont self.fieldfont = fieldfont self.buttonfnt = buttonfnt self.row = row self.column = column self.title = title self.name = name self.group_leader = group_leader self.modal = modal self.doe = doe self.pass_ext_events = pass_ext_events self.undefined = PTR_NEW (undefined) ; Create the widgets. IF orphan THEN BEGIN ; Check if the keyword menu_bar was passed to us and is a defined variable name. ; If it was then we pass it as parameter to the WIDGET_BASE function. Note that ; a MODAL dialog box can never have a menu bar, so will omit that as an option ; from the first call. IF KEYWORD_SET (menu_bar) THEN BEGIN mb = 0L self.tlb = WIDGET_BASE ( $ FRAME = frame, $ BASE_ALIGN_CENTER = 1, $ MBAR = mb, $ TITLE = title, $ UNAME = name, $ UVALUE = uvalue, $ GROUP_LEADER = group_leader, $ FUNC_GET_VALUE = 'def_widget_get_value', $ EVENT_PRO = event_pro, $ EVENT_FUNC = event_func $ ) self.menu_bar = mb ENDIF ELSE BEGIN self.tlb = WIDGET_BASE ( $ FRAME = frame, $ BASE_ALIGN_CENTER = 1, $ TITLE = title, $ UNAME = name, $ UVALUE = uvalue, $ MODAL = modal, $ GROUP_LEADER = group_leader, $ FUNC_GET_VALUE = 'def_widget_get_value', $ EVENT_PRO = event_pro, $ EVENT_FUNC = event_func $ ) ENDELSE ENDIF ELSE BEGIN self.tlb = WIDGET_BASE (parent, $ FRAME = frame, $ BASE_ALIGN_CENTER = 1, $ TITLE = title, $ UNAME = name, $ UVALUE = uvalue, $ FUNC_GET_VALUE = 'def_widget_get_value', $ EVENT_PRO = event_pro, $ EVENT_FUNC = event_func $ ) ENDELSE ; Set up a base widget to align the other child widgets to. self.align = WIDGET_BASE (self.tlb, COLUMN = column, ROW = row) ; Store a pointer to the object as the uvalue of the child widget. WIDGET_CONTROL, self.align, SET_UVALUE = self ; Set up procedure to kill off the object if the widget dies WIDGET_CONTROL, self.align, KILL_NOTIFY = 'def_widget_kill_notify' RETURN, 1 END ; ------------------------------------------------------------------------------------------------ PRO def_widget_obj::def_widget_event, event ; This is just a stub. Any widget that actually will use this method should replace it ; with thier own version. RETURN END ; ------------------------------------------------------------------------------------------------ PRO def_widget_obj::cleanup ; This method makes sure there are not pointers left on the heap. ; First check to see if the debug flag is set. If it is, then create message ; describing the object that is about to be destroyed. IF self.debug THEN BEGIN msg = 'CLEANUP method called for ' IF self.name EQ "" $ THEN msg = msg + 'unnamed widget' $ ELSE msg = msg + 'widget: ' + self.name msg = msg + ' with ID: ' + STRING (self.tlb, FORMAT = '(I0)') PRINT, msg ENDIF ; Get rid of whatever value we are using to represent an undefined value. PTR_FREE, self.undefined ; Kill off the widget if it is still around. ; IF WIDGET_INFO (self.tlb, /VALID_ID) THEN BEGIN IF self.doe THEN BEGIN WIDGET_CONTROL, self.tlb, KILL_NOTIFY = '' WIDGET_CONTROL, self.tlb, /DESTROY ENDIF RETURN END ; ------------------------------------------------------------------------------------------------ PRO def_widget_event, event ;-- Default event handler event_type = TAG_NAMES (event, /STRUCTURE_NAME) PRINT, event_type, " Event Generated By Widget ID: ", event.id ; Get the object reference for the object that generated this event. ; The object reference is stored in the first child widget of the top level base of ; the calling widget. child = WIDGET_INFO (event.top, /CHILD) ; Now get the object reference. WIDGET_CONTROL, child, GET_UVALUE = obj ; Now call the def_widget_event method for the object. CALL_METHOD,'def_widget_event', obj, event RETURN END ; ------------------------------------------------------------------------------------------------ FUNCTION def_widget_event_handler, event ; The main event handler for the compound widget. It reacts ; to "messages" in the UValue of the text widget. ; The message indicates which object method to call. A message ; consists of an object method and the self object reference. WIDGET_CONTROL, event.id, GET_UVALUE = message ; Check if need to print debugging info. IF message.object->getdebug () THEN BEGIN message.object->getproperty, NAME = name msg = 'Calling method: ' + message.method + ' from ' IF name EQ "" $ THEN msg = msg + 'unnamed widget' $ ELSE msg = msg + 'widget: ' + name msg = msg + ' with ID: ' + STRING (event.id, FORMAT = '(I0)') PRINT, msg ENDIF event = CALL_METHOD (message.method, message.object, event) RETURN, event END ; ------------------------------------------------------------------------------------------------ PRO def_widget_event__define ; The DEF_WIDGET_OBJ Event Structure. Sent only if EVENT_PRO or EVENT_FUNC keywords ; have defined an event handler for the top-level base of the compound widget. event = { DEF_WIDGET_EVENT, $ ; The name of the event structure. ID: 0L, $ ; The ID of the compound widget's top-level base. TOP: 0L, $ ; The widget ID of the top-level base of the hierarchy. HANDLER: 0L $ ; The event handler ID. Filled out by IDL. } END ; ------------------------------------------------------------------------------------------------ FUNCTION def_widget_get_value, tlb ; This utilty routine is invoked when the user tries to get ; the value of the compound widget using the base widget ; identifier of the top-level base of the compound widget. ; The self object is located, and the get_value method is called ; on the object. childid = WIDGET_INFO (tlb, /CHILD) WIDGET_CONTROL, childid, GET_UVALUE = self RETURN, self->get_value () END ; ------------------------------------------------------------------------------------------------ PRO def_widget_kill_notify, widget_id ; This widget call-back procedure makes sure the self object is ; destroyed when the widget is destroyed. WIDGET_CONTROL, widget_id, GET_UVALUE = obj ; Set the object tag doe to 0 to indicate that the widget is already being killed ; so it doesn't need to be destroyed a second time. obj->setproperty, DOE = 0 ; Destroy the object associated with the widget. OBJ_DESTROY, obj END ; ------------------------------------------------------------------------------------------------ PRO def_widget_notify_realize, widget_id ; This widget call-back procedure is used to route a call to ; an object method when the widget is realized. The object ; method must be called 'notify_realize'. WIDGET_CONTROL, widget_id, GET_UVALUE = uval ; Check if need to print debugging info. IF uval.object->getdebug () THEN BEGIN uval.object->getproperty, NAME = name msg = 'Calling method: notify_realize from ' IF name EQ "" $ THEN msg = msg + 'unnamed widget' $ ELSE msg = msg + 'widget: ' + name msg = msg + ' for child widget with ID: ' + STRING (widget_id, FORMAT = '(I0)') PRINT, msg ENDIF CALL_METHOD, 'notify_realize', uval.object, widget_id END ; ------------------------------------------------------------------------------------------------ PRO def_widget_obj__define obj = { DEF_WIDGET_OBJ, $; The object class name. parent: 0L, $; The parent widget ID. align: 0L, $; Widget ID of the align base widget. tlb: 0L, $; The top-level base of the compound widget. lbl_id: 0L, $; The main title label widget ID. menu_bar: 0L, $; The ID of the menu_bar widget (if there is a menu bar). event_func: "", $; The name of the specified event handler function. event_pro: "", $; The name of the specified event handler procedure nonsensitive: 0, $; Setting this keywords makes the text widget non-sensitive. name:"", $; a scalar string name for the object undefined: PTR_NEW (), $; The "undefined" value. Used in Get_Value methods, etc. fieldfont: "", $; The font name for the text in the Text Widget. labelfont: "", $; The font name for the text in the Label Widget. buttonfnt: "", $; The font name for the text in the Button Widgets. title: "", $; The text to go on the Label Widget. modal: 0, $; Creates a modal widget -- group leader must be specified. group_leader: 0L, $; Group leader for the widget. column: 0, $; Hint to the object that the widget should align in columns. row: 0, $; Hint to the object that the widget should align in rows. doe: 0, $; Set to 1 if the widget should be killed during cleanup. pass_ext_events: 0, $; Set to 1 if an external handler is defined. realized: 0, $; True if widget has been realized by using the MAP() method. debug: 0 $; Debug flag. If TRUE (1) then print debug info. } END