home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROCS.ZIP / SNAPSHOT.ICN < prev    next >
Encoding:
Text File  |  1992-09-28  |  3.6 KB  |  130 lines
  1. ############################################################################
  2. #
  3. #    File:     snapshot.icn
  4. #
  5. #    Subject:  Procedures to show snapshot of Icon string scanning
  6. #
  7. #    Author:   Ralph E. Griswold and Randal L. Schwartz, modified by
  8. #       Cheyenne Wills and Richard Goerwitz
  9. #
  10. #    Date:     Mar 23, 1991
  11. #
  12. ###########################################################################
  13. #
  14. #     The procedure snapshot(title,len) writes a snapshot of the state
  15. #  of string scanning, showing the value of &subject and &pos, an
  16. #  optional title (arg 1), and (again optionally) wrapping the display
  17. #  for a terminal of len (arg 2) columns.
  18. #
  19. #  For example,
  20. #
  21. #     "((a+b)-delta)/(c*d))" ? {
  22. #     tab(bal('+-/*'))
  23. #     snapshot("example")
  24. #     }
  25. #
  26. #  produces
  27. #
  28. #    ---example---------------------------
  29. #    |                    |
  30. #    |                    |
  31. #    | &subject = "((a+b)-delta)/(c*d))" |
  32. #    |               |        |
  33. #    |                        |
  34. #    -------------------------------------
  35. #
  36. #     Note that the bar showing the &pos is positioned under the &posth
  37. #  character (actual positions are between characters).  If &pos is
  38. #  at the end of &subject, the bar is positioned under the quotation
  39. #  mark delimiting the subject. For example,
  40. #
  41. #     "abcdefgh" ? (tab(0) & snapshot())
  42. #
  43. #  produces
  44. #
  45. #    -------------------------
  46. #    |            |
  47. #    |            |
  48. #    | &subject = "abcdefgh" |
  49. #    |              | |
  50. #    |            |
  51. #    -------------------------
  52. #
  53. #     Escape sequences are handled properly. For example,
  54. #
  55. #     "abc\tdef\nghi" ? (tab(upto('\n')) & snapshot())
  56. #
  57. #  produces
  58. #
  59. #    ------------------------------
  60. #    |                 |
  61. #    |                 |
  62. #    | &subject = "abc\tdef\nghi" |
  63. #    |              |      |
  64. #    |                 |
  65. #    ------------------------------
  66. #
  67. #  The title argument places a title into the top bar, as in
  68. #
  69. #    "abc\tdef\nghi" ? (tab(upto('\n')) & snapshot("upto('\n')")
  70. #
  71. #  which produces
  72. #
  73. #      --upto('\n')-------------------
  74. #      |                             |
  75. #      |                             |
  76. #      | &subject = "abc\tdef\nghi"  |
  77. #      |                     |       |
  78. #      |                             |
  79. #      -------------------------------
  80. #
  81. #  The len argument rewraps the display for a screen of len width.
  82. #
  83. ############################################################################
  84.  
  85.  
  86. procedure snapshot(title,len)
  87.  
  88.    local bar1, bar2, bar3, is, is0, prefix, titlel, placement, POS
  89.  
  90.    /title := ""            # no meaningful default
  91.    \len <:= 20            # any less is really not useful
  92.    prefix := "&subject = "
  93.    is := image(&subject)
  94.    is0 := *image(&subject[1:&pos]) | fail
  95.  
  96.    #
  97.    # Set up top and bottom bars (not exceeding len width, if
  98.    # len is nonnull).  Fit title into top bar (bar1).
  99.    #
  100.    bar1 := bar3 := repl("-", *is + *prefix + 4)[1:\len-4|0]
  101.    # in *is + *prefix + 4, the 4 is for two vbars/two spaces
  102.    titlel := (*title > *bar3-4) | *title[1:\len-4|0]
  103.    bar1 ?:= move(3) || (tab(4+titlel), title) || tab(0)
  104.  
  105.    #
  106.    # Write bar1, then spacers (bar2).  Then write out len-size chunks
  107.    # of &subject, with the | pointer-line, where appropriate. Finally,
  108.    # write out bar3 (like bar1, but with no title).
  109.    #
  110.    write(bar1)
  111.    bar2 := "|" || repl(" ", *bar3 - 2) || "|"
  112.    write(bar2, "\n", bar2)
  113.    placement := *prefix + is0
  114.    (prefix || is) ? {
  115.        until pos(0) do {
  116.        POS := &pos - 1
  117.        write("| ", move(*bar3-4) | left(tab(0), *bar3-4), " |")
  118.        if POS < placement < &pos then {
  119.            writes("| ")
  120.            writes(left(repl(" ", placement - POS - 1) || "|", *bar3-4))
  121.            write(" |\n", bar2)
  122.        }
  123.        else write(bar2, "\n", bar2)
  124.        }
  125.    }
  126.    write(bar3)
  127.    return            # nothing useful to return
  128.  
  129. end
  130.