home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROCS.ZIP / FULLIMAG.ICN < prev    next >
Encoding:
Text File  |  1992-09-28  |  3.3 KB  |  120 lines
  1. ############################################################################
  2. #
  3. #    File:     fullimage.icn
  4. #
  5. #    Subject:  Procedures to produce complete image of structured data
  6. #
  7. #    Author:   Robert J. Alexander
  8. #
  9. #    Date:     December 5, 1989
  10. #
  11. ###########################################################################
  12. #
  13. #  fullimage() -- enhanced image()-type procedure that outputs all data
  14. #  contained in structured types.  The "level" argument tells it how far
  15. #  to descend into nested structures (defaults to unlimited).
  16. #
  17. ############################################################################
  18.  
  19. global fullimage_level,fullimage_maxlevel,fullimage_done,fullimage_used,
  20.       fullimage_indent
  21.  
  22. procedure fullimage(x,indent,maxlevel)
  23.    local tr,s,t
  24.    #
  25.    #  Initialize
  26.    #
  27.    tr := &trace ; &trace := 0    # turn off trace till we're done
  28.    fullimage_level := 1
  29.    fullimage_indent := indent
  30.    fullimage_maxlevel := \maxlevel | 0
  31.    fullimage_done := table()
  32.    fullimage_used := set()
  33.    #
  34.    #  Call fullimage_() to do the work.
  35.    #
  36.    s := fullimage_(x)
  37.    #
  38.    #  Remove unreferenced tags from the result string, and even
  39.    #  renumber them.
  40.    #
  41.    fullimage_done := table()
  42.    s ? {
  43.       s := ""
  44.       while s ||:= tab(upto('\'"<')) do {
  45.      case t := move(1) of {
  46.         "\"" | "'": {
  47.            s ||:= t
  48.            while (s ||:= tab(find(t) + 1)) \ 1 & s[-2] ~== "\\"
  49.            }
  50.         "<": {
  51.            t := +tab(find(">")) & move(1)
  52.            if member(fullimage_used,t) then {
  53.           /fullimage_done[t] := *fullimage_done + 1
  54.           s ||:= "<" || fullimage_done[t] || ">"
  55.           }
  56.            }
  57.         }
  58.      }
  59.       s ||:= tab(0)
  60.       }
  61.    #
  62.    #  Clean up and return.
  63.    #
  64.    fullimage_done := fullimage_used := &null     # remove structures
  65.    &trace := tr                  # restore &trace
  66.    return s
  67. end
  68.  
  69.  
  70. procedure fullimage_(x,noindent)
  71.    local s,t,tr
  72.    t := type(x)
  73.    s := case t of {
  74.       "null" | "string" | "integer" | "real" | "co-expression" | "cset" |
  75.       "file" | "window" | "procedure" | "external": image(x)
  76.       default: fullimage_structure(x)
  77.       }
  78.    #
  79.    #  Return the result.
  80.    #
  81.    return (
  82.       if \fullimage_indent & not \noindent then
  83.      "\n" || repl(fullimage_indent,fullimage_level - 1) || s
  84.       else
  85.         s
  86.    )
  87. end
  88.  
  89. procedure fullimage_structure(x)
  90.    local sep,s,t,tag,y
  91.    #
  92.    #  If this structure has already been output, just output its tag.
  93.    #
  94.    if \(tag := fullimage_done[x]) then {
  95.       insert(fullimage_used,tag)
  96.       return "<" || tag || ">"
  97.       }
  98.    #
  99.    #  If we've reached the max level, just output a normal image
  100.    #  enclosed in braces to indicate end of the line.
  101.    #
  102.    if fullimage_level = fullimage_maxlevel then
  103.      return "{" || image(x) || "}"
  104.    #
  105.    #  Output the structure in a style indicative of its type.
  106.    #
  107.    fullimage_level +:= 1
  108.    fullimage_done[x] := tag := *fullimage_done + 1
  109.    if (t := type(x)) == ("table" | "set") then x := sort(x)
  110.    s := "<" || tag || ">" || if t == "list" then "[" else t || "("
  111.    sep := ""
  112.    if t == "table" then every y := !x do {
  113.       s ||:= sep || fullimage_(y[1]) || "->" || fullimage_(y[2],"noindent")
  114.       sep := ","
  115.       }
  116.    else every s ||:= sep || fullimage_(!x) do sep := ","
  117.    fullimage_level -:= 1
  118.    return s || if t == "list" then "]" else ")"
  119. end
  120.