;;AUTOLOAD: trace-all
;;AUTODOC: trace-all "simple trace mode to trace all evaluations"
;;(trace-all t) 
;;
;;Enables full tracing, i.e. printing of all the lists to be
;;evaluated before the evaluation, prefixed by "=>", and the returned value 
;;prefixed by "<="
;;Symbol values are printed prefixed by =|, but only if the value is changed
;;since last tracing.
;;(trace-all ()) disables the tracing mode
;;output is truncated to trace-all:truncate (defaults 256 chars)
;;if truncated, a # character is appended

(defvar trace-all:on ())
(defvar trace-all:memory (Hashtable ())) ;list of previous printed values
					; for vars
(defvar trace-all:stream ())		; where to print
(defvar trace-all:max 256)		; max chars per output

(if (not (boundp '*evalhook*)) (load 'evalhook))

(defun trace-all (flag)
  (if flag
    (if (not trace-all:on) (progn
	(setq trace-all:on 0)
	(setq *evalhook*
	  (lambda (form &aux result)
	    (if
	      (and (typep form List) (not (typep form QuotedExpr)))
	      (progn
		(print-format trace-all:stream "=>[%n0] %n1\n" trace-all:on 
		  (trace-all:truncate form)
		)
		(++ trace-all:on)
		(setq result (evalhook form))
		(if trace-all:on (-- trace-all:on))
		(print-format trace-all:stream "<=[%n0] %n1\n"
		  trace-all:on (trace-all:truncate result)
		)
		result
	      )

	      (typep form Atom)
	      (progn
		(setq result (evalhook form))
		(if (/= result (get trace-all:memory form ::nil)) (progn
		    (print-format trace-all:stream "|= %n0 = %n1\n"
		      form (trace-all:truncate  result)
		    )
		    (put trace-all:memory form result)
		))
		result
	      )

	      (evalhook form)      
    )))))
    (if trace-all:on (progn
	(setq *evalhook* ())
	(setq trace-all:on ())
    ))
))

;;returns printable version of expr truncated to trace-all:max
(defun trace-all:truncate (expr &aux s
  )
  ;; first see if these are BIG things:
  (if (and (or (typep expr List) (typep expr String))
      (> (length expr) 2000)		;really big buffer/list
    )
    (setq s (print-format String "***BIG(%n1) %n0 beginning with: %r2#"
	(type-of expr) (length expr) (subseq expr 0 1024)
    ))
    (setq s (print-format String "%r0" expr))
  )
  (if (> (length s) trace-all:max)
    (+ (subseq s 0 trace-all:max) "#")
    s
  )  
)
