;;; -*- Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The data in this file contains enhancments. ;;;;; ;;; ;;;;; ;;; Copyright (c) 1984,1987 by William Schelter,University of Texas ;;;;; ;;; All rights reserved ;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (in-package "MAXIMA") ; ** (c) Copyright 1982 Massachusetts Institute of Technology ** ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; Miscellaneous Out-of-core Files ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (macsyma-module outmis) (declare-top (FIXNUM NN)) #+ITS (DECLARE (SPECIAL TTY-FILE)) (declare-top (SPLITFILE STATUS)) #+(or ITS Multics TOPS-20) (declare-top (SPECIAL LINEL MATHLAB-GROUP-MEMBERS) (*EXPR STRIPDOLLAR MEVAL) (*LEXPR CONCAT)) #+(or ITS Multics TOPS-20) (PROGN 'COMPILE ;;; These are used by $SEND when sending to logged in Mathlab members #-Multics (SETQ MATHLAB-GROUP-MEMBERS '(JPG ELLEN GJC RZ KMP WGD MERMAN)) ;;; IOTA is a macro for doing file I/O binding, guaranteeing that ;;; the files it loads will get closed. ;;; Usage: (IOTA (( ) ;;; ( ) ...) ;;; ) ;;; Opens with binding it to . Closes ;;; any which still has an open file or SFA in it when ;;; PDL unwinding is done. ;;; No IOTA on Multics yet, #-Multics (EVAL-WHEN (EVAL COMPILE) (COND ((NOT (STATUS FEATURE IOTA)) (LOAD #+ITS '((DSK LIBLSP) IOTA FASL) #-ITS '((LISP) IOTA FASL))))) ;;; TEXT-OUT ;;; Prints a list of TEXT onto STREAM. ;;; ;;; TEXT must be a list of things to be printed onto STREAM. ;;; For each element in TEXT, A, if A is a symbol with first ;;; character "&", it will be fullstripped and PRINC'd into the ;;; stream; otherwise it will be $DISP'd onto STREAM (by binding ;;; OUTFILES and just calling $DISP normally). ;;; ;;; STREAM must be an already-open file object. (DEFUN TEXT-OUT (TEXT STREAM) (DO ((A TEXT (CDR A)) (|^R| T) (|^W| T) (LINEL 69.) (OUTFILES (NCONS STREAM))) ((NULL A)) (COND ((AND (SYMBOLP (CAR A)) (EQ (GETCHAR (CAR A) 1.) '|&|)) (PRINC (STRIPDOLLAR (CAR A)) STREAM)) (T (TERPRI STREAM) (MEVAL `(($DISP) ($STRING ,(CAR A)))))) (TERPRI STREAM))) ;;; MAIL ;;; Sends mail to a recipient, TO, via the normal ITS mail protocol ;;; by writing out to DSK:.MAIL.;MAIL > and letting COMSAT pick it ;;; up and deliver it. Format for what goes in the MAIL > file should ;;; be kept up to date with what is documented in KSC;?RQFMT > ;;; ;;; TO must be a name (already STRIPDOLLAR'd) to whom the mail should ;;; be delivered. ;;; ;;; TEXT-LIST is a list of Macsyma strings and/or general expressions ;;; which will compose the message. #+(OR LISPM ITS) ;Do these both at once. (DEFUN MAIL (TO TEXT-LIST) (IOTA ((STREAM "DSK:.MAIL.;MAIL >" 'OUT)) (mformat stream "FROM-PROGRAM:Macsyma AUTHOR:~A FROM-UNAME:~A RCPT:~A TEXT;-1~%" (STATUS USERID) (STATUS UNAME) (NCONS TO)) (TEXT-OUT TEXT-LIST STREAM))) ;;; This code is new and untested. Please report bugs -kmp ;#+TOPS-20 ;(DEFUN MAIL (TO TEXT-LIST) ; (IOTA ((STREAM "MAIL:/[--NETWORK-MAIL--/]..-1" ; '(OUT ASCII DSK BLOCK NODEFAULT))) ; (MFORMAT STREAM ; "/ ~A ;~A ;/ ;From: ~A at ~A~%" ; (STATUS SITE) TO (STATUS USERID) (STATUS SITE)) ; (COND ((NOT (EQ (STATUS USERID) (STATUS UNAME))) ; (MFORMAT STREAM "Sender: ~A at ~A~%" (STATUS UNAME) (STATUS SITE)))) ; (MFORMAT STREAM "Date: ~A ;TO: ~A~%~%" ; (TIME-AND-DATE) TO) ; (TEXT-OUT TEXT-LIST STREAM))) #+Multics (defvar macsyma-mail-count 0 "The number of messages sent so far") #+Multics (progn 'compile (DEFUN MAIL (TO TEXT-LIST) (let* ((open-file ()) (macsyma-unique-id (macsyma-unique-id 'unsent (increment macsyma-mail-count))) (file-name (catenate (pathname-util "pd") ">macsyma_mail." macsyma-unique-id))) (unwind-protect (progn (setq open-file (open file-name '(out ascii block dsk))) (text-out text-list open-file) (close open-file) (cline (catenate "send_mail " to " -input_file " file-name " -no_subject"))) (deletef open-file)))) (defun macsyma-unique-id (prefix number) (implode (append (explode prefix) (list number)))) ) ;;; $BUG ;;; With no args, gives info on itself. With any positive number of ;;; args, mails all args to MACSYMA via the MAX-MAIL command. ;;; Returns $DONE (DEFMSPEC $BUG (X) (SETQ X (CDR X)) (COND ((NULL X) (MDESCRIBE '$BUG)) (T (MAX-MAIL 'BUG X))) '$DONE) #+MULTICS (DEFMACRO CHECK-AND-STRIP-ADDRESS (ADDRESS) `(COND ((EQUAL (GETCHARN ,ADDRESS 1) #\&) (STRIPDOLLAR ,ADDRESS)) (T (MERROR "Mail: Address field must be a string")))) #-MULTICS (DEFMACRO CHECK-AND-STRIP-ADDRESS (ADDRESS) `(STRIPDOLLAR ,ADDRESS)) ;;; $MAIL ;;; With no args, gives info on itself. ;;; With 1 arg, sends the MAIL to Macsyma. Like bug, only doesn't ;;; tag the mail as a bug to be fixed. ;;; With 2 or more args, assumes that arg1 is a recipient and other ;;; args are the text to be MAIL'd. ;;; Works for Multics, ITS, and TOPS-20. (DEFMSPEC $MAIL (X) (SETQ X (CDR X)) (COND ((NULL X) (MDESCRIBE '$MAIL)) ((= (LENGTH X) 1.) (MAX-MAIL 'MAIL X)) (T (LET ((NAME (CHECK-AND-STRIP-ADDRESS (CAR X)))) (MAIL NAME (CDR X)) #-Multics(MFORMAT NIL "~&;MAIL'd to ~A~%" NAME)))) ;;;On Multics Mailer will do this. '$DONE) ;;; MAX-MAIL ;;; Mails TEXT-LIST to MACSYMA mail. Normal ITS mail header ;;; is suppressed. Header comes out as: ;;; From via command. ;;; ;;; SOURCE is the name of the originating command (eg, BUG or ;;; MAIL) to be printed in the header of the message. ;;; ;;; TEXT-LIST is a list of expressions making up the message. #+(OR LISPM ITS) (DEFUN MAX-MAIL (SOURCE TEXT-LIST) (IOTA ((MAIL-FILE "DSK:.MAIL.;_MAXIM >" '(OUT ASCII DSK BLOCK))) (LINEL MAIL-FILE 69.) (MFORMAT MAIL-FILE "FROM-PROGRAM:Macsyma HEADER-FORCE:NULL TO:(MACSYMA) SENT-BY:~A TEXT;-1 From ~A via ~A command. ~A~%" (STATUS UNAME) (STATUS USERID) SOURCE (TIME-AND-DATE)) (TEXT-OUT TEXT-LIST MAIL-FILE) (RENAMEF MAIL-FILE "MAIL >")) (MFORMAT NIL "~&;Sent to MACSYMA~%") '$DONE) ;;; This code is new and untested. Please report bugs -kmp ;#+TOPS-20 ;(DEFUN MAX-MAIL (SOURCE TEXT-LIST) ; (IOTA ((MAIL-FILE "MAIL:/[--NETWORK-MAIL--/]..-1" ; '(OUT ASCII DSK BLOCK NODEFAULT))) ; (MFORMAT MAIL-FILE ; "/ MIT-MC ;BUG-MACSYMA ;/ From ~A at ~A via ~A command. ~A~%" ; (STATUS USERID) (STATUS SITE) SOURCE (TIME-AND-DATE)) ; (TEXT-OUT TEXT-LIST MAIL-FILE) ; (MFORMAT NIL "~%;Sent to MACSYMA"))) #+Multics (defun max-mail (source text-list) (let ((address (cond ((eq source 'mail) (setq source "Multics-Macsyma-Consultant -at MIT-MC")) (t (setq source "Multics-Macsyma-Bugs -at MIT-MC"))))) (mail address text-list))) ); END of (or ITS Multics TOPS-20) conditionalization. ;; On ITS, this returns a list of user ids for some random reason. On other ;; systems, just print who's logged in. We pray that nobody uses this list for ;; value. #+ITS (PROGN 'COMPILE (DEFMFUN $who nil (do ((tty*) (wholist nil (cond ((eq (getchar tty* 1) ;just consoles, not device 'D) wholist) (t (LET ((UNAME (READUNAME))) (COND ((MEMQ UNAME WHOLIST) WHOLIST) (T (CONS UNAME WHOLIST))))))) (ur (crunit)) (tty-file ((lambda (tty-file) (readline tty-file) ;blank line tty-file) ;get rid of cruft (open '((tty) |.file.| |(dir)|) 'single)))) ((progn (readline tty-file) (setq tty* (read tty-file)) (eq tty* 'free)) (close tty-file) (apply 'crunit ur) (cons '(mlist simp) wholist)))) ;;; $SEND ;;; With no args, gives info about itself. ;;; With one arg, sends the info to any logged in Macsyma users. ;;; With 2 or more args, assumes that arg1 is a recipient and ;;; args 2 on are a list of expressions to make up the message. (DEFMSPEC $SEND (X) (SETQ X (CDR X)) (COND ((NULL X) (MDESCRIBE '$SEND)) ((= (LENGTH X) 1.) (MAX-SEND X)) (T (MSEND (STRIPDOLLAR (CAR X)) (CDR X) T))) '$DONE) ;;; MSEND ;;; Sends mail to a recipient, TO, by opening the CLI: device on the ;;; recipient's HACTRN. ;;; ;;; TO must be a name (already FULLSTRIP'd) to whom the mail should ;;; be delivered. A header is printed of the form: ;;; [MESSAGE FROM MACSYMA USER