diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 8f4470a..f1a64a2 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -1990,9 +1990,9 @@ system function and constructor caches. \end{list} \par\noindent{\bf Command Description:} -This command is used to close down interpreter client processes. -Such processes are started by HyperDoc to run Axiom examples -when you click on their text. When you have finished examining or modifying the +This command is used to close down interpreter client processes. Such +processes are started by HyperDoc to run Axiom examples when you click +on their text. When you have finished examining or modifying the example and you do not want the extra window around anymore, issue \begin{verbatim} )close @@ -2000,9 +2000,8 @@ example and you do not want the extra window around anymore, issue to the Axiom prompt in the window. If you try to close down the last remaining interpreter client -process, Axiom will offer to close down the entire Axiom -session and return you to the operating system by displaying something -like +process, Axiom will offer to close down the entire Axiom session and +return you to the operating system by displaying something like \begin{verbatim} This is the last AXIOM session. Do you want to kill AXIOM? \end{verbatim} @@ -2017,6 +2016,92 @@ the entire Axiom session. \fnref{quit} and \fnref{pquit} +\subsection{defun queryClients} +Returns the number of active scratchpad clients +<>= +(defun |queryClients| () + (progn + (|sockSendInt| |$SessionManager| |$QueryClients|) + (|sockGetInt| |$SessionManager|))) + +@ + +\section{defun close} +\begin{verbatim} +;close args == +; $saturn => +; sayErrorly('"Obsolete system command", _ +; ['" The )close system command is obsolete in this version of AXIOM.", +; '" Please use Close from the File menu instead."]) +; quiet:local:= false +; null $SpadServer => +; throwKeyedMsg('"S2IZ0071", []) +; numClients := queryClients() +; numClients > 1 => +; sockSendInt($SessionManager, $CloseClient) +; sockSendInt($SessionManager, $currentFrameNum) +; closeInterpreterFrame(NIL) +; for [opt,:.] in $options repeat +; fullopt := selectOptionLC(opt, '(quiet), 'optionError) +; fullopt = 'quiet => +; quiet:=true +; quiet => +; sockSendInt($SessionManager, $CloseClient) +; sockSendInt($SessionManager, $currentFrameNum) +; closeInterpreterFrame(NIL) +; x := UPCASE queryUserKeyedMsg('"S2IZ0072", nil) +; MEMQ(STRING2ID_-N(x,1), '(YES Y)) => +; BYE() +; nil +\end{verbatim} + +<>= +(defun |close| (args) + (prog (numClients opt fullopt quiet x) + (return + (seq + (cond + (|$saturn| + (|sayErrorly| "Obsolete system command" (cons + " The )close system command is obsolete in this version of AXIOM." + (cons " Please use Close from the File menu instead." nil)))) + (t + (spadlet quiet nil) + (cond + ((null |$SpadServer|) (|throwKeyedMsg| 's2iz0071 nil)) + (t + (spadlet numClients (|queryClients|)) + (cond + ((> numClients 1) + (|sockSendInt| |$SessionManager| |$CloseClient|) + (|sockSendInt| |$SessionManager| |$currentFrameNum|) + (|closeInterpreterFrame| NIL)) + (t + (do ((t0 |$options| (cdr t0)) (t1 nil)) + ((or (atom t0) + (progn (setq t1 (car t0)) nil) + (progn (progn (spadlet opt (car t1)) t1) nil)) + nil) + (seq + (exit + (progn + (spadlet fullopt + (|selectOptionLC| opt '(|quiet|) '|optionError|)) + (cond ((boot-equal fullopt '|quiet|) + (spadlet quiet t))))))) + (cond + (quiet + (|sockSendInt| |$SessionManager| |$CloseClient|) + (|sockSendInt| |$SessionManager| |$currentFrameNum|) + (|closeInterpreterFrame| NIL)) + (t + (spadlet x (upcase (|queryUserKeyedMsg| 's2iz0072 nil))) + (cond + ((memq (string2id-n x 1) '(yes y)) (bye)) + (t nil)))))))))))))) + +@ + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \cmdhead{compiler} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2331,14 +2416,722 @@ The value of the {\tt )set break} variable then controls what happens. {\tt )edit}, and {\tt )library} +\subsection{defun compiler} +\begin{verbatim} +;compiler args == +; $newConlist: local := nil --reset by compDefineLisplib and astran +; null args and null $options and null _/EDITFILE => helpSpad2Cmd '(compiler) +; if null args then args := [_/EDITFILE] +; -- first see if the user has explicitly specified the compiler +; -- to use. +; optlist := '(new old translate constructor) +; haveNew := nil +; haveOld := nil +; for opt in $options while ^(haveNew and haveOld) repeat +; [optname,:optargs] := opt +; fullopt := selectOptionLC(optname,optlist,nil) +; fullopt = 'new => haveNew := true +; fullopt = 'translate => haveOld := true +; fullopt = 'constructor => haveOld := true +; fullopt = 'old => haveOld := true +; haveNew and haveOld => throwKeyedMsg("S2IZ0081", nil) +; af := pathname args +; aft := pathnameType af +;-- Whats this for? MCD/PAB 21-9-95 +;-- if haveNew and (null(aft) or (aft = '"")) then +;-- af := pathname [af, '"as"] +;-- aft = '"as" +;-- if haveOld and (null(aft) or (aft = '"")) then +;-- af := pathname [af, '"spad"] +;-- aft = '"spad" +; haveNew or (aft = '"as") => +; not (af1 := $FINDFILE (af, '(as))) => +; throwKeyedMsg("S2IL0003",[NAMESTRING af]) +; compileAsharpCmd [af1] +; haveOld or (aft = '"spad") => +; not (af1 := $FINDFILE (af, '(spad))) => +; throwKeyedMsg("S2IL0003",[NAMESTRING af]) +; compileSpad2Cmd [af1] +; aft = '"lsp" => +; not (af1 := $FINDFILE (af, '(lsp))) => +; throwKeyedMsg("S2IL0003",[NAMESTRING af]) +; compileAsharpLispCmd [af1] +; aft = '"nrlib" => +; not (af1 := $FINDFILE (af, '(nrlib))) => +; throwKeyedMsg("S2IL0003",[NAMESTRING af]) +; compileSpadLispCmd [af1] +; aft = '"ao" => +; not (af1 := $FINDFILE (af, '(ao))) => +; throwKeyedMsg("S2IL0003",[NAMESTRING af]) +; compileAsharpCmd [af1] +; aft = '"al" => -- archive library of .ao files +; not (af1 := $FINDFILE (af, '(al))) => +; throwKeyedMsg("S2IL0003",[NAMESTRING af]) +; compileAsharpArchiveCmd [af1] +; -- see if we something with the appropriate file extension +; -- lying around +; af1 := $FINDFILE (af, '(as spad ao asy)) +; af1 and pathnameType(af1) = '"as" => compileAsharpCmd [af1] +; af1 and pathnameType(af1) = '"ao" => compileAsharpCmd [af1] +; af1 and pathnameType(af1) = '"spad" => compileSpad2Cmd [af1] +; af1 and pathnameType(af1) = '"asy" => compileAsharpArchiveCmd [af1] +; -- maybe /EDITFILE has some stuff that can help us +; ef := pathname _/EDITFILE +; ef := mergePathnames(af,ef) +; ef = af => throwKeyedMsg("S2IZ0039", nil) +; af := ef +; pathnameType(af) = '"as" => compileAsharpCmd args +; pathnameType(af) = '"ao" => compileAsharpCmd args +; pathnameType(af) = '"spad" => compileSpad2Cmd args +; -- see if we something with the appropriate file extension +; -- lying around +; af1 := $FINDFILE (af, '(as spad ao asy)) +; af1 and pathnameType(af1) = '"as" => compileAsharpCmd [af1] +; af1 and pathnameType(af1) = '"ao" => compileAsharpCmd [af1] +; af1 and pathnameType(af1) = '"spad" => compileSpad2Cmd [af1] +; af1 and pathnameType(af1) = '"asy" => compileAsharpArchiveCmd [af1] +; throwKeyedMsg("S2IZ0039", nil) +\end{verbatim} + +<>= +(defun |compiler| (args) + (prog (|$newConlist| optlist optname optargs fullopt havenew haveold + aft ef af af1) + (declare (special |$newConlist|)) + (return + (seq + (progn + (spadlet |$newConlist| nil) + (cond + ((and (null args) (null |$options|) (null /editfile)) + (|helpSpad2Cmd| '(|compiler|))) + (t + (cond ((null args) (spadlet args (cons /editfile nil)))) + (spadlet optlist '(|new| |old| |translate| |constructor|)) + (spadlet havenew nil) + (spadlet haveold nil) + (do ((t0 |$options| (CDR t0)) (|opt| NIL)) + ((or (atom t0) + (progn (setq |opt| (car t0)) nil) + (null (null (and havenew haveold)))) + nil) + (seq + (exit + (progn + (spadlet optname (car |opt|)) + (spadlet optargs (cdr |opt|)) + (spadlet fullopt (|selectOptionLC| optname optlist nil)) + (cond + ((boot-equal fullopt '|new|) (spadlet havenew t)) + ((boot-equal fullopt '|translate|) (spadlet haveold t)) + ((boot-equal fullopt '|constructor|) (spadlet haveold t)) + ((boot-equal fullopt '|old|) (spadlet haveold t))))))) + (cond + ((and havenew haveold) (|throwKeyedMsg| 's2iz0081 nil)) + (t + (spadlet af (|pathname| args)) + (spadlet aft (|pathnameType| af)) + (cond + ((or havenew (boot-equal aft "as")) + (cond + ((null (spadlet af1 ($findfile af '(|as|)))) + (|throwKeyedMsg| 's2il0003 (cons (namestring af) nil))) + (t + (|compileAsharpCmd| (cons af1 nil))))) + ((or haveold (boot-equal aft "spad")) + (cond + ((null (spadlet af1 ($findfile af '(|spad|)))) + (|throwKeyedMsg| 's2il0003 (cons (namestring af) nil))) + (t + (|compileSpad2Cmd| (cons af1 nil))))) + ((boot-equal aft "lsp") + (cond + ((null (spadlet af1 ($findfile af '(|lsp|)))) + (|throwKeyedMsg| 's2il0003 (cons (namestring af) nil))) + (t + (|compileAsharpLispCmd| (CONS af1 NIL))))) + ((boot-equal aft "nrlib") + (cond + ((null (spadlet af1 ($findfile af '(|nrlib|)))) + (|throwKeyedMsg| 'S2IL0003 (cons (namestring af) nil))) + (t + (|compileSpadLispCmd| (cons af1 nil))))) + ((boot-equal aft "ao") + (cond + ((null (spadlet af1 ($findfile af '(|ao|)))) + (|throwKeyedMsg| 's2il0003 (cons (namestring af) nil))) + (t (|compileAsharpCmd| (cons af1 nil))))) + ((boot-equal aft "al") + (cond + ((null (spadlet af1 ($findfile af '(|al|)))) + (|throwKeyedMsg| 's2il0003 (cons (namestring af) nil))) + (t (|compileAsharpArchiveCmd| (cons af1 nil))))) + (t + (spadlet af1 ($findfile af '(|as| |spad| |ao| |asy|))) + (cond + ((and af1 (boot-equal (|pathnameType| af1) "as")) + (|compileAsharpCmd| (CONS af1 NIL))) + ((and af1 (boot-equal (|pathnameType| af1) "ao")) + (|compileAsharpCmd| (CONS af1 NIL))) + ((and af1 (boot-equal (|pathnameType| af1) "spad")) + (|compileSpad2Cmd| (CONS af1 NIL))) + ((and af1 (boot-equal (|pathnameType| af1) "asy")) + (|compileAsharpArchiveCmd| (CONS af1 NIL))) + (t + (spadlet ef (|pathname| /editfile)) + (spadlet ef (|mergePathnames| af ef)) + (cond + ((boot-equal ef af) (|throwKeyedMsg| 's2iz0039 nil)) + (t + (spadlet af ef) + (cond + ((boot-equal (|pathnameType| af) "as") + (|compileAsharpCmd| args)) + ((boot-equal (|pathnameType| af) "ao") + (|compileAsharpCmd| args)) + ((boot-equal (|pathnameType| af) "spad") + (|compileSpad2Cmd| args)) + (t + (spadlet af1 ($findfile af '(|as| |spad| |ao| |asy|))) + (cond + ((and af1 (boot-equal (|pathnameType| af1) "as")) + (|compileAsharpCmd| (CONS af1 NIL))) + ((and af1 (boot-equal (|pathnameType| af1) "ao")) + (|compileAsharpCmd| (CONS af1 NIL))) + ((and af1 (boot-equal (|pathnameType| af1) "spad")) + (|compileSpad2Cmd| (CONS af1 NIL))) + ((and af1 (boot-equal (|pathnameType| af1) "asy")) + (|compileAsharpArchiveCmd| (CONS af1 NIL))) + (t (|throwKeyedMsg| 's2iz0039 nil)))))))))))))))))))) + +@ + +\subsection{defun compileAsharpCmd} +<>= +(defun |compileAsharpCmd| (args) + (|compileAsharpCmd1| args) + (|terminateSystemCommand|) + (|spadPrompt|)) + +@ + +\subsection{defun compileAsharpCmd1} +\begin{verbatim} +;compileAsharpCmd1 args == +; -- Assume we entered from the "compiler" function, so args ^= nil +; -- and is a file with file extension .as or .ao +; path := pathname args +; pathType := pathnameType path +; (pathType ^= '"as") and (pathType ^= '"ao") => throwKeyedMsg("S2IZ0083", nil) +; ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args]) +; SETQ(_/EDITFILE, path) +; updateSourceFiles path +; optList := '( _ +; new _ +; old _ +; translate _ +; onlyargs _ +; moreargs _ +; quiet _ +; nolispcompile _ +; noquiet _ +; library _ +; nolibrary _ +; ) +; beQuiet := false -- be verbose here +; doLibrary := true -- so a )library after compilation +; doCompileLisp := true -- do compile generated lisp code +; moreArgs := NIL +; onlyArgs := NIL +; for opt in $options repeat +; [optname,:optargs] := opt +; fullopt := selectOptionLC(optname,optList,nil) +; fullopt = 'new => nil +; fullopt = 'old => error "Internal error: compileAsharpCmd got )old" +; fullopt = 'translate => error "Internal error: compileAsharpCmd got )translate" +; fullopt = 'quiet => beQuiet := true +; fullopt = 'noquiet => beQuiet := false +; fullopt = 'nolispcompile => doCompileLisp := false +; fullopt = 'moreargs => moreArgs := optargs +; fullopt = 'onlyargs => onlyArgs := optargs +; fullopt = 'library => doLibrary := true +; fullopt = 'nolibrary => doLibrary := false +; throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)]) +; tempArgs := +; pathType = '"ao" => +; -- want to strip out -Fao +; (p := STRPOS('"-Fao", $asharpCmdlineFlags, 0, NIL)) => +; p = 0 => SUBSTRING($asharpCmdlineFlags, 5, NIL) +; STRCONC(SUBSTRING($asharpCmdlineFlags, 0, p), '" ", +; SUBSTRING($asharpCmdlineFlags, p+5, NIL)) +; $asharpCmdlineFlags +; $asharpCmdlineFlags +; asharpArgs := +; onlyArgs => +; s := "" +; for a in onlyArgs repeat +; s := STRCONC(s, '" ", object2String a) +; s +; moreArgs => +; s := tempArgs +; for a in moreArgs repeat +; s := STRCONC(s, '" ", object2String a) +; s +; tempArgs +; if ^beQuiet then sayKeyedMsg("S2IZ0038A",[namestring args, asharpArgs]) +; command := +; STRCONC(STRCONC(GETENV('"ALDORROOT"),'"/bin/"),_ +; "aldor ", asharpArgs, '" ", namestring args) +; rc := OBEY command +; if (rc = 0) and doCompileLisp then +; lsp := fnameMake('".", pathnameName args, '"lsp") +; if fnameReadable?(lsp) then +; if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp]) +; compileFileQuietly(lsp) +; else +; sayKeyedMsg("S2IL0003", [namestring lsp]) +; if rc = 0 and doLibrary then +; -- do we need to worry about where the compilation output went? +; if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ]) +; withAsharpCmd [ pathnameName path ] +; else if ^beQuiet then +; sayKeyedMsg("S2IZ0084", nil) +; extendLocalLibdb $newConlist +\end{verbatim} + +<>= +(defun |compileAsharpCmd1| (args) + (prog (path pathtype optlist optname optargs fullopt bequiet docompilelisp + moreargs onlyargs dolibrary p tempargs s asharpargs command rc lsp) + (return + (seq + (progn + (spadlet path (|pathname| args)) + (spadlet pathtype (|pathnameType| path)) + (cond + ((and (nequal pathtype "as") (nequal pathtype "ao")) + (|throwKeyedMsg| 's2iz0083 nil)) + ((null (probe-file path)) + (|throwKeyedMsg| 's2il0003 (cons (|namestring| args) nil))) + (t + (setq /editfile path) + (|updateSourceFiles| path) + (spadlet optlist + '(|new| |old| |translate| |onlyargs| |moreargs| |quiet| + |nolispcompile| |noquiet| |library| |nolibrary|)) + (spadlet bequiet nil) + (spadlet dolibrary t) + (spadlet docompilelisp t) + (spadlet moreargs nil) + (spadlet onlyargs nil) + (do ((t0 |$options| (cdr t0)) (|opt| nil)) + ((or (atom t0) (progn (setq |opt| (car t0)) nil)) nil) + (seq + (exit + (progn + (spadlet optname (car |opt|)) + (spadlet optargs (cdr |opt|)) + (spadlet fullopt (|selectOptionLC| optname optlist nil)) + (cond + ((boot-equal fullopt '|new|) nil) + ((boot-equal fullopt '|old|) + (|error| '|Internal error: compileAsharpCmd got )old|)) + ((boot-equal fullopt '|translate|) + (|error| '|Internal error: compileAsharpCmd got )translate|)) + ((boot-equal fullopt '|quiet|) (spadlet bequiet t)) + ((boot-equal fullopt '|noquiet|) (spadlet bequiet nil)) + ((boot-equal fullopt '|nolispcompile|) + (spadlet docompilelisp nil)) + ((boot-equal fullopt '|moreargs|) (spadlet moreargs optargs)) + ((boot-equal fullopt '|onlyargs|) (spadlet onlyargs optargs)) + ((boot-equal fullopt '|library|) (spadlet dolibrary t)) + ((boot-equal fullopt '|nolibrary|) (spadlet dolibrary nil)) + (t + (|throwKeyedMsg| 's2iz0036 + (cons (strconc ")" (|object2String| optname)) nil)))))))) + (spadlet tempargs + (cond + ((boot-equal pathtype "ao") + (cond + ((spadlet p (strpos "-Fao" |$asharpCmdlineFlags| 0 nil)) + (cond + ((eql p 0) (substring |$asharpCmdlineFlags| 5 nil)) + (t + (strconc (substring |$asharpCmdlineFlags| 0 p) + " " (substring |$asharpCmdlineFlags| (plus p 5) nil))))) + (t |$asharpCmdlineFlags|))) + (t |$asharpCmdlineFlags|))) + (spadlet asharpargs + (cond + (onlyargs + (spadlet s '||) + (do ((t1 onlyargs (cdr t1)) (|a| nil)) + ((or (atom t1) (progn (setq |a| (car t1)) nil)) nil) + (seq + (exit + (spadlet s (strconc s " " (|object2String| |a|)))))) + s) + (moreargs + (spadlet s tempargs) + (do ((t2 moreargs (cdr t2)) (|a| nil)) + ((or (atom t2) (progn (setq |a| (car t2)) nil)) nil) + (seq + (exit + (spadlet s (strconc s " " (|object2String| |a|)))))) + s) + (t tempargs))) + (cond ((null bequiet) + (|sayKeyedMsg| 's2iz0038a + (cons (|namestring| args) (cons asharpargs nil))))) + (spadlet command + (strconc + (strconc (getenv "ALDORROOT") "/bin/") + '|aldor | asharpargs " " (|namestring| args))) + (spadlet rc (obey command)) + (cond + ((and (eql rc 0) docompilelisp) + (spadlet lsp (|fnameMake| "." (|pathnameName| args) "lsp")) + (cond + ((|fnameReadable?| lsp) + (cond + ((null bequiet) + (|sayKeyedMsg| 's2iz0089 (cons (|namestring| lsp) nil)))) + (|compileFileQuietly| lsp)) + (t (|sayKeyedMsg| 's2il0003 (cons (|namestring| lsp) nil)))))) + (cond + ((and (eql rc 0) dolibrary) + (cond + ((null bequiet) + (|sayKeyedMsg| 's2iz0090 (cons (|pathnameName| path) nil)))) + (|withAsharpCmd| (cons (|pathnameName| path) nil))) + ((null bequiet) (|sayKeyedMsg| 's2iz0084 nil)) + (t nil)) + (|extendLocalLibdb| |$newConlist|)))))))) + +@ + +\subsection{defun compileAsharpArchiveCmd} +\begin{verbatim} +;compileAsharpArchiveCmd args == +; -- Assume we entered from the "compiler" function, so args ^= nil +; -- and is a file with file extension .al. We also assume that +; -- the name is fully qualified. +; path := pathname args +; ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args]) +; -- here is the plan: +; -- 1. extract the file name and try to make a directory based +; -- on that name. +; -- 2. cd to that directory and ar x the .al file +; -- 3. for each .ao file that shows up, compile it +; -- 4. delete the generated .ao files +; -- First try to make the directory in the current directory +; dir := fnameMake('".", pathnameName path, '"axldir") +; exists := PROBE_-FILE dir +; isDir := directoryp namestring dir +; exists and isDir ^= 1=> +; throwKeyedMsg("S2IL0027",[namestring dir, namestring args]) +; if isDir ^= 1 then +; cmd := STRCONC('"mkdir ", namestring dir) +; rc := OBEY cmd +; rc ^= 0 => throwKeyedMsg("S2IL0027",[namestring dir, namestring args]) +; curDir := $CURRENT_-DIRECTORY +; -- cd to that directory and try to unarchive the .al file +; cd [ object2Identifier namestring dir ] +; cmd := STRCONC( '"ar x ", namestring path ) +; rc := OBEY cmd +; rc ^= 0 => +; cd [ object2Identifier namestring curDir ] +; throwKeyedMsg("S2IL0028",[namestring dir, namestring args]) +; -- Look for .ao files +; asos := DIRECTORY '"*.ao" +; null asos => +; cd [ object2Identifier namestring curDir ] +; throwKeyedMsg("S2IL0029",[namestring dir, namestring args]) +; -- Compile the .ao files +; for aso in asos repeat +; compileAsharpCmd1 [ namestring aso ] +; -- Reset the current directory +; cd [ object2Identifier namestring curDir ] +; terminateSystemCommand() +; spadPrompt() +\end{verbatim} + +<>= +(defun |compileAsharpArchiveCmd| (args) + (prog (path dir exists isdir curdir cmd rc asos) + (return + (seq + (progn + (spadlet path (|pathname| args)) + (cond + ((null (probe-file path)) + (|throwKeyedMsg| 's2il0003 (cons (|namestring| args) nil))) + (t + (spadlet dir (|fnameMake| "." (|pathnameName| path) "axldir")) + (spadlet exists (probe-file dir)) + (spadlet isdir (|directoryp| (|namestring| dir))) + (cond + ((and exists (nequal isdir 1)) + (|throwKeyedMsg| 's2il0027 + (cons (|namestring| dir) (cons (|namestring| args) nil)))) + (t + (cond + ((nequal isdir 1) + (spadlet cmd (strconc "mkdir " (|namestring| dir))) + (spadlet rc (obey cmd)) + (cond + ((nequal rc 0) + (|throwKeyedMsg| 's2il0027 + (cons (|namestring| dir) (cons (|namestring| args) nil))))))) + (spadlet curdir $current-directory) + (|cd| (cons (|object2Identifier| (|namestring| dir)) nil)) + (spadlet cmd (strconc "ar x " (|namestring| path))) + (spadlet rc (obey cmd)) + (cond + ((nequal rc 0) + (|cd| (cons (|object2Identifier| (|namestring| curdir)) nil)) + (|throwKeyedMsg| 's2il0028 + (cons (|namestring| dir) (cons (|namestring| args) nil)))) + (t + (spadlet asos (directory (makestring "*.ao"))) + (cond + ((null asos) + (|cd| (cons (|object2Identifier| (|namestring| curdir)) nil)) + (|throwKeyedMsg| 's2il0029 + (cons (|namestring| dir) (cons (|namestring| args) nil)))) + (t + (do ((t0 asos (cdr t0)) (|aso| nil)) + ((or (atom t0) (progn (setq |aso| (car t0)) nil)) nil) + (seq + (exit + (|compileAsharpCmd1| (cons (|namestring| |aso|) nil))))) + (|cd| (CONS (|object2Identifier| (|namestring| curdir)) NIL)) + (|terminateSystemCommand|) + (|spadPrompt|)))))))))))))) + +@ + +\subsection{defun compileAsharpLispCmd} +\begin{verbatim} +;compileAsharpLispCmd args == +; -- Assume we entered from the "compiler" function, so args ^= nil +; -- and is a file with file extension .lsp +; path := pathname args +; ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args]) +; optList := '( _ +; quiet _ +; noquiet _ +; library _ +; nolibrary _ +; ) +; beQuiet := false -- be verbose here +; doLibrary := true -- so a )library after compilation +; for opt in $options repeat +; [optname,:optargs] := opt +; fullopt := selectOptionLC(optname,optList,nil) +; fullopt = 'quiet => beQuiet := true +; fullopt = 'noquiet => beQuiet := false +; fullopt = 'library => doLibrary := true +; fullopt = 'nolibrary => doLibrary := false +; throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)]) +; lsp := fnameMake(pathnameDirectory path, pathnameName path, pathnameType path) +; if fnameReadable?(lsp) then +; if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp]) +; compileFileQuietly(lsp) +; else +; sayKeyedMsg("S2IL0003", [namestring lsp]) +; if doLibrary then +; -- do we need to worry about where the compilation output went? +; if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ]) +; withAsharpCmd [ pathnameName path ] +; else if ^beQuiet then +; sayKeyedMsg("S2IZ0084", nil) +; terminateSystemCommand() +; spadPrompt() +\end{verbatim} + +<>= +(defun |compileAsharpLispCmd| (args) + (prog (path optlist optname optargs fullopt bequiet + dolibrary lsp) + (return + (seq + (progn + (spadlet path (|pathname| args)) + (cond + ((null (probe-file path)) + (|throwKeyedMsg| 's2il0003 (CONS (|namestring| args) NIL))) + (t + (spadlet optlist '(|quiet| |noquiet| |library| |nolibrary|)) + (spadlet bequiet nil) + (spadlet dolibrary t) + (do ((t0 |$options| (cdr t0)) (|opt| nil)) + ((or (atom t0) (progn (setq |opt| (car t0)) nil)) nil) + (seq + (exit + (progn + (spadlet optname (car |opt|)) + (spadlet optargs (cdr |opt|)) + (spadlet fullopt (|selectOptionLC| optname optlist nil)) + (cond + ((boot-equal fullopt '|quiet|) (spadlet bequiet t)) + ((boot-equal fullopt '|noquiet|) (spadlet bequiet nil)) + ((boot-equal fullopt '|library|) (spadlet dolibrary t)) + ((boot-equal fullopt '|nolibrary|) (spadlet dolibrary nil)) + (t + (|throwKeyedMsg| 's2iz0036 + (cons (strconc ")" (|object2String| optname)) nil)))))))) + (spadlet lsp + (|fnameMake| + (|pathnameDirectory| path) + (|pathnameName| path) + (|pathnameType| path))) + (cond + ((|fnameReadable?| lsp) + (cond + ((null bequiet) + (|sayKeyedMsg| 's2iz0089 (cons (|namestring| lsp) NIL)))) + (|compileFileQuietly| lsp)) + (t (|sayKeyedMsg| 's2il0003 (cons (|namestring| lsp) nil)))) + (cond + (dolibrary + (cond + ((null bequiet) + (|sayKeyedMsg| 's2iz0090 (cons (|pathnameName| path) nil)))) + (|withAsharpCmd| (CONS (|pathnameName| path) NIL))) + ((null bequiet) (|sayKeyedMsg| 's2iz0084 nil)) + (t nil)) + (|terminateSystemCommand|) + (|spadPrompt|)))))))) + +@ + +\subsection{defun compileSpadLispCmd} +\begin{verbatim} +;compileSpadLispCmd args == +; -- Assume we entered from the "compiler" function, so args ^= nil +; -- and is a file with file extension .nrlib +; path := pathname fnameMake(first args, '"code", '"lsp") +; ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args]) +; optList := '( _ +; quiet _ +; noquiet _ +; library _ +; nolibrary _ +; ) +; beQuiet := false -- be verbose here +; doLibrary := true -- so a )library after compilation +; for opt in $options repeat +; [optname,:optargs] := opt +; fullopt := selectOptionLC(optname,optList,nil) +; fullopt = 'quiet => beQuiet := true +; fullopt = 'noquiet => beQuiet := false +; fullopt = 'library => doLibrary := true +; fullopt = 'nolibrary => doLibrary := false +; throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)]) +; lsp := fnameMake(pathnameDirectory path, pathnameName path, pathnameType path) +; if fnameReadable?(lsp) then +; if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp]) +; --compileFileQuietly(lsp) +; RECOMPILE_-LIB_-FILE_-IF_-NECESSARY lsp +; else +; sayKeyedMsg("S2IL0003", [namestring lsp]) +; if doLibrary then +; -- do we need to worry about where the compilation output went? +; if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ]) +; LOCALDATABASE([ pathnameName first args ],[]) +; else if ^beQuiet then +; sayKeyedMsg("S2IZ0084", nil) +; terminateSystemCommand() +; spadPrompt() +\end{verbatim} + +<>= +(defun |compileSpadLispCmd| (args) + (prog (path optlist optname optargs fullopt beQuiet dolibrary lsp) + (return + (seq + (progn + (spadlet path (|pathname| (|fnameMake| (car args) "code" "lsp"))) + (cond + ((null (probe-file path)) + (|throwKeyedMsg| 's2il0003 (cons (|namestring| args) nil))) + (t + (spadlet optlist '(|quiet| |noquiet| |library| |nolibrary|)) + (spadlet beQuiet nil) + (spadlet dolibrary t) + (do ((t0 |$options| (cdr t0)) (|opt| nil)) + ((or (atom t0) (progn (setq |opt| (car t0)) nil)) nil) + (seq + (exit + (progn + (spadlet optname (car |opt|)) + (spadlet optargs (cdr |opt|)) + (spadlet fullopt (|selectOptionLC| optname optlist nil)) + (cond + ((boot-equal fullopt '|quiet|) (spadlet beQuiet t)) + ((boot-equal fullopt '|noquiet|) (spadlet beQuiet nil)) + ((boot-equal fullopt '|library|) (spadlet dolibrary t)) + ((boot-equal fullopt '|nolibrary|) (spadlet dolibrary nil)) + (t + (|throwKeyedMsg| 's2iz0036 + (cons (strconc ")" (|object2String| optname)) nil)))))))) + (spadlet lsp + (|fnameMake| + (|pathnameDirectory| path) + (|pathnameName| path) + (|pathnameType| path))) + (cond + ((|fnameReadable?| lsp) + (cond + ((null beQuiet) + (|sayKeyedMsg| 's2iz0089 (cons (|namestring| lsp) nil)))) + (recompile-lib-file-if-necessary lsp)) + (t + (|sayKeyedMsg| 's2il0003 (cons (|namestring| lsp) nil)))) + (cond + (dolibrary + (cond + ((null beQuiet) + (|sayKeyedMsg| 's2iz0090 (cons (|pathnameName| path) nil)))) + (localdatabase (cons (|pathnameName| (car args)) nil) nil)) + ((null beQuiet) (|sayKeyedMsg| 's2iz0084 nil)) + (t nil)) + (|terminateSystemCommand|) + (|spadPrompt|)))))))) + +@ + +\subsection{defun withAsharpCmd} +<>= +(defun |withAsharpCmd| (args) + (let (|$options|) + (declare (special |$options|)) + (localdatabase args |$options|))) + +@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \cmdhead{copyright} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\subsection{defun copyright} +<>= +(defun |copyright| () + (obey (strconc "cat " (|getEnv| "AXIOM") "/lib/copyright"))) + +@ + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \cmdhead{credits} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\subsection{defun credits} +<>= +(defun |credits| () + (mapcar #'(lambda (x) (princ x) (terpri)) credits)) + +@ + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \cmdhead{display} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -3718,6 +4511,94 @@ and in HyperDoc. In HyperDoc, choose the {\bf Commands} item from the {\bf Reference} menu. +\subsection{defun help} +<>= +(defun |help| (l) + (|helpSpad2Cmd| l)) + +@ + +\subsection{defun helpSpad2Cmd} +<>= +(defun |helpSpad2Cmd| (|args|) + (unless (|newHelpSpad2Cmd| |args|) + (|sayKeyedMsg| 's2iz0025 (cons |args| nil)))) + +@ + +\subsection{defun newHelpSpad2Cmd} +\begin{verbatim} +;newHelpSpad2Cmd args == +; if null args then args := ["?"] +; # args > 1 => +; sayKeyedMsg("S2IZ0026",NIL) +; true +; sarg := PNAME first args +; if sarg = '"?" then args := ['help] +; else if sarg = '"%" then args := ['history] +; else if sarg = '"%%" then args := ['history] +; arg := selectOptionLC(first args,$SYSCOMMANDS,nil) +; if null arg then arg := first args +; if arg = 'compiler then arg := 'compile +; -- see if new help file exists +; narg := PNAME arg +; null (helpFile := MAKE_-INPUT_-FILENAME [narg,'HELPSPAD,'_*]) => NIL +; $useFullScreenHelp => +; OBEY STRCONC('"$AXIOM/lib/SPADEDIT ",namestring helpFile) +; true +; filestream := MAKE_-INSTREAM(helpFile) +; repeat +; line := read_-line(filestream,false) +; NULL line => +; SHUT filestream +; return true +; SAY line +; true +\end{verbatim} + +<>= +(defun |newHelpSpad2Cmd| (|args|) + (prog (|sarg| |arg| |narg| |helpFile| |filestream| |line|) + (return + (seq + (progn + (cond ((null |args|) (spadlet |args| (cons '? nil)))) + (cond + ((> (|#| |args|) 1) (|sayKeyedMsg| 's2iz0026 nil) t) + (t + (spadlet |sarg| (pname (car |args|))) + (cond + ((boot-equal |sarg| "?") (spadlet |args| (cons '|help| nil))) + ((boot-equal |sarg| "%") (spadlet |args| (cons '|history| nil))) + ((boot-equal |sarg| "%%") (spadlet |args| (cons '|history| nil))) + (t nil)) + (spadlet |arg| (|selectOptionLC| (car |args|) $syscommands nil)) + (cond ((null |arg|) (spadlet |arg| (car |args|)))) + (cond ((boot-equal |arg| '|compiler|) (spadlet |arg| '|compile|))) + (spadlet |narg| (pname |arg|)) + (cond + ((null + (spadlet |helpFile| + (make-input-filename + (cons |narg| (cons 'helpspad (cons '* nil)))))) + nil) + (|$useFullScreenHelp| + (obey (strconc "$AXIOM/lib/SPADEDIT " (|namestring| |helpFile|))) t) + (t + (spadlet |filestream| (make-instream |helpFile|)) + (do () + (nil nil) + (seq + (exit + (progn + (spadlet |line| (|read-line| |filestream| nil)) + (cond + ((null |line|) (shut |filestream|) (return t)) + (t (say |line|))))))) + t))))))))) + +@ + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \cmdhead{history} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -6748,6 +7629,13 @@ Axiom or is the directory you specified using the \cmdhead{summary} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\subsection{defun summary} +<>= +(defun |summary| (l) + (obey (strconc "cat " (|getEnv| "AXIOM") "/lib/summary"))) + +@ + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \cmdhead{synonym} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -8043,11 +8931,11 @@ This reports the traced functions (prog (t0) (spadlet t0 nil) (return - (do ((t1 arg (cdr t1)) (|x| nil)) - ((or (atom t1) (progn (setq |x| (car t1)) nil)) (nreverse0 t0)) + (do ((t1 arg (cdr t1)) (x nil)) + ((or (atom t1) (progn (setq x (car t1)) nil)) (nreverse0 t0)) (seq (exit - (setq t0 (cons (|transTraceItem| |x|) t0)))))))) + (setq t0 (cons (|transTraceItem| x) t0)))))))) (|/UNTRACE,0| (prog (t2) (spadlet t2 nil) @@ -8086,33 +8974,33 @@ This reports the traced functions \end{verbatim} <>= -(defun |transTraceItem| (|x|) +(defun |transTraceItem| (x) (prog (|$doNotAddEmptyModeIfTrue| |value| |y|) (declare (special |$doNotAddEmptyModeIfTrue|)) (return (progn (spadlet |$doNotAddEmptyModeIfTrue| t) (cond - ((atom |x|) + ((atom x) (cond - ((and (spadlet |value| (|get| |x| '|value| |$InteractiveFrame|)) + ((and (spadlet |value| (|get| x '|value| |$InteractiveFrame|)) (|member| (|objMode| |value|) '((|Mode|) (|Domain|) (|SubDomain| (|Domain|))))) - (spadlet |x| (|objVal| |value|)) + (spadlet x (|objVal| |value|)) (cond - ((spadlet |y| (|domainToGenvar| |x|)) |y|) - (t |x|))) - ((upper-case-p (elt (stringimage |x|) 0)) - (spadlet |y| (|unabbrev| |x|)) + ((spadlet |y| (|domainToGenvar| x)) |y|) + (t x))) + ((upper-case-p (elt (stringimage x) 0)) + (spadlet |y| (|unabbrev| x)) (cond ((|constructor?| |y|) |y|) ((and (pairp |y|) (|constructor?| (car |y|))) (car |y|)) - ((spadlet |y| (|domainToGenvar| |x|)) |y|) - (t |x|))) - (t |x|))) - ((vecp (car |x|)) (|transTraceItem| (|devaluate| (car |x|)))) - ((spadlet |y| (|domainToGenvar| |x|)) |y|) - (t (|throwKeyedMsg| 's2it0018 (cons |x| nil)))))))) + ((spadlet |y| (|domainToGenvar| x)) |y|) + (t x))) + (t x))) + ((vecp (car x)) (|transTraceItem| (|devaluate| (car x)))) + ((spadlet |y| (|domainToGenvar| x)) |y|) + (t (|throwKeyedMsg| 's2it0018 (cons x nil)))))))) @ @@ -8148,7 +9036,7 @@ This reports the traced functions \end{verbatim} <>= -(defun |coerceTraceArgs2E| (|traceName| |subName| |args|) +(defun |coerceTraceArgs2E| (|traceName| |subName| args) (prog (|name|) (return (seq @@ -8156,7 +9044,7 @@ This reports the traced functions ((memq (spadlet |name| |subName|) |$mathTraceList|) (cond ((spadsysnamep (pname |name|)) - (|coerceSpadArgs2E| (reverse (cdr (reverse |args|))))) + (|coerceSpadArgs2E| (reverse (cdr (reverse args))))) (t (prog (t0) (spadlet t0 nil) @@ -8165,7 +9053,7 @@ This reports the traced functions |arg9| |arg10| |arg11| |arg12| |arg13| |arg14| |arg15| |arg16| |arg17| |arg18| |arg19|) (cdr t1)) (|name| nil) - (t2 |args| (cdr t2)) + (t2 args (cdr t2)) (|arg| nil) (t3 (cdr (lassoc |subName| |$tracedMapSignatures|)) (cdr t3)) (type nil)) @@ -8187,8 +9075,8 @@ This reports the traced functions (|objNewWrap| |arg| type) |$OutputForm|)) nil))) t0)))))))))) - ((spadsysnamep (pname |name|)) (reverse (cdr (reverse |args|)))) - (t |args|)))))) + ((spadsysnamep (pname |name|)) (reverse (cdr (reverse args)))) + (t args)))))) @ @@ -8203,7 +9091,7 @@ This reports the traced functions \end{verbatim} <>= -(defun |coerceSpadArgs2E| (|args|) +(defun |coerceSpadArgs2E| (args) (prog (|$streamCount|) (declare (special |$streamCount|)) (return @@ -8217,7 +9105,7 @@ This reports the traced functions |arg9| |arg10| |arg11| |arg12| |arg13| |arg14| |arg15| |arg16| |arg17| |arg18| |arg19|) (cdr t1)) (|name| nil) - (t2 |args| (cdr t2)) + (t2 args (cdr t2)) (|arg| nil) (t3 (cdr |$tracedSpadModemap|) (cdr t3)) (type nil)) @@ -8253,12 +9141,12 @@ This reports the traced functions <>= (defun |subTypes| (|mm| |sublist|) - (prog (|s|) + (prog (s) (return (seq (cond ((atom |mm|) - (cond ((spadlet |s| (lassoc |mm| |sublist|)) |s|) (t |mm|))) + (cond ((spadlet s (lassoc |mm| |sublist|)) s) (t |mm|))) (t (prog (t0) (spadlet t0 nil) @@ -8336,11 +9224,11 @@ This reports the traced functions (prog (t0) (spadlet t0 t) (return - (do ((t1 nil (null t0)) (t2 arg (cdr t2)) (|x| nil)) - ((or t1 (atom t2) (progn (setq |x| (car t2)) nil)) t0) + (do ((t1 nil (null t0)) (t2 arg (cdr t2)) (x nil)) + ((or t1 (atom t2) (progn (setq x (car t2)) nil)) t0) (seq (exit - (setq t0 (and t0 (identp |x|)))))))))))) + (setq t0 (and t0 (identp x)))))))))))) @ @@ -8357,11 +9245,11 @@ This reports the traced functions (prog (t0) (spadlet t0 t) (return - (do ((t1 nil (null t0)) (t2 arg (cdr t2)) (|x| nil)) - ((or t1 (atom t2) (progn (setq |x| (car t2)) nil)) t0) + (do ((t1 nil (null t0)) (t2 arg (cdr t2)) (x nil)) + ((or t1 (atom t2) (progn (setq x (car t2)) nil)) t0) (seq (exit - (setq t0 (and t0 (or (identp |x|) (stringp |x|))))))))))))) + (setq t0 (and t0 (or (identp x) (stringp x))))))))))))) @ @@ -8459,12 +9347,12 @@ This reports the traced functions \end{verbatim} <>= -(defun |lassocSub| (|x| |subs|) +(defun |lassocSub| (x |subs|) (prog (|y|) (return (cond - ((spadlet |y| (lassq |x| |subs|)) |y|) - (t |x|))))) + ((spadlet |y| (lassq x |subs|)) |y|) + (t x))))) @ @@ -8476,12 +9364,12 @@ This reports the traced functions \end{verbatim} <>= -(defun |rassocSub| (|x| |subs|) +(defun |rassocSub| (x |subs|) (prog (|y|) (return (cond - ((spadlet |y| (|rassoc| |x| |subs|)) |y|) - (t |x|))))) + ((spadlet |y| (|rassoc| x |subs|)) |y|) + (t x))))) @ @@ -8751,30 +9639,30 @@ This reports the traced functions \end{verbatim} <>= -(defun |spadTrace,g| (|x|) +(defun |spadTrace,g| (x) (seq - (if (stringp |x|) (exit (intern |x|))) - (exit |x|))) + (if (stringp x) (exit (intern x))) + (exit x))) @ <>= -(defun |spadTrace,isTraceable| (|x| |domain|) +(defun |spadTrace,isTraceable| (x |domain|) (prog (|n| |functionSlot|) (return (seq (progn - (spadlet |n| (caddr |x|)) - |x| + (spadlet |n| (caddr x)) + x (seq (if (atom (elt |domain| |n|)) (exit nil)) (spadlet |functionSlot| (car (elt |domain| |n|))) (if (gensymp |functionSlot|) - (exit (seq (|reportSpadTrace| '|Already Traced| |x|) (exit nil)))) + (exit (seq (|reportSpadTrace| '|Already Traced| x) (exit nil)))) (if (null (bpiname |functionSlot|)) (exit (seq - (|reportSpadTrace| '|No function for| |x|) + (|reportSpadTrace| '|No function for| x) (exit nil)))) (exit t))))))) @@ -8804,11 +9692,11 @@ This reports the traced functions (prog (t0) (spadlet t0 nil) (return - (do ((t1 (|getOption| 'ops |options|) (cdr t1)) (|x| nil)) - ((or (atom t1) (progn (setq |x| (car t1)) nil)) (nreverse0 t0)) + (do ((t1 (|getOption| 'ops |options|) (cdr t1)) (x nil)) + ((or (atom t1) (progn (setq x (car t1)) nil)) (nreverse0 t0)) (seq (exit - (setq t0 (cons (|spadTrace,g| |x|) t0)))))))) + (setq t0 (cons (|spadTrace,g| x) t0)))))))) (cond ((spadlet |listOfVariables| (|getOption| 'vars |options|)) (spadlet |options| (|removeOption| 'vars |options|)))) @@ -8901,20 +9789,20 @@ This reports the traced functions (prog (t10) (spadlet t10 nil) (return - (do ((t11 |sigSlotNumberAlist| (cdr t11)) (|x| nil)) - ((or (atom t11) (progn (setq |x| (car t11)) nil)) (nreverse0 t10)) + (do ((t11 |sigSlotNumberAlist| (cdr t11)) (x nil)) + ((or (atom t11) (progn (setq x (car t11)) nil)) (nreverse0 t10)) (seq (exit - (cond ((cdddr |x|) (setq t10 (cons |x| t10)))))))))) + (cond ((cdddr x) (setq t10 (cons x t10)))))))))) (cond (|$reportSpadTrace| (cond (|$traceNoisely| (|printDashedLine|))) (do ((t12 (|orderBySlotNumber| |sigSlotNumberAlist|) (cdr t12)) - (|x| nil)) + (x nil)) ((or (atom t12) - (progn (setq |x| (car t12)) nil)) + (progn (setq x (car t12)) nil)) nil) - (seq (exit (|reportSpadTrace| 'tracing |x|)))))) + (seq (exit (|reportSpadTrace| 'tracing x)))))) (cond (|$letAssoc| (setletprintflag t))) (cond (|currentEntry| @@ -9078,7 +9966,7 @@ This reports the traced functions (cons 'lambda (cons (cons '&rest - (cons '|args| nil)) + (cons 'args nil)) (cons (cons 'prog (cons @@ -9088,7 +9976,7 @@ This reports the traced functions (cons '|domain| (cons (cons 'apply (cons |domainConstructor| - (cons '|args| nil))) nil))) + (cons 'args nil))) nil))) (cons (cons '|spadTrace| (cons '|domain| @@ -9236,7 +10124,7 @@ This reports the traced functions \end{verbatim} <>= -(defun |letPrint| (|x| |val| |currentFunction|) +(defun |letPrint| (x |val| |currentFunction|) (prog (|y|) (return (progn @@ -9246,24 +10134,24 @@ This reports the traced functions (spadlet |y| (lassoc '|all| |$letAssoc|)))) (cond ((and (or (boot-equal |y| '|all|) - (memq |x| |y|)) + (memq x |y|)) (null - (or (is_genvar |x|) (|isSharpVarWithNum| |x|) (gensymp |x|)))) - (|sayBrightlyNT| (append (|bright| |x|) (cons '|: | nil))) + (or (is_genvar x) (|isSharpVarWithNum| x) (gensymp x)))) + (|sayBrightlyNT| (append (|bright| x) (cons '|: | nil))) (prin0 (|shortenForPrinting| |val|)) (terpri))) (cond ((and (spadlet |y| (|hasPair| 'break |y|)) (or (boot-equal |y| '|all|) - (and (memq |x| |y|) - (null (memq (elt (pname |x|) 0) '($ |#|))) - (null (gensymp |x|))))) + (and (memq x |y|) + (null (memq (elt (pname x) 0) '($ |#|))) + (null (gensymp x))))) (|break| (append (|bright| |currentFunction|) (cons "breaks after" (append - (|bright| |x|) + (|bright| x) (cons ":= " (cons (|shortenForPrinting| |val|) nil))))))) (t nil)))) |val|)))) @@ -9293,7 +10181,7 @@ This reports the traced functions \end{verbatim} <>= -(defun |letPrint2| (|x| |printform| |currentFunction|) +(defun |letPrint2| (x |printform| |currentFunction|) (prog (|$BreakMode| |flag| |y|) (declare (special |$BreakMode|)) (return @@ -9305,12 +10193,12 @@ This reports the traced functions (spadlet |y| (lassoc '|all| |$letAssoc|)))) (cond ((and - (or (boot-equal |y| '|all|) (memq |x| |y|)) - (null (or (is_genvar |x|) (|isSharpVarWithNum| |x|) (gensymp |x|)))) + (or (boot-equal |y| '|all|) (memq x |y|)) + (null (or (is_genvar x) (|isSharpVarWithNum| x) (gensymp x)))) (spadlet |$BreakMode| '|letPrint2|) (spadlet |flag| nil) (catch '|letPrint2| - (|mathprint| (cons '= (cons |x| (cons |printform| nil)))) |flag|) + (|mathprint| (cons '= (cons x (cons |printform| nil)))) |flag|) (cond ((boot-equal |flag| '|letPrint2|) (|print| |printform|)) (t nil)))) @@ -9319,16 +10207,16 @@ This reports the traced functions (spadlet |y| (|hasPair| 'break |y|)) (or (boot-equal |y| '|all|) (and - (memq |x| |y|) - (null (memq (elt (pname |x|) 0) '($ |#|))) - (null (gensymp |x|))))) + (memq x |y|) + (null (memq (elt (pname x) 0) '($ |#|))) + (null (gensymp x))))) (|break| (append (|bright| |currentFunction|) (cons "breaks after" - (append (|bright| |x|) (cons '|:= | (cons |printform| nil))))))) + (append (|bright| x) (cons '|:= | (cons |printform| nil))))))) (t nil)))) - |x|)))) + x)))) @ @@ -9355,7 +10243,7 @@ This reports the traced functions \end{verbatim} <>= -(defun |letPrint3| (|x| |xval| |printfn| |currentFunction|) +(defun |letPrint3| (x |xval| |printfn| |currentFunction|) (prog (|$BreakMode| |flag| |y|) (declare (special |$BreakMode|)) (return @@ -9367,13 +10255,13 @@ This reports the traced functions (spadlet |y| (lassoc '|all| |$letAssoc|)))) (cond ((and - (or (boot-equal |y| '|all|) (memq |x| |y|)) - (null (or (is_genvar |x|) (|isSharpVarWithNum| |x|) (gensymp |x|)))) + (or (boot-equal |y| '|all|) (memq x |y|)) + (null (or (is_genvar x) (|isSharpVarWithNum| x) (gensymp x)))) (spadlet |$BreakMode| '|letPrint2|) (spadlet |flag| nil) (catch '|letPrint2| (|mathprint| - (cons '= (cons |x| (cons (spadcall |xval| |printfn|) nil)))) + (cons '= (cons x (cons (spadcall |xval| |printfn|) nil)))) |flag|) (cond ((boot-equal |flag| '|letPrint2|) (|print| |xval|)) @@ -9384,16 +10272,16 @@ This reports the traced functions (or (boot-equal |y| '|all|) (and - (memq |x| |y|) - (null (memq (elt (pname |x|) 0) '($ |#|))) - (null (gensymp |x|))))) + (memq x |y|) + (null (memq (elt (pname x) 0) '($ |#|))) + (null (gensymp x))))) (|break| (append (|bright| |currentFunction|) (cons "breaks after" - (append (|bright| |x|) (cons ":= " (cons |xval| nil))))))) + (append (|bright| x) (cons ":= " (cons |xval| nil))))))) (t nil)))) - |x|)))) + x)))) @ \subsection{defun getAliasIfTracedMapParameter} @@ -9406,20 +10294,20 @@ This reports the traced functions \end{verbatim} <>= -(defun |getAliasIfTracedMapParameter| (|x| |currentFunction|) +(defun |getAliasIfTracedMapParameter| (x |currentFunction|) (prog (|aliasList|) (return (seq (cond - ((|isSharpVarWithNum| |x|) + ((|isSharpVarWithNum| x) (cond ((spadlet |aliasList| (|get| |currentFunction| '|alias| |$InteractiveFrame|)) (exit (elt |aliasList| (spaddifference - (string2pint-n (substring (pname |x|) 1 nil) 1) 1)))))) - (t |x|)))))) + (string2pint-n (substring (pname x) 1 nil) 1) 1)))))) + (t x)))))) @ @@ -9577,14 +10465,14 @@ This reports the traced functions (prog (t0) (spadlet t0 nil) (return - (do ((t1 arg (cdr t1)) (|x| nil)) + (do ((t1 arg (cdr t1)) (x nil)) ((or (atom t1) - (progn (setq |x| (car t1)) nil) - (progn (progn (spadlet |n| (caddr |x|)) |x|) nil)) + (progn (setq x (car t1)) nil) + (progn (progn (spadlet |n| (caddr x)) x) nil)) (nreverse0 t0)) (seq (exit - (setq t0 (cons (cons |n| |x|) t0))))))))))))) + (setq t0 (cons (cons |n| x) t0))))))))))))) @ @@ -9607,17 +10495,17 @@ This reports the traced functions (cond ((null /tracenames) " Nothing is traced.") (t - (do ((t0 /tracenames (cdr t0)) (|x| nil)) - ((or (atom t0) (progn (setq |x| (car t0)) nil)) nil) + (do ((t0 /tracenames (cdr t0)) (x nil)) + ((or (atom t0) (progn (setq x (car t0)) nil)) nil) (seq (exit (cond - ((and (pairp |x|) - (progn (spadlet |d| (qcar |x|)) t) + ((and (pairp x) + (progn (spadlet |d| (qcar x)) t) (|isDomainOrPackage| |d|)) (spadlet |domainList| (cons (|devaluate| |d|) |domainList|))) (t - (spadlet |functionList| (cons |x| |functionList|))))))) + (spadlet |functionList| (cons x |functionList|))))))) (append |functionList| (append |domainList| (cons '|traced| nil))))))))) @@ -9633,14 +10521,14 @@ This reports the traced functions \end{verbatim} <>= -(defun |spadReply,printName| (|x|) +(defun |spadReply,printName| (x) (prog (|d|) (return (seq - (if (and (and (pairp |x|) (progn (spadlet |d| (qcar |x|)) t)) + (if (and (and (pairp x) (progn (spadlet |d| (qcar x)) t)) (|isDomainOrPackage| |d|)) (exit (|devaluate| |d|))) - (exit |x|))))) + (exit x))))) @ @@ -9652,11 +10540,11 @@ This reports the traced functions (prog (t0) (spadlet t0 nil) (return - (do ((t1 /tracenames (cdr t1)) (|x| nil)) - ((or (atom t1) (progn (setq |x| (car t1)) nil)) (nreverse0 t0)) + (do ((t1 /tracenames (cdr t1)) (x nil)) + ((or (atom t1) (progn (setq x (car t1)) nil)) (nreverse0 t0)) (seq (exit - (setq t0 (cons (|spadReply,printName| |x|) t0))))))))))) + (setq t0 (cons (|spadReply,printName| x) t0))))))))))) @ @@ -9743,11 +10631,11 @@ This reports the traced functions (prog (t1) (spadlet t1 nil) (return - (do ((t2 |sigSlotNumberAlist| (cdr t2)) (|x| nil)) - ((or (atom t2) (progn (setq |x| (car t2)) nil)) (nreverse0 t1)) + (do ((t2 |sigSlotNumberAlist| (cdr t2)) (x nil)) + ((or (atom t2) (progn (setq x (car t2)) nil)) (nreverse0 t1)) (seq (exit - (cond ((cdddr |x|) (setq t1 (cons |x| t1)))))))))) + (cond ((cdddr x) (setq t1 (cons x t1)))))))))) (cond (|newSigSlotNumberAlist| (rplac (cdr |pair|) |newSigSlotNumberAlist|)) @@ -9766,15 +10654,15 @@ This reports the traced functions \end{verbatim} <>= -(defun |prTraceNames,fn| (|x|) +(defun |prTraceNames,fn| (x) (prog (|d| |t|) (return (seq - (if (and (and (pairp |x|) - (progn (spadlet |d| (qcar |x|)) (spadlet |t| (qcdr |x|)) t)) + (if (and (and (pairp x) + (progn (spadlet |d| (qcar x)) (spadlet |t| (qcdr x)) t)) (|isDomainOrPackage| |d|)) (exit (cons (|devaluate| |d|) |t|))) - (exit |x|))))) + (exit x))))) @ @@ -9782,11 +10670,11 @@ This reports the traced functions (defun |prTraceNames| () (seq (progn - (do ((t0 /tracenames (cdr t0)) (|x| nil)) - ((or (atom t0) (progn (setq |x| (car t0)) nil)) nil) + (do ((t0 /tracenames (cdr t0)) (x nil)) + ((or (atom t0) (progn (setq x (car t0)) nil)) nil) (seq (exit - (print (|prTraceNames,fn| |x|))))) nil))) + (print (|prTraceNames,fn| x))))) nil))) @ @@ -9850,33 +10738,33 @@ This reports the traced functions ((null /tracenames) (|sayMessage| " Nothing is traced now.")) (t (|sayBrightly| " ") - (do ((t0 /tracenames (cdr t0)) (|x| nil)) - ((or (atom t0) (progn (setq |x| (car t0)) nil)) nil) + (do ((t0 /tracenames (cdr t0)) (x nil)) + ((or (atom t0) (progn (setq x (car t0)) nil)) nil) (seq (exit (cond - ((and (pairp |x|) - (progn (spadlet |d| (qcar |x|)) t) (|isDomainOrPackage| |d|)) + ((and (pairp x) + (progn (spadlet |d| (qcar x)) t) (|isDomainOrPackage| |d|)) (|addTraceItem| |d|)) - ((atom |x|) + ((atom x) (cond - ((|isFunctor| |x|) (|addTraceItem| |x|)) - ((is_genvar |x|) (|addTraceItem| (EVAL |x|))) - (t (spadlet |functionList| (CONS |x| |functionList|))))) + ((|isFunctor| x) (|addTraceItem| x)) + ((is_genvar x) (|addTraceItem| (EVAL x))) + (t (spadlet |functionList| (CONS x |functionList|))))) (t (|userError| "bad argument to trace")))))) (spadlet |functionList| (prog (t1) (spadlet t1 nil) (return - (do ((t2 |functionList| (cdr t2)) (|x| nil)) - ((or (atom t2) (progn (setq |x| (car t2)) nil)) t1) + (do ((t2 |functionList| (cdr t2)) (x nil)) + ((or (atom t2) (progn (setq x (car t2)) nil)) t1) (seq (exit (cond - ((null (|isSubForRedundantMapName| |x|)) + ((null (|isSubForRedundantMapName| x)) (setq t1 (append t1 - (cons (|rassocSub| |x| |$mapSubNameAlist|) + (cons (|rassocSub| x |$mapSubNameAlist|) (cons " " nil)))))))))))) (cond (|functionList| @@ -9897,12 +10785,12 @@ This reports the traced functions (prog (t3) (spadlet t3 nil) (return - (do ((t4 (cdr |$domains|) (cdr t4)) (|x| nil)) - ((or (atom t4) (progn (setq |x| (car t4)) nil)) t3) + (do ((t4 (cdr |$domains|) (cdr t4)) (x nil)) + ((or (atom t4) (progn (setq x (car t4)) nil)) t3) (seq (exit (setq t3 - (append t3 (|concat| "," " " (|prefix2String| |x|))))))))))) + (append t3 (|concat| "," " " (|prefix2String| x))))))))))) (cond ((atom |displayList|) (spadlet |displayList| (cons |displayList| nil)))) @@ -9916,12 +10804,12 @@ This reports the traced functions (prog (t5) (spadlet t5 nil) (return - (do ((t6 (cdr |$packages|) (cdr t6)) (|x| nil)) - ((or (atom t6) (progn (setq |x| (car t6)) nil)) t5) + (do ((t6 (cdr |$packages|) (cdr t6)) (x nil)) + ((or (atom t6) (progn (setq x (car t6)) nil)) t5) (seq (exit (setq t5 - (append t5 (|concat| '|, | (|prefix2String| |x|))))))))))) + (append t5 (|concat| '|, | (|prefix2String| x))))))))))) (cond ((atom |displayList|) (spadlet |displayList| (cons |displayList| nil)))) (|sayBrightly| " Packages traced: ") @@ -9934,12 +10822,12 @@ This reports the traced functions (prog (t7) (spadlet t7 nil) (return - (do ((t8 (cdr |$constructors|) (cdr t8)) (|x| nil)) - ((or (atom t8) (progn (setq |x| (car t8)) nil)) t7) + (do ((t8 (cdr |$constructors|) (cdr t8)) (x nil)) + ((or (atom t8) (progn (setq x (car t8)) nil)) t7) (seq (exit (setq t7 - (append t7 (|concat| '|, | (|abbreviate| |x|))))))))))) + (append t7 (|concat| '|, | (|abbreviate| x))))))))))) (cond ((atom |displayList|) (spadlet |displayList| (CONS |displayList| nil)))) (|sayBrightly| " Parameterized constructors traced:") @@ -9987,34 +10875,34 @@ This reports the traced functions <>= (defun |?t| () - (prog (|llm| |x| |d| |l| |suffix|) + (prog (|llm| x |d| |l| |suffix|) (return (seq (cond ((null /tracenames) (|sayMSG| (|bright| "nothing is traced"))) (t - (do ((t0 /tracenames (cdr t0)) (|x| nil)) - ((or (atom t0) (progn (setq |x| (car t0)) nil)) nil) + (do ((t0 /tracenames (cdr t0)) (x nil)) + ((or (atom t0) (progn (setq x (car t0)) nil)) nil) (seq (exit (cond - ((and (atom |x|) (null (is_genvar |x|))) + ((and (atom x) (null (is_genvar x))) (progn (cond - ((spadlet |llm| (|get| |x| '|localModemap| |$InteractiveFrame|)) - (spadlet |x| (list (cadar |llm|))))) + ((spadlet |llm| (|get| x '|localModemap| |$InteractiveFrame|)) + (spadlet x (list (cadar |llm|))))) (|sayMSG| (cons "Function" (append - (|bright| (|rassocSub| |x| |$mapSubNameAlist|)) + (|bright| (|rassocSub| x |$mapSubNameAlist|)) (cons "traced" nil)))))))))) - (do ((t1 /tracenames (cdr t1)) (|x| nil)) - ((or (atom t1) (progn (setq |x| (car t1)) nil)) nil) + (do ((t1 /tracenames (cdr t1)) (x nil)) + ((or (atom t1) (progn (setq x (car t1)) nil)) nil) (seq (exit (cond - ((and (pairp |x|) - (progn (spadlet |d| (qcar |x|)) (spadlet |l| (qcdr |x|)) t) + ((and (pairp x) + (progn (spadlet |d| (qcar x)) (spadlet |l| (qcdr x)) t) (|isDomainOrPackage| |d|)) (progn (spadlet |suffix| (cond ((|isDomain| |d|) "domain") (t "package"))) @@ -10025,11 +10913,11 @@ This reports the traced functions (cons (|devaluate| |d|) (cons '|%d| (cons ":" nil))))))) - (do ((t2 (|orderBySlotNumber| |l|) (cdr t2)) (|x| nil)) - ((or (atom t2) (progn (setq |x| (car t2)) nil)) nil) + (do ((t2 (|orderBySlotNumber| |l|) (cdr t2)) (x nil)) + ((or (atom t2) (progn (setq x (car t2)) nil)) nil) (seq (exit - (|reportSpadTrace| '| | (TAKE 4 |x|))))) + (|reportSpadTrace| '| | (TAKE 4 x))))) (terpri))))))))))))) @ @@ -11160,20 +12048,20 @@ whatSpad2Cmd l == \subsection{defun whatSpad2Cmd,fixpat} <>= -(defun |whatSpad2Cmd,fixpat| (|x|) +(defun |whatSpad2Cmd,fixpat| (x) (prog (|x'|) (return (seq - (if (and (pairp |x|) (progn (spadlet |x'| (qcar |x|)) t)) + (if (and (pairp x) (progn (spadlet |x'| (qcar x)) t)) (exit (downcase |x'|))) - (exit (downcase |x|)))))) + (exit (downcase x)))))) @ \subsection{defun whatSpad2Cmd} <>= (defun |whatSpad2Cmd| (arg) - (prog (|$e| |key0| key |args|) + (prog (|$e| |key0| key args) (declare (special |$e|)) (return (seq @@ -11183,22 +12071,22 @@ whatSpad2Cmd l == ((null arg) (|reportWhatOptions|)) (t (spadlet |key0| (car arg)) - (spadlet |args| (cdr arg)) + (spadlet args (cdr arg)) (spadlet key (|selectOptionLC| |key0| |$whatOptions| nil)) (cond ((null key) (|sayKeyedMsg| 's2iz0043 nil)) (t - (spadlet |args| + (spadlet args (prog (t0) (spadlet t0 nil) (return - (do ((t1 |args| (cdr t1)) (|p| nil)) + (do ((t1 args (cdr t1)) (p nil)) ((or (atom t1) - (progn (setq |p| (car t1)) nil)) + (progn (setq p (car t1)) nil)) (nreverse0 t0)) (seq (exit - (setq t0 (cons (|whatSpad2Cmd,fixpat| |p|) t0)))))))) + (setq t0 (cons (|whatSpad2Cmd,fixpat| p) t0)))))))) (seq (cond ((boot-equal key '|things|) @@ -11208,19 +12096,19 @@ whatSpad2Cmd l == (exit (cond ((null (memq opt '(|things|))) - (exit (|whatSpad2Cmd| (cons opt |args|))))))))) + (exit (|whatSpad2Cmd| (cons opt args))))))))) ((boot-equal key '|categories|) - (|filterAndFormatConstructors| '|category| "Categories" |args|)) - ((boot-equal key '|commands|) (|whatCommands| |args|)) + (|filterAndFormatConstructors| '|category| "Categories" args)) + ((boot-equal key '|commands|) (|whatCommands| args)) ((boot-equal key '|domains|) - (|filterAndFormatConstructors| '|domain| "Domains" |args|)) + (|filterAndFormatConstructors| '|domain| "Domains" args)) ((boot-equal key '|operations|) - (|apropos| |args|)) + (|apropos| args)) ((boot-equal key '|packages|) - (|filterAndFormatConstructors| '|package| "Packages" |args|)) + (|filterAndFormatConstructors| '|package| "Packages" args)) (t (cond ((boot-equal key '|synonyms|) - (|printSynonyms| |args|))))))))))))))) + (|printSynonyms| args))))))))))))))) @ @@ -11338,10 +12226,10 @@ apropos l == (prog (t0) (spadlet t0 nil) (return - (do ((t1 arg (cdr t1)) (|p| nil)) - ((or (atom t1) (progn (setq |p| (car t1)) nil)) + (do ((t1 arg (cdr t1)) (p nil)) + ((or (atom t1) (progn (setq p (car t1)) nil)) (nreverse0 t0)) - (seq (exit (setq t0 (cons (downcase (stringimage |p|)) t0))))))) + (seq (exit (setq t0 (cons (downcase (stringimage p)) t0))))))) (|allOperations|))))) (cond (|ops| @@ -11406,12 +12294,12 @@ workfilesSpad2Cmd args == for fl in $sourceFiles repeat sayBrightly [" " ,namestring fl] \end{verbatim} <>= -(defun |workfilesSpad2Cmd| (|args|) +(defun |workfilesSpad2Cmd| (args) (prog (|deleteFlag| type |flist| |type1| |fl|) (return (seq (cond - (|args| (|throwKeyedMsg| 's2iz0047 nil)) + (args (|throwKeyedMsg| 's2iz0047 nil)) (t (spadlet |deleteFlag| nil) (do ((t0 |$options| (cdr t0)) (t1 nil)) @@ -11546,7 +12434,7 @@ zsystemdevelopment1(l,im) == \end{verbatim} <>= (defun |zsystemdevelopment1| (arg |im|) - (prog (|$InteractiveMode| |fromopt| opt |optargs| |newopt| |opt1| + (prog (|$InteractiveMode| |fromopt| opt optargs |newopt| |opt1| |conStream| |upf| |fun|) (declare (special |$InteractiveMode|)) (return @@ -11560,7 +12448,7 @@ zsystemdevelopment1(l,im) == (progn (progn (spadlet opt (CAR t1)) - (spadlet |optargs| (CDR t1)) + (spadlet optargs (CDR t1)) t1) nil)) nil) @@ -11570,22 +12458,22 @@ zsystemdevelopment1(l,im) == (spadlet |opt1| (|selectOptionLC| opt '(|from|) nil)) (cond ((boot-equal |opt1| '|from|) - (spadlet |fromopt| (cons (cons 'from |optargs|) nil)))))))) + (spadlet |fromopt| (cons (cons 'from optargs) nil)))))))) (do ((t2 |$options| (cdr t2)) (t3 nil)) ((or (atom t2) (progn (setq t3 (car t2)) nil) (progn (progn (spadlet opt (car t3)) - (spadlet |optargs| (cdr t3)) + (spadlet optargs (cdr t3)) t3) nil)) nil) (seq (exit (progn - (cond ((null |optargs|) (spadlet |optargs| arg))) - (spadlet |newopt| (append |optargs| |fromopt|)) + (cond ((null optargs) (spadlet optargs arg))) + (spadlet |newopt| (append optargs |fromopt|)) (spadlet |opt1| (|selectOptionLC| opt '(|from|) nil)) (cond ((boot-equal |opt1| '|from|) @@ -11619,17 +12507,17 @@ zsystemdevelopment1(l,im) == (spadlet |$InteractiveMode| nil) (spadlet |upf| (cons - (or (kar |optargs|) /version) + (or (kar optargs) /version) (cons - (or (kadr |optargs|) /wsname) - (cons (or (kaddr |optargs|) '*) nil)))) + (or (kadr optargs) /wsname) + (cons (or (kaddr optargs) '*) nil)))) (spadlet |fun| (cond ((boot-equal opt '|patch|) '/update-lib-1) (t '/update-1))) (catch 'filenam (funcall |fun| |upf|)) (|sayMessage| " Update/patch is completed.")) - ((null |optargs|) + ((null optargs) (|sayBrightly| (cons " An argument is required for" @@ -11789,13 +12677,20 @@ load the file \verb|exposed.lsp| to set up the exposure group information. <> <> <> +<> <> +<> +<> +<> <> +<> +<> <> <> <> <> <> +<> <> <> @@ -11908,6 +12803,8 @@ load the file \verb|exposed.lsp| to set up the exposure group information. <> <> +<> + <> <> <> @@ -11961,6 +12858,7 @@ load the file \verb|exposed.lsp| to set up the exposure group information. <> <> <> +<> <> <> @@ -12000,6 +12898,7 @@ load the file \verb|exposed.lsp| to set up the exposure group information. <> <> <> +<> <> <> <> diff --git a/changelog b/changelog index 13496a6..244900f 100644 --- a/changelog +++ b/changelog @@ -1,4 +1,8 @@ -20090408 tpd src/axiom-website/patches.html 20090308.02.tpd.patch +20090308 tpd src/axiom-website/patches.html 20090308.03.tpd.patch +20090308 tpd src/input/unittest1.input unit test commands +20090308 tpd src/interp/i-syscmd.boot move commands to bookvol5 +20090308 tpd books/bookvol5 move summary, copyright, help roots +20090308 tpd src/axiom-website/patches.html 20090308.02.tpd.patch 20090308 tpd src/interp/i-syscmd.boot move clear to bookvol5 20090308 tpd books/bookvol5 add )clear root 20090308 tpd src/axiom-website/patches.html 20090308.01.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 1d7f8eb..80e328c 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -995,5 +995,7 @@ bookvol5 add trace root
bookvol5 add include, abbreviation roots
20090308.02.tpd.patch bookvol5 add clear root
+20090308.03.tpd.patch +bookvol5 add summary, copyright, help roots
diff --git a/src/input/unittest1.input.pamphlet b/src/input/unittest1.input.pamphlet index c5c9bd3..ac70ef0 100644 --- a/src/input/unittest1.input.pamphlet +++ b/src/input/unittest1.input.pamphlet @@ -21,7 +21,7 @@ Unit test the user level commands The )with command is the same as the )library command and really should be a synonym. <<*>>= ---S 1 +--S 1 0f 28 )with API --R )library cannot find the file API. --E 1 @@ -30,7 +30,7 @@ should be a synonym. The )apropos command is the same as a )what command <<*>>= ---S 2 +--S 2 0f 28 )apropos matrix --R --R @@ -103,7 +103,7 @@ The )apropos command is the same as a )what command --R --E 2 ---S 3 +--S 3 0f 28 )what categories set --R --R------------------------------- Categories -------------------------------- @@ -122,7 +122,7 @@ The )apropos command is the same as a )what command --R TSETCAT TriangularSetCategory --E 3 ---S 4 +--S 4 0f 28 )what commands set --R --R--------------- System Commands for User Level: development --------------- @@ -134,7 +134,7 @@ The )apropos command is the same as a )what command --R --E 4 ---S 5 +--S 5 0f 28 )what domains set --R --R--------------------------------- Domains --------------------------------- @@ -157,7 +157,7 @@ The )apropos command is the same as a )what command --R WUTSET WuWenTsunTriangularSet --E 5 ---S 6 +--S 6 0f 28 )what operations set --R --R @@ -262,7 +262,7 @@ The )apropos command is the same as a )what command --R setAttributeButtonStep --E 6 ---S 7 +--S 7 0f 28 )what packages set --R --R-------------------------------- Packages --------------------------------- @@ -279,7 +279,7 @@ The )apropos command is the same as a )what command --R SRDCMPK SquareFreeRegularSetDecompositionPackage --E 7 ---S 8 +--S 8 0f 28 )what synonym set --R --R------------------------- System Command Synonyms ------------------------- @@ -289,7 +289,7 @@ The )apropos command is the same as a )what command --R --E 8 ---S 9 +--S 9 0f 28 )what things set --R --R @@ -450,7 +450,7 @@ The )apropos command is the same as a )what command --R --E 9 ---S 10 +--S 10 0f 28 )apropos set --R --ROperations whose names satisfy the above pattern(s): @@ -609,7 +609,7 @@ The )apropos command is the same as a )what command --R --E 10 ---S 11 +--S 11 0f 28 )prompt --R---------------------------- The prompt Option ---------------------------- --R @@ -627,13 +627,13 @@ The )apropos command is the same as a )what command --R --E 11 ---S 12 +--S 12 0f 28 )version --R --IValue = "Saturday February 21, 2009 at 17:59:27 " --E 12 ---S 13 +--S 13 0f 28 )zsys )from )c --R --R @@ -644,7 +644,7 @@ The )apropos command is the same as a )what command --R --E 13 ---S 14 +--S 14 0f 28 )zsys )from )d --R --R @@ -655,7 +655,7 @@ The )apropos command is the same as a )what command --R --E 14 ---S 15 +--S 15 0f 28 )zsys )from )dt --R --R @@ -666,7 +666,7 @@ The )apropos command is the same as a )what command --R --E 15 ---S 16 +--S 16 0f 28 )zsys )from )ct --R --R @@ -677,7 +677,7 @@ The )apropos command is the same as a )what command --R --E 16 ---S 17 +--S 17 0f 28 )zsys )from )ctl --R --R @@ -688,7 +688,7 @@ The )apropos command is the same as a )what command --R --E 17 ---S 18 +--S 18 0f 28 )zsys )from )ec --R --R @@ -699,7 +699,7 @@ The )apropos command is the same as a )what command --R --E 18 ---S 19 +--S 19 0f 28 )zsys )from )ect --R --R @@ -710,7 +710,7 @@ The )apropos command is the same as a )what command --R --E 19 ---S 20 +--S 20 0f 28 )zsys )from )e --R --R @@ -721,12 +721,12 @@ The )apropos command is the same as a )what command --R --E 20 ---S 21 +--S 21 0f 28 )zsys )from )version --R --E 21 ---S 22 +--S 22 0f 28 )zsys )from )update --R --R @@ -737,7 +737,7 @@ The )apropos command is the same as a )what command --R --E 22 ---S 23 +--S 23 0f 28 )zsys )from )patch --R --R @@ -748,7 +748,7 @@ The )apropos command is the same as a )what command --R --E 23 ---S 24 +--S 24 0f 28 )zsys )from )there 1 --R --R @@ -757,18 +757,134 @@ The )apropos command is the same as a )what command --R --E 24 ---S 25 +--S 25 0f 28 )zsys )from )compare --R --R An argument is required for compare --E 25 ---S 26 +--S 26 0f 28 )zsys )from )record --R --R An argument is required for record --E 26 +--S 27 0f 28 +)summary + )credits : list the people who have contributed to Axiom + + )help gives more information + )quit : exit AXIOM + + )abbreviation : query, set and remove abbreviations for constructors + )cd : set working directory + )clear : remove declarations, definitions or values + )close : throw away an interpreter client and workspace + )compile : invoke constructor compiler + )display : display Library operations and objects in your workspace + )edit : edit a file + )frame : manage interpreter workspaces + )history : manage aspects of interactive session + )library : introduce new constructors + )lisp : evaluate a LISP expression + )read : execute AXIOM commands from a file + )savesystem : save LISP image to a file + )set : view and set system variables + )show : show constructor information + )spool : log input and output to a file + )synonym : define an abbreviation for system commands + )system : issue shell commands + )trace : trace execution of functions + )undo : restore workspace to earlier state + )what : search for various things by name + +--E 27 + +--S 28 0f 28 +)credits +An alphabetical listing of contributors to AXIOM: +Cyril Alberga Roy Adler Christian Aistleitner +Richard Anderson George Andrews S.J. Atkins +Henry Baker Stephen Balzac Yurij Baransky +David R. Barton Gerald Baumgartner Gilbert Baumslag +Jay Belanger David Bindel Fred Blair +Vladimir Bondarenko Mark Botch +Alexandre Bouyer Peter A. Broadbery Martin Brock +Manuel Bronstein Stephen Buchwald Florian Bundschuh +Luanne Burns William Burge +Quentin Carpent Robert Caviness Bruce Char +Ondrej Certik Cheekai Chin David V. Chudnovsky +Gregory V. Chudnovsky Josh Cohen Christophe Conil +Don Coppersmith George Corliss Robert Corless +Gary Cornell Meino Cramer Claire Di Crescenzo +David Cyganski +Timothy Daly Sr. Timothy Daly Jr. James H. Davenport +Didier Deshommes Michael Dewar +Jean Della Dora Gabriel Dos Reis Claire DiCrescendo +Sam Dooley Lionel Ducos Martin Dunstan +Brian Dupee Dominique Duval +Robert Edwards Heow Eide-Goodman Lars Erickson +Richard Fateman Bertfried Fauser Stuart Feldman +Brian Ford Albrecht Fortenbacher George Frances +Constantine Frangos Timothy Freeman Korrinn Fu +Marc Gaetano Rudiger Gebauer Kathy Gerber +Patricia Gianni Samantha Goldrich Holger Gollan +Teresa Gomez-Diaz Laureano Gonzalez-Vega Stephen Gortler +Johannes Grabmeier Matt Grayson Klaus Ebbe Grue +James Griesmer Vladimir Grinberg Oswald Gschnitzer +Jocelyn Guidry +Steve Hague Satoshi Hamaguchi Mike Hansen +Richard Harke Vilya Harvey Martin Hassner +Arthur S. Hathaway Dan Hatton Waldek Hebisch +Karl Hegbloom Ralf Hemmecke Henderson +Antoine Hersen Gernot Hueber +Pietro Iglio +Alejandro Jakubi Richard Jenks +Kai Kaminski Grant Keady Tony Kennedy +Paul Kosinski Klaus Kusche Bernhard Kutzler +Tim Lahey Larry Lambe Franz Lehner +Frederic Lehobey Michel Levaud Howard Levy +Liu Xiaojun Rudiger Loos Michael Lucks +Richard Luczak +Camm Maguire Francois Maltey Alasdair McAndrew +Bob McElrath Michael McGettrick Ian Meikle +David Mentre Victor S. Miller Gerard Milmeister +Mohammed Mobarak H. Michael Moeller Michael Monagan +Marc Moreno-Maza Scott Morrison Joel Moses +Mark Murray +William Naylor C. Andrew Neff John Nelder +Godfrey Nolan Arthur Norman Jinzhong Niu +Michael O'Connor Summat Oemrawsingh Kostas Oikonomou +Humberto Ortiz-Zuazaga +Julian A. Padget Bill Page Susan Pelzel +Michel Petitot Didier Pinchon Ayal Pinkus +Jose Alfredo Portes +Claude Quitte +Arthur C. Ralfs Norman Ramsey Anatoly Raportirenko +Michael Richardson Renaud Rioboo Jean Rivlin +Nicolas Robidoux Simon Robinson Raymond Rogers +Michael Rothstein Martin Rubey +Philip Santas Alfred Scheerhorn William Schelter +Gerhard Schneider Martin Schoenert Marshall Schor +Frithjof Schulze Fritz Schwarz Nick Simicich +William Sit Elena Smirnova Jonathan Steinbach +Fabio Stumbo Christine Sundaresan Robert Sutor +Moss E. Sweedler Eugene Surowitz +Max Tegmark James Thatcher Balbir Thomas +Mike Thomas Dylan Thurston Barry Trager +Themos T. Tsikas +Gregory Vanuxem +Bernhard Wall Stephen Watt Jaap Weel +Juergen Weiss M. Weller Mark Wegman +James Wen Thorsten Werther Michael Wester +John M. Wiley Berhard Will Clifton J. Williamson +Stephen Wilson Shmuel Winograd Robert Wisbauer +Sandra Wityak Waldemar Wiwianka Knut Wolf +Clifford Yapp David Yun +Vadim Zhytnikov Richard Zippel Evelyn Zoernack +Bruno Zuercher Dan Zwillinger +--E 28 + )spool )lisp (bye) diff --git a/src/interp/i-syscmd.boot.pamphlet b/src/interp/i-syscmd.boot.pamphlet index 771c0ae..4597564 100644 --- a/src/interp/i-syscmd.boot.pamphlet +++ b/src/interp/i-syscmd.boot.pamphlet @@ -270,408 +270,6 @@ getSystemCommandLine() == ------------ start of commands ------------------------------------------ ---% )close - -queryClients () == - -- Returns the number of active scratchpad clients - sockSendInt($SessionManager, $QueryClients) - sockGetInt $SessionManager - - -close args == - $saturn => - sayErrorly('"Obsolete system command", _ - ['" The )close system command is obsolete in this version of AXIOM.", - '" Please use Close from the File menu instead."]) - quiet:local:= false - null $SpadServer => - throwKeyedMsg('"S2IZ0071", []) - numClients := queryClients() - numClients > 1 => - sockSendInt($SessionManager, $CloseClient) - sockSendInt($SessionManager, $currentFrameNum) - closeInterpreterFrame(NIL) - for [opt,:.] in $options repeat - fullopt := selectOptionLC(opt, '(quiet), 'optionError) - fullopt = 'quiet => - quiet:=true - quiet => - sockSendInt($SessionManager, $CloseClient) - sockSendInt($SessionManager, $currentFrameNum) - closeInterpreterFrame(NIL) - x := UPCASE queryUserKeyedMsg('"S2IZ0072", nil) - MEMQ(STRING2ID_-N(x,1), '(YES Y)) => - BYE() - nil - ---% )constructor - -constructor args == - sayMessage '" Not implemented yet." - NIL - ---% )compiler - -compiler args == - $newConlist: local := nil --reset by compDefineLisplib and astran - null args and null $options and null _/EDITFILE => helpSpad2Cmd '(compiler) - if null args then args := [_/EDITFILE] - - -- first see if the user has explicitly specified the compiler - -- to use. - - optlist := '(new old translate constructor) - haveNew := nil - haveOld := nil - for opt in $options while ^(haveNew and haveOld) repeat - [optname,:optargs] := opt - fullopt := selectOptionLC(optname,optlist,nil) - fullopt = 'new => haveNew := true - fullopt = 'translate => haveOld := true - fullopt = 'constructor => haveOld := true - fullopt = 'old => haveOld := true - - haveNew and haveOld => throwKeyedMsg("S2IZ0081", nil) - - af := pathname args - aft := pathnameType af --- Whats this for? MCD/PAB 21-9-95 --- if haveNew and (null(aft) or (aft = '"")) then --- af := pathname [af, '"as"] --- aft = '"as" --- if haveOld and (null(aft) or (aft = '"")) then --- af := pathname [af, '"spad"] --- aft = '"spad" - - haveNew or (aft = '"as") => - not (af1 := $FINDFILE (af, '(as))) => - throwKeyedMsg("S2IL0003",[NAMESTRING af]) - compileAsharpCmd [af1] - haveOld or (aft = '"spad") => - not (af1 := $FINDFILE (af, '(spad))) => - throwKeyedMsg("S2IL0003",[NAMESTRING af]) - compileSpad2Cmd [af1] - aft = '"lsp" => - not (af1 := $FINDFILE (af, '(lsp))) => - throwKeyedMsg("S2IL0003",[NAMESTRING af]) - compileAsharpLispCmd [af1] - aft = '"nrlib" => - not (af1 := $FINDFILE (af, '(nrlib))) => - throwKeyedMsg("S2IL0003",[NAMESTRING af]) - compileSpadLispCmd [af1] - aft = '"ao" => - not (af1 := $FINDFILE (af, '(ao))) => - throwKeyedMsg("S2IL0003",[NAMESTRING af]) - compileAsharpCmd [af1] - aft = '"al" => -- archive library of .ao files - not (af1 := $FINDFILE (af, '(al))) => - throwKeyedMsg("S2IL0003",[NAMESTRING af]) - compileAsharpArchiveCmd [af1] - - -- see if we something with the appropriate file extension - -- lying around - - af1 := $FINDFILE (af, '(as spad ao asy)) - - af1 and pathnameType(af1) = '"as" => compileAsharpCmd [af1] - af1 and pathnameType(af1) = '"ao" => compileAsharpCmd [af1] - af1 and pathnameType(af1) = '"spad" => compileSpad2Cmd [af1] - af1 and pathnameType(af1) = '"asy" => compileAsharpArchiveCmd [af1] - - -- maybe /EDITFILE has some stuff that can help us - ef := pathname _/EDITFILE - ef := mergePathnames(af,ef) - - ef = af => throwKeyedMsg("S2IZ0039", nil) - af := ef - - pathnameType(af) = '"as" => compileAsharpCmd args - pathnameType(af) = '"ao" => compileAsharpCmd args - pathnameType(af) = '"spad" => compileSpad2Cmd args - - -- see if we something with the appropriate file extension - -- lying around - af1 := $FINDFILE (af, '(as spad ao asy)) - - af1 and pathnameType(af1) = '"as" => compileAsharpCmd [af1] - af1 and pathnameType(af1) = '"ao" => compileAsharpCmd [af1] - af1 and pathnameType(af1) = '"spad" => compileSpad2Cmd [af1] - af1 and pathnameType(af1) = '"asy" => compileAsharpArchiveCmd [af1] - - throwKeyedMsg("S2IZ0039", nil) - -compileAsharpCmd args == - compileAsharpCmd1 args - terminateSystemCommand() - spadPrompt() - -compileAsharpCmd1 args == - -- Assume we entered from the "compiler" function, so args ^= nil - -- and is a file with file extension .as or .ao - - path := pathname args - pathType := pathnameType path - (pathType ^= '"as") and (pathType ^= '"ao") => throwKeyedMsg("S2IZ0083", nil) - ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args]) - - SETQ(_/EDITFILE, path) - updateSourceFiles path - - optList := '( _ - new _ - old _ - translate _ - onlyargs _ - moreargs _ - quiet _ - nolispcompile _ - noquiet _ - library _ - nolibrary _ - ) - - beQuiet := false -- be verbose here - doLibrary := true -- so a )library after compilation - doCompileLisp := true -- do compile generated lisp code - - moreArgs := NIL - onlyArgs := NIL - - for opt in $options repeat - [optname,:optargs] := opt - fullopt := selectOptionLC(optname,optList,nil) - - fullopt = 'new => nil - fullopt = 'old => error "Internal error: compileAsharpCmd got )old" - fullopt = 'translate => error "Internal error: compileAsharpCmd got )translate" - - fullopt = 'quiet => beQuiet := true - fullopt = 'noquiet => beQuiet := false - - fullopt = 'nolispcompile => doCompileLisp := false - - fullopt = 'moreargs => moreArgs := optargs - fullopt = 'onlyargs => onlyArgs := optargs - - fullopt = 'library => doLibrary := true - fullopt = 'nolibrary => doLibrary := false - - throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)]) - - tempArgs := - pathType = '"ao" => - -- want to strip out -Fao - (p := STRPOS('"-Fao", $asharpCmdlineFlags, 0, NIL)) => - p = 0 => SUBSTRING($asharpCmdlineFlags, 5, NIL) - STRCONC(SUBSTRING($asharpCmdlineFlags, 0, p), '" ", - SUBSTRING($asharpCmdlineFlags, p+5, NIL)) - $asharpCmdlineFlags - $asharpCmdlineFlags - - asharpArgs := - onlyArgs => - s := "" - for a in onlyArgs repeat - s := STRCONC(s, '" ", object2String a) - s - moreArgs => - s := tempArgs - for a in moreArgs repeat - s := STRCONC(s, '" ", object2String a) - s - tempArgs - - if ^beQuiet then sayKeyedMsg("S2IZ0038A",[namestring args, asharpArgs]) - - command := -<> - rc := OBEY command - - if (rc = 0) and doCompileLisp then - lsp := fnameMake('".", pathnameName args, '"lsp") - if fnameReadable?(lsp) then - if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp]) - compileFileQuietly(lsp) - else - sayKeyedMsg("S2IL0003", [namestring lsp]) - - if rc = 0 and doLibrary then - -- do we need to worry about where the compilation output went? - if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ]) - withAsharpCmd [ pathnameName path ] - else if ^beQuiet then - sayKeyedMsg("S2IZ0084", nil) - - extendLocalLibdb $newConlist - -compileAsharpArchiveCmd args == - -- Assume we entered from the "compiler" function, so args ^= nil - -- and is a file with file extension .al. We also assume that - -- the name is fully qualified. - - path := pathname args - ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args]) - - -- here is the plan: - -- 1. extract the file name and try to make a directory based - -- on that name. - -- 2. cd to that directory and ar x the .al file - -- 3. for each .ao file that shows up, compile it - -- 4. delete the generated .ao files - - -- First try to make the directory in the current directory - - dir := fnameMake('".", pathnameName path, '"axldir") - exists := PROBE_-FILE dir - isDir := directoryp namestring dir - exists and isDir ^= 1=> - throwKeyedMsg("S2IL0027",[namestring dir, namestring args]) - - if isDir ^= 1 then - cmd := STRCONC('"mkdir ", namestring dir) - rc := OBEY cmd - rc ^= 0 => throwKeyedMsg("S2IL0027",[namestring dir, namestring args]) - - curDir := $CURRENT_-DIRECTORY - - -- cd to that directory and try to unarchive the .al file - - cd [ object2Identifier namestring dir ] - - cmd := STRCONC( '"ar x ", namestring path ) - rc := OBEY cmd - rc ^= 0 => - cd [ object2Identifier namestring curDir ] - throwKeyedMsg("S2IL0028",[namestring dir, namestring args]) - - -- Look for .ao files - - asos := DIRECTORY '"*.ao" - null asos => - cd [ object2Identifier namestring curDir ] - throwKeyedMsg("S2IL0029",[namestring dir, namestring args]) - - -- Compile the .ao files - - for aso in asos repeat - compileAsharpCmd1 [ namestring aso ] - - -- Reset the current directory - - cd [ object2Identifier namestring curDir ] - - terminateSystemCommand() - spadPrompt() - -compileAsharpLispCmd args == - -- Assume we entered from the "compiler" function, so args ^= nil - -- and is a file with file extension .lsp - - path := pathname args - ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args]) - - optList := '( _ - quiet _ - noquiet _ - library _ - nolibrary _ - ) - - beQuiet := false -- be verbose here - doLibrary := true -- so a )library after compilation - - for opt in $options repeat - [optname,:optargs] := opt - fullopt := selectOptionLC(optname,optList,nil) - - fullopt = 'quiet => beQuiet := true - fullopt = 'noquiet => beQuiet := false - - fullopt = 'library => doLibrary := true - fullopt = 'nolibrary => doLibrary := false - - throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)]) - - lsp := fnameMake(pathnameDirectory path, pathnameName path, pathnameType path) - if fnameReadable?(lsp) then - if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp]) - compileFileQuietly(lsp) - else - sayKeyedMsg("S2IL0003", [namestring lsp]) - - if doLibrary then - -- do we need to worry about where the compilation output went? - if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ]) - withAsharpCmd [ pathnameName path ] - else if ^beQuiet then - sayKeyedMsg("S2IZ0084", nil) - terminateSystemCommand() - spadPrompt() - -compileSpadLispCmd args == - -- Assume we entered from the "compiler" function, so args ^= nil - -- and is a file with file extension .nrlib - - path := pathname fnameMake(first args, '"code", '"lsp") - ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args]) - - optList := '( _ - quiet _ - noquiet _ - library _ - nolibrary _ - ) - - beQuiet := false -- be verbose here - doLibrary := true -- so a )library after compilation - - for opt in $options repeat - [optname,:optargs] := opt - fullopt := selectOptionLC(optname,optList,nil) - - fullopt = 'quiet => beQuiet := true - fullopt = 'noquiet => beQuiet := false - - fullopt = 'library => doLibrary := true - fullopt = 'nolibrary => doLibrary := false - - throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)]) - - lsp := fnameMake(pathnameDirectory path, pathnameName path, pathnameType path) - if fnameReadable?(lsp) then - if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp]) - --compileFileQuietly(lsp) - RECOMPILE_-LIB_-FILE_-IF_-NECESSARY lsp - else - sayKeyedMsg("S2IL0003", [namestring lsp]) - - if doLibrary then - -- do we need to worry about where the compilation output went? - if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ]) - LOCALDATABASE([ pathnameName first args ],[]) - else if ^beQuiet then - sayKeyedMsg("S2IZ0084", nil) - terminateSystemCommand() - spadPrompt() - -withAsharpCmd args == - $options: local := nil - LOCALDATABASE(args, $options) - ---% )copyright -- display copyright notice - -summary l == - OBEY STRCONC ('"cat ",getEnv('"AXIOM"),'"/lib/summary") -copyright () == - OBEY STRCONC ('"cat ",getEnv('"AXIOM"),'"/lib/copyright") - ---% )credits -- display credit list - -credits() == - for i in CREDITS repeat - PRINC(i) - TERPRI() - --% )display getParserMacroNames() == @@ -886,48 +484,6 @@ editSpad2Cmd l == updateSourceFiles l rc ---% )help - -help l == helpSpad2Cmd l - -helpSpad2Cmd args == - -- try to use new stuff first - if newHelpSpad2Cmd(args) then return nil - - sayKeyedMsg("S2IZ0025",[args]) - nil - -newHelpSpad2Cmd args == - if null args then args := ["?"] - # args > 1 => - sayKeyedMsg("S2IZ0026",NIL) - true - sarg := PNAME first args - if sarg = '"?" then args := ['help] - else if sarg = '"%" then args := ['history] - else if sarg = '"%%" then args := ['history] - arg := selectOptionLC(first args,$SYSCOMMANDS,nil) - if null arg then arg := first args - if arg = 'compiler then arg := 'compile - - -- see if new help file exists - - narg := PNAME arg - null (helpFile := MAKE_-INPUT_-FILENAME [narg,'HELPSPAD,'_*]) => NIL - - $useFullScreenHelp => - OBEY STRCONC('"$AXIOM/lib/SPADEDIT ",namestring helpFile) - true - - filestream := MAKE_-INSTREAM(helpFile) - repeat - line := read_-line(filestream,false) - NULL line => - SHUT filestream - return true - SAY line - true - --% )load load args == loadSpad2Cmd args