home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume6 / xlisp1.6 / part5 / simplepp.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1986-11-30  |  2.3 KB  |  66 lines
  1. ;
  2. ; a pretty-printer, with hooks for the editor
  3. ;
  4.  
  5. ; First, the terminal width and things to manipulate it
  6. (setq pp$terminal-width 79)
  7.  
  8. (defmacro get-terminal-width nil
  9.   pp$terminal_width)
  10.  
  11. (defmacro set-terminal-width (new-width)
  12.   (let ((old-width pp$terminal-width))
  13.     (setq pp$terminal-width new-width)
  14.     old-width))
  15. ;
  16. ; Now, a basic, simple pretty-printer
  17. ; pp$pp prints expression, indented to indent-level, assuming that things
  18. ; have already been indented to indent-so-far. It *NEVER* leaves the cursor
  19. ; on a new line after printing expression. This is to make the recursion
  20. ; simpler. This may change in the future, in which case pp$pp could vanish.
  21. ;
  22. (defun pp$pp (expression indent-level indent-so-far)
  23. ; Step one, make sure we've indented to indent-level
  24.   (dotimes (x (- indent-level indent-so-far)) (princ " "))
  25. ; Step two, if it's an atom or it fits just print it
  26.   (cond ((or (not (consp expression))
  27.          (> (- pp$terminal-width indent-level) (flatsize expression)))
  28.      (prin1 expression))
  29. ; else, print open paren, the car, then each sub expression, then close paren
  30.     (t (princ "(")
  31.        (pp$pp (car expression) (1+ indent-level) (1+ indent-level))
  32.        (if (cadr expression)
  33.            (progn
  34.          (if (or (consp (car expression))
  35.              (> (/ (flatsize (car expression)) 3)
  36.                 pp$terminal-width))
  37.              (progn (terpri)
  38.                 (pp$pp (cadr expression) 
  39.                    (1+ indent-level)
  40.                    0))
  41.              (pp$pp (cadr expression)
  42.                 (+ 2 indent-level (flatsize (car expression)))
  43.                 (+ 1 indent-level (flatsize (car expression)))))
  44.          (dolist (current-expression (cddr expression))
  45.              (terpri)
  46.              (pp$pp current-expression
  47.                 (+ 2 indent-level 
  48.                    (flatsize (car expression)))
  49.                 0))))
  50.        (princ ")")))
  51.   nil)
  52. ;
  53. ; Now, the thing that outside users should call
  54. ; We have to have an interface layer to get the final terpri after pp$pp.
  55. ; This also allows hiding the second and third args to pp$pp. Said args
  56. ; being required makes the pp recursion loop run faster (don't have to map
  57. ; nil's to 0).
  58. ;    The where arg to pp is ingnored, as the obvious hack to pp$pp [adding
  59. ; an extra arg to every call to a print routine or pp$pp] doesn't work,
  60. ; printing nothing when where is nil.
  61. ;
  62. (defun pp (expression &optional where)
  63. "Print EXPRESSION on STREAM, prettily"
  64.   (pp$pp expression 0 0)
  65.   (terpri))
  66.