;;;;;;;;;;;;;;;;;;; -*- Mode: Lisp; Package: Macsyma -*- ;;;;;;;;;;;;;;;;;;;
;;;     (c) Copyright 1980 Massachusetts Institute of Technology         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(macsyma-module trdump)
	   

(DEFVAR TRF-START-HOOK NIL)

(defun umail (JUNK &aux stream winp)
       (unwind-protect
	(progn
       	 (SETQ STREAM (OPEN "DSK:.MAIL.;MAIL _TEMP" 'OUT))
	 (MFORMAT STREAM
		  "FROM-PROGRAM:~A~
		  ~%FROM-XUNAME:~A~
		  ~%FROM-UNAME:~A~
		  ~%RCPT:([DSK:GJC;TM USAGE])~
		  ~%TEXT;-1~%~S"
		  (STATUS SUBSYS)
		  (STATUS XUNAME)
		  (STATUS UNAME)
		  JUNK)
	 (SETQ WINP T))
	(IF WINP
	    (RENAMEF STREAM "DSK:.MAIL.;MAIL >") ; actually "sends" the mail.
	    (IF STREAM (DELETEF STREAM)))))

(defun $trdump (v &optional (purep nil))
       (let ((*pure purep)
	     (putprop (if purep
			  `(translate autoload-translate
				      special *expr *fexpr *lexpr
				      mode function-mode
				      ,@putprop)
			  putprop)))
	    (find-function '$suspend)
	    (SETQ $DUMPTIME ($TIMEDATE))
	    (or (get 'transl-autoload 'version)
		($load '|&dsk:macsym;transl autoload|))
	    (or (fboundp 'sprin1)
		(load-and-tell (get 'sprin1 'autoload)))
	    (or (fboundp '$tty_INIT)
		(load (get '$tty_init 'autoload)))
	    (mapc '(lambda (u)
			   (let ((file `((dsk macsym) ,u fasl)))
				(or (get u 'version)
				    (not (probef file))
				    (load-and-tell file))))
		  transl-modules))
       (meval '(($KILL) $LABELS))
       ($suspend (namestring `((dsk maxdmp) trdump ,v)))
       ($tty_init)
       (SSTATUS GCTIME 0)
       (MTELL-OPEN
	"~%This is the Macsyma Translator version ~A~
	~%in Macsyma version ~A~%"
	v $version)
       (let* ((filedir `((dsk ,(status udir)) * *))
	      (init (mergef filedir `(,(status uname) tm))))
	     (defaultf (mergef filedir '(foo >)))
	     (cond ((probef init)
		    ($load (to-macsyma-namestring init)))
		   ((setq init (probef (mergef filedir '(* tm))))
		    ($load (to-macsyma-namestring init)))))
       (let ((jcl (mapcar #'(lambda (u) (getcharn u 1))
			  (status jcl))))
	    (COND ((AND jcl
			(SETQ JCL (do ((junks '(#^@ #^C #\CR #^_ #\LF) (cdr junks)))
				      ((null junks) JCL)
				      (SETQ JCL (DELETE (CAR JUNKS) JCL))))
			(DO ((L JCL (CDR L)))
			    ((NULL L) NIL)
			    (IF (NOT (MEMBER (CAR L) '(#\SP #\TAB)))
				(RETURN T))))
		   (LET ((TRF-START-HOOK
			  #'(LAMBDA (F)
				    (UMAIL `((FILENAME . ,F)))
				    (SETQ ^W T)
				    (VALRET '|:PROCED |)))
			 (WINP NIL)
			 (^W ^W)
			 (FILENAME  (maknam (cons #/& jcl))))
			(UNWIND-PROTECT
			 (PROGN ($translate_file FILENAME)
				(SETQ WINP T))
			 (IF WINP (QUIT)))))
		  (t
		   (continue)))))