home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / compsrcs / unix / volume03 / pretty < prev    next >
Encoding:
Text File  |  1988-09-11  |  11.0 KB  |  343 lines
  1. Subject: mc & xlisp pretty printer
  2. From: Mike Meyer <genrad!ucbvax!ucbjade!ucbopal:mwm>
  3. Newsgroups: mod.sources
  4. Approved: jpn@panda.UUCP
  5.  
  6. Mod.sources:  Volume 2, Issue 36
  7. Submitted by: Mike Meyer <ucbvax!ucbjade!ucbopal:mwm>
  8.  
  9.  
  10. # This is a shell archive.  Remove anything before this line, then
  11. # unpack it by saving it in a file and typing "sh file".  (Files
  12. # unpacked will be owned by you and have default permissions.)
  13. #
  14. # This archive contains:
  15. # README mc.clu mc.n pp.lsp
  16.  
  17. echo x - README
  18. sed 's/^    //' > "README" << '//E*O*F README//'
  19.     Since it doesn't look like I'm going to have time to work on the xlisp
  20.     editor for a while, and mc looked finished, I decided to collect this
  21.     up and let people have it.
  22.     
  23.     pp.lsp contains a simple lisp pretty printer for xlisp. It doesn't
  24.     know about special forms, but is useable as is. Teaching it about
  25.     special forms would be easy, but I find the thought ugly. For some
  26.     reason, changing pp$pp to use the where argument causes all output to
  27.     fall into the bit bucket. I think there's a problem in the xlisp I/O
  28.     system (actually, I *know* there are problems in the xlisp I/O system,
  29.     but I'm not sure that this is one of them), but I'm not going to chase
  30.     it until I finish the xlisp editor. If somebody out there fixes this
  31.     problem, please let me know.
  32.     
  33.     mc.clu and mc.n are the source and documentation for a simple
  34.     multi-column printer. Mc is more flexible and faster than the pr hack
  35.     suggested in K&P, but still a very simple filter. Of course, you do
  36.     have to have a CLU compiler to use it. I can provide a pointer for
  37.     said compiler if anyone is interested. I've also got an early version
  38.     of mc written in C, but it's larger, slower, and less robust than the
  39.     posted version. This is available for the asking.
  40.     
  41.         <mike
  42.         ucbvax!mwm
  43.     
  44.     "Damn the tiddlywinks, full speed ahead!"
  45. //E*O*F README//
  46.  
  47. echo x - mc.clu
  48. sed 's/^    //' > "mc.clu" << '//E*O*F mc.clu//'
  49.     %
  50.     % mc - a multi-column print routine. Turns an arbitary stream of lines
  51.     %    into a multi-column print.
  52.     %
  53.     % usage: mc [-g #] [-c #] [-w #] [ file ]
  54.     %    -g sets the gutter width; default is 2
  55.     %    -c sets the number of columns to print; default is as many as will fit
  56.     %    -w sets the width of the output device; default is taken from co entry
  57.     %        of the termcap for the current terminal.
  58.     %    file is input file name; default is standard input
  59.     %
  60.     % notes: column width is fixed at width of the longest element. No changing
  61.     %    allowed. If both -c and -w are specified, -w will be ignored if needed
  62.     %    to make everything fit on the page. Non-positive c or w is ignored.
  63.     %    Negative g is ignored. Only one file argument is allowed.
  64.     %
  65.     
  66.     file = stream        % file type, later to tweak to handle long pipes
  67.     list = array[string]    % list of strings
  68.     fetch = string$fetch
  69.     parse = int$parse
  70.     putl = stream$putl
  71.     gutter_default = 2
  72.     characters_default = 79
  73.     
  74.     start_up = proc ()
  75.         input: file
  76.         stdout: stream := stream$primary_output()
  77.         stderr: stream := stream$error_output()
  78.         lines: list := list$create(0)    % place to store input lines
  79.         argv: sequence[string] := get_argv()
  80.         gutter: int := gutter_default    % spacing between columns
  81.         longest: int := 0        % longest line to date
  82.         characters: int := 0        % # of characters in print line
  83.         columns: int := 0        % # of columns to print
  84.         i: int
  85.         my_name: string := _get_pname()
  86.     
  87.         % parse the arguments we was handed
  88.         i := 1
  89.         while fetch(argv[i], 1) = '-' do
  90.             if fetch(argv[i], 2) = 'g' then
  91.                 i := i + 1
  92.                 gutter := parse(argv[i])
  93.             elseif fetch(argv[i], 2) = 'w' then
  94.                 i := i + 1
  95.                 characters := parse(argv[i])
  96.             elseif fetch(argv[i], 2) = 'c' then
  97.                 i := i + 1
  98.                 columns := parse(argv[i])
  99.             else putl(stderr, my_name || ": unknown flag " || argv[i])
  100.                 end
  101.             i := i + 1
  102.             end except when bounds: end
  103.     
  104.         if i < sequence[string]$size(argv) then
  105.             putl(stderr, my_name || ": only one input file allowed") end
  106.     
  107.         input := file$open(file_name$parse(argv[i]), "read")
  108.             except when bounds: input := file$primary_input() end
  109.             except when not_possible (s: string):
  110.                 signal failure(my_name || ": " ||
  111.                         argv[i] || ": " || s)
  112.                 end
  113.     
  114.         % get the list of lines to print, noting the longest line
  115.         i := 0
  116.         while true do
  117.             list$addh(lines, file$getl(input))
  118.             i := string$size(lines[list$high(lines)])
  119.             if i > longest then longest := i end
  120.             end except when end_of_file: end
  121.     
  122.         % now, figure out how to print it
  123.         if gutter < 0 then gutter := gutter_default end
  124.         longest := longest + gutter
  125.         if characters < 1 then characters := get_tty_characters()
  126.             except when not_found: characters := characters_default end
  127.             end
  128.         if columns < 1 then columns := characters / longest 
  129.             except when zero_divide:
  130.                 signal failure(my_name ||
  131.                         "All input lines of length 0") end
  132.             end
  133.         % We have to have at least one column, or things get sticky.
  134.         % (Hm... How about no output if columns < 1?)
  135.         if columns < 1 then columns := 1 end
  136.     
  137.         % now print it
  138.         i := 0
  139.         for j: int in list$indexes(lines) do
  140.             if j // columns = 0 & j ~= 0 then
  141.                 stream$putc_image(stdout, '\012')
  142.             else stream$putspace(stdout, i) end
  143.             stream$puts(stdout, lines[j])
  144.             i := longest - string$size(lines[j])
  145.             end
  146.         stream$putc_image(stdout, '\012')
  147.         end start_up
  148.     %
  149.     % get the # of columns in ther terminal
  150.     %
  151.     get_tty_characters = proc () returns (int) signals (not_found)
  152.         termcap: string := _get_termcap() resignal not_found
  153.         count: int :=  int$parse(_termcap(termcap, ":co#", 0, 0))
  154.             resignal not_found
  155.     
  156.         if string$indexs(":am", termcap) = 0 then return (count)
  157.         else return (count - 1) end
  158.         end get_tty_characters
  159. //E*O*F mc.clu//
  160.  
  161. echo x - mc.n
  162. sed 's/^    //' > "mc.n" << '//E*O*F mc.n//'
  163.     .TH MC 1
  164.     .UC
  165.     .SH NAME
  166.     mc \- multi-columnate an input string
  167.     .SH SYNOPSIS
  168.     .B mc [
  169.     .B -g # ] [
  170.     .B -w # ] [
  171.     .B -c # ] [
  172.     .B file ]
  173.     .SH DESCRIPTION
  174.     .I Mc
  175.     reads it's input, and copies it to standard out in a multicolumn
  176.     format, one line of input turning into one column entry in the output.
  177.     The first line of input goes to the top of the first column, the
  178.     second line of input to the top of the second column, ... the line
  179.     after the top entry of the last column goes to the seceond entry of
  180.     the first column, etc.
  181.     
  182.     The
  183.     .I -g
  184.     flag specifies the width of the gutter of whitespace between
  185.     columns.  This defaults to 2, and negative values for
  186.     .I g
  187.     are ignored. A zero value is legal.
  188.     
  189.     The
  190.     .I -w
  191.     flag specifies how many characters wide the output device can be. The
  192.     default is the width of the terminal. If
  193.     .I w
  194.     is unspecified, and no termcap entry can be found, a warning is
  195.     printed on standard error, and a value of 79 is used. Non-positive
  196.     values of
  197.     .I w
  198.     are ignored.
  199.     
  200.     The
  201.     .I -c
  202.     flag specifies how many columns of output there should be. The default
  203.     is to print as many columns as will fit in the output device.
  204.     Non-positive values of
  205.     .I c
  206.     are ignored.
  207.     
  208.     Mc accepts one
  209.     .I file
  210.     argument, which is used for input if specified. If not specified,
  211.     standard input is used. If more than one file is specified, a warning
  212.     is printed on standard error, and the first file is used and all
  213.     others are ignored.
  214.     
  215.     The width of the columns is the width of the longest line in the
  216.     input. There is
  217.     .B no
  218.     way to specify this width. If
  219.     .I c
  220.     is specified, and is larger than
  221.     .B mc
  222.     would have printed by default, then the specified number of
  223.     columns is printed using extra space on the output line if needed.
  224.     This can cause
  225.     .I w
  226.     flag to be ignored.
  227.     
  228.     The
  229.     .B tr(1)
  230.     command can be used to prepare input for mc. For example, to columnate
  231.     all the words of a document, the command
  232.     .I "cat document | tr -s '     \\\\012' '\\\\012' | mc"
  233.     will do.
  234.     
  235.     The second argument to 
  236.     .B tr
  237.     is a space followed by a tab. The
  238.     .I \\\\012
  239.     is the ascii representation for a newline, and the
  240.     .I -s
  241.     flag causes it to squeeze all runs of spaces, tabs and newlines
  242.     into a single newline.
  243.     
  244.     To print the entries in a colon seperated list as in columns, the command
  245.     .I "cat list | tr -s ':\\\\012' '\\\012' | mc"
  246.     works. The
  247.     .B tr
  248.     command maps all strings of colons and newlines into a single newline.
  249.     
  250.     If the input file is already in a column format, the
  251.     .B rs(1)
  252.     command might be more useful in reformating it.
  253.     .SH BUGS
  254.     All lines are kept in memory. For pipes, this is probably as good as
  255.     can be done. For input files, a seek to the start of the file should
  256.     be used if the file won't fit in memory.
  257.     .SH SEE ALSO
  258.     tr(1), rs(1)
  259. //E*O*F mc.n//
  260.  
  261. echo x - pp.lsp
  262. sed 's/^    //' > "pp.lsp" << '//E*O*F pp.lsp//'
  263.     ;
  264.     ; a pretty-printer, with hooks for the editor
  265.     ;
  266.     
  267.     ; First, the terminal width and things to manipulate it
  268.     (setq pp$terminal-width 79)
  269.     
  270.     (defmacro get-terminal-width nil
  271.       pp$terminal_width)
  272.     
  273.     (defmacro set-terminal-width (new-width)
  274.       (let ((old-width pp$terminal-width))
  275.         (setq pp$terminal-width new-width)
  276.         old-width))
  277.     ;
  278.     ; Now, a basic, simple pretty-printer
  279.     ; pp$pp prints expression, indented to indent-level, assuming that things
  280.     ; have already been indented to indent-so-far. It *NEVER* leaves the cursor
  281.     ; on a new line after printing expression. This is to make the recursion
  282.     ; simpler. This may change in the future, in which case pp$pp could vanish.
  283.     ;
  284.     (defun pp$pp (expression indent-level indent-so-far)
  285.     ; Step one, make sure we've indented to indent-level
  286.       (dotimes (x (- indent-level indent-so-far)) (princ " "))
  287.     ; Step two, if it's an atom or it fits just print it
  288.       (cond ((or (not (consp expression))
  289.              (> (- pp$terminal-width indent-level) (flatsize expression)))
  290.          (prin1 expression))
  291.     ; else, print open paren, the car, then each sub expression, then close paren
  292.         (t (princ "(")
  293.            (pp$pp (car expression) (1+ indent-level) (1+ indent-level))
  294.            (if (cadr expression)
  295.                (progn
  296.              (if (or (consp (car expression))
  297.                  (> (/ (flatsize (car expression)) 3)
  298.                     pp$terminal-width))
  299.                  (progn (terpri)
  300.                     (pp$pp (cadr expression) 
  301.                        (1+ indent-level)
  302.                        0))
  303.                  (pp$pp (cadr expression)
  304.                     (+ 2 indent-level (flatsize (car expression)))
  305.                     (+ 1 indent-level (flatsize (car expression)))))
  306.              (dolist (current-expression (cddr expression))
  307.                  (terpri)
  308.                  (pp$pp current-expression
  309.                     (+ 2 indent-level 
  310.                        (flatsize (car expression)))
  311.                     0))))
  312.            (princ ")")))
  313.       nil)
  314.     ;
  315.     ; Now, the thing that outside users should call
  316.     ; We have to have an interface layer to get the final terpri after pp$pp.
  317.     ; This also allows hiding the second and third args to pp$pp. Said args
  318.     ; being required makes the pp recursion loop run faster (don't have to map
  319.     ; nil's to 0).
  320.     ;    The where arg to pp is ingnored, as the obvious hack to pp$pp [adding
  321.     ; an extra arg to every call to a print routine or pp$pp] doesn't work,
  322.     ; printing nothing when where is nil.
  323.     ;
  324.     (defun pp (expression &optional where)
  325.     "Print EXPRESSION on STREAM, prettily"
  326.       (pp$pp expression 0 0)
  327.       (terpri))
  328. //E*O*F pp.lsp//
  329.  
  330. echo Possible errors detected by \'wc\' [hopefully none]:
  331. temp=/tmp/shar$$
  332. trap "rm -f $temp; exit" 0 1 2 3 15
  333. cat > $temp <<\!!!
  334.       26     235    1269 README
  335.      110     599    3567 mc.clu
  336.       96     528    2663 mc.n
  337.       65     333    2323 pp.lsp
  338.      297    1695    9822 total
  339. !!!
  340. wc  README mc.clu mc.n pp.lsp | sed 's=[^ ]*/==' | diff -b $temp -
  341. exit 0
  342.  
  343.