&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12 GUI &ANALYZE-RESUME &Scoped-define WINDOW-NAME C-Win &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS C-Win /*------------------------------------------------------------------------ File: Description: Input Parameters: Output Parameters: Author: Allan Doane Created: September 15, 2003 Version: 002 ------------------------------------------------------------------------*/ /* This .W file was created with the Progress AppBuilder. */ /*----------------------------------------------------------------------*/ /* Create an unnamed pool to store all the widgets created by this procedure. This is a good default which assures that this procedure's triggers and internal procedures will execute in this procedure's storage, and that proper cleanup will occur on deletion of the procedure. */ CREATE WIDGET-POOL. /* *************************** Definitions ************************** */ /* Parameters Definitions --- */ /* Local Variable Definitions --- */ DEFINE VARIABLE hParser AS HANDLE NO-UNDO. {proparse/api/proparse.i hParser} define variable topNode as integer no-undo. define variable cMyQuery as character no-undo initial "myQuery". define temp-table ttQueryNode no-undo field ttiNodeNumber as integer field ttiNodeHandle as integer index idx-nbr is primary unique ttiNodeNumber. function getProparseHandle returns handle forward. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK /* ******************** Preprocessor Definitions ******************** */ &Scoped-define PROCEDURE-TYPE Window &Scoped-define DB-AWARE no /* Name of first Frame and/or Browse and/or first Query */ &Scoped-define FRAME-NAME DEFAULT-FRAME /* Standard List Definitions */ &Scoped-Define ENABLED-OBJECTS cCompileUnit bParse cSubQuery bRunQuery ~ tDirect cQueryTypes cProgramText cNodeTextDisplay BtnFirst BtnPrev BtnNext ~ BtnLast BtnDone &Scoped-Define DISPLAYED-OBJECTS cCompileUnit cSubQuery cFilename tDirect ~ cQueryTypes cProgramText iCurrentNode iNumResults cNodeTextDisplay ~ iCurrentLine cNodeText /* Custom List Definitions */ /* List-1,List-2,List-3,List-4,List-5,List-6 */ /* _UIB-PREPROCESSOR-BLOCK-END */ &ANALYZE-RESUME /* ************************ Function Prototypes ********************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getFullText C-Win FUNCTION getFullText RETURNS CHARACTER (input piNode as integer) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getProparseHandle C-Win FUNCTION getProparseHandle RETURNS HANDLE ( /* parameter-definitions */ ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD includeNodeAny C-Win FUNCTION includeNodeAny RETURNS LOGICAL ( input piNode as integer, input pcFilter as character ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD includeNodeDirect C-Win FUNCTION includeNodeDirect RETURNS LOGICAL ( input piNode as integer, input pcFilter as character ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* *********************** Control Definitions ********************** */ /* Define the widget handle for the window */ DEFINE VAR C-Win AS WIDGET-HANDLE NO-UNDO. /* Definitions of the field level widgets */ DEFINE BUTTON bParse LABEL "Parse it" SIZE 15 BY 1.15. DEFINE BUTTON bRunQuery LABEL "Run Query" SIZE 15 BY 1.15. DEFINE BUTTON BtnDone DEFAULT LABEL "&Done" SIZE 15 BY 1.15 BGCOLOR 8 . DEFINE BUTTON BtnFirst LABEL "&First" SIZE 15 BY 1.15 BGCOLOR 8 . DEFINE BUTTON BtnLast LABEL "&Last" SIZE 15 BY 1.15 BGCOLOR 8 . DEFINE BUTTON BtnNext LABEL "&Next" SIZE 15 BY 1.15 BGCOLOR 8 . DEFINE BUTTON BtnPrev LABEL "&Prev" SIZE 15 BY 1.15 BGCOLOR 8 . DEFINE VARIABLE cProgramText AS CHARACTER VIEW-AS EDITOR NO-WORD-WRAP SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL LARGE SIZE 140 BY 16.62 FONT 0 NO-UNDO. DEFINE VARIABLE cCompileUnit AS CHARACTER FORMAT "X(25)":U LABEL "Compile Unit" VIEW-AS FILL-IN SIZE 21 BY 1 TOOLTIP "Enter the name of the program to be analyzed" NO-UNDO. DEFINE VARIABLE cFilename AS CHARACTER FORMAT "X(256)":U LABEL "Source File" VIEW-AS FILL-IN SIZE 37 BY 1 NO-UNDO. DEFINE VARIABLE cNodeText AS CHARACTER FORMAT "X(25)":U LABEL "Node Text" VIEW-AS FILL-IN SIZE 26 BY 1 NO-UNDO. DEFINE VARIABLE cNodeTextDisplay AS CHARACTER FORMAT "X(256)":U VIEW-AS FILL-IN SIZE 117 BY 1 FONT 0 NO-UNDO. DEFINE VARIABLE cSubQuery AS CHARACTER FORMAT "X(24)":U LABEL "Subquery" VIEW-AS FILL-IN SIZE 17 BY 1 TOOLTIP "Enter valid subnodes for the selected query type" NO-UNDO. DEFINE VARIABLE iCurrentLine AS INTEGER FORMAT ">>,>>9":U INITIAL 0 LABEL "Current Line" VIEW-AS FILL-IN SIZE 8 BY 1 NO-UNDO. DEFINE VARIABLE iCurrentNode AS INTEGER FORMAT ">>,>>9":U INITIAL 0 VIEW-AS FILL-IN SIZE 8 BY 1 NO-UNDO. DEFINE VARIABLE iNumResults AS INTEGER FORMAT ">>,>>9":U INITIAL 0 VIEW-AS FILL-IN SIZE 9 BY 1 NO-UNDO. DEFINE VARIABLE cQueryTypes AS CHARACTER VIEW-AS SELECTION-LIST SINGLE NO-DRAG SORT SCROLLBAR-VERTICAL SIZE 25 BY 19.77 TOOLTIP "Select on of these as the basis of a query" NO-UNDO. DEFINE VARIABLE tDirect AS LOGICAL INITIAL yes LABEL "Direct Child Only?" VIEW-AS TOGGLE-BOX SIZE 20 BY .77 TOOLTIP "Subquery based on direct child only? (False = any descendant)" NO-UNDO. /* ************************ Frame Definitions *********************** */ DEFINE FRAME DEFAULT-FRAME cCompileUnit AT ROW 1.54 COL 13 COLON-ALIGNED bParse AT ROW 1.54 COL 37 cSubQuery AT ROW 1.54 COL 62 COLON-ALIGNED cFilename AT ROW 1.54 COL 113 COLON-ALIGNED bRunQuery AT ROW 1.54 COL 153 tDirect AT ROW 1.81 COL 82 cQueryTypes AT ROW 3.38 COL 2 NO-LABEL cProgramText AT ROW 3.42 COL 28 NO-LABEL iCurrentNode AT ROW 20.77 COL 29 NO-LABEL iNumResults AT ROW 20.77 COL 39 COLON-ALIGNED NO-LABEL cNodeTextDisplay AT ROW 20.77 COL 49 COLON-ALIGNED NO-LABEL BtnFirst AT ROW 22.19 COL 28 BtnPrev AT ROW 22.19 COL 43 BtnNext AT ROW 22.19 COL 58 BtnLast AT ROW 22.19 COL 73 iCurrentLine AT ROW 22.19 COL 101 COLON-ALIGNED cNodeText AT ROW 22.19 COL 122 COLON-ALIGNED BtnDone AT ROW 22.19 COL 152 "of" VIEW-AS TEXT SIZE 3 BY .62 AT ROW 20.92 COL 37.43 "Query Types" VIEW-AS TEXT SIZE 20 BY .62 AT ROW 2.65 COL 3 WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY SIDE-LABELS NO-UNDERLINE THREE-D AT COL 1 ROW 1 SIZE 169.8 BY 23.38. /* *********************** Procedure Settings ************************ */ &ANALYZE-SUSPEND _PROCEDURE-SETTINGS /* Settings for THIS-PROCEDURE Type: Window Allow: Basic,Browse,DB-Fields,Window,Query Other Settings: COMPILE */ &ANALYZE-RESUME _END-PROCEDURE-SETTINGS /* ************************* Create Window ************************** */ &ANALYZE-SUSPEND _CREATE-WINDOW IF SESSION:DISPLAY-TYPE = "GUI":U THEN CREATE WINDOW C-Win ASSIGN HIDDEN = YES TITLE = "Proparse Browser" HEIGHT = 23.38 WIDTH = 169.86 MAX-HEIGHT = 23.38 MAX-WIDTH = 169.86 VIRTUAL-HEIGHT = 23.38 VIRTUAL-WIDTH = 169.86 RESIZE = yes SCROLL-BARS = no STATUS-AREA = no BGCOLOR = ? FGCOLOR = ? KEEP-FRAME-Z-ORDER = yes THREE-D = yes MESSAGE-AREA = no SENSITIVE = yes. ELSE {&WINDOW-NAME} = CURRENT-WINDOW. /* END WINDOW DEFINITION */ &ANALYZE-RESUME /* *********** Runtime Attributes and AppBuilder Settings *********** */ &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES /* SETTINGS FOR WINDOW C-Win VISIBLE,,RUN-PERSISTENT */ /* SETTINGS FOR FRAME DEFAULT-FRAME */ /* SETTINGS FOR FILL-IN cFilename IN FRAME DEFAULT-FRAME NO-ENABLE */ /* SETTINGS FOR FILL-IN cNodeText IN FRAME DEFAULT-FRAME NO-ENABLE */ ASSIGN cNodeTextDisplay:READ-ONLY IN FRAME DEFAULT-FRAME = TRUE. /* SETTINGS FOR FILL-IN iCurrentLine IN FRAME DEFAULT-FRAME NO-ENABLE */ /* SETTINGS FOR FILL-IN iCurrentNode IN FRAME DEFAULT-FRAME NO-ENABLE ALIGN-L */ /* SETTINGS FOR FILL-IN iNumResults IN FRAME DEFAULT-FRAME NO-ENABLE */ IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win) THEN C-Win:HIDDEN = no. /* _RUN-TIME-ATTRIBUTES-END */ &ANALYZE-RESUME /* ************************ Control Triggers ************************ */ &Scoped-define SELF-NAME C-Win &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win ON END-ERROR OF C-Win /* Proparse Browser */ OR ENDKEY OF {&WINDOW-NAME} ANYWHERE DO: /* This case occurs when the user presses the "Esc" key. In a persistently run window, just ignore this. If we did not, the application would exit. */ IF THIS-PROCEDURE:PERSISTENT THEN RETURN NO-APPLY. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win ON WINDOW-CLOSE OF C-Win /* Proparse Browser */ DO: /* This event will close the window and terminate the procedure. */ APPLY "CLOSE":U TO THIS-PROCEDURE. RETURN NO-APPLY. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME bParse &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bParse C-Win ON CHOOSE OF bParse IN FRAME DEFAULT-FRAME /* Parse it */ DO: run parseProgram(input cCompileUnit:screen-value). END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME bRunQuery &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bRunQuery C-Win ON CHOOSE OF bRunQuery IN FRAME DEFAULT-FRAME /* Run Query */ DO: DEFINE VARIABLE iNumNodes AS INTEGER NO-UNDO. if cQueryTypes:screen-value <> ? then do: iNumNodes = parserQueryCreate(topNode, cMyQuery, cQueryTypes:screen-value). if iNumNodes > 0 then do: run accumulateNodes( input iNumNodes, input cSubquery:screen-value, input tDirect:screen-value ). iNumResults:screen-value = string(iNumResults). if iNumResults > 0 then publish "getQueryFirst". else do: MESSAGE substitute("No &1 nodes found.", cQueryTypes:screen-value) VIEW-AS ALERT-BOX INFO BUTTONS OK. run resetDisplay. end. end. else do: MESSAGE substitute("No &1 nodes found.", cQueryTypes:screen-value) VIEW-AS ALERT-BOX INFO BUTTONS OK. run resetDisplay. end. end. else MESSAGE "Please specify the Query type from the selection list." VIEW-AS ALERT-BOX INFO BUTTONS OK. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME BtnDone &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BtnDone C-Win ON CHOOSE OF BtnDone IN FRAME DEFAULT-FRAME /* Done */ DO: &IF "{&PROCEDURE-TYPE}" EQ "SmartPanel" &THEN &IF "{&ADM-VERSION}" EQ "ADM1.1" &THEN RUN dispatch IN THIS-PROCEDURE ('exit'). &ELSE RUN exitObject. &ENDIF &ELSE APPLY "CLOSE":U TO THIS-PROCEDURE. &ENDIF END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME BtnFirst &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BtnFirst C-Win ON CHOOSE OF BtnFirst IN FRAME DEFAULT-FRAME /* First */ DO: publish "getQueryFirst". END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME BtnLast &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BtnLast C-Win ON CHOOSE OF BtnLast IN FRAME DEFAULT-FRAME /* Last */ DO: publish "getQueryLast". END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME BtnNext &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BtnNext C-Win ON CHOOSE OF BtnNext IN FRAME DEFAULT-FRAME /* Next */ DO: publish "getQueryNext". END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME BtnPrev &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BtnPrev C-Win ON CHOOSE OF BtnPrev IN FRAME DEFAULT-FRAME /* Prev */ DO: publish "getQueryPrev". END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &UNDEFINE SELF-NAME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK C-Win /* *************************** Main Block *************************** */ /* Set CURRENT-WINDOW: this will parent dialog-boxes and frames. */ ASSIGN CURRENT-WINDOW = {&WINDOW-NAME} THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}. /* The CLOSE event can be used from inside or outside the procedure to */ /* terminate it. */ ON CLOSE OF THIS-PROCEDURE RUN disable_UI. /* Best default for GUI applications is... */ PAUSE 0 BEFORE-HIDE. subscribe to "getQueryFirst" anywhere. subscribe to "getQueryPrev" anywhere. subscribe to "getQueryNext" anywhere. subscribe to "getQueryLast" anywhere. /* bring in the Proparse Tokens to be used as queries */ RUN loadQueryTypes. /* Start up Proparse (as necessary) and get handle */ assign hParser = ?. /* load and initialize proparse.dll */ hParser = getProparseHandle(). if not valid-handle(hParser) then do: message "Proparse Load Error" view-as alert-box error. APPLY "CLOSE":U TO THIS-PROCEDURE. end. /* Now enable the interface and wait for the exit condition. */ /* (NOTE: handle ERROR and END-KEY so cleanup code will always fire. */ MAIN-BLOCK: DO ON ERROR UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK: RUN enable_UI. IF NOT THIS-PROCEDURE:PERSISTENT THEN WAIT-FOR CLOSE OF THIS-PROCEDURE. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ********************** Internal Procedures *********************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE accumulateNodes C-Win PROCEDURE accumulateNodes : /*------------------------------------------------------------------------------ Purpose: to build up a list (in a temp-table) of valid query nodes Parameters: Notes: uses temp-table ttQueryNode ------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER piNumNodes AS INTEGER NO-UNDO. DEFINE INPUT PARAMETER pcSubquery AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER plDirect AS LOGICAL NO-UNDO. DEFINE VARIABLE i AS INTEGER NO-UNDO. DEFINE VARIABLE iCurrentNode AS INTEGER NO-UNDO. DEFINE VARIABLE iNodeCounter AS INTEGER NO-UNDO. run resetNodes. iCurrentNode = parserGetHandle(). filterLoop: do i = 1 to piNumNodes: parserQueryGetResult(cMyQuery, i, iCurrentNode). if pcSubquery <> ? and pcSubquery <> "" then do: /* filter query results before adding to temp-table */ if plDirect then do: /* direct child only */ if not includeNodeDirect(input iCurrentNode, input pcSubquery) then next filterLoop. end. else do: /* any descendant (child, grandchild, etc) */ if not includeNodeAny(input iCurrentNode, input pcSubquery) then next filterLoop. end. end. /* have a valid node at this point */ iNodeCounter = iNodeCounter + 1. create ttQueryNode. ttQueryNode.ttiNodeNumber = iNodeCounter. ttQueryNode.ttiNodeHandle = parserGetHandle(). parserCopyHandle(iCurrentNode, ttQueryNode.ttiNodeHandle). end. iNumResults = iNodeCounter. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI C-Win _DEFAULT-DISABLE PROCEDURE disable_UI : /*------------------------------------------------------------------------------ Purpose: DISABLE the User Interface Parameters: Notes: Here we clean-up the user-interface by deleting dynamic widgets we have created and/or hide frames. This procedure is usually called when we are ready to "clean-up" after running. ------------------------------------------------------------------------------*/ /* Delete the WINDOW we created */ IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win) THEN DELETE WIDGET C-Win. IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE displayCurrentNode C-Win PROCEDURE displayCurrentNode : /*------------------------------------------------------------------------------ Purpose: displays node Parameters: piNode - number of node to display Notes: ------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER piNode AS INTEGER NO-UNDO. DEFINE VARIABLE cNodeFileName AS CHARACTER NO-UNDO. DEFINE VARIABLE iNodeLine AS INTEGER NO-UNDO. DEFINE VARIABLE iSelStart AS INTEGER NO-UNDO. DEFINE VARIABLE iSelEnd AS INTEGER NO-UNDO. DEFINE VARIABLE iLine AS INTEGER NO-UNDO. DEFINE VARIABLE iDisplayNode AS INTEGER NO-UNDO. DEFINE VARIABLE iChild AS INTEGER NO-UNDO. DEFINE VARIABLE cChildType AS CHARACTER NO-UNDO. do with frame {&frame-name}: /* update current current position 1..iNumResults */ iCurrentNode = piNode. display iCurrentNode. iDisplayNode = parserGetHandle(). find first ttQueryNode where ttQueryNode.ttiNodeNumber = piNode. parserCopyHandle(ttQueryNode.ttiNodeHandle, iDisplayNode). iChild = parserGetHandle(). do while parserGetNodeLine(iDisplayNode) = 0: /* we have to look for a child node */ cChildType = parserNodeFirstChild(iDisplayNode, iDisplayNode). if cChildType = "" then do: /* no children, look for peer */ cChildType = parserNodeNextSibling(iDisplayNode, iDisplayNode). end. end. parserReleaseHandle(iChild). iNodeLine = parserGetNodeLine(iDisplayNode). cNodeFileName = parserGetNodeFilename(iDisplayNode). /* if current file is not the file we're already showing */ if cNodeFileName <> cFileName then do: cFileName = cNodeFileName. display cFilename. cProgramText:read-file(cFilename). end. assign iSelStart = cProgramText:convert-to-offset(iNodeLine, 1) iSelEnd = cProgramText:convert-to-offset(iNodeLine + 1, 1) - 1. cProgramText:set-selection(iSelStart, iSelEnd). iCurrentLine:screen-value = string(iNodeLine). cNodeText:screen-value = if parserGetNodeText(ttQueryNode.ttiNodeHandle) = "" then "" else parserGetNodeText(ttQueryNode.ttiNodeHandle). cNodeTextDisplay:screen-value = getFullText(input iDisplayNode). end. parserReleaseHandle(iDisplayNode). END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI C-Win _DEFAULT-ENABLE PROCEDURE enable_UI : /*------------------------------------------------------------------------------ Purpose: ENABLE the User Interface Parameters: Notes: Here we display/view/enable the widgets in the user-interface. In addition, OPEN all queries associated with each FRAME and BROWSE. These statements here are based on the "Other Settings" section of the widget Property Sheets. ------------------------------------------------------------------------------*/ DISPLAY cCompileUnit cSubQuery cFilename tDirect cQueryTypes cProgramText iCurrentNode iNumResults cNodeTextDisplay iCurrentLine cNodeText WITH FRAME DEFAULT-FRAME IN WINDOW C-Win. ENABLE cCompileUnit bParse cSubQuery bRunQuery tDirect cQueryTypes cProgramText cNodeTextDisplay BtnFirst BtnPrev BtnNext BtnLast BtnDone WITH FRAME DEFAULT-FRAME IN WINDOW C-Win. {&OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME} VIEW C-Win. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE getQueryFirst C-Win PROCEDURE getQueryFirst : /*------------------------------------------------------------------------------ Purpose: get First node in Current Query Parameters: Notes: ------------------------------------------------------------------------------*/ run displayCurrentNode(input 1). END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE getQueryLast C-Win PROCEDURE getQueryLast : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ run displayCurrentNode(input iNumResults). END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE getQueryNext C-Win PROCEDURE getQueryNext : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ if iCurrentNode < iNumResults then run displayCurrentNode(input iCurrentNode + 1). END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE getQueryPrev C-Win PROCEDURE getQueryPrev : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ if iCurrentNode > 1 then run displayCurrentNode(input iCurrentNode - 1). END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE loadQueryTypes C-Win PROCEDURE loadQueryTypes : /*------------------------------------------------------------------------------ Purpose: Make proparse tokenTypes available for selection as queries Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE VARIABLE cTokenType AS CHARACTER NO-UNDO. file-info:file-name = "proparseTokenTypes.txt". input from value(file-info:full-pathname). repeat with frame {&frame-name}: import unformatted cTokenType. cQueryTypes:add-last(entry(1, cTokenType, "=")). end. input close. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parseProgram C-Win PROCEDURE parseProgram : /*------------------------------------------------------------------------------ Purpose: To run Proparse against the specified program Parameters: Notes: ------------------------------------------------------------------------------*/ define input parameter pcSourceFile as character no-undo. define variable cErrorMessage as character no-undo initial "":U. file-info:file-name = pcSourceFile. /* parse sourcefile in proparse.dll */ if not parserParse(file-info:full-pathname) then cErrorMessage = parserErrorGetText(). if cErrorMessage <> "":U then do: /* These kinds of warnings should be reported to joanju.com */ MESSAGE substitute("Parsing Error in &1 : &2", pcSourceFile, cErrorMessage) VIEW-AS ALERT-BOX error BUTTONS OK. end. else do: assign topNode = parserGetHandle(). /* note: must be assigned after parserParse() */ parserNodeTop(topNode). /* this gets us the "Program_root" node */ end. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE resetDisplay C-Win PROCEDURE resetDisplay : /*------------------------------------------------------------------------------ Purpose: To clear away artifacts from previous query. Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE VARIABLE iSelStart AS INTEGER NO-UNDO. DEFINE VARIABLE ISelEnd AS INTEGER NO-UNDO. do with frame {&frame-name}: assign cNodeTextDisplay = "" iNumResults = 0 iCurrentNode = 0 iCurrentLine = 0 cNodeText = "" cFileName = "" iSelStart = cProgramText:convert-to-offset(1, 1) iSelEnd = cProgramText:convert-to-offset(99999, 99). cProgramText:set-selection(iSelStart, iSelEnd). cProgramText:replace-selection-text(""). display cFileName cNodeTextDisplay iNumResults iCurrentNode iCurrentLine cNodeText. end. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE resetNodes C-Win PROCEDURE resetNodes : /*------------------------------------------------------------------------------ Purpose: to purge the ttQueryNode temp-table and release its handles Parameters: Notes: ------------------------------------------------------------------------------*/ for each ttQueryNode: parserReleaseHandle(ttQueryNode.ttiNodeHandle). delete ttQueryNode. end. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ************************ Function Implementations ***************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getFullText C-Win FUNCTION getFullText RETURNS CHARACTER (input piNode as integer) : /*------------------------------------------------------------------------------ Purpose: to fetch all the text from a particular node Notes: ------------------------------------------------------------------------------*/ define variable numResults as integer no-undo. define variable i as integer no-undo. define variable subNode as integer no-undo. define variable nodeFile as character no-undo. DEFINE VARIABLE cResult AS CHARACTER NO-UNDO. /* Use an "unfiltered query" for displaying the node's text. * I use LEFT-TRIM as a trick: if the node has no text, then * we don't display the extra space. */ subNode = parserGetHandle(). numResults = parserQueryCreate(piNode, "textQuery", ""). do i = 1 to numResults: parserQueryGetResult("textQuery", i, subNode). cResult = cResult + left-trim(parserGetNodeText(subNode) + " "). end. parserQueryClear("textQuery"). parserReleaseHandle(subNode). RETURN cResult. /* Function return value. */ END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getProparseHandle C-Win FUNCTION getProparseHandle RETURNS HANDLE ( /* parameter-definitions */ ) : /*------------------------------------------------------------------------------ Purpose: run proparse.p persistent set hParser or find an already running instance of proparse.p and use its handle Parameters: none Notes: ------------------------------------------------------------------------------*/ define variable hpp as handle no-undo. define variable hResult as handle no-undo. define variable lHasProparse as logical no-undo. hResult = ?. hpp = session:first-procedure. do while valid-handle(hpp) and (not valid-handle(hParser)) : if hpp:file-name matches "~*~/proparse.*":u then /* added tildes because progress confused it for a comment :-)*/ hResult = hpp. else hpp = hpp:next-sibling. end. /* did the user install (purchase) proparse yet? */ lHasProparse = if opsys = "unix":u then not( search("proparse/libproparse.so":U) = ? ) else not( search("proparse/proparse.dll":U) = ? ). if lHasProparse then run proparse/api/proparse.p persistent set hResult. return hResult. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION includeNodeAny C-Win FUNCTION includeNodeAny RETURNS LOGICAL ( input piNode as integer, input pcFilter as character ) : /*------------------------------------------------------------------------------ Purpose: to include only nodes that meet the subquery criterion Notes: filter must be a descendant node of piNode ------------------------------------------------------------------------------*/ DEFINE VARIABLE iNumRes AS INTEGER NO-UNDO. DEFINE VARIABLE cQueryName AS CHARACTER NO-UNDO INITIAL "includeNodeAny":U. iNumRes = parserQueryCreate(piNode, cQueryName, pcFilter). parserQueryClear(cQueryName). return (iNumRes > 0). END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION includeNodeDirect C-Win FUNCTION includeNodeDirect RETURNS LOGICAL ( input piNode as integer, input pcFilter as character ) : /*------------------------------------------------------------------------------ Purpose: to include only nodes that meet the subquery criterion Notes: filter MUST be a DIRECT child node of piNode ------------------------------------------------------------------------------*/ DEFINE VARIABLE iChild AS INTEGER NO-UNDO. DEFINE VARIABLE cNodeType AS CHARACTER NO-UNDO. iChild = parserGetHandle(). cNodeType = parserNodeFirstChild(piNode, iChild). do while cNodeType <> "": if cNodeType = pcFilter then do: parserReleaseHandle(iChild). return true. end. else cNodeType = parserNodeNextSibling(iChild, iChild). end. parserReleaseHandle(iChild). RETURN FALSE. /* Function return value. */ END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME