mirror of
https://github.com/PDP-10/its.git
synced 2026-03-25 17:58:40 +00:00
563 lines
17 KiB
Common Lisp
563 lines
17 KiB
Common Lisp
;;; -*- Mode: Lisp; Package: Macsyma -*-
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;; (c) Copyright 1979, 1983 Massachusetts Institute of Technology ;;;
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
||
(macsyma-module mload)
|
||
|
||
;; I decided to move most of the file hacking utilities I used in TRANSL to
|
||
;; this file. -GJC
|
||
|
||
;; Concepts:
|
||
;; Lisp_level_filename. Anything taken by the built-in lisp I/O primitives.
|
||
;;
|
||
;; User_level_filename. Comes through the macsyma reader, so it has an extra "&"
|
||
;; in the pname in the case of "filename" or has extra "$" and has undergone
|
||
;; ALIAS transformation in the case of 'FOOBAR or '[FOO,BAR,BAZ].
|
||
;;
|
||
;; Canonical_filename. Can be passed to built-in lisp I/O primitives, and
|
||
;; can also be passed back to the user, is specially handled by the DISPLAY.
|
||
;;
|
||
;; Functions:
|
||
;; $FILENAME_MERGE. Takes User_level_filename(s) and Canonical_filename(s) and
|
||
;; merges them together, returning a Canonical_filename.
|
||
;;
|
||
;; TO-MACSYMA-NAMESTRING. Converts a Lisp_level_filename to a Canonical_filename
|
||
;;
|
||
;; $FILE_SEARCH ............ Takes a user or canonical filename and a list of types of
|
||
;; applicable files to look for.
|
||
;; $FILE_TYPE ............. Takes a user or canonical filename and returns
|
||
;; NIL, $MACSYMA, $LISP, or $FASL.
|
||
;; CALL-BATCH1 ............. takes a canonical filename and a no-echop flag.
|
||
|
||
;; Define the Macsyma canonical type.
|
||
#+LispM
|
||
(progn 'compile
|
||
FS:
|
||
(DEFINE-CANONICAL-TYPE :MACSYMA "MACSYMA"
|
||
((:TENEX :TOPS-20) "MAC" "MACSYMA")
|
||
(:ITS :UNSPECIFIC)
|
||
(:UNIX "M" "MACSYMA")
|
||
(:VMS "MAC")))
|
||
|
||
;; Note: This needs to be generalized some more to take into account
|
||
;; the lispmachine situation of access to many different file systems
|
||
;; at the same time without, and also take into account the way it presently
|
||
;; deals with that situation. The main thing wrong now is that the file-default
|
||
;; strings are constants.
|
||
|
||
;; What a cannonical filename is on the different systems:
|
||
;; This is for informational purposes only, as the Macsyma-Namestringp
|
||
;; predicate is provided.
|
||
;; [PDP-10 Maclisp] An uninterned symbol with various properties.
|
||
;; [Franz Lisp] a string or a symbol (whose print name is used).
|
||
;; [Multics Maclisp] A STRING.
|
||
;; [LispMachine] A generic pathname object, which is a system-provided FLAVOR.
|
||
;; [NIL] Not decided yet, but a STRING should do ok, since in NIL files are
|
||
;; a low-level primitive, and programs, modules, and environments are the
|
||
;; practical abstraction used. No attempt is made to come up with ad-hoc generalizations
|
||
;; of the ITS'ish and DEC'ish filenames, as such attempts fail miserably to provide
|
||
;; the functionality of filesystems such as on Multics.
|
||
|
||
(DECLARE (SPECIAL $FILE_SEARCH $FILE_TYPES))
|
||
|
||
(DEFMFUN $LISTP_CHECK (VAR VAL)
|
||
"Gives an error message including its first argument if its second
|
||
argument is not a LIST"
|
||
(OR ($LISTP VAL)
|
||
(MERROR "The variable ~:M being set to a non-LISTP object:~%~M"
|
||
VAR VAL)))
|
||
|
||
(DEFPROP $FILE_SEARCH $LISTP_CHECK ASSIGN)
|
||
|
||
(DEFPROP $FILE_TYPES $LISTP_CHECK ASSIGN)
|
||
|
||
#-Franz
|
||
(DEFMFUN $FILE_SEARCH (X &OPTIONAL
|
||
(LISTP NIL)
|
||
(L $FILE_TYPES))
|
||
(SETQ X ($FILENAME_MERGE X))
|
||
(IF ($LISTP L) (SETQ L (CDR L))
|
||
(MERROR "3'rd arg to FILE_SEARCH not a list.~%~M" L))
|
||
(DO ((MERGE-SPECS (CONS ($filename_merge)
|
||
;; Get a complete "star filename"
|
||
(CDR $FILE_SEARCH))
|
||
(CDR MERGE-SPECS))
|
||
(PROBED)
|
||
(FOUND))
|
||
((NULL MERGE-SPECS)
|
||
(IF LISTP
|
||
`((MLIST) ,@(NREVERSE FOUND))
|
||
(MERROR "Could not find file which matches ~M" X)))
|
||
(IF (DO ((L L (CDR L))
|
||
(U ($FILENAME_MERGE (CAR MERGE-SPECS))))
|
||
((NULL L) NIL)
|
||
(IF (SETQ PROBED #-Lispm (PROBEF #-PDP10 (ADD-TYPE ($FILENAME_MERGE X U) (CAR L))
|
||
#+PDP10 ($FILENAME_MERGE X U (CAR L)))
|
||
#+Lispm (condition-case ()
|
||
(probef (add-type ($filename_merge x u) (car l)))
|
||
(fs:directory-not-found nil)))
|
||
(IF LISTP
|
||
(PUSH (TO-MACSYMA-NAMESTRING PROBED) FOUND)
|
||
(RETURN T))))
|
||
(RETURN (TO-MACSYMA-NAMESTRING PROBED)))))
|
||
|
||
#-LispM
|
||
(DEFUN ADD-TYPE (PATH TYPE)
|
||
(MERGEF PATH TYPE))
|
||
|
||
#+LispM
|
||
(DEFUN ADD-TYPE (PATH MACSYMA-TYPE)
|
||
(LET ((TYPE (STRING (FULLSTRIP1 MACSYMA-TYPE))))
|
||
(COND ((not (null (send path ':type)))
|
||
path)
|
||
((STRING-EQUAL TYPE "FALSE")
|
||
PATH)
|
||
((STRING-EQUAL TYPE "LISP")
|
||
(SEND PATH ':NEW-CANONICAL-TYPE ':LISP))
|
||
((STRING-EQUAL TYPE "MACSYMA")
|
||
(SEND PATH ':NEW-CANONICAL-TYPE ':MACSYMA))
|
||
((STRING-EQUAL TYPE "BIN")
|
||
(SEND PATH ':NEW-CANONICAL-TYPE ':BIN))
|
||
((STRING-EQUAL TYPE "QBIN")
|
||
(SEND PATH ':NEW-CANONICAL-TYPE ':QBIN))
|
||
(T (SEND PATH ':NEW-RAW-TYPE TYPE)))))
|
||
|
||
;; Filename merging is unheard of on Unix.
|
||
;; If the user doesn't supply a file extension, we look for .o, .l .mac and .v
|
||
;; and finally the file itself. If the user supplies one of the standard
|
||
;; extensions, we just use that.
|
||
#+Franz
|
||
(defmfun $file_search (x &optional (listp nil) (l $file_types) &aux char)
|
||
(if (or (= (setq char (substringn x 1 0)) #/&)
|
||
(= char #/$))
|
||
(setq x (substring x 2)))
|
||
(let ((filelist (cond ((cdr $file_search))
|
||
(t '("."))))
|
||
(extlist (cond ((or (member (substring x -2) '(".o" ".l" ".v"))
|
||
(equal (substring x -4) ".mac"))
|
||
'(nil))
|
||
(t (cdr $file_types)))))
|
||
(do ((dir filelist (cdr dir))
|
||
(ret))
|
||
((null dir)
|
||
(cond (listp '((mlist)))
|
||
(t (MERROR "Could not find file ~M" X))))
|
||
(cond ((setq ret
|
||
(do ((try extlist (cdr try))
|
||
(this))
|
||
((null try))
|
||
(setq this (cond ((null (car try)) x)
|
||
(t (concat x "." (car try)))))
|
||
(cond ((not (equal "." (car dir)))
|
||
(setq this (concat (car dir) "//" this))))
|
||
(cond ((probef this)
|
||
(return
|
||
(cond (listp `((mlist)
|
||
,(to-macsyma-namestring x)))
|
||
(t (to-macsyma-namestring this))))))))
|
||
(return ret))))))
|
||
|
||
|
||
(DECLARE (SPECIAL $LOADPRINT))
|
||
|
||
(DEFMFUN LOAD-AND-TELL (FILENAME)
|
||
(LOADFILE FILENAME
|
||
T ;; means this is a lisp-level call, not user-level.
|
||
$LOADPRINT))
|
||
|
||
#+PDP10
|
||
(PROGN 'COMPILE
|
||
;; on the PDP10 cannonical filenames are represented as symbols
|
||
;; with a DIMENSION-LIST property of DISPLAY-FILENAME.
|
||
|
||
(DEFUN DIMENSION-FILENAME (FORM RESULT)
|
||
(DIMENSION-STRING (CONS #/" (NCONC (EXPLODEN FORM) (LIST #/"))) RESULT))
|
||
|
||
(DEFUN TO-MACSYMA-NAMESTRING (X)
|
||
;; create an uninterned symbol, uninterned so that
|
||
;; it will be GC'd.
|
||
(SETQ X (PNPUT (PNGET (NAMESTRING X) 7) NIL))
|
||
(PUTPROP X 'DIMENSION-FILENAME 'DIMENSION-LIST)
|
||
X)
|
||
|
||
(DEFUN MACSYMA-NAMESTRINGP (X)
|
||
(AND (SYMBOLP X) (EQ (GET X 'DIMENSION-LIST) 'DIMENSION-FILENAME)))
|
||
|
||
(DEFMACRO ERRSET-NAMESTRING (X)
|
||
`(LET ((ERRSET NIL))
|
||
(ERRSET (NAMESTRING ,X) NIL)))
|
||
|
||
(DEFMFUN $FILENAME_MERGE N
|
||
(DO ((F "" (MERGEF (MACSYMA-NAMESTRING-SUB (ARG J)) F))
|
||
(J N (1- J)))
|
||
((ZEROP J)
|
||
(TO-MACSYMA-NAMESTRING F))))
|
||
)
|
||
|
||
#+Franz
|
||
(progn 'compile
|
||
|
||
;; a first crack at these functions
|
||
|
||
(defun to-macsyma-namestring (x)
|
||
(cond ((macsyma-namestringp x) x)
|
||
((symbolp x)
|
||
(cond ((memq (getcharn x 1) '(#/& #/$))
|
||
(substring (get_pname x) 2))
|
||
(t (get_pname x))))
|
||
(t (merror "to-macsyma-namestring: non symbol arg ~M~%" x))))
|
||
|
||
(defun macsyma-namestringp (x)
|
||
(stringp x))
|
||
|
||
;;--- $filename_merge
|
||
; may not need this ask filename merging is not done on Unix systems.
|
||
;
|
||
(defmfun $filename_merge (&rest files)
|
||
(cond (files (filestrip (ncons (car files))))))
|
||
)
|
||
|
||
#+MULTICS
|
||
(PROGN 'COMPILE
|
||
(DEFUN TO-MACSYMA-NAMESTRING (X)
|
||
(cond ((macsyma-namestringp x) x)
|
||
((symbolp x) (substring (string x) 1))
|
||
((listp x) (namestring x))
|
||
(t x)))
|
||
|
||
(DEFUN MACSYMA-NAMESTRINGP (X) (STRINGP X))
|
||
(DEFUN ERRSET-NAMESTRING (X)
|
||
(IF (ATOM X) (NCONS (STRING X)) (ERRSET (NAMESTRING X) NIL)))
|
||
|
||
(DEFMFUN $FILENAME_MERGE (&REST FILE-SPECS)
|
||
(SETQ FILE-SPECS (cond (file-specs
|
||
(MAPCAR #'MACSYMA-NAMESTRING-SUB FILE-SPECS))
|
||
(t '("**"))))
|
||
(TO-MACSYMA-NAMESTRING (IF (NULL (CDR FILE-SPECS))
|
||
(CAR FILE-SPECS)
|
||
(APPLY #'MERGEF FILE-SPECS))))
|
||
|
||
)
|
||
|
||
#+LISPM
|
||
(PROGN 'COMPILE
|
||
(DEFUN TO-MACSYMA-NAMESTRING (X)
|
||
(FS:PARSE-PATHNAME X))
|
||
(DEFUN MACSYMA-NAMESTRINGP (X)
|
||
(TYPEP X 'FS:PATHNAME))
|
||
(DEFUN ERRSET-NAMESTRING (X)
|
||
(LET ((ERRSET NIL))
|
||
(ERRSET (FS:PARSE-PATHNAME X) NIL)))
|
||
|
||
(DEFMFUN $FILENAME_MERGE (&REST FILE-SPECS)
|
||
(DO ((SPECS FILE-SPECS (CDR SPECS))
|
||
(F "" (FS:MERGE-PATHNAMES F (MACSYMA-NAMESTRING-SUB (CAR SPECS)))))
|
||
((NULL SPECS)
|
||
(TO-MACSYMA-NAMESTRING F))))
|
||
|
||
(DEFUN MACSYMA-NAMESTRING-SUB (USER-OBJECT)
|
||
(IF (MACSYMA-NAMESTRINGP USER-OBJECT) USER-OBJECT
|
||
(LET* ((SYSTEM-OBJECT
|
||
(COND ((ATOM USER-OBJECT)
|
||
(FULLSTRIP1 USER-OBJECT))
|
||
(($LISTP USER-OBJECT)
|
||
(FULLSTRIP (CDR USER-OBJECT)))
|
||
(T USER-OBJECT))))
|
||
(STRING SYSTEM-OBJECT))))
|
||
|
||
)
|
||
|
||
#-LispM
|
||
(DEFUN MACSYMA-NAMESTRING-SUB (USER-OBJECT)
|
||
(IF (MACSYMA-NAMESTRINGP USER-OBJECT) USER-OBJECT
|
||
(LET* ((SYSTEM-OBJECT
|
||
(COND ((ATOM USER-OBJECT)
|
||
(FULLSTRIP1 USER-OBJECT))
|
||
(($LISTP USER-OBJECT)
|
||
(FULLSTRIP (CDR USER-OBJECT)))
|
||
(T
|
||
(MERROR "Bad file spec:~%~M" USER-OBJECT))))
|
||
(NAMESTRING-TRY (ERRSET-NAMESTRING SYSTEM-OBJECT)))
|
||
(IF NAMESTRING-TRY (CAR NAMESTRING-TRY)
|
||
;; know its small now, so print on same line.
|
||
(MERROR "Bad file spec: ~:M" USER-OBJECT)))))
|
||
|
||
(DEFMFUN open-out-dsk (x)
|
||
(open x #-(or LISPM Multics) '(out dsk ascii block)
|
||
#+Multics '(out ascii block)
|
||
#+LISPM '(:out :ascii)))
|
||
|
||
(DEFMFUN open-in-dsk(x)
|
||
(open x #-(or Lispm Multics) '(in dsk ascii block)
|
||
#+Multics '(in ascii block)
|
||
#+LISPM '(:in :ascii)))
|
||
|
||
#-MAXII
|
||
(PROGN 'COMPILE
|
||
|
||
(DECLARE (SPECIAL DSKFNP OLDST ST $NOLABELS REPHRASE ^W))
|
||
|
||
(DEFMFUN CALL-BATCH1 (FILENAME ^W)
|
||
(LET ((^R (AND ^R (NOT ^W)))
|
||
($NOLABELS T)
|
||
($CHANGE_FILEDEFAULTS)
|
||
(DSKFNP T)
|
||
(OLDST)
|
||
(ST))
|
||
;; cons #/& to avoid the double-stripdollar problem.
|
||
(BATCH1 (LIST (MAKNAM (CONS #/& (EXPLODEN FILENAME))))
|
||
NIL
|
||
NIL
|
||
T)
|
||
(SETQ REPHRASE T)))
|
||
|
||
|
||
(DEFMVAR *IN-$BATCHLOAD* NIL
|
||
"I should have a single state variable with a bit-vector or even a list
|
||
of symbols for describing the state of file translation.")
|
||
(DEFMVAR *IN-TRANSLATE-FILE* NIL "")
|
||
(DEFMVAR *IN-MACSYMA-INDEXER* NIL)
|
||
|
||
(DEFUN TRANSLATE-MACEXPR (FORM &optional FILEPOS)
|
||
(COND (*IN-TRANSLATE-FILE*
|
||
(TRANSLATE-MACEXPR-ACTUAL FORM FILEPOS))
|
||
(*in-macsyma-indexer*
|
||
(outex-hook-exp form))
|
||
(T
|
||
(LET ((R (ERRSET (MEVAL* FORM))))
|
||
(COND ((NULL R)
|
||
(LET ((^W NIL))
|
||
(MERROR "~%This form caused an error in evaluation:~
|
||
~%~:M" FORM))))))))
|
||
|
||
|
||
(DEFMFUN $BATCHLOAD (FILENAME)
|
||
(LET ((WINP NIL)
|
||
(NAME ($FILENAME_MERGE FILENAME))
|
||
(*IN-$BATCHLOAD* T))
|
||
(TRUEFNAME NAME)
|
||
(IF $LOADPRINT (MTELL "~%Batching the file ~M~%" NAME))
|
||
(UNWIND-PROTECT
|
||
(PROGN (CALL-BATCH1 NAME T) (SETQ WINP T) NAME)
|
||
;; unwind protected.
|
||
(IF WINP
|
||
(IF $LOADPRINT (MTELL "Batching done.~%"))
|
||
(MTELL "Some error in loading this file: ~M" NAME)))))
|
||
|
||
;; end of moby & crufty #-MAXII
|
||
)
|
||
|
||
#+MAXII
|
||
(DEFMFUN $BATCHLOAD (FILENAME)
|
||
(LET ((EOF (LIST NIL))
|
||
(NAME ($FILENAME_MERGE FILENAME))
|
||
(*MREAD-PROMPT* "(Batching) "))
|
||
(TRUEFNAME NAME)
|
||
(IF $LOADPRINT (MTELL "~%Batching the file ~M~%" NAME))
|
||
(WITH-OPEN-FILE (STREAM NAME '(:IN :ASCII))
|
||
(DO ((FORM NIL (MREAD STREAM EOF)))
|
||
((EQ FORM EOF)
|
||
(IF $LOADPRINT (MTELL "Batching done.~%"))
|
||
'$DONE)
|
||
(MEVAL* (CADDR FORM))))))
|
||
|
||
|
||
(DEFMFUN $LOAD (MACSYMA-USER-FILENAME)
|
||
"This is the generic loading function.
|
||
LOAD(/"filename/") will either BATCHLOAD or LOADFILE the file,
|
||
depending on wether the file contains Macsyma, Lisp, or Compiled
|
||
code. The file specifications default such that a compiled file
|
||
is searched for first, then a lisp file, and finally a macsyma batch
|
||
file. This command is designed to provide maximum utility and
|
||
convenience for writers of packages and users of the macsyma->lisp
|
||
translator."
|
||
(LET* ((SEARCHED-FOR ($FILE_SEARCH MACSYMA-USER-FILENAME))
|
||
(TYPE ($FILE_TYPE SEARCHED-FOR)))
|
||
(CASEQ TYPE
|
||
(($MACSYMA)
|
||
($BATCHLOAD SEARCHED-FOR))
|
||
(($LISP $FASL)
|
||
;; do something about handling errors
|
||
;; during loading. Foobar fail act errors.
|
||
(LOAD-AND-TELL SEARCHED-FOR))
|
||
(T
|
||
(MERROR "MACSYMA BUG: Unknown file type ~M" TYPE)))
|
||
SEARCHED-FOR
|
||
))
|
||
|
||
#+Multics
|
||
(DEFMFUN $FILE_TYPE (FILE)
|
||
(SETQ FILE ($FILENAME_MERGE FILE))
|
||
(IF (NULL (PROBEF FILE)) NIL
|
||
(CASEQ (CAR (LAST (NAMELIST FILE)))
|
||
((MACSYMA) '$MACSYMA)
|
||
((LISP) '$LISP)
|
||
(T '$FASL))))
|
||
|
||
#-MULTICS
|
||
(DEFMFUN $FILE_TYPE (FILENAME &AUX STREAM)
|
||
(SETQ FILENAME ($FILENAME_MERGE FILENAME))
|
||
(COND ((NULL (PROBEF FILENAME))
|
||
NIL)
|
||
#-Franz ((FASLP FILENAME)
|
||
'$FASL)
|
||
#+Franz ((cdr (assoc (substring filename -2)
|
||
'((".l" . $lisp) (".o" . $fasl)
|
||
(".mac" . $macsyma) (".v" . $macsyma)))))
|
||
('ELSE
|
||
;; This has to be simple and small for greatest utility
|
||
;; as an in-core pdp10 function.
|
||
(UNWIND-PROTECT
|
||
(DO ((C (PROGN (SETQ STREAM (OPEN-IN-DSK FILENAME))
|
||
#\SP)
|
||
(TYI STREAM -1)))
|
||
((NOT (MEMBER C '(#\SP #\TAB #\CR #\LF #\FF)))
|
||
;; heuristic number one,
|
||
;; check for cannonical language "comment." as first thing
|
||
;; in file after whitespace.
|
||
(COND ((MEMBER C '(-1 #/;))
|
||
'$LISP)
|
||
((AND (= C #//)
|
||
(= (TYI STREAM -1) #/*))
|
||
'$MACSYMA)
|
||
#+Franz ((eq c 7) ;; fasl files begin with bytes 7,1
|
||
'$fasl) ;; but just seeing 7 is good enough
|
||
('ELSE
|
||
;; the above will win with all Lisp files written by
|
||
;; the macsyma system, e.g. the $SAVE and
|
||
;; $TRANSLATE_FILE commands, all lisp files written
|
||
;; by macsyma system programmers, and anybody else
|
||
;; who starts his files with a "comment," lisp or
|
||
;; macsyma.
|
||
(REWIND-STREAM STREAM)
|
||
;; heuristic number two, see if READ returns something
|
||
;; evaluable.
|
||
(LET ((FORM (LET ((ERRSET NIL))
|
||
;; this is really bad to do since
|
||
;; it can screw the lisp programmer out
|
||
;; of a chance to identify read errors
|
||
;; as they happen.
|
||
(ERRSET (READ STREAM NIL) NIL))))
|
||
(IF (OR (NULL FORM)
|
||
(ATOM (CAR FORM)))
|
||
'$MACSYMA
|
||
'$LISP))))))
|
||
;; Unwind protected.
|
||
(IF STREAM (CLOSE STREAM))))))
|
||
|
||
#+LISPM
|
||
(defun faslp (filename)
|
||
;; wasteful to be opening file objects so many times, one for
|
||
;; each predicate and then again to actually load. Fix that perhaps
|
||
;; by having the predicates return "failure-objects," which can be
|
||
;; passed on to other predicates and on to FS:FASLOAD-INTERNAL and
|
||
;; FS:READFILE-INTERNAL.
|
||
(equal (send filename ':canonical-type) #+3600 ':BIN #-3600 ':QBIN))
|
||
|
||
(DEFMVAR $FILE_SEARCH
|
||
#+ITS
|
||
`((MLIST)
|
||
,@(MAPCAR #'TO-MACSYMA-NAMESTRING
|
||
'("DSK:SHARE;" "DSK:SHARE1;" "DSK:SHARE2;" "DSK:SHAREM;")))
|
||
#+Franz
|
||
`((mlist)
|
||
,@(mapcar #'to-macsyma-namestring
|
||
`("."
|
||
,(concat vaxima-main-dir "//share")
|
||
,(concat vaxima-main-dir "//share1")
|
||
,(concat vaxima-main-dir "//share2")
|
||
,(concat vaxima-main-dir "//ode"))))
|
||
|
||
#+LISPM
|
||
`((MLIST)
|
||
,@(MAPCAR #'TO-MACSYMA-NAMESTRING
|
||
'("MC:SHARE;" "MC:SHARE1;" "MC:SHARE2;" "MC:SHAREM")))
|
||
#+Multics
|
||
'((MLIST))
|
||
"During startup initialized to a list of places the LOAD function
|
||
should search for files."
|
||
)
|
||
|
||
#+Multics
|
||
(PROGN 'COMPILE
|
||
;; We need an abstract entry in this list to indicate "working_dir".
|
||
(DEFMFUN INITIATE-FILE-SEARCH-LIST ()
|
||
(LET ((WHERE-AM-I (CAR (NAMELIST EXECUTABLE-DIR))))
|
||
(SETQ
|
||
$FILE_SEARCH
|
||
`((MLIST)
|
||
,@(mapcar #'to-macsyma-namestring
|
||
`(,(string-append (PATHNAME-UTIL "hd") ">**")
|
||
,(string-append (NAMESTRING `(,WHERE-AM-I "share")) ">**")
|
||
,(string-append (NAMESTRING `(,WHERE-AM-I "executable"))
|
||
">**")))))))
|
||
|
||
;; These forms getting evaluated at macsyma start-up time.
|
||
(if (boundp 'macsyma-startup-queue)
|
||
(PUSH '(INITIATE-FILE-SEARCH-LIST) MACSYMA-STARTUP-QUEUE)
|
||
(setq macsyma-startup-queue '((initiate-file-search-list))))
|
||
|
||
;; Done for debuggings sake.
|
||
(eval-when (eval load)
|
||
(initiate-file-search-list))
|
||
|
||
)
|
||
|
||
#+LispM
|
||
(progn 'compile
|
||
(defmfun simple-file-search-list ()
|
||
(let ((share-dir (fs:parse-pathname "macsyma-object:share;")))
|
||
(setq $file_search `((mlist) ,(to-macsyma-namestring
|
||
(send share-dir ':translated-pathname))))))
|
||
|
||
(defmfun delete-file-search-list ()
|
||
(setq $file_search ()))
|
||
|
||
(defmfun add-user-homedir-to-file-search-list ()
|
||
(setq $file_search `((mlist) ,(fs:user-homedir) ,@(cdr $file_search))))
|
||
|
||
(add-initialization 'simple-file-search-list
|
||
'(simple-file-search-list)
|
||
'(:cold))
|
||
|
||
(add-initialization 'simple-file-search-list
|
||
'(simple-file-search-list)
|
||
'(:logout))
|
||
|
||
(add-initialization 'delete-file-search-list
|
||
'(delete-file-search-list)
|
||
'(:before-cold))
|
||
|
||
(add-initialization 'add-user-homedir-to-file-search-list
|
||
'(add-user-homedir-to-file-search-list)
|
||
'(:login))
|
||
)
|
||
|
||
#-LISPM
|
||
(DEFMVAR $FILE_TYPES
|
||
`((MLIST)
|
||
,@(MAPCAR #'TO-MACSYMA-NAMESTRING
|
||
#+ITS
|
||
;; ITS filesystem. Sigh. This should be runtime conditionalization.
|
||
'("* FASL" "* TRLISP" "* LISP" "* >")
|
||
#+MULTICS
|
||
'("**" "**.lisp" "**.macsyma")
|
||
#+Franz
|
||
'("o" "l" "mac" "v")))
|
||
"The types of files that can be loaded into a macsyma automatically")
|
||
|
||
#+LISPM
|
||
(DEFMVAR $FILE_TYPES '((MLIST) #-3600 "QBIN" #+3600 "BIN" "LISP" "MACSYMA"))
|
||
|
||
|
||
(defmfun mfilename-onlyp (x)
|
||
"Returns T iff the argument could only be reasonably taken as a filename."
|
||
(cond ((macsyma-namestringp x) t)
|
||
(($listp x) t)
|
||
((symbolp x)
|
||
(= #/& (getcharn x 1)))
|
||
('else
|
||
nil)))
|
||
|
||
|