Relay-Version: version B 2.10.3 4.3bsd-beta 6/6/85; site seismo.CSS.GOV
Posting-Version: version B 2.10.2 9/3/84; site panda.UUCP
Path: seismo!bbnccv!harvard!talcott!panda!sources-request
From: sources-request@panda.UUCP
Newsgroups: mod.sources
Subject: mc & xlisp pretty printer
Message-ID: <792@panda.UUCP>
Date: 21 Aug 85 23:59:38 GMT
Sender: jpn@panda.UUCP
Lines: 336
Approved: jpn@panda.UUCP

Mod.sources:  Volume 2, Issue 36
Submitted by: Mike Meyer <ucbvax!ucbjade!ucbopal:mwm>


# This is a shell archive.  Remove anything before this line, then
# unpack it by saving it in a file and typing "sh file".  (Files
# unpacked will be owned by you and have default permissions.)
#
# This archive contains:
# README mc.clu mc.n pp.lsp

echo x - README
sed 's/^	//' > "README" << '//E*O*F README//'
	Since it doesn't look like I'm going to have time to work on the xlisp
	editor for a while, and mc looked finished, I decided to collect this
	up and let people have it.
	
	pp.lsp contains a simple lisp pretty printer for xlisp. It doesn't
	know about special forms, but is useable as is. Teaching it about
	special forms would be easy, but I find the thought ugly. For some
	reason, changing pp$pp to use the where argument causes all output to
	fall into the bit bucket. I think there's a problem in the xlisp I/O
	system (actually, I *know* there are problems in the xlisp I/O system,
	but I'm not sure that this is one of them), but I'm not going to chase
	it until I finish the xlisp editor. If somebody out there fixes this
	problem, please let me know.
	
	mc.clu and mc.n are the source and documentation for a simple
	multi-column printer. Mc is more flexible and faster than the pr hack
	suggested in K&P, but still a very simple filter. Of course, you do
	have to have a CLU compiler to use it. I can provide a pointer for
	said compiler if anyone is interested. I've also got an early version
	of mc written in C, but it's larger, slower, and less robust than the
	posted version. This is available for the asking.
	
		<mike
		ucbvax!mwm
	
	"Damn the tiddlywinks, full speed ahead!"
//E*O*F README//

echo x - mc.clu
sed 's/^	//' > "mc.clu" << '//E*O*F mc.clu//'
	%
	% mc - a multi-column print routine. Turns an arbitary stream of lines
	%	into a multi-column print.
	%
	% usage: mc [-g #] [-c #] [-w #] [ file ]
	%	-g sets the gutter width; default is 2
	%	-c sets the number of columns to print; default is as many as will fit
	%	-w sets the width of the output device; default is taken from co entry
	%		of the termcap for the current terminal.
	%	file is input file name; default is standard input
	%
	% notes: column width is fixed at width of the longest element. No changing
	%	allowed. If both -c and -w are specified, -w will be ignored if needed
	%	to make everything fit on the page. Non-positive c or w is ignored.
	%	Negative g is ignored. Only one file argument is allowed.
	%
	
	file = stream		% file type, later to tweak to handle long pipes
	list = array[string]	% list of strings
	fetch = string$fetch
	parse = int$parse
	putl = stream$putl
	gutter_default = 2
	characters_default = 79
	
	start_up = proc ()
		input: file
		stdout: stream := stream$primary_output()
		stderr: stream := stream$error_output()
		lines: list := list$create(0)	% place to store input lines
		argv: sequence[string] := get_argv()
		gutter: int := gutter_default	% spacing between columns
		longest: int := 0		% longest line to date
		characters: int := 0		% # of characters in print line
		columns: int := 0		% # of columns to print
		i: int
		my_name: string := _get_pname()
	
		% parse the arguments we was handed
		i := 1
		while fetch(argv[i], 1) = '-' do
			if fetch(argv[i], 2) = 'g' then
				i := i + 1
				gutter := parse(argv[i])
			elseif fetch(argv[i], 2) = 'w' then
				i := i + 1
				characters := parse(argv[i])
			elseif fetch(argv[i], 2) = 'c' then
				i := i + 1
				columns := parse(argv[i])
			else putl(stderr, my_name || ": unknown flag " || argv[i])
				end
			i := i + 1
			end except when bounds: end
	
		if i < sequence[string]$size(argv) then
			putl(stderr, my_name || ": only one input file allowed") end
	
		input := file$open(file_name$parse(argv[i]), "read")
			except when bounds: input := file$primary_input() end
			except when not_possible (s: string):
				signal failure(my_name || ": " ||
						argv[i] || ": " || s)
				end
	
		% get the list of lines to print, noting the longest line
		i := 0
		while true do
			list$addh(lines, file$getl(input))
			i := string$size(lines[list$high(lines)])
			if i > longest then longest := i end
			end except when end_of_file: end
	
		% now, figure out how to print it
		if gutter < 0 then gutter := gutter_default end
		longest := longest + gutter
		if characters < 1 then characters := get_tty_characters()
			except when not_found: characters := characters_default end
			end
		if columns < 1 then columns := characters / longest 
			except when zero_divide:
				signal failure(my_name ||
						"All input lines of length 0") end
			end
		% We have to have at least one column, or things get sticky.
		% (Hm... How about no output if columns < 1?)
		if columns < 1 then columns := 1 end
	
		% now print it
		i := 0
		for j: int in list$indexes(lines) do
			if j // columns = 0 & j ~= 0 then
				stream$putc_image(stdout, '\012')
			else stream$putspace(stdout, i) end
			stream$puts(stdout, lines[j])
			i := longest - string$size(lines[j])
			end
		stream$putc_image(stdout, '\012')
		end start_up
	%
	% get the # of columns in ther terminal
	%
	get_tty_characters = proc () returns (int) signals (not_found)
		termcap: string := _get_termcap() resignal not_found
		count: int :=  int$parse(_termcap(termcap, ":co#", 0, 0))
			resignal not_found
	
		if string$indexs(":am", termcap) = 0 then return (count)
		else return (count - 1) end
		end get_tty_characters
//E*O*F mc.clu//

echo x - mc.n
sed 's/^	//' > "mc.n" << '//E*O*F mc.n//'
	.TH MC 1
	.UC
	.SH NAME
	mc \- multi-columnate an input string
	.SH SYNOPSIS
	.B mc [
	.B -g # ] [
	.B -w # ] [
	.B -c # ] [
	.B file ]
	.SH DESCRIPTION
	.I Mc
	reads it's input, and copies it to standard out in a multicolumn
	format, one line of input turning into one column entry in the output.
	The first line of input goes to the top of the first column, the
	second line of input to the top of the second column, ... the line
	after the top entry of the last column goes to the seceond entry of
	the first column, etc.
	
	The
	.I -g
	flag specifies the width of the gutter of whitespace between
	columns.  This defaults to 2, and negative values for
	.I g
	are ignored. A zero value is legal.
	
	The
	.I -w
	flag specifies how many characters wide the output device can be. The
	default is the width of the terminal. If
	.I w
	is unspecified, and no termcap entry can be found, a warning is
	printed on standard error, and a value of 79 is used. Non-positive
	values of
	.I w
	are ignored.
	
	The
	.I -c
	flag specifies how many columns of output there should be. The default
	is to print as many columns as will fit in the output device.
	Non-positive values of
	.I c
	are ignored.
	
	Mc accepts one
	.I file
	argument, which is used for input if specified. If not specified,
	standard input is used. If more than one file is specified, a warning
	is printed on standard error, and the first file is used and all
	others are ignored.
	
	The width of the columns is the width of the longest line in the
	input. There is
	.B no
	way to specify this width. If
	.I c
	is specified, and is larger than
	.B mc
	would have printed by default, then the specified number of
	columns is printed using extra space on the output line if needed.
	This can cause
	.I w
	flag to be ignored.
	
	The
	.B tr(1)
	command can be used to prepare input for mc. For example, to columnate
	all the words of a document, the command
	.I "cat document | tr -s ' 	\\\\012' '\\\\012' | mc"
	will do.
	
	The second argument to 
	.B tr
	is a space followed by a tab. The
	.I \\\\012
	is the ascii representation for a newline, and the
	.I -s
	flag causes it to squeeze all runs of spaces, tabs and newlines
	into a single newline.
	
	To print the entries in a colon seperated list as in columns, the command
	.I "cat list | tr -s ':\\\\012' '\\\012' | mc"
	works. The
	.B tr
	command maps all strings of colons and newlines into a single newline.
	
	If the input file is already in a column format, the
	.B rs(1)
	command might be more useful in reformating it.
	.SH BUGS
	All lines are kept in memory. For pipes, this is probably as good as
	can be done. For input files, a seek to the start of the file should
	be used if the file won't fit in memory.
	.SH SEE ALSO
	tr(1), rs(1)
//E*O*F mc.n//

echo x - pp.lsp
sed 's/^	//' > "pp.lsp" << '//E*O*F pp.lsp//'
	;
	; a pretty-printer, with hooks for the editor
	;
	
	; First, the terminal width and things to manipulate it
	(setq pp$terminal-width 79)
	
	(defmacro get-terminal-width nil
	  pp$terminal_width)
	
	(defmacro set-terminal-width (new-width)
	  (let ((old-width pp$terminal-width))
	    (setq pp$terminal-width new-width)
	    old-width))
	;
	; Now, a basic, simple pretty-printer
	; pp$pp prints expression, indented to indent-level, assuming that things
	; have already been indented to indent-so-far. It *NEVER* leaves the cursor
	; on a new line after printing expression. This is to make the recursion
	; simpler. This may change in the future, in which case pp$pp could vanish.
	;
	(defun pp$pp (expression indent-level indent-so-far)
	; Step one, make sure we've indented to indent-level
	  (dotimes (x (- indent-level indent-so-far)) (princ " "))
	; Step two, if it's an atom or it fits just print it
	  (cond ((or (not (consp expression))
		     (> (- pp$terminal-width indent-level) (flatsize expression)))
		 (prin1 expression))
	; else, print open paren, the car, then each sub expression, then close paren
		(t (princ "(")
		   (pp$pp (car expression) (1+ indent-level) (1+ indent-level))
		   (if (cadr expression)
		       (progn
			 (if (or (consp (car expression))
				 (> (/ (flatsize (car expression)) 3)
				    pp$terminal-width))
			     (progn (terpri)
				    (pp$pp (cadr expression) 
					   (1+ indent-level)
					   0))
			     (pp$pp (cadr expression)
				    (+ 2 indent-level (flatsize (car expression)))
				    (+ 1 indent-level (flatsize (car expression)))))
			 (dolist (current-expression (cddr expression))
				 (terpri)
				 (pp$pp current-expression
					(+ 2 indent-level 
					   (flatsize (car expression)))
					0))))
		   (princ ")")))
	  nil)
	;
	; Now, the thing that outside users should call
	; We have to have an interface layer to get the final terpri after pp$pp.
	; This also allows hiding the second and third args to pp$pp. Said args
	; being required makes the pp recursion loop run faster (don't have to map
	; nil's to 0).
	;	The where arg to pp is ingnored, as the obvious hack to pp$pp [adding
	; an extra arg to every call to a print routine or pp$pp] doesn't work,
	; printing nothing when where is nil.
	;
	(defun pp (expression &optional where)
	"Print EXPRESSION on STREAM, prettily"
	  (pp$pp expression 0 0)
	  (terpri))
//E*O*F pp.lsp//

echo Possible errors detected by \'wc\' [hopefully none]:
temp=/tmp/shar$$
trap "rm -f $temp; exit" 0 1 2 3 15
cat > $temp <<\!!!
      26     235    1269 README
     110     599    3567 mc.clu
      96     528    2663 mc.n
      65     333    2323 pp.lsp
     297    1695    9822 total
!!!
wc  README mc.clu mc.n pp.lsp | sed 's=[^ ]*/==' | diff -b $temp -
exit 0