FUNCTION eis_search_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 eis_search::getlabelid ; This method returns the ID of the text widget of the compound widget. RETURN, self.lbl_id END ; ------------------------------------------------------------------------------------------------ FUNCTION eis_search::getdebug ; This method returns the debug flag from the compound widget. RETURN, self.debug END ; ------------------------------------------------------------------------------------------------ FUNCTION eis_search::getid ; This method returns the ID of the top-level base of the compound widget. RETURN, self.tlb END ; ------------------------------------------------------------------------------------------------ FUNCTION eis_search::geometry ; This method returns the geometry of the compound widget. RETURN, WIDGET_INFO (self.tlb, /GEOMETRY) END ; ------------------------------------------------------------------------------------------------ FUNCTION eis_search::get_value ; This method returns the actual value of the compound widget. ; Check which radio button is set. IF self.usr_mode EQ 1 THEN BEGIN ; The usr_mode flag is TRUE, therefore we need to get the search string from ; the user text entry box. WIDGET_CONTROL, self.str_id, GET_VALUE = text ; Check if the empty string was retreived from the text entry box. ; If it was, then return it as the result of this function. IF text [0] EQ "" THEN RETURN, "" ; Check the search string to make sure that there are no syntax errors. status = self.db_tools->check_querry (text, ERRMSG = errmsg, ERRPOS = errpos, DB_ITEM = *self.db_item) ; Check if their there were any errors in the search string. If there were, put up ; an informative text box describing them. IF status NE 0 THEN BEGIN msg1 = text msg2 = BLANK (errpos + 1) ; msg3 = STRING (status, errmsg, FORMAT = '("Detected Error : ", I0, "::", A)') msg3 = errmsg STRPUT, msg2, '^', errpos msg1 = " " + msg1 + " " msg2 = " " + msg2 + " " msg3 = " " + msg3 + " " xack, ["", msg3, "", msg1, msg2], $ result, $ GROUP = self.tlb, $ /STOP_ICON, $ TITLE = 'Error In Database Querry', $ SPACE = 0 text = "" ENDIF ENDIF ELSE BEGIN ; Otherwise get the search string from the database field entry boxes, if any exist. text = self.search_id->get_value () ENDELSE ; Make sure that text is a scaler variable. text = text [0] ; Trim any leading or trailing blanks off the user search string. Also pretty it up a bit. text = STRTRIM (STRCOMPRESS (text), 2) ; Were done, return. RETURN, text END ; ------------------------------------------------------------------------------------------------ FUNCTION eis_search::applyevent, event ; The APPLY button was pressed. ; Check if either an event procedure or event function is defined for the top level ; base widget. If it is, then set compound_event to the apply button event. Otherwise ; compound_event just gets set to 0. IF self.event_func NE "" OR self.event_pro NE "" THEN BEGIN ; Get value of the widget. val = self->get_value () ; Check if the empty string is set as the value of the widget. If it is, just eat the ; event so that no further processing will occur. IF val EQ "" THEN RETURN, 0 ; Create the OK event. compound_event = { EIS_SEARCH_EVENT, $ self.tlb, $ event.top, $ 0L, $ val, $ 1 } ENDIF ELSE compound_event = 0 RETURN, compound_event END ; ------------------------------------------------------------------------------------------------ FUNCTION eis_search::btn1event, event ; Radio button 1 was pressed. ; Unset radio button 2. WIDGET_CONTROL, self.bt2_id, SET_BUTTON = 0 ; Set the user mode to 1 (TRUE) self.usr_mode = 1 RETURN, 0 END ; ------------------------------------------------------------------------------------------------ FUNCTION eis_search::btn2event, event ; Radio button 2 was pressed. ; Unset radio button 1. WIDGET_CONTROL, self.bt1_id, SET_BUTTON = 0 ; Set the user mode to 0 (FALSE) self.usr_mode = 0 RETURN, 0 END ; ------------------------------------------------------------------------------------------------ FUNCTION eis_search::cancelevent, event ; The cancel button was pressed. ; Check if either an event procedure or event function is defined for the top level ; base widget. If it is, then set compound_event to the cancel button event. Otherwise ; compound_event just gets set to 0. IF self.event_func NE "" OR self.event_pro NE "" THEN BEGIN compound_event = { EIS_SEARCH_EVENT, $ self.tlb, $ event.top, $ 0L, $ "", $ 0 } RETURN, compound_event ENDIF ; Otherwise, destroy the widget. WIDGET_CONTROL, self.tlb, /DESTROY RETURN, 0 END ; ------------------------------------------------------------------------------------------------ FUNCTION eis_search::listevent, event ; An event was generated by the database item list box. ; Check what type of event was generated. IF event.type EQ "CLICK" THEN BEGIN ; CLICK event ; Make sure that it is a double click. Single clicks are ignored. IF event.clicks EQ 1 THEN RETURN, 0 ; Get the list of data base items that are in the selection list box. ptr = self.select_id->get_value () ; Find out which item the user double clicked on in the list widget item = (*ptr) [event.index] ; Add the item into the list or selected database fields self.search_id->add_search_field, item ; Were done. RETURN, 0 ENDIF IF event.type EQ "CANCEL" THEN BEGIN ; CANCEL event ; Clear any stored database item names. self.search_id->del_all_field ; Were done. RETURN, 0 ENDIF IF event.type EQ "SELECT" THEN BEGIN ; SELECT event ; Get the list of data base items that are in the selection list box. ptr = self.select_id->get_value () ; Loop to add each selected item into the list of selected database fields. FOR i = 0, event.num - 1 DO BEGIN ; Get the next database field name from the list widget item = (*ptr) [event.index + i] ; Add the item into the list or selected database fields self.search_id->add_search_field, item ENDFOR ; Were done. RETURN, 0 ENDIF RETURN, 0 END ; ------------------------------------------------------------------------------------------------ PRO eis_search::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. DATABASE = database, $ ; Name of the database to interogate. UVALUE = uvalue, $ ; A user value for any purpose. DEBUG = debug ; Debug flag. If TRUE (1) then print debug info. ; Error Handling. Catch, theError IF theError NE 0 THEN BEGIN CATCH, /CANCEL ok = eis_search_Error_Message (/TRACEBACK) RETURN ENDIF ; Get the properties. event_func = self.event_func event_pro = self.event_pro name = self.name database = self.database nonsensitive = self.nonsensitive debug = self.debug WIDGET_CONTROL, self.tlb, GET_UVALUE = uvalue END ; ------------------------------------------------------------------------------------------------ PRO eis_search::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. UNDEFINED = undefinded, $ ; 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 = eis_search_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 (database) THEN BEGIN self.database = database self.select_id->setproperty, DATABASE = database ; Free the old database item list PTR_FREE, self.db_item ; Get the item list for the new database. self.db_tools->get_db_info, database, DB_ITEM = lst ; Explode the item list for the selected database and at the same time create a heap ; variable to reference it. self.db_item = PTR_NEW (self.db_tools->exp_ptr_items (lst)) ENDIF END ; ------------------------------------------------------------------------------------------------ PRO eis_search::setsensitive, value ; Error Handling. Catch, theError IF theError NE 0 THEN BEGIN Catch, /Cancel ok = eis_search_Error_Message(/Traceback) RETURN ENDIF IF N_Elements (value) EQ 0 THEN value = 1 self.nonsensitive = value END ; ------------------------------------------------------------------------------------------------ FUNCTION eis_search::init, $ ; The compound widget EIS_SEARCH 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 text 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. DATABASE = database, $ ; Name of the database to interogate. NONSENSITIVE = nonsensitive, $ ; Setting this keywords makes the text widget non-sensitive. TITLE = title, $ ; The text to go on the Label Widget. DEBUG = debug, $ ; Debug flag. If TRUE (1) then print debug info. UVALUE = uvalue ; A user value for any purpose. ; Error Handling. Catch, theError IF theError NE 0 THEN BEGIN Catch, /Cancel ok = eis_search_error_message (/TRACEBACK) RETURN, 0 ENDIF ; 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 ; PRINT, 'WARNING: EIS SEARCH Widget is being called without a PARENT arguement.' orphan = 1 ENDIF ; 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 (database) EQ 0 THEN database = "" IF N_ELEMENTS (name) EQ 0 THEN name = "" nonsensitive = KEYWORD_SET (nonsensitive) debug = KEYWORD_SET (debug) IF N_ELEMENTS (title) EQ 0 THEN title = "EIS Advanced Database Search " IF N_ELEMENTS (uvalue) EQ 0 THEN uvalue = "" IF N_ELEMENTS (value) EQ 0 THEN value = "" ; 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.database = database IF N_ELEMENTS (name) NE 0 Then self.name = STRING (name[0]) ; Create the widgets. IF orphan THEN BEGIN self.tlb = WIDGET_BASE ( $ FRAME = frame, $ BASE_ALIGN_CENTER = 1, $ TITLE = title, $ UNAME = name, $ UVALUE = uvalue, $ FUNC_GET_VALUE = 'eis_search_get_value', $ EVENT_PRO = event_pro, $ EVENT_FUNC = event_func $ ) ENDIF ELSE BEGIN self.tlb = WIDGET_BASE (parent, $ FRAME = frame, $ BASE_ALIGN_CENTER = 1, $ TITLE = title, $ UNAME = name, $ UVALUE = uvalue, $ FUNC_GET_VALUE = 'eis_search_get_value', $ EVENT_PRO = event_pro, $ EVENT_FUNC = event_func $ ) ENDELSE ; Set desc_1 to a descriptive string describing the use dababase field selection ; widget. desc_1 = "Select individual database fields From the list below." ; Set desc_2 to a descriptive string describing the use of text entry widget. desc_2 = "OR enter a search string to query the database:" ; Set desc_3 to a descriptive string to briefly describe database field query widgets. desc_3 = "Use the select button on the left to define the query operation" align = WIDGET_BASE (self.tlb, /COLUMN) self.lbl_id = WIDGET_LABEL ( align, $ VALUE = title, $ FONT = labelfont, $ /FRAME $ ) but = WIDGET_BASE (align, /EXCLUSIVE) but = WIDGET_BUTTON (but, $ VALUE = desc_1, $ FONT = buttonfnt, $ EVENT_FUNC = 'eis_search_event_handler', $ UVALUE = {method: "btn2event", object:self} $ ) self.bt2_id = but slc = OBJ_NEW ('list_db_item', $ align, $ DATABASE = self.database, $ /ROW, $ /NO_LABEL, $ FLDFONT = fieldfont, $ LBLFONT = labelfont, $ BTNFONT = buttonfnt, $ EVENT_FUNC = 'eis_search_event_handler', $ UVALUE = {method: "listevent", object:self} $ ) self.select_id = slc lst = OBJ_NEW ('search_db_item', $ align, $ TITLE = desc_3, $ FLDFONT = fieldfont, $ LBLFONT = labelfont, $ BTNFONT = buttonfnt $ ) self.search_id = lst srch = WIDGET_BASE (align, /COLUMN, /FRAME) but = WIDGET_BASE (srch, /EXCLUSIVE) but = WIDGET_BUTTON (but, $ VALUE = desc_2, $ FONT = buttonfnt, $ EVENT_FUNC = 'eis_search_event_handler', $ UVALUE = {method: "btn1event", object:self} $ ) self.bt1_id = but str = WIDGET_TEXT (srch, $ /EDITABLE, $ FONT = textfont, $ XSIZE = 40, $ VALUE = "", $ EVENT_FUNC = 'eis_search_event_handler', $ UVALUE = {method: "applyevent", object:self} $ ) self.str_id = str ; Set the db list object to return an empty string as its NULL value. self.search_id->setproperty, UNDEFINED = "" btns = WIDGET_BASE (align, /ROW) app = WIDGET_BUTTON (btns, $ /FRAME, $ VALUE = 'Apply', $ FONT = buttonfnt, $ EVENT_FUNC = 'eis_search_event_handler', $ UVALUE = {method: "applyevent", object:self} $ ) self.app_id = app can = WIDGET_BUTTON (btns, $ /FRAME, $ VALUE = 'Cancel', $ FONT = buttonfnt, $ EVENT_FUNC = 'eis_search_event_handler', $ UVALUE = {method: "cancelevent", object:self} $ ) self.can_id = can ; Create a db_tools object. This will be useful for certain operations. self.db_tools = OBJ_NEW ('DB_TOOLS') ; Get the item list for the new database. self.db_tools->get_db_info, database, DB_ITEM = lst ; Explode the item list for the selected database and at the same time create a heap ; variable to reference it. self.db_item = PTR_NEW (self.db_tools->exp_ptr_items (lst)) ; Set the default type of search to database field search WIDGET_CONTROL, self.bt1_id, SET_BUTTON = 0 WIDGET_CONTROL, self.bt2_id, SET_BUTTON = 1 self.usr_mode = 0 ; Find the widget ID of the first widget child. childid = WIDGET_INFO ( self.tlb, /CHILD ) ; Store a pointer to the object as the uvalue of the child widget. WIDGET_CONTROL, childid, SET_UVALUE = self ; Set up procedure to kill off the object if the widget dies WIDGET_CONTROL, childid, KILL_NOTIFY = 'eis_search_kill_notify' RETURN, 1 END ; ------------------------------------------------------------------------------------------------ PRO eis_search::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 ; Kill off the widget if it is still around. IF WIDGET_INFO (self.tlb, /VALID_ID) THEN BEGIN WIDGET_CONTROL, self.tlb, /DESTROY ENDIF ; Get rid of the DB_TOOLS object. OBJ_DESTROY, self.db_tools ; Get rid of any database item list we may have hanging around PTR_FREE, self.db_item END ; ------------------------------------------------------------------------------------------------ FUNCTION eis_search_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 eis_search_event__define ; The EIS_SEARCH 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 = { EIS_SEARCH_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. VALUE: "", $ ; The widget value. TYPE: 0 $ ; Event Type: 0 CANCEL, 1 OK, 2 APPLY. } END ; ------------------------------------------------------------------------------------------------ FUNCTION eis_search_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 eis_search_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 OBJ_DESTROY, obj END ; ------------------------------------------------------------------------------------------------ PRO eis_search__define obj = { EIS_SEARCH, $; The object class name. parent: 0L, $; The parent widget ID. tlb: 0L, $; The top-level base of the compound widget. lbl_id: 0L, $; The main title label widget ID. str_id: 0L, $; The text widget ID containing the search string. can_id: 0L, $ ; The cancel button widget ID. app_id: 0L, $ ; The apply button widget ID. bt1_id: 0L, $ ; Select Button 1 bt2_id: 0L, $ ; Select Button 2 db_tools : OBJ_NEW (), $ ; Database tools object usr_mode : 1, $ ; Set to one if the user text will be used for db querries. select_id: OBJ_NEW (), $; The database item selection widget search_id: OBJ_NEW (), $; The database item search widget event_func: "", $; The name of the specified event handler function. event_pro: "", $; The name of the specified event handler procedure db_item : PTR_NEW (), $; The item list from the selected database. database: "", $; The name of the database to querry. nonsensitive: 0, $; Setting this keywords makes the text widget non-sensitive. name:"", $; a scalar string name for the object debug: 0 $; Debug flag. If TRUE (1) then print debug info. } END