;-*-LISP-*-
; maxima utilities. initialy set up for string file manglement.
; -RWK  November 1980.
; restructed with a DEFTOOLAGE, & merged in my CODESIZE file
; maker, TAGS file maker, data-base maker for the macsyma->lisp
; translator, MCL (macsyma source file compiler) check file maker.
; Comment: Arguments to DEFTOOLAGE should act as more than just
; documentation, should be processed by the command loop,
; don't have time for this now.
; -GJC	4:08pm  Thursday, 4 December 1980
; added a standard argument reader.
; N.B. Inferiour JOB stuff isn't really handled properly for
; ^Z ^P P and the like.
; -GJC 2:47pm  Friday, 19 December 1980

(HERALD MAXTUL)

(eval-when (eval compile)
  (or (get 'defmfile 'version)
      (load '((maxtul)defile)))
  (or (get 'IOTA 'VERSION)
      (load '((LIBLSP)IOTA)))
  (or (get 'ERMSGX 'VERSION)
      (load '((LIBMAX) ERMSGX)))
  (or (get 'TTY 'VERSION)
      (load '((LIBLSP) TTY))))

(declare (*EXPR OPEN-MESSAGE-FILE LISPM-DECLARE-FILE-MAKE FASL-IZE DECLARE-FILE-MAKE
		DISP-MACSYMA-SOURCE-FILE GEN-CODEL GEN-COMPLR-CHECK GEN-NTAGS
		MERGE-INCORE-SYSTEM GET-STRING-FILE-NAME READ-UNTIL-CR
		DISPLAY-STRING-FILES-NO-FASLS COMPLETING-READ GET-MFD-INDEXES))

(eval-when (eval compile load)
  (or (get 'toolm 'version)
      (load '((maxtul)toolm))))

(defun dump-it ()
  (gc)
  (pure-suspend () '|MAXTUL;TS MAXTUL|)
  (load '((MAXDOC)FILES))
  (load '((MAXDOC)MCLDAT))
  (get-mfd-indexes)			;Just in case
  (sstatus tople '(command-loop)))

(defun ^^-INT (stream ignore-char)
       (tyi stream)
       (sstatus tople '(command-loop))
       (^g))
(sstatus ttyint #^^ #'^^-INT)

(defvar toolage nil)

(defvar command)

(defun command-loop ()
  (do ((command))
      (NIL)
    (setq command (car (completing-read '"MAXIMUM TOOLAGE>" toolage)))
    (apply (or (get command 'toolage)
	       #'(lambda ignore-n
		   (format t "~&BUG: no toolage for ~S~%"
			   command)))
	   (read-argument-list (get command 'toolage-args)))))

(defun read-argument-list (l)
       (mapcar #'read-argument l))

(defun read-argument (desc)
  (if (atom desc) (setq desc (cons 's-exp desc)))
  (caseq (car desc)
    (s-exp
     (print (cdr desc) t)
     (read t))
    (string
     (read-until-cr (cdr desc)))
    (t
     (error "unknown type of argument to read-argument" desc
	    'fail-act))))

(deftoolage load-info ()
  "Recompile MAXDOC;FILES and reload."
  (ljob-run-job 'complr '|DSK:SYS;TS CL| "MAXDOC;FILES (T)")
  (setq info-loaded nil)
  (load-info))

(deftoolage load-file ((string . |Filename-> |))
  "Lisp Load a file"
  (load (mergef |Filename-> | "DSK:MAXTUL;FOO *")))

(deftoolage REAP-STRING-DISPLAY ()
  "Displays the out-of-core string files from MAXERR and MAXER1"
  "which do not  have findable FASL files."
  (display-string-files-no-fasls))

(deftoolage GET-FASL-STRING-FILE ((string . |(FASL file) |))
  "Tells the name of the string file which goes with that FASL file"
  (let* ((filename (namelist |(FASL file) |))
	 (fasldir (get (cadr filename) 'fasl-dir))
	 (answer))
    (if fasldir
	(setq filename
	      (mergef filename `((DSK ,fasldir) * FASL))))
    (setq answer (get-string-file-name filename))
    (format T "~&FASL file: ~A --> String file: ~A"
	    (namestring filename)
	    (if answer (namestring answer)
		"[NONE]"))))

(deftoolage GET-STRING-FILE-INFO ((string . |(String file) |))
  "Abstracts the information from the string file directory"
  (display-string-file-info |(String file) |))

(deftoolage MERGE-INCORE-SYSTEM ()
  "Merge together the out-of-core strings for the"
  "in-core files in preparation for a new MACSYMA dump."
  (merge-incore-system))

(deftoolage gen-tags ()
  "Generate NTAGS file."
  (format t "~&; Generating NTAGS file.~%")
  (GEN-NTAGS)
  (VALRET ": I'm using a VALRET :TAGS MACSYMA;MACSYMA NTAGSî:CONTINUEî")
  (FORMAT T "~&; Now, do :MOVE MACSYMA;MACSYMA NTAGS, MACSYMA TAGS~
	  ~%; after verifying that things are ok.~%"))

(DEFUN MOVE-FILE (X Y)
       (IF (NOT (PROBEF X))
	   (ERROR "file-not-found" x 'IO-LOSSAGE))
       (IF (PROBEF Y) (DELETEF Y))
       (RENAMEF X Y))

(deftoolage gen-mcl-check ()
  "Generate MCL data base"
  (gen-complr-check))

(deftoolage gen-codel ()
  "Generate MAXDOC;CODEL > listing of CODE-SIZEs"
  (GEN-CODEL))

(deftoolage display-macsyma-source-file-info ((string . |(first name) |))
  "using information presently in the environment"
  (let* ((name (cadr (namelist |(first name) |)))
	 ;; uppcase and intern the name with NAMELIST.
	 (ob
	  (ass #'(lambda (name item)
		   (eq name
		       (macsyma-source-file-name item)))
	       name
	       macsyma-source-files)))
    (cond (ob
	   (cursorpos 'c)
	   (disp-macsyma-source-file ob t))
	  (t
	   (format t "~&; No data for ~A" name)))))

(deftoolage declare-file-make ()
  "Update the declare file used by translated code."
  (declare-file-make)
  (let ((f "DSK:MAXDOC;DCL LOAD"))
    (format t "~&; ~A written, making FASL now." f)
    (fasl-ize f)))

(deftoolage lispm-declare-file-make ()
  "Update declare file used by a bare lisp machine."
  (lispm-declare-file-make))

(deftoolage QUIT ()
  "To lisp TOPLEVEL"
  (sstatus tople nil)
  (^g))

(deftoolage KILL-JOB ()
  "Kill job"
  (if (memq (car (completing-read "Kill job. [Confirm?] "
				  '(yes help no maybe why-not what who-me)))
	    '(yes maybe why-not))
      (QUIT)))

(deftoolage HELP ()
  "Print this cruft."
  (cursorpos 'c)
  (format t "~
		    ~&Welcome to the MACSYMA TOOL~
		    ~%The following commands are currently implemented:")
  (mapc #'(lambda (cmd)
	    (format t
		    "~&~A ~{~A ~}~%~{   ~A~%~}"
		    cmd
		    (get cmd 'toolage-args)
		    (or (get cmd 'toolage-doc)
			'("BUG: no documentation for this!"))))
	toolage)
  (format t
	  "~
		    ~&The command reader completes on altmode or space,~
		    ~%so the long command names should not deter you.~
		    ~%"))

(defun msgfiles-int (stream char)
  (if (= char (tyipeek () stream -1))
      (tyi stream))
  (format t
	  "~&; ~:[Pushing T onto~;Deleting T from~] msgfiles.~%"
	  (memq t msgfiles))
  (if (memq t msgfiles)
      (setq msgfiles (delq t msgfiles))
      (push t msgfiles)))

(sstatus ttyint #^N #'msgfiles-int)

(defvar wall-file ())
(deftoolage wallpaper ()
  "Toggle wallpaper output"
  (cond (wall-file
	 (setq msgfiles (delq wall-file msgfiles))
	 (close wall-file)
	 (format t "~&; Wall-paper file was ~S~%"
		 (namestring (truename wall-file)))
	 (setq wall-file nil))
	('else
	 (format t "~&; Opening wall-paper file.~%")
	 (setq wall-file (open "DSK:MAXTUL;WALL >" 'OUT))
	 (push wall-file msgfiles))))



(defun display-string-file-info (file)
  (phi ((message-file (open-message-file file)))
    (let* ((truename (truename message-file))
	   (alist (message-file-alist message-file))
	   (temp (or (cdr (assq 'source-file-name alist))
		     (cdr (assq 'filename alist))))
	   (source-files (if temp (ncons temp)
			     (or (cdr (assq 'filenames alist)) '(<NONE?>))))
	   (author (or (cdr (assq 'source-file-author alist)) '|???|))
	   (creator (or (cdr (assq 'creator alist)) '|???|))
	   (fasl (cdr (assq 'output-file-name alist)))
	   (funs (mapcar #'CAR (cdr (assq 'fun-doc-alist alist))))
	   (vars (mapcar #'CAR (cdr (assq 'var-doc-alist alist)))))
       (format t "~&Filename:  ~A~%~
	       Creator:  ~A~%~
	       Source files: ~A~%~
	       Author:  ~A~%~
	       Output file:  ~A~%~
	       Documented variables:  ~S~%~
	       Documented functions:  ~S~%~
	       Total number of strings:  ~D~%"
	       (namestring truename)
	       creator
	       (mapcar #'namestring source-files)
	       author
	       (namestring fasl)
	       vars funs
	       (cadr (assq 'message-count alist))))))

(or (get 'breaklevel 'version)
    (load '((liblsp)break)))
(sstatus breaklevel '(Breaklevel))