Artifact 514e6a3cc7c280cc24e5e0835d6e7551a0f4b37da564405d1a6ae0dfc7259bdb:
- File
psl-1983/emode/misc-emode.sl
— part of check-in
[eb17ceb7f6]
at
2020-04-21 19:40:01
on branch master
— Add Reduce 3.0 to the historical section of the archive, and some more
files relating to version sof PSL from the early 1980s. Thanks are due to
Paul McJones and Nelson Beebe for these, as well as to all the original
authors.git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 1662) [annotate] [blame] [check-ins using] [more...]
% % MISC-EMODE.SL - Miscellaneous EMODE routines % % Author: William F. Galway % Symbolic Computation Group % Computer Science Dept. % University of Utah % Date: 29 July 1982 % Copyright (c) 1982 University of Utah % % Get a "command" (lisp expression) and "execute" (evaluate) it. % This routine is meant to be bound to the M-X key. (de execute_command () (let ((old-channels (save-important-channels))) (SelectEmodeChannels) % Do we need some sort of ErrorSet here? (eval (read_from_string (prompt_for_string "M-X " NIL))) (restore-important-channels old-channels))) % Insert the next character "typed". (de InsertNextCharacter () (InsertCharacter (GetNextCommandCharacter))) % Display a list of all the buffers known to EMODE. % This needs to be redone to fit better with current window/virtual screen % package. (de PrintBufferNames () (let ((old-channels (save-important-channels))) % Make sure that output goes to "EMODE output" channel. (SelectEmodeChannels) (for (in buffer-name BufferNames) (do % car gives name of (name . environment) pair. (prin2t (car buffer-name)))) (restore-important-channels old-channels))) % Return a list of the current "important" channel bindings. (de save-important-channels () (list STDIN* STDOUT* ErrOut*)) % "Restore" the channels saved by save-important-channels. (de restore-important-channels (saved-channels) (progn (setf STDIN* (car saved-channels)) (setf STDOUT* (cadr saved-channels)) (setf ErrOut* (caddr saved-channels)) (RDS STDIN*) (WRS STDOUT*)))