home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / orx7.zip / orx_analyze_ascii.cmd next >
OS/2 REXX Batch file  |  1997-07-21  |  56KB  |  1,507 lines
  1. /*
  2.    analyze REXX file, format in plain ASCII
  3. program:   orx_analyze_ascii.cmd
  4. type:      Object REXX, REXXSAA 6.0
  5. purpose:   formats results of analyzed REXX-program in ASCII-format
  6. version:   1.00
  7. date:      1995-11, 1996-05-09
  8. changed:   1997-04-15, ---rgf, adapted for the new module structure
  9.  
  10. author:    Rony G. Flatscher
  11.            Rony.Flatscher@wu-wien.ac.at
  12.            (Wirtschaftsuniversitaet Wien, University of Economics and Business
  13.            Administration, Vienna/Austria/Europe)
  14.  
  15. needs:     rgf_util.cmd, orx_analyze.cmd (which needs nls_util.cmd, orx_util.cmd, rgf_util.cmd)
  16.  
  17. usage:     orx_analyze_ascii some_rexx_file
  18.  
  19.            returns ASCII-formatted output to STDOUT:
  20.  
  21. comments:  almost finished :)
  22.  
  23. All rights reserved, copyrighted 1995 - 1997, no guarantee that it works without
  24. errors, etc. etc.
  25.  
  26.  
  27. You are granted the right to use this module under the condition that you don't charge money for this module (as you didn't write
  28. it in the first place) or modules directly derived from this module, that you document the original author (to give appropriate
  29. credit) with the original name of the module and that you make the unaltered, original source-code of this module available on
  30. demand.  If that holds, you may even bundle this module (either in source or compiled form) with commercial software.
  31.  
  32.  
  33. Please, if you find an error, post me a message describing it, I will
  34. try to fix and rerelease it to the net.
  35.  
  36. */
  37.  
  38. /* retrieve methods of classes defined in .environment ? */
  39. .local ~ bQueryEnvClassMethods        = .false
  40.  
  41. /* HUGE performance penalty, HUGE html-files results */
  42. .local ~ bShowEnvTilingWithMethodsEnv = .false     /* show methods while tiling classes of .environment ? */
  43.  
  44. /* perfomance penalty */
  45. .local ~ bShowEnvMethods              = .false     /* show .environment class methods while tiling non .environment classes ? */
  46.  
  47. PARSE ARG start_file
  48.  
  49.  
  50. CALL TIME "Reset"                               /* timer start */
  51. ctl. = orx_analyze( start_file )                /* have file parsed */
  52. PARSE VALUE TIME("Elapsed") WITH elapsed
  53.  
  54.  
  55.  
  56. .local ~ missing.class = ctl.eMissingClass      /* sentinel object, indicating a missing class */
  57. .local ~ indent_step1 = 3
  58. .local ~ indent_step2 = 3
  59. .local ~ indent1      = COPIES( " ", .indent_step1 )
  60. .local ~ indent2      = COPIES( " ", .indent_step2 )
  61. .local ~ indent3      = .indent1 .indent2
  62.  
  63.  
  64. CALL leadin elapsed
  65. CALL require_structure ctl.eFileStart           /* start with file which we had to analyze */
  66.  
  67. CALL sayError
  68. CALL sayError "Formatting summary ..."  /* summary results */
  69. CALL file_statistics
  70.  
  71. CALL sayError "Formatting details ..."  /* details results */
  72. CALL file_details
  73.  
  74. PARSE VALUE TIME("Elapsed") WITH elapsed
  75. CALL leadin elapsed
  76.  
  77. EXIT
  78.  
  79. /* ------------------------------------------------------------------------------------- */
  80. /* show header */
  81. LEADIN: PROCEDURE EXPOSE ctl.
  82.    PARSE ARG elapsed
  83.  
  84.    PARSE SOURCE op_sys call_type proc_name
  85.    SAY DATE( "Standard" ) TIME( "Normal" ) "running" pp( proc_name ) "under" pp( op_sys )
  86.    SAY
  87.  
  88.    SAY "Results of analyzing:" pp( ctl.eFileStart ~ name ) "analyze time:" pp( FORMAT( elapsed, , 2 ) ) "seconds"
  89.    SAY
  90.    RETURN
  91. /* ------------------------------------------------------------------------- */
  92.  
  93.  
  94. /* ------------------------------------------------------------------------- */
  95. /* show dependency tree of encountered ::REQUIRES directives */
  96. REQUIRE_STRUCTURE: PROCEDURE
  97.    USE ARG tmpFile, level
  98.  
  99.    IF tmpFile ~ requires_files ~ items = 0 THEN         /* if no files are required, then return */
  100.       RETURN
  101.  
  102.    SAY CENTER( " dependency tree, imposed by ::REQUIRES directives: ", 79, "-")
  103.    SAY
  104.    CALL show_requires_tree tmpFile
  105.    SAY
  106.    RETURN
  107.  
  108. SHOW_REQUIRES_TREE: PROCEDURE
  109.    USE ARG tmpFile, level
  110.  
  111.    IF \VAR( "level" ) THEN              /* initial call ! */
  112.    DO
  113.       level = 1
  114.    END
  115.  
  116.    indent = COPIES( " ", 4 * level - 1 )
  117.    SAY indent pp( tmpFile ~ name )
  118.  
  119.    DO item OVER tmpFile ~ requires_files
  120.       CALL show_requires_tree item, ( level + 1 )
  121.    END
  122.    RETURN
  123. /* ------------------------------------------------------------------------- */
  124.  
  125.  
  126.  
  127.  
  128. /* ------------------------------------------------------------------------- */
  129. /* show statistical data of analyzed files (in alphabetical order ) */
  130. FILE_STATISTICS: PROCEDURE EXPOSE ctl. stats.
  131.    startFile = ctl.eFileStart
  132.  
  133.    stats.         = 0
  134.  
  135.    stats.eLines.1.eText = "Total lines of code         " pp( format( 100, , 2 ) "%" )
  136.    stats.eLines.2.eText = "LOCs (lines of code, edited)"
  137.    stats.eLines.0      = 2
  138.  
  139.    i = 1
  140.  
  141.    stats.eFile.i.eText  = "procedure(s) found"           /* 1 */
  142.    i = i + 1
  143.    stats.eFile.i.eText  = "label(s)     found"           /* 2 */
  144.    i = i + 1
  145.  
  146.    stats.eFile.i.eText  = "::REQUIRES   found"           /* 3 */
  147.    i = i + 1
  148.  
  149.    stats.eFile.i.eText  = "::ROUTINE(s) found"           /* 4 */
  150.    i = i + 1
  151.  
  152.    stats.eFile.i.eText  = "::CLASS(es)  found"           /* 5 */
  153.    i = i + 1
  154.  
  155.    stats.eFile.i.eText  = "::METHOD(s)  found"           /* 6 */
  156.    i = i + 1
  157.  
  158.    stats.eFile.0       = i - 1
  159.  
  160.  
  161.    sortedFiles = sort( ctl.eFiles )     /* returns array with sorted indices of .directory */
  162.  
  163.    maxFileLength = startFile ~ class ~ max_name_length + 2 /* get maximum file length, account for pp() brackets */
  164.  
  165.    SAY CENTER( " statistics about analyzed files: ", 79, "=")
  166.    SAY
  167.  
  168.    DO i = 1 TO sortedFiles ~ items
  169.  
  170.       tmpFile = ctl.eFiles ~ entry( sortedFiles[ i ] )  /* get file object */
  171.  
  172.       /* if this is the file which got analyzed, indicate this fact and show accessible routines and classes */
  173.       IF tmpFile = startFile THEN
  174.       DO
  175.          SAY LEFT( pp( tmpFile ~ name ) "<--- This file started the analysis !", 79, "-" )
  176.       END
  177.       ELSE
  178.          SAY LEFT( pp( tmpFile ~ name ), 79, "-" )
  179.       SAY
  180.  
  181.       /* indicate which files REQUIRE this one */
  182.       SAY .indent1 "According to the analysis the following file(s) require(s) this one:"
  183.       SAY
  184.  
  185.       IF tmpFile ~ required_by ~ items > 0 THEN
  186.       DO
  187.  
  188.          tmpArray = sort_def_list( tmpFile ~ required_by, maxFileLength +2 , "FILE" )
  189.          DO item OVER tmpArray
  190.             SAY .indent1 .indent2 item
  191.          END
  192.       END
  193.       ELSE
  194.          SAY .indent1 .indent2 "--- none ---"
  195.  
  196.       SAY
  197.  
  198.       /* indicate which files are REQUIRED by this one */
  199.       SAY .indent1 "According to the analysis this file requires the following file(s):"
  200.       SAY
  201.  
  202.       IF tmpFile ~ requires_files ~ items > 0 THEN
  203.       DO
  204.          tmpArray = sort_def_list( tmpFile ~ requires_files, maxFileLength +2, "FILE" )
  205.          DO item OVER tmpArray
  206.             SAY .indent1 .indent2 item
  207.          END
  208.       END
  209.       ELSE
  210.          SAY .indent1 .indent2 "--- none ---"
  211.  
  212.       SAY
  213.  
  214.  
  215.       /* indicate whether file may be called as a procedure / function */
  216.       /* if so, show signatures and returns                            */
  217.  
  218.       IF tmpFile ~ IsProcedure | tmpFile ~ IsFunction THEN
  219.       DO
  220.          tmpString = "This file may be called as a procedure"
  221.          IF tmpFile ~ IsFunction THEN tmpString = tmpString "*and* as a function (it returns values)"
  222.  
  223.          SAY .indent1 tmpString || ":"
  224.          SAY
  225.  
  226.          /* show signatures */
  227.          IF tmpFile ~ signatures ~ items > 0 THEN
  228.          DO
  229.             title_string = ""
  230.             CALL dump_detail_dir2string tmpFile ~ signatures, .indent1, .indent2, title_string
  231.          END
  232.  
  233.          /* show return expressions */
  234.          IF tmpFile ~ returns ~ items > 0 THEN
  235.          DO
  236.             title_string = ""
  237.             CALL dump_detail_dir2string tmpFile ~ returns, .indent1, .indent2, title_string
  238.          END
  239.  
  240.          /* show exit expressions */
  241.          IF tmpFile ~ returns ~ items > 0 THEN
  242.          DO
  243.             title_string = ""
  244.             CALL dump_detail_dir2string tmpFile ~ exits, .indent1, .indent2, title_string
  245.          END
  246.       END
  247.  
  248.  
  249.       /* show LOCs  pp_number() */
  250.  
  251.       /* total number of lines */
  252.       stats.eLines.1      = pp( RIGHT( pp_number( tmpFile ~ total_loc ), 7) ) stats.eLines.1.eText
  253.       stats.eLines.1.eSum = stats.eLines.1.eSum + tmpFile ~ total_loc    /* grand total */
  254.  
  255.       stats.eLines.2      = pp( RIGHT( pp_number( tmpFile ~ loc ), 7) ) stats.eLines.2.eText,
  256.                             pp( RIGHT( format( (tmpFile ~ loc * 100 / MAX( tmpFile ~ total_loc, 1 )) , , 2), 6) "%" )
  257.       stats.eLines.2.eSum = stats.eLines.2.eSum + tmpFile ~ loc          /* grand total */
  258.  
  259.       SAY .indent1 'Lines of code (total and stripped of comments, blank lines etc.)'
  260.       SAY
  261.       SAY .indent1 .indent2 stats.eLines.1
  262.       SAY .indent1 .indent2 stats.eLines.2
  263.  
  264.       SAY
  265.  
  266.       /* show number of procedures, routines, classes and methods defined in this file */
  267.       SAY .indent1 'The following statistics were gathered in addition:'
  268.       SAY
  269.  
  270.       j = 1
  271.       stats.eFile.j = ctl.eProcedures2Files ~ allat( tmpFile ) ~ items
  272.       j = j + 1
  273.       stats.eFile.j = ctl.eLabels2Files     ~ allat( tmpFile ) ~ items
  274.       j = j + 1
  275.       stats.eFile.j = ctl.eRequires2Files   ~ allat( tmpFile ) ~ items
  276.       j = j + 1
  277.       stats.eFile.j = ctl.eRoutines2Files   ~ allat( tmpFile ) ~ items
  278.       j = j + 1
  279.       stats.eFile.j = ctl.eClasses2Files    ~ allat( tmpFile ) ~ items
  280.       j = j + 1
  281.       stats.eFile.j = ctl.eMethods2Files    ~ allat( tmpFile ) ~ items
  282.  
  283.       DO j = 1 TO stats.eFile.0
  284.          SAY .indent1 .indent2 pp( RIGHT( pp_number( stats.eFile.j ), 7 ) ) stats.eFile.j.eText
  285.          stats.eFile.j.eSum = stats.eFile.j.eSum + stats.eFile.j
  286.       END
  287.       SAY
  288.  
  289.  
  290.       /* show available ROUTINES ( all local and all public defined via requires ) */
  291.       tmpDir = tmpFile ~ local_Routines ~ union( tmpFile ~ visible_routines )
  292.       title_String = "The following routine(s) is (are) accessible for this file:"
  293.       CALL dump_directory tmpDir, tmpFile, ctl.eRoutines2Files, title_string, .indent1, .indent2
  294.  
  295.  
  296.  
  297.       /* show available CLASSES ( all local and all public defined via requires ) */
  298.       tmpDir = tmpFile ~ local_classes ~ union( tmpFile ~ visible_classes )
  299.       title_String = "The following class(es) is (are) accessible for this file:"
  300.       CALL dump_directory tmpDir, tmpFile, ctl.eClasses2Files, title_string, .indent1, .indent2
  301.       SAY
  302.  
  303.       /* show available classes as tree(s), indicate metaclass trees */
  304.       CALL dump_roots tmpFile, .indent1, .indent2
  305.  
  306.       /* show usage of metaclasses (display metaclasses and their classes) */
  307.       CALL dump_classes_using_metaclasses tmpFile
  308.  
  309.       /* show order of tiled classes for every leaf class */
  310.       CALL dump_tiled_classes tmpFile, tmpFile ~ Local_Leaf_Classes, .false
  311.  
  312.  
  313.       /* show found errors */
  314.       SAY
  315.       SAY .indent1 "The following error(s) was (were) found during parsing:"
  316.       SAY
  317.       IF tmpFile ~ errors ~ items > 0 THEN
  318.       DO
  319.          stats.eFile.eError.eSum = stats.eFile.eError.eSum + tmpFile ~ errors ~ items
  320.          CALL show_sorted_errors tmpFile ~ errors, .indent1 .indent2
  321.       END
  322.       ELSE
  323.          SAY .indent1 .indent2 "--- none ---"
  324.  
  325.       SAY
  326.  
  327.       SAY LEFT( .indent1, 79, "-" )
  328.    END
  329.  
  330.  
  331.    /* --------------------------- grand totals ----------------------------- */
  332.    /* total number of lines */
  333.    SAY
  334.    SAY CENTER( " Grand totals for" pp( sortedFiles ~ items ) "file(s): ", 79, "-" )
  335.    SAY
  336.    tmp1 = pp( RIGHT( pp_number( stats.eLines.1.eSum ), 7) ) stats.eLines.1.eText
  337.  
  338.    tmp2 = pp( RIGHT( pp_number( stats.eLines.2.eSum ), 7) ) stats.eLines.2.eText,
  339.           pp( RIGHT( format( ( stats.eLines.2.eSum * 100 / MAX( stats.eLines.1.eSum, 1) ) , , 2), 6) "%" )
  340.  
  341.    SAY .indent1 'Lines of code (total and stripped of comments, blank lines etc.)'
  342.    SAY
  343.    SAY .indent1 .indent2 tmp1
  344.    SAY .indent1 .indent2 tmp2
  345.    SAY
  346.  
  347.    /* show number of procedures, routines, classes and methods defined in this file */
  348.    SAY .indent1 'The following statistics were gathered in addition:'
  349.    SAY
  350.    DO j = 1 TO stats.eFile.0
  351.       SAY .indent1 .indent2 pp( RIGHT( pp_number( stats.eFile.j.eSum ), 7 ) ) stats.eFile.j.eText
  352.    END
  353.  
  354.    SAY
  355.  
  356.    /* show found errors */
  357.    SAY .indent1 "Error(s) found during parsing:"
  358.    SAY
  359.    IF stats.eFile.eError.eSum > 0 THEN
  360.       SAY .indent1 .indent2 pp( RIGHT( pp_number( stats.eFile.eError.eSum ), 7 ) ) "error(s)"
  361.    ELSE
  362.       SAY .indent1 .indent2 "--- none ---"
  363.    SAY
  364.    /* --------------------------- grand totals - end ----------------------- */
  365.  
  366.    SAY CENTER( " end of file statistics ", 79, "=" )
  367.    SAY
  368.    SAY
  369.  
  370.    RETURN
  371.  
  372. /* ------------------------------------------------------------------------- */
  373.  
  374.  
  375.  
  376.  
  377.  
  378.  
  379. /* ------------------------------------------------------------------------- */
  380. /* show details of analyzed files (in alphabetical order ) */
  381. FILE_DETAILS: PROCEDURE EXPOSE ctl. stats.
  382.    startFile = ctl.eFileStart
  383.  
  384.    sortedFiles = sort( ctl.eFiles )     /* returns array with sorted indices of .directory */
  385.  
  386.    maxFileLength = startFile ~ class ~ max_name_length + 2 /* get maximum file length, account for pp() brackets */
  387.  
  388.    SAY CENTER( " details about analyzed files: ", 79, "=")
  389.    SAY
  390.  
  391.    DO i = 1 TO sortedFiles ~ items
  392.  
  393.       tmpFile = ctl.eFiles ~ entry( sortedFiles[ i ] )  /* get file object */
  394.       CALL sayError "   details for" pp( tmpFile ~ Name ) "..."
  395.  
  396.       /* if this is the file which got analyzed, indicate this fact and show accessible routines and classes */
  397.       IF tmpFile = startFile THEN
  398.          SAY LEFT( pp( tmpFile ~ name ) "<--- this file started the analysis !", 79, "-" )
  399.       ELSE
  400.          SAY LEFT( pp( tmpFile ~ name ), 79, "-" )
  401.  
  402.       SAY
  403.  
  404.  
  405.       /* indicate which files require this one */
  406.       SAY .indent1 "According to the analysis the following file(s) require(s) this one:"
  407.       SAY
  408.  
  409.       IF tmpFile ~ required_by ~ items > 0 THEN
  410.       DO
  411.  
  412.          tmpArray = sort_def_list( tmpFile ~ required_by, maxFileLength +2 , "FILE" )
  413.          DO item OVER tmpArray
  414.             SAY .indent1 .indent2 item
  415.          END
  416.       END
  417.       ELSE
  418.          SAY .indent1 .indent2 "--- none ---"
  419.  
  420.       SAY
  421.  
  422.  
  423.       /* indicate which files are required by this one */
  424.       SAY .indent1 "According to the analysis this file requires the following file(s):"
  425.       SAY
  426.  
  427.       IF tmpFile ~ requires_files ~ items > 0 THEN
  428.       DO
  429.          tmpArray = sort_def_list( tmpFile ~ requires_files, maxFileLength +2, "FILE" )
  430.          DO item OVER tmpArray
  431.             SAY .indent1 .indent2 item
  432.          END
  433.       END
  434.       ELSE
  435.          SAY .indent1 .indent2 "--- none ---"
  436.  
  437.       SAY
  438.  
  439.  
  440.       /* show LOCs  pp_number() */
  441.  
  442.       /* total number of lines */
  443.       tmpTotLines         = pp( RIGHT( pp_number( tmpFile ~ total_loc ), 7) ) stats.eLines.1.eText
  444.  
  445.       tmpRealLines        = pp( RIGHT( pp_number( tmpFile ~ loc ), 7) ) stats.eLines.2.eText,
  446.                             pp( RIGHT( format( (tmpFile ~ loc * 100 / MAX( tmpFile ~ total_loc, 1 ) ) , , 2), 6) "%" )
  447.  
  448.  
  449.       SAY .indent1 'LOCs  [without remarks, empty lines, but joined (,) and split (;) where appropriate]:'
  450.       SAY
  451.       SAY .indent1 .indent2 tmpTotLines
  452.       SAY .indent1 .indent2 tmpRealLines
  453.       SAY
  454.  
  455.  
  456.       /* show number of procedures, routines, classes and methods defined in this file */
  457.       SAY .indent1 'The following statistics were gathered in addition:'
  458.       SAY
  459.  
  460.       nrProcedures         = ctl.eProcedures2Files ~ allat( tmpFile ) ~ items
  461.       nrLabels             = ctl.eLabels2Files     ~ allat( tmpFile ) ~ items
  462.       nrRequires           = ctl.eRequires2Files   ~ allat( tmpFile ) ~ items
  463.       nrRoutines           = ctl.eRoutines2Files   ~ allat( tmpFile ) ~ items
  464.       nrClasses            = ctl.eClasses2Files    ~ allat( tmpFile ) ~ items
  465.       nrMethods            = ctl.eMethods2Files    ~ allat( tmpFile ) ~ items
  466.  
  467.  
  468.       SAY .indent1 .indent2 pp( RIGHT(pp_number( nrProcedures ), 7) ) "procedure(s) found"
  469.       SAY .indent1 .indent2 pp( RIGHT(pp_number( nrLabels     ), 7) ) "label(s)     found"
  470.       SAY .indent1 .indent2 pp( RIGHT(pp_number( nrRequires   ), 7) ) "::REQUIRES   found"
  471.       SAY .indent1 .indent2 pp( RIGHT(pp_number( nrRoutines   ), 7) ) "::ROUTINE(s) found"
  472.       SAY .indent1 .indent2 pp( RIGHT(pp_number( nrClasses    ), 7) ) "::CLASS(es)  found"
  473.       SAY .indent1 .indent2 pp( RIGHT(pp_number( nrMethods    ), 7) ) "::METHOD(s)  found"
  474.  
  475.  
  476.  
  477.       /* show available routines ( all local and all public defined via requires ) */
  478.       tmpDir = tmpFile ~ local_Routines ~ union( tmpFile ~ visible_routines )
  479.       title_String = "The following routine(s) is (are) accessible for this file:"
  480.       CALL dump_directory tmpDir, tmpFile, ctl.eRoutines2Files, title_string, .indent1, .indent2, .true
  481.       SAY
  482.  
  483.  
  484.       /* show available classes ( all local and all public defined via requires ) */
  485.       tmpDir = tmpFile ~ local_classes ~ union( tmpFile ~ visible_classes )
  486.       title_String = "The following class(es) is (are) accessible for this file:"
  487.       CALL dump_directory tmpDir, tmpFile, ctl.eClasses2Files, title_string, .indent1, .indent2, .true
  488.       SAY
  489.  
  490.       /* show available classes as tree(s), indicate metaclass trees */
  491.       CALL dump_roots tmpFile, .indent1, .indent2
  492.  
  493.  
  494.       /* show usage of metaclasses (display metaclasses and their classes) */
  495.       CALL dump_classes_using_metaclasses tmpFile
  496.  
  497.  
  498.       /* indicate whether file may be called as a procedure / function */
  499.       /* if so, show signatures and returns                            */
  500.  
  501.       tmpString = ""
  502.       IF tmpFile ~ IsProcedure | tmpFile ~ IsFunction THEN
  503.       DO
  504.          tmpString = "This file may be called as a procedure"
  505.          IF tmpFile ~ IsFunction THEN tmpString = tmpString "*and* as a function (it returns values)"
  506.  
  507.          SAY .indent1 tmpString || ":"
  508.          SAY
  509.       END
  510.       SAY
  511.  
  512.       title_string = ""
  513.       /* show signatures */
  514.       title_string = "The following attempt(s) for argument parsing was (were) found:"
  515.       CALL dump_detail_dir2string tmpFile ~ signatures, .indent3, .indent2, title_string
  516.  
  517.       /* show returns */
  518.       title_string = "The following RETURN statements was (were) found:"
  519.       CALL dump_detail_dir2string tmpFile ~ returns, .indent3, .indent2, title_string
  520.  
  521.       /* show exit expressions */
  522.       title_string = "The following EXIT statements was (were) found:"
  523.       CALL dump_detail_dir2string tmpFile ~ exits, .indent3, .indent2, title_string
  524.  
  525.       /* show labels within main body */
  526.       title_string = "This file contains the following label(s) in its main body:"
  527.       CALL dump_detail_dir2proclikes tmpFile ~ local_labels, .indent1, .indent2, title_string, .true
  528.  
  529.  
  530. /* show procedures for file, including labels */
  531.       title_string = "Procedures defined for file:"
  532.       CALL dump_detail_dir2proclikes tmpFile ~ local_procedures, .indent1, .indent2, title_string, .true
  533.  
  534. /* show routines for file, including labels, procedures */
  535.       title_string = "::ROUTINE(s) defined within file:"
  536.       CALL dump_detail_dir2proclikes tmpFile ~ local_routines, .indent1, .indent2, title_string, .true
  537.  
  538.  
  539. /* show floating methods for file including labels & procedures */
  540.       title_string = "::METHOD(s) *not* attached to a specific class ('floating')"
  541.       CALL dump_detail_dir2methods tmpFile ~ local_methods, .indent1, .indent2, title_string, .true
  542.  
  543.  
  544. /* show classes for file, including methods, which:
  545.         show class & instance methods including labels & procedures */
  546.       title_string = "::CLASS(es) defined:"
  547.       CALL dump_detail_dir2classes tmpFile ~ local_classes, .indent1, .indent2, title_string, .true
  548.  
  549.  
  550.       /* show order of tiled classes for *every* class, including methods (!) */
  551.       tmp = tmpFile ~ Local_Classes ~ supplier
  552.  
  553.       tmpList = .list ~ new                     /* produce list containing def_classes only */
  554.       DO WHILE tmp ~ available
  555.          tmpList ~ insert( tmp ~ item )
  556.          tmp ~ next
  557.       END
  558.       CALL dump_tiled_classes tmpFile, tmpList, .true
  559.  
  560.  
  561.  
  562.  
  563.  
  564.       /* show found errors */
  565.       SAY
  566.       SAY .indent1 "The following error(s) was (were) found during parsing:"
  567.       SAY
  568.  
  569.       IF tmpFile ~ errors ~ items > 0 THEN
  570.          CALL show_sorted_errors tmpFile ~ errors, .indent1 .indent2
  571.       ELSE
  572.          SAY .indent1 .indent2 "--- none ---"
  573.  
  574.       SAY
  575.  
  576.       SAY LEFT( .indent1, 79, "-" )
  577.    END
  578.  
  579.    SAY CENTER( " end of file statistics ", 79, "=" )
  580.    SAY
  581.    SAY
  582.  
  583.    RETURN
  584.  
  585.  
  586.  
  587. /* ------------------------------------------------------------------------- */
  588.  
  589. /* show all metaclasses and classes using it */
  590. DUMP_CLASSES_USING_METACLASSES: PROCEDURE
  591.     USE ARG tmpFile, line_nr
  592.  
  593.     IF \VAR( "line_nr" ) THEN line_nr = .false   /* default to not show line numbers */
  594.  
  595.     tmpDir = tmpFile ~ Local_MetaClasses                /* show metaclass usage */
  596.     IF tmpDir ~ items = 0 THEN RETURN                   /* no metaclasses used in this file */
  597.  
  598.    indent1 = .indent1
  599.    indent2 = .indent2
  600.    indent3 = indent1 indent2
  601.    indent4 = indent3 indent2
  602.  
  603.  
  604.     title_string = "Usage of metaclasses (display metaclasses and classes using it):"
  605.     SAY indent1 title_string                  /* display title */
  606.     SAY
  607.  
  608.     tmpArr = sort( tmpDir )
  609.     max_width = MAX( 3, LENGTH( tmpArr ~ items ) + 1 )
  610.     /* get maximum length of name, account for brackets */
  611.  
  612.     max_name_width =  tmpDir ~ entry( tmpArr[ 1 ] ) ~ class ~ max_name_length + 2
  613.  
  614.     DO i = 1 TO tmpArr ~ items                  /* display metaclasses */
  615.        tmpObject = tmpDir ~ entry( tmpArr[ i ] )
  616.        tmpString = RIGHT( i, max_width) "metaclass"
  617.  
  618.        tmpString = tmpString LEFT( pp( tmpObject ~ name), max_name_width )
  619.  
  620.        IF line_nr THEN
  621.        DO
  622.           IF tmpObject ~ LineNr <> .nil THEN
  623.              tmpString = tmpString pp_lineNr( tmpObject ~ LineNr )
  624.        END
  625.  
  626.        IF tmpObject ~ IsMetaClass THEN
  627.           SAY indent2 tmpString "is used by:"           /* show name */
  628.        ELSE
  629.           SAY indent2 tmpString "*** error *** (class is *not* a metaclass!)"   /* show name */
  630.  
  631.        IF tmpObject ~ MetaUsedBySet ~ items > 0 THEN    /* show classes using this metaclass */
  632.        DO
  633.           SAY
  634.           tmpUseDir = .directory ~ new                  /* build a directory of classes using this metaclass */
  635.           DO item OVER tmpObject ~ MetaUsedBySet
  636.              tmpUseDir ~ setentry( item ~ name, item )
  637.           END
  638.  
  639.           tmpUseArr = sort( tmpUseDir )                 /* sort entries */
  640.           DO j = 1 TO tmpUseArr ~ items
  641.              aClass = tmpUseDir ~ entry( tmpUseArr[ j ] )       /* get class */
  642.  
  643.              tmpString = LEFT( pp( aClass ~ name), max_name_width  )
  644.  
  645.              IF aClass ~ IsMetaClass THEN               /* ha, a metaclass is using a metaclass ! */
  646.              DO
  647.                 tmpString = tmpString "(metaclass)"
  648.              END
  649.  
  650.              SAY  indent3 tmpString
  651.           END
  652.        END
  653.        ELSE
  654.        DO
  655.           IF tmpObject ~ IsMetaClass THEN
  656.              SAY  indent3 "--- no class ! ---"
  657.        END
  658.        SAY
  659.     END
  660.  
  661.     RETURN
  662.  
  663.  
  664.  
  665.  
  666.  
  667. /* ------------------------------------------------------------------------- */
  668. /* show order of tiled classes for classes, passed in via every a collection
  669.  
  670.      tmpFile  - File (local classes being shown)
  671.      collObj  - Collection of local [leaf] classes
  672.      bDetail  - indicate whether methods should be shown (and aligned)
  673.      bTopDown - indicate whether tiling should show class first and .object last (.true) or
  674.                                                show .object first and class last (.false)
  675.  
  676.      Remarks: while building the class-tree for a a leaf-class the starting class has a "level" of
  677.               0, a meta-class, a level of "-1", a meta-class for a meta-class, a level of "-2", etc.
  678. */
  679. DUMP_TILED_CLASSES : PROCEDURE EXPOSE ctl.
  680.    USE ARG tmpFile, collObject, bDetail, bObjectClassAtTop
  681.  
  682.    IF \ VAR( bObjectClassAtTop) THEN bObjectClassAtTop = .false   /* default, determines order of shown "tiling" */
  683.  
  684.    indent1 = .indent1
  685.    indent2 = .indent2
  686.  
  687.    IF collObject ~ items = 0 THEN RETURN        /* nothing to show */
  688.  
  689.  
  690.    IF \ .bShowEnvTilingWithMethodsEnv THEN      /* do a detailed tiling on .environment classes ? */
  691.    DO
  692.       /* too large ! 800KB with environment tiling !!! */
  693.       IF bDetail & tmpFile = ctl.eFileEnvironment THEN
  694.          RETURN
  695.    END
  696.  
  697.    indent = indent1 indent2
  698.  
  699.    /* build a list of superclasses, starting with leaves, remember top of every */
  700.    tmpLeafDir  = .directory ~ new
  701.  
  702.    /* turn set into directory, store class leaves */
  703.    DO aClass OVER collObject
  704.       IF tmpFile = .Env.FileObj THEN            /* if dumping environment, don't show classes given in .ignoreClasses */
  705.       DO
  706.         IF WORDPOS( SUBSTR( aClass ~ name, 2 ), .ignoreClasses ) > 0 THEN       /* remove leading dot */
  707.            ITERATE
  708.       END
  709.  
  710.       tmpList = .list ~ new
  711.       tmpLeafDir ~ setentry( aClass ~ name, tmpList )
  712.  
  713.       /* build list of superclasses (last entry is root class) */
  714.       tmpList ~ insert( aClass )                        /* store starting class  */
  715.    END
  716.  
  717.  
  718.    def_Class = aClass ~ class                           /* save class-object for def_class */
  719.    max_length = def_Class ~ max_name_length + 2         /* get maximum classname length, account for brackets */
  720.  
  721.    /* sort directory of lists */
  722.    tmpArr = sort( tmpLeafDir )
  723.  
  724.    DO i = 1 TO tmpArr ~ items                           /* produce and display tiled classes */
  725.       tmpSetDir = .directory ~ new                      /* directory to contain sets for different class/metaclass levels */
  726.       tmpSetDir ~ setentry( "1", .set ~ new )           /* set to contain classes already processed */
  727.  
  728.       HighestLevel = 0
  729.  
  730.       tmpList = tmpLeafDir ~ entry( tmpArr[ i ] )       /* process list, setup tiling, print it */
  731.       tmpHierarchyList = .list ~ new
  732.  
  733.  
  734.       next  = tmpList ~ first                           /* get first list entry */
  735.       aClass = tmpList ~ at( next )                  /* get class-def */
  736.       last = tmpHierarchyList ~ last                 /* get last entry, everything has to be inserted right after it */
  737.       /* "HighestLevel" gets set in routine */
  738.       CALL get_hierarchy_up aClass, tmpSetDir, tmpHierarchyList, last, 1 /* create tiled tree */
  739.  
  740.  
  741.       /* now dump tiling */
  742.       firstItem = tmpList ~ firstItem                   /* get first list item */
  743.       tmpClass  = tmpList ~ firstItem                   /* get def_class object */
  744.  
  745.       tmpString = pp( tmpClass ~ name )
  746.       tmpAttrString = tmpClass ~ dumpAttributes( .false )
  747.       IF tmpAttrString <> "" THEN tmpString = tmpString pp( tmpAttrString )
  748.  
  749.       IF \bDetail THEN                                  /* show summary */
  750.       DO
  751.          SAY
  752.          tmpString = tmpString "- tiling for this leaf class (i.e. summary view):"
  753.          SAY indent1 tmpString
  754.          SAY indent1 COPIES( "=", LENGTH( tmpString ) )
  755.          SAY
  756.  
  757.          IF bObjectClassAtTop THEN next = tmpHierarchyList ~ last
  758.                      ELSE next = tmpHierarchyList ~ first
  759.  
  760.          ind1 = LEFT("", 8)                             /* indention blanks */
  761.  
  762.          tmp_length = max_length + 25
  763.          DO WHILE next <> .nil
  764.             tmpItem = tmpHierarchyList ~ at( next )
  765.             list_Item = tmpItem[ 1 ]                    /* get def_class object */
  766.             tmpLevel  = HighestLevel - tmpItem[ 2 ]     /* level this class was found at, calculate indention */
  767.  
  768.             tmpString = ""
  769.             tmpHint   = ""
  770.             IF      list_item = .missing.class THEN tmpHint = "<-- MISSING"
  771.             ELSE IF list_item ~ IsMetaClass    THEN tmpHint = "(metaclass)"
  772.  
  773.             /* check whether defined in a different file, if so, display it ! */
  774.             sourceFile = ctl.eClasses2Files ~ index( list_item )
  775.  
  776.             IF tmpFile <> sourceFile THEN
  777.                tmpString = LEFT(pp( list_item ~ name ) || " ", tmp_length, ".") STRIP( tmpHint) pp( sourceFile ~ name )
  778.             ELSE
  779.                tmpString = LEFT(pp( list_item ~ name ), tmp_length) tmpHint
  780.  
  781.             IF list_item ~ errors ~ items > 0 THEN tmpString = tmpString "** errors found ! **"
  782.  
  783.             IF tmpLevel > 0 THEN
  784.                SAY indent COPIES(ind1, tmpLevel) "|" tmpString
  785.             ELSE
  786.                SAY indent "|" tmpString
  787.  
  788.             IF bObjectClassAtTop THEN next = tmpHierarchyList ~ previous( next )
  789.                         ELSE next = tmpHierarchyList ~ next( next )
  790.          END
  791.       END
  792.  
  793.  
  794.  
  795.  
  796.  
  797.       ELSE                                              /* show detail (aligned methods) */
  798.       DO
  799.          SAY
  800.          tmpString = tmpString "- tiling (i.e. detail view):"
  801.          SAY indent1 tmpString
  802.          SAY indent1 COPIES( "=", LENGTH( tmpString ) )
  803.          SAY
  804.          ind1 = LEFT("", 15)
  805.  
  806.          /* create temporary set to save methods already directly accessible */
  807.          tmpClassMethDir     = .directory ~ new     /* save seen class methods */
  808.          tmpInstanceMethDir  = .directory ~ new     /* save seen instance methods */
  809.  
  810.          IF bObjectClassAtTop THEN next = tmpHierarchyList ~ last
  811.                      ELSE next = tmpHierarchyList ~ first
  812.  
  813.  
  814.          tmpRootClass = tmpHierarchyList ~ at( next )[1]/* save root class */
  815.          IsRootClassMeta = tmpRootClass ~ IsMetaClass   /* get metaclass indicator */
  816.  
  817.          DO WHILE next <> .nil
  818.             tmpItem = tmpHierarchyList ~ at( next )
  819.             list_Item = tmpItem[ 1 ]                    /* get def_class object */
  820.             tmpLevel  = HighestLevel - tmpItem[ 2 ]     /* level this class was found at, calculate indention */
  821.             oriLevel  = tmpItem[ 2 ]                    /* original level */
  822.  
  823.             bIsMetaClass = list_item ~ IsMetaClass
  824.  
  825.             IF      list_item = .missing.class THEN tmpString = "MISSING -->" pp( list_item ~ name )
  826.             ELSE IF bIsMetaClass               THEN tmpString = pp( list_item ~ name ) "(metaclass)"
  827.             ELSE                                    tmpString = pp( list_item ~ name )
  828.  
  829.             /* check whether defined in a different file, if so, display it ! */
  830.             sourceFile = ctl.eClasses2Files ~ index( list_item )
  831.  
  832.             IF tmpFile <> sourceFile THEN
  833.                tmpString = tmpString "---> defined in" pp( sourceFile ~ name )
  834.  
  835.             IF list_item ~ errors ~ items > 0 THEN tmpString = tmpString "** errors found ! **"
  836.  
  837.             SAY indent || COPIES(ind1, tmpLevel) || "|" tmpString "L#" pp( oriLevel )
  838.  
  839.             bShowMethods = ( list_item <> .missing.class )
  840.  
  841.             IF bShowMethods THEN
  842.             DO
  843.                IF \ .bShowEnvMethods THEN               /* show .environment class methods while tiling non .environment classes ? */
  844.                DO       /* don't show methods, if they belong to an .environment class */
  845.  
  846.                   bShowMethods = \ ctl.eEnvClassSet ~ HASINDEX( list_item )
  847.                END
  848.             END
  849.  
  850.  
  851.             /* now show methods */
  852.             IF bShowMethods THEN
  853.             DO
  854.                methIndent = indent || COPIES(ind1, tmpLevel)
  855.  
  856.         /* dump *class* methods */
  857.                tmpClassDir = list_item ~ Local_Class_Methods
  858.                tmpClassArr = sort( tmpClassDir )
  859.                IF tmpClassArr ~ items > 0 THEN SAY
  860.  
  861.                DO k = 1 TO tmpClassArr ~ items
  862.                   tmpMethObj = tmpClassDir ~ entry( tmpClassArr[ k ] )
  863.                   tmpString = "::METHOD" pp( tmpMethObj ~ name )
  864.  
  865.                   tmpAttributes = STRIP( tmpMethObj ~ DumpAttributes( .false ) )
  866.                   IF tmpAttributes <> "" THEN tmpString = tmpString pp( tmpAttributes )
  867.  
  868.                   IF oriLevel = 1  THEN                 /* class methods only reachable if at level 1 */
  869.                   DO
  870.                      tmpName = tmpMethObj ~ name                            /* get method's name */
  871.                      IF  tmpClassMethDir ~ entry( tmpName ) = .nil THEN     /* not recorded as of yet */
  872.                      DO
  873.                         IF \ bObjectClassAtTop THEN
  874.                            tmpString = tmpString "<--- 'direct' access for" pp( tmpRootClass ~ name )
  875.                         tmpClassMethDir ~ setentry( tmpName, tmpName )
  876.                      END
  877.                   END
  878.                   SAY methIndent || "|" tmpString
  879.                END
  880.  
  881.                methindent = methindent || ind1     /* indent more */
  882.  
  883.         /* dump *instance* methods */
  884.                tmpClassDir = list_item ~ Local_Instance_Methods
  885.                tmpClassArr = sort( tmpClassDir )
  886.                IF tmpClassArr ~ items > 0 THEN SAY
  887.  
  888.                DO k = 1 TO tmpClassArr ~ items
  889.                   tmpMethObj = tmpClassDir ~ entry( tmpClassArr[ k ] )
  890.                   tmpString = "::METHOD" pp( tmpMethObj ~ name )
  891.  
  892.                   tmpAttributes = STRIP( tmpMethObj ~ DumpAttributes( .false ) )
  893.                   IF tmpAttributes <> "" THEN tmpString = tmpString pp( tmpAttributes )
  894.  
  895.  
  896.                   IF oriLevel <= 2 THEN
  897.                   DO
  898.                      /* indicate whether class method is directly accessible from starting class */
  899.                      tmpName = tmpMethObj ~ name                   /* get method's name */
  900.  
  901.                      IF oriLevel = 1 THEN                               /* instance method in same column */
  902.                      DO
  903.                         IF  tmpInstanceMethDir ~ entry( tmpName ) = .nil THEN  /* not recorded as of yet */
  904.                         DO
  905.                            IF \ bObjectClassAtTop THEN
  906.                               tmpString = tmpString "<--- 'direct' access for" pp( tmpRootClass ~ name )
  907.                            tmpInstanceMethDir ~ setentry( tmpName, tmpName )
  908.                         END
  909.                      END
  910.                      ELSE
  911.                      DO
  912.                         IF tmpClassMethDir ~ entry( tmpName ) = .nil THEN      /* not recorded as of yet */
  913.                         DO
  914.                            IF \ bObjectClassAtTop THEN
  915.                               tmpString = tmpString "<--- 'direct' access for" pp( tmpRootClass ~ name )
  916.                            tmpClassMethDir ~ setentry( tmpName, tmpName )
  917.                         END
  918.                      END
  919.                   END
  920.  
  921.                   SAY methIndent || "|" tmpString
  922.                END
  923.             END
  924.  
  925.             SAY indent LEFT( "", MAX( max_length, 100 ), "-" )
  926.             SAY
  927.  
  928.             IF bObjectClassAtTop THEN next = tmpHierarchyList ~ previous( next )
  929.                         ELSE next = tmpHierarchyList ~ next( next )
  930.          END
  931.       END
  932.    END
  933.  
  934.    SAY
  935.    RETURN
  936.  
  937.  
  938.  
  939.  
  940. /* ---------------------------------------------------------------------------------------- */
  941. /* produce a hierarchy list with starting class */
  942. /* insert aCLASS into TMPHIERARCHYLIST, if it is not in TMPSET, position in list is
  943.    indicated by POSITION_IN_LIST */
  944. GET_HIERARCHY_UP: PROCEDURE EXPOSE ctl. HighestLevel
  945.    USE ARG aClass, tmpSetDir, tmpHierarchyList, position_in_list, level
  946.  
  947.    IF aClass = .missing.class THEN                      /* leave missing class in list to indicate error */
  948.    DO
  949.       tmpHierarchyList ~ insert( .array~ of(aClass, level) , position_in_list )     /* insert class in front */
  950.       RETURN
  951.    END
  952.  
  953.    tmpSet = tmpSetDir ~ entry( level )                  /* get appropriate set to contain classes already processed at this level */
  954.  
  955.    IF tmpSet ~ hasindex( aClass ) THEN                  /* already handled */
  956.       RETURN
  957.  
  958.  
  959.    HighestLevel = MAX( level, HighestLevel )            /* store highest level (deepness w.r.t. metaclasses) */
  960.    listIndex = tmpHierarchyList ~ insert( .array ~ of( aClass, level) , position_in_list) /* insert class in front, remember level */
  961.    tmpSet ~ put( aClass )                               /* indicate that class has been handled at this level */
  962.  
  963. /**/
  964.    tmpListOfSuperClasses = aClass ~ ListOfSuperClasses
  965.    next = tmpListOfSuperClasses ~ last
  966.    DO WHILE next <> .nil
  967.       item = tmpListOfSuperClasses ~ at( next )
  968.  
  969.       IF \tmpSet ~ HASINDEX( item ) THEN      /* class not handled as of yet */
  970.          CALL get_hierarchy_up item, tmpSetDir, tmpHierarchyList, listIndex, level
  971.  
  972.       next = tmpListOfSuperClasses ~ previous( next )
  973.    END
  974.  
  975. /**/
  976.  
  977.    aMetaClass = aClass ~ MetaClassObject                /* now resolve metaclass by putting it in front */
  978.    IF aMetaClass <> .nil THEN
  979.    DO
  980.       IF \tmpSet ~ HASINDEX( aMetaClass) THEN           /* this class was not handled at this level as of yet */
  981.       DO
  982.          tmpSet ~ put( aMetaClass )                     /* indicate that class has been handled at this level */
  983.          level = level + 1                              /* generate a new level */
  984.  
  985.          tmpSet = tmpSetDir ~ entry( level )            /* get the set of the next level and check whether metaclass was handled already */
  986.  
  987.          bRecurse = .false
  988.          IF tmpSet = .nil THEN                          /* does a set for this metaclass level exist already ? */
  989.          DO
  990.             tmpSetDir ~ setentry( level, .set ~ new )   /* create an empty set for this new level */
  991.             bRecurse = .true
  992.          END
  993.          ELSE
  994.             bRecurse = \ tmpSet ~ HASINDEX( aMetaClass) /* only recurse if not handled at that level already ! */
  995.  
  996.  
  997.  
  998.          /* recurse, build a hierarchy for this metaclass at this new level */
  999.          IF bRecurse THEN
  1000.             CALL get_hierarchy_up aMetaClass, tmpSetDir, tmpHierarchyList, listIndex, level
  1001.  
  1002.       END
  1003.    END
  1004.  
  1005.    RETURN
  1006.  
  1007.  
  1008.  
  1009.  
  1010.  
  1011.  
  1012. /* ------------------------------------------------------------------------- */
  1013. DUMP_ROOTS: PROCEDURE   EXPOSE ctl.
  1014.    USE ARG tmpFile, indent1, indent2
  1015.  
  1016.  
  1017.    IF tmpFile ~ Local_Root_classes ~ items = 0 THEN RETURN      /* nothing to show */
  1018.  
  1019.    SAY indent1 "Show available classes as tree(s), indicating metaclass being used:"
  1020.    SAY
  1021.  
  1022.    tmpRootDir  = .directory ~ new
  1023.    /* turn set into directory */
  1024.    DO aClass OVER tmpFile ~ Local_Root_Classes
  1025.       tmpRootDir ~ setentry( aClass ~ name, aClass )
  1026.    END
  1027.  
  1028.    max_name_width =  aClass ~ class ~ max_name_length + 2 /* get maximum length of name, account for brackets */
  1029.  
  1030.    tmpArray = sort( tmpRootDir )                /* sort directory */
  1031.    DO i = 1 TO tmpArray ~ items                 /* dump in sorted root-order */
  1032.       tmpClass = tmpRootDir ~ entry( tmpArray[i] )
  1033.       CALL dump_sub_classes tmpClass, 1, tmpClass ~ IsMetaClass
  1034.       SAY
  1035.    END
  1036.    RETURN
  1037.  
  1038.  
  1039.  
  1040. /* dump class tree recursively */
  1041. DUMP_SUB_CLASSES: PROCEDURE EXPOSE indent1 indent2 max_name_width
  1042.   USE ARG class, level, IsMetaClass
  1043.  
  1044.   name = pp( class ~ name )
  1045.  
  1046.   tmpString = indent1  COPIES( indent2, level )
  1047.   tmpString = tmpString name
  1048.  
  1049.   /* if this class has a metaclass defined with it, show it */
  1050.   IF ( level = 1 & IsMetaClass = .true ) | ( class ~ MetaClassObject <> .nil ) THEN
  1051.   DO
  1052.      max = 60
  1053.      tmpWidth = MAX( LENGTH( tmpString ), max )                 /* define gap */
  1054.  
  1055.      IF tmpWidth = max THEN tmpWidth = tmpWidth - LENGTH( tmpString )
  1056.      filler = RIGHT( "",  tmpWidth, "." )
  1057.  
  1058.      IF class ~ MetaClassObject <> .nil THEN
  1059.          tmpString = tmpString filler pp( class ~ MetaClassObject ~ name )
  1060.      ELSE               /* no explicit metaclass, but subclassing .class */
  1061.      DO
  1062.         IF class ~ SuperClassObject ~ SuperClassObject <> .nil THEN     /* make sure .object is not shown */
  1063.            tmpString = tmpString filler pp( class ~ SuperClassObject ~ name )
  1064.      END
  1065.   END
  1066.  
  1067.   SAY tmpString         /* show class */
  1068.  
  1069.   subClassSet = class ~ SetOfSubclasses
  1070.   tmpDir  = .directory ~ new
  1071.   /* turn set into directory */
  1072.   DO aClass OVER SubClassSet
  1073.      tmpDir ~ setentry( aClass ~ name, aClass )
  1074.   END
  1075.  
  1076.   tmpArray = sort( tmpDir )                    /* sort directory */
  1077.   DO i = 1 TO tmpArray ~ items                 /* dump in sorted root-order */
  1078.      tmpClass = tmpDir ~ entry( tmpArray[i] )
  1079.      CALL dump_sub_classes tmpClass, level + 1, IsMetaClass /* call recursively */
  1080.   END
  1081.  
  1082.   RETURN
  1083.  
  1084.  
  1085.  
  1086.  
  1087. /* ------------------------------------------------------------------------- */
  1088.  
  1089. /* dump detail of a directory pointing to strings ( LABELS, PROCEDURES, ROUTINES ) */
  1090. DUMP_DETAIL_DIR2PROCLIKES: PROCEDURE EXPOSE ctl
  1091.    USE ARG tmpDir, indent1, indent2, title_string, line_nr
  1092.  
  1093.    IF \VAR( "line_nr" ) THEN line_nr = .false   /* default to not show line numbers */
  1094.  
  1095.    indent3 = indent1 indent2
  1096.    indent4 = indent3 indent2
  1097.  
  1098.  
  1099.    /* show labels, procedures, routines stored with directory */
  1100.    IF tmpDir ~ items > 0 THEN
  1101.    DO
  1102.       SAY indent1 title_string                  /* display title */
  1103.       SAY
  1104.  
  1105.       tmpArr = sort( tmpDir )
  1106.       max_width = MAX( 3, LENGTH( tmpArr ~ items ) + 1 )
  1107.       max_name_width =  tmpDir ~ entry( tmpArr[ 1 ] ) ~ class ~ max_name_length /* get maximum length of name */
  1108.  
  1109.       DO i = 1 TO tmpArr ~ items                        /* display entries */
  1110.          tmpObject = tmpDir ~ entry( tmpArr[ i ] )
  1111.          tmpString = indent1 indent2 RIGHT( i, max_width)
  1112.  
  1113.          tmpName = pp( LEFT( tmpObject ~ name, max_name_width ) )
  1114.  
  1115.          IF      tmpObject ~ class ~ id = "DEF_PROCEDURE" THEN tmpName = tmpName ": PROCEDURE"
  1116.          ELSE IF tmpObject ~ class ~ id = "DEF_LABEL"     THEN tmpName = tmpName ":"
  1117.          ELSE IF tmpObject ~ class ~ id = "DEF_ROUTINE"   THEN tmpName = tmpObject ~ type tmpName
  1118.  
  1119.          tmpAttributes = tmpObject ~ dumpAttributes     /* show attributes (EXPOSE, PUBLIC) */
  1120.  
  1121.          IF tmpAttributes <> "" THEN
  1122.             tmpString = tmpString pp( tmpName tmpAttributes )
  1123.          ELSE
  1124.             tmpString = tmpString pp( tmpName )
  1125.  
  1126.          IF line_nr THEN
  1127.          DO
  1128.             IF tmpObject ~ LineNr <> .nil THEN
  1129.                tmpString = tmpString pp_lineNr( tmpObject ~ LineNr )
  1130.          END
  1131.  
  1132.          SAY tmpString                          /* show name */
  1133.          SAY
  1134.  
  1135.          IF tmpObject ~ errors ~ items > 0 THEN /* show errors */
  1136.          DO
  1137.             SAY indent1 indent2 "The following error(s) was (were) recorded:"
  1138.             SAY
  1139.             CALL show_sorted_errors tmpObject ~ errors, indent3 indent2
  1140.             SAY
  1141.          END
  1142.  
  1143.          IF tmpObject ~ signatures ~ items > 0 THEN     /* show signatures */
  1144.          DO
  1145.             title_string = ""
  1146.             CALL dump_detail_dir2string tmpObject ~ signatures, indent4, indent2, title_string
  1147.          END
  1148.  
  1149.          IF tmpObject ~ returns    ~ items > 0 THEN     /* show return statements */
  1150.          DO
  1151.             title_string = ""
  1152.             CALL dump_detail_dir2string tmpObject ~ returns, indent4, indent2, title_string
  1153.          END
  1154.  
  1155.          IF tmpObject ~ exits      ~ items > 0 THEN     /* show exit-statements */
  1156.          DO
  1157.             title_string = ""
  1158.             CALL dump_detail_dir2string tmpObject ~ exits, indent4, indent2, title_string
  1159.          END
  1160.  
  1161.  
  1162.          IF tmpObject ~ hasmethod( "local_labels" ) THEN
  1163.          DO
  1164.             IF tmpObject ~ local_labels ~ items > 0 THEN           /* show labels, but recurse */
  1165.             DO
  1166.                title_string = "Locally defined LABEL(s):"
  1167.                CALL dump_detail_dir2proclikes tmpObject ~ local_labels, indent4, indent2, title_string, line_nr
  1168.             END
  1169.          END
  1170.  
  1171.          IF tmpObject ~ hasmethod( "local_procedures" ) THEN
  1172.          DO
  1173.             IF tmpObject ~ local_procedures ~ items > 0 THEN       /* show procedures, but recurse */
  1174.             DO
  1175.                title_string = "Locally defined PROCEDURE(s):"
  1176.                CALL dump_detail_dir2proclikes tmpObject ~ local_procedures, indent4, indent2, title_string, line_nr
  1177.             END
  1178.          END
  1179.       END
  1180.       SAY
  1181.     END
  1182.     RETURN
  1183.  
  1184.  
  1185.  
  1186.  
  1187. /* dump detail of a directory pointing to strings ( METHOD ) */
  1188. DUMP_DETAIL_DIR2METHODS: PROCEDURE EXPOSE ctl
  1189.    USE ARG tmpDir, indent1, indent2, title_string, line_nr
  1190.  
  1191.    IF \VAR( "line_nr" ) THEN line_nr = .false   /* default to not show line numbers */
  1192.  
  1193.    indent3 = indent1 indent2
  1194.    indent4 = indent3 indent2
  1195.  
  1196.    /* show methods */
  1197.    IF tmpDir ~ items > 0 THEN
  1198.    DO
  1199.       SAY indent1 title_string                  /* display title */
  1200.       SAY
  1201.  
  1202.       tmpArr = sort( tmpDir )
  1203.       max_width = MAX( 3, LENGTH( tmpArr ~ items ) + 1 )
  1204.       max_name_width =  tmpDir ~ entry( tmpArr[ 1 ] ) ~ class ~ max_name_length /* get maximum length of name */
  1205.       DO i = 1 TO tmpArr ~ items                        /* display entries */
  1206.          tmpObject = tmpDir ~ entry( tmpArr[ i ] )
  1207.          tmpName = tmpObject ~ type LEFT( pp(tmpObject ~ name), max_name_width)
  1208.          tmpString = indent1 indent2 RIGHT( i, max_width)
  1209.          tmpAttributes = tmpObject ~ dumpAttributes
  1210.  
  1211.          IF tmpAttributes <> "" THEN
  1212.             tmpString = tmpString pp( tmpName STRIP( tmpAttributes, "Trailing" ) )
  1213.          ELSE
  1214.             tmpString = tmpString pp( tmpName )
  1215.  
  1216.  
  1217.          IF line_nr THEN
  1218.          DO
  1219.             IF tmpObject ~ LineNr <> .nil THEN
  1220.                tmpString = tmpString pp_lineNr( tmpObject ~ LineNr )
  1221.          END
  1222.  
  1223.          SAY tmpString                          /* show name */
  1224.  
  1225.          IF tmpObject ~ errors ~ items > 0 THEN /* show errors */
  1226.          DO
  1227.             SAY
  1228.             SAY indent1 indent2 "The following error(s) was (were) recorded:"
  1229.             SAY
  1230.             CALL show_sorted_errors tmpObject ~ errors, indent3 indent2
  1231.          END
  1232.  
  1233.          IF tmpObject ~ expose ~ items > 0 THEN         /* show EXPOSE string */
  1234.          DO
  1235.             SAY
  1236.             SAY indent4 indent2 pp( tmpObject ~ exposeAsString )
  1237.             SAY
  1238.          END
  1239.  
  1240.  
  1241.          IF tmpObject ~ signatures ~ items > 0 THEN     /* show signatures */
  1242.          DO
  1243.             SAY
  1244.             title_string = ""
  1245.             CALL dump_detail_dir2string tmpObject ~ signatures, indent4, indent2, title_string
  1246.          END
  1247.  
  1248.          IF tmpObject ~ returns    ~ items > 0 THEN     /* show return-statements */
  1249.          DO
  1250.             SAY
  1251.             title_string = ""
  1252.             CALL dump_detail_dir2string tmpObject ~ returns, indent4, indent2, title_string
  1253.          END
  1254.  
  1255.          IF tmpObject ~ exits      ~ items > 0 THEN     /* show exit-statements */
  1256.          DO
  1257.             title_string = ""
  1258.             SAY
  1259.             CALL dump_detail_dir2string tmpObject ~ exits, indent4, indent2, title_string
  1260.          END
  1261.  
  1262.          IF tmpObject ~ local_labels ~ items > 0 THEN           /* show labels */
  1263.          DO
  1264.             SAY
  1265.             title_string = "Locally defined LABEL(s):"
  1266.             CALL dump_detail_dir2proclikes tmpObject ~ local_labels, indent4, indent2, title_string, line_nr
  1267.          END
  1268.  
  1269.          IF tmpObject ~ local_procedures ~ items > 0 THEN       /* show procedures */
  1270.          DO
  1271.             SAY
  1272.             title_string = "Locally defined PROCEDURE(s):"
  1273.             CALL dump_detail_dir2proclikes tmpObject ~ local_procedures, indent4, indent2, title_string, line_nr
  1274.          END
  1275.       END
  1276.       SAY
  1277.     END
  1278.     RETURN
  1279.  
  1280.  
  1281.  
  1282.  
  1283. /* dump detail of a directory pointing to strings ( CLASS ) */
  1284. DUMP_DETAIL_DIR2CLASSES: PROCEDURE EXPOSE ctl
  1285.    USE ARG tmpDir, indent1, indent2, title_string, line_nr
  1286.  
  1287.    IF \VAR( "line_nr" ) THEN line_nr = .false   /* default to not show line numbers */
  1288.  
  1289.    indent3 = indent1 indent2
  1290.    indent4 = indent3 indent2
  1291.  
  1292.    /* show classes */
  1293.    IF tmpDir ~ items > 0 THEN
  1294.    DO
  1295.       SAY indent1 title_string                  /* display title */
  1296.       SAY
  1297.  
  1298.       tmpArr = sort( tmpDir )
  1299.       max_width = MAX( 3, LENGTH( tmpArr ~ items ) + 1 )
  1300.       max_name_width =  tmpDir ~ entry( tmpArr[ 1 ] ) ~ class ~ max_name_length /* get maximum length of name */
  1301.       DO i = 1 TO tmpArr ~ items                        /* display entries */
  1302.          tmpObject = tmpDir ~ entry( tmpArr[ i ] )
  1303.  
  1304.          IF tmpObject = ctl.eMissingClass THEN          /* missing class in hand ? */
  1305.             tmpName   = pp( i "->" tmpObject ~ name )   /* indicate missing class ! */
  1306.          ELSE
  1307.             tmpName = tmpObject ~ type LEFT( pp( tmpObject ~ name ), max_name_width + 2)
  1308.  
  1309.          tmpString = indent1 indent2 RIGHT( i, max_width)
  1310.          tmpAttributes = tmpObject ~ dumpAttributes
  1311.  
  1312.          IF tmpAttributes <> "" THEN
  1313.             tmpString = tmpString pp( tmpName STRIP( tmpAttributes, "Trailing" ) )
  1314.          ELSE
  1315.             tmpString = tmpString pp( tmpName )
  1316.  
  1317.          IF line_nr THEN
  1318.          DO
  1319.             IF tmpObject ~ LineNr <> .nil THEN
  1320.                tmpString = tmpString pp_lineNr( tmpObject ~ LineNr )
  1321.          END
  1322.  
  1323.          SAY tmpString                          /* show name */
  1324.  
  1325.          IF tmpObject ~ errors ~ items > 0 THEN /* show errors */
  1326.          DO
  1327.             SAY
  1328.             SAY indent1 indent2 "The following error(s) was (were) recorded:"
  1329.             SAY
  1330.             CALL show_sorted_errors tmpObject ~ errors, indent3 indent2
  1331.             SAY
  1332.          END
  1333.  
  1334.          /* CLASS scope */
  1335.          IF tmpObject ~ ExposeClass ~ items > 0 THEN     /* show object variables at class scope */
  1336.          DO
  1337.             SAY
  1338.             title_String = "The following object variable(s) was (were) found at CLASS scope:"
  1339.             CALL dump_detail_dir2string tmpObject ~ ExposeClass, indent4, indent2, title_string
  1340.          END
  1341.  
  1342.          IF tmpObject ~ local_Class_Methods ~ items > 0 THEN     /* show object variables at class scope */
  1343.          DO
  1344.             SAY
  1345.             title_string = "CLASS METHOD(s):"
  1346.             CALL dump_detail_dir2methods tmpObject ~ local_class_methods, indent4, indent2, title_string, .true
  1347.          END
  1348.  
  1349.          /* INSTANCE scope */
  1350.          IF tmpObject ~ ExposeInstance ~ items > 0 THEN     /* show object variables at Instance scope */
  1351.          DO
  1352.             SAY
  1353.             title_String = "The following object variable(s) was (were) found at INSTANCE scope:"
  1354.             CALL dump_detail_dir2string tmpObject ~ ExposeInstance, indent4, indent2, title_string
  1355.          END
  1356.  
  1357.          IF tmpObject ~ local_Instance_Methods ~ items > 0 THEN     /* show object variables at Instance scope */
  1358.          DO
  1359.             SAY
  1360.             title_string = "INSTANCE METHOD(s):"
  1361.             CALL dump_detail_dir2methods tmpObject ~ local_Instance_methods, indent4, indent2, title_string, .true
  1362.          END
  1363.       END
  1364.       SAY
  1365.     END
  1366.     RETURN
  1367.  
  1368.  
  1369.  
  1370.  
  1371. /* ------------------------------------------------------------------------- */
  1372. /* dump detail of a directory pointing to strings ( SIGNATURES, RETURNS ) */
  1373. DUMP_DETAIL_DIR2STRING: PROCEDURE EXPOSE ctl.
  1374.    USE ARG tmpDir, indent1, indent2, title_string
  1375.  
  1376.    /* show strings stored with directory */
  1377.    IF tmpDir ~ items > 0 THEN
  1378.    DO
  1379.       IF title_string <> "" THEN
  1380.       DO
  1381.          SAY indent1 title_string               /* display title */
  1382.          SAY
  1383.       END
  1384.  
  1385.       tmpArr = sort( tmpDir )
  1386.       max_width = MAX( 3, LENGTH( tmpArr ~ items ) + 1 )
  1387.       DO i = 1 TO tmpArr ~ items                        /* display entries */
  1388.          SAY indent1 indent2 RIGHT( i, max_width) pp( tmpDir ~ entry( tmpArr[ i ] ) )
  1389.       END
  1390.       SAY
  1391.     END
  1392.  
  1393.     RETURN
  1394.  
  1395.  
  1396.  
  1397.  
  1398.  
  1399.  
  1400.  
  1401. /* ------------------------------------------------------------------------- */
  1402. /* dump directory of same objects */
  1403. DUMP_DIRECTORY: PROCEDURE EXPOSE ctl.
  1404.    USE ARG tmpDir, tmpFile, Object2Files, title_string, indent1, indent2, line_nr
  1405.  
  1406.    IF \var( "line_nr" ) THEN line_nr = .false
  1407.  
  1408.    IF tmpDir ~ items > 0 THEN               /* tokens available for this file ? */
  1409.    DO
  1410.       tmpArray = sort( tmpDir )             /* sort directory */
  1411.  
  1412.                                                   /* account for pp's "[" and "]" ... */
  1413.       tmpIndentLength = tmpDir  ~ entry( tmpArray[ 1 ]  ) ~ class ~ max_name_length + 2 /* get maximum width info from class method */
  1414.       tmpIndent = COPIES( " ", tmpIndentLength )
  1415.  
  1416.       maxArray    = tmpArray ~ items                            /* get maximum array-elements */
  1417.  
  1418.       maxArrWidth = MAX( 3, LENGTH( maxArray ), LENGTH( pp_number( maxArray ) ) )
  1419.       IF maxArray > 0 THEN
  1420.       DO
  1421.          SAY indent1 title_string
  1422.          SAY
  1423.       END
  1424.  
  1425.       DO tmpI = 1 TO maxArray
  1426.  
  1427.          tmpObject     = tmpDir ~ entry( tmpArray[ tmpI ] )     /* get first token object accessible */
  1428.          tmpObjectFile  = Object2Files ~ index( tmpObject )     /* get file-object in which token is defined in */
  1429.  
  1430.          IF tmpObject = ctl.eMissingClass THEN          /* missing class in hand ? */
  1431.             tmpString = pp( tmpI "->" tmpObject ~ name )        /* indicate missing class ! */
  1432.          ELSE
  1433.             tmpString = LEFT( pp( tmpObject ~ name ), tmpIndentLength ) /* get name of object */
  1434.  
  1435.          IF tmpObjectFile <> tmpFile THEN                       /* if files differ, indicate source-file */
  1436.          DO
  1437.             IF tmpobjectfile <> .nil then                       /* e.g. def_class for missing-class has not file */
  1438.                tmpString = tmpString "defined in:" pp( tmpObjectFile ~ name )
  1439.          END
  1440.  
  1441.          IF line_nr THEN
  1442.          DO
  1443.             IF tmpObject ~ LineNr <> .nil THEN
  1444.                tmpString = tmpString pp_lineNr( tmpObject ~ LineNr )
  1445.          END
  1446.  
  1447.          SAY indent1 indent2 RIGHT( tmpI, maxArrWidth ) tmpString
  1448.       END
  1449.       SAY
  1450.    END
  1451.    RETURN
  1452.  
  1453.  
  1454.  
  1455. /* ------------------------------------------------------------------------- */
  1456. SORT_DEF_LIST: PROCEDURE
  1457.    USE ARG def_list, maxLength, type
  1458.  
  1459.    tmpArray = .array ~ new                      /* create empty array */
  1460.  
  1461.    tmpSupp = def_list ~ supplier                /* get a supplier for list */
  1462.    i = 1
  1463.    DO WHILE tmpSupp ~ available
  1464.       IF type = "FILE" THEN
  1465.       DO
  1466.          tmpName = tmpSupp ~ item ~ name
  1467.                                                 /* store name in array */
  1468.          tmpArray[ i ] = LEFT( pp( FILESPEC( "Name", tmpName) ) || " ", maxLength + 1, "." ) pp( tmpName )
  1469.  
  1470.       END
  1471.       ELSE
  1472.          tmpArray[ i ] = pp( tmpSupp ~ item ~ name )    /* store name in array */
  1473.  
  1474.       tmpSupp ~ next
  1475.       i = i + 1
  1476.    END
  1477.  
  1478.    RETURN sort( tmpArray )
  1479.  
  1480. /* ------------------------------------------------------------------------- */
  1481.  
  1482. /* return the line number in edited form */
  1483. pp_lineNr : PROCEDURE
  1484.    RETURN "@ l#" pp( ARG(1) )
  1485.  
  1486.  
  1487. /* ------------------------------------------------------------------------- */
  1488. SHOW_SORTED_ERRORS: PROCEDURE
  1489.    USE ARG container, indent
  1490.  
  1491.    sorted = sort( container )
  1492.  
  1493.    DO i = 1 TO sorted ~ items
  1494.       SAY indent sorted[ i ]
  1495.    END
  1496.  
  1497.    RETURN
  1498.  
  1499.  
  1500.  
  1501.  
  1502. /* ------------------------------------------------------------------------------------- */
  1503.  
  1504. ::REQUIRES rgf_util.cmd
  1505.  
  1506.  
  1507.