Artifact 547e6f26e0f13c61e4c3e1f7bf360448f2239a3778cfb6156adc6c3d0222d269:

• File psl-1983/nmode/extended-input.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: 3377) [annotate] [blame] [check-ins using] [more...]

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Extended-Input.SL - 9-bit terminal input (for 7 or 8 bit terminals)
% 
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        31 August 1982
% Revised:     17 February 1983
%
% 17-Feb-83 Alan Snyder
%  Added PUSH-BACK-INPUT-CHARACTER function.  Revise mapping so that
%  bit prefix characters are recognized after mapping.
% 22-Dec-82 Jeffrey Soreff
%  Added PUSH-BACK-EXTENDED-CHARACTER function.
%  
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(CompileTime (load extended-char fast-int fast-vectors))

% Global variables:

(fluid '(nmode-meta-bit-prefix-character
	 nmode-control-bit-prefix-character
	 nmode-control-meta-bit-prefix-character))

(setf nmode-meta-bit-prefix-character (x-char C-!\))
(setf nmode-control-bit-prefix-character (x-char C-^))
(setf nmode-control-meta-bit-prefix-character (x-char C-Z))

% Internal static variables:

(fluid '(nmode-terminal-map nmode-lookahead-extended-char nmode-lookahead-char))
(setf nmode-lookahead-extended-char nil)
(setf nmode-lookahead-char nil)

(de nmode-initialize-extended-input ()
  (setf nmode-terminal-map (MkVect 255))

  % Most input characters map to themselves.
  (for (from i 0 255)
       (do (vector-store nmode-terminal-map i i)))

  % Some ASCII control character map to Extended Control characters.
  % Exceptions: BACKSPACE, TAB, RETURN, LINEFEED, ESCAPE
  (for (from i 0 31)
       (unless (member i '#.(list (char BS) (char tab)
					 (char CR) (char LF) (char ESC))))
       (do (let ((mch (X-Set-Control (+ i 64))))
	     (vector-store nmode-terminal-map i mch)
	     (vector-store nmode-terminal-map (+ i 128) (+ mch 128))
	     )))
  )

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de input-extended-character ()
  (if nmode-lookahead-extended-char
    (prog1 nmode-lookahead-extended-char
	   (setf nmode-lookahead-extended-char nil))
    (input-direct-extended-character)))

(de push-back-extended-character (ch)
  (setf nmode-lookahead-extended-char ch))

(de input-direct-extended-character ()
  % Read an extended character from the terminal.
  % Recognize and interpret bit-prefix characters.

  (let* ((ch (input-terminal-character)))
    (cond
      ((= ch nmode-meta-bit-prefix-character)
	(nmode-append-separated-prompt "M-")
	(setf ch (input-terminal-character))
	(nmode-complete-prompt (x-char-name (x-unmeta ch)))
	(x-set-meta ch)
	)
      ((= ch nmode-control-bit-prefix-character)
	(nmode-append-separated-prompt "C-")
	(setf ch (input-terminal-character))
	(nmode-complete-prompt (x-char-name (x-uncontrol ch)))
	(x-set-control ch)
	)
      ((= ch nmode-control-meta-bit-prefix-character)
	(nmode-append-separated-prompt "C-M-")
	(setf ch (input-terminal-character))
	(nmode-complete-prompt (x-char-name (x-base ch)))
	(x-set-meta (x-set-control ch))
	)
      (t ch)
      )))

(de push-back-input-character (ch)
  (setf nmode-lookahead-char ch)
  )

(de input-terminal-character ()
  % Read an extended character from the terminal.  Perform mapping from 8-bit
  % to 9-bit characters.  Do not interpret bit prefix characters.

  (if nmode-lookahead-char
    (prog1 nmode-lookahead-char (setf nmode-lookahead-char nil))
    (vector-fetch nmode-terminal-map (input-direct-terminal-character))
    ))