Artifact e6e3c190e5270843687be61b873a4506dce2b33c6cb28d643dbf307ca896e288:

• File psl-1983/3-1/nmode/prompting.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: 9333) [annotate] [blame] [check-ins using] [more...]

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Prompting.SL - NMODE Prompt Line Manager
% 
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        19 August 1982
% Revised:     28 February 1983
%
% Adapted from Will Galway's EMODE.
%
% 28-Feb-83 Alan Snyder
%   Extend write-prompt to work properly when NMODE is not running.
% 16-Feb-83 Alan Snyder
%   Declare -> Declare-Flavor.
% 7-Feb-83 Alan Snyder
%   Use one-window or one-screen refresh.
% 29-Dec-82 Alan Snyder
%   Revised input completion support to run completion characters as commands
%   rather than terminating and resuming.  Added new functions to manipulate the
%   input buffer.
% 22-Dec-82 Jeffrey Soreff
%   Revised to handle control characters on prompt and message lines.
% 21-Dec-82 Alan Snyder
%   Efficiency improvement: Added declarations for virtual screens and buffer
%   windows.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(CompileTime (load objects extended-char fast-strings numeric-operators))
(on fast-integers)

% External variables used:

(fluid
 '(nmode-prompt-screen
   nmode-message-screen
   nmode-input-window
   nmode-current-window
   *NMODE-RUNNING
   ))

% Global variables defined here:

(fluid
 '(nmode-input-default
   ))

% Internal static variables:

(fluid
 '(nmode-prompt-cursor
   nmode-message-cursor
   nmode-message-string
   nmode-input-level
   nmode-input-special-command-list
   ))

(setf nmode-prompt-cursor 0)
(setf nmode-message-cursor 0)
(setf nmode-message-string "")
(setf nmode-input-level 0)
(setf nmode-input-default NIL)

(declare-flavor virtual-screen nmode-prompt-screen nmode-message-screen)
(declare-flavor buffer-window nmode-input-window nmode-current-window)
(declare-flavor text-buffer input-buffer)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% String input:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de prompt-for-string (prompt-string default-string)

  % Prompt for a string (terminated by CR or NL).  Use default-string if an
  % empty string is returned (and default-string is non-NIL).  The original
  % message line is restored, but not refreshed.  Note: if you attempt to use
  % this function recursively, it will automatically throw '$ERROR$.  The effect
  % of this action is that in string-input mode, commands that request string
  % input appear to be undefined.  (This assumes that all such commands do
  % nothing visible before they first request string input.)

  (prompt-for-string-special prompt-string default-string NIL))

(de prompt-for-string-special (prompt-string default-string command-list)

  % This function is similar to PROMPT-FOR-STRING, except that it accepts a
  % command list that specifies a set of additional commands to be defined
  % while the user is typing at the input window.

  (if (> nmode-input-level 0)
    (throw '$error$ NIL)
    % else
    (setf nmode-input-special-command-list command-list)
    (setf nmode-input-default default-string)
    (let ((old-msg nmode-message-string)
	  (old-window nmode-current-window)
	  (nmode-input-level (+ nmode-input-level 1)) % FLUID
	  )
      (if default-string
	(setf prompt-string
	  (string-concat prompt-string " (Default is: '" default-string "')")))

      (=> (=> nmode-input-window buffer) reset)
      (nmode-select-window nmode-input-window)
      (set-message prompt-string)
      (set-prompt "") % avoid old prompt popping back up when we're done

      % Edit the buffer until an "exit" character is typed or the user aborts.

      (cond ((eq (NMODE-reader T) 'abort)
	     (=> nmode-input-window deexpose)
	     (nmode-select-window old-window)
	     (set-message old-msg)
	     (throw 'abort NIL)
	     ))

      % Show the user that his input has been accepted.
      (move-to-start-of-line)
      (nmode-refresh-one-window nmode-input-window)

      % Pick up the string that was typed. 
      (let ((return-string (current-line)))

	% Switch back to old window, etc.
	(=> nmode-input-window deexpose)
	(nmode-select-window old-window)

	% Restore original "message window".
	(set-message old-msg)

	% If an empty string, use default (unless it's NIL).
	(if (and default-string (equal return-string ""))
	  default-string
	  return-string
	  )))))

(de nmode-substitute-default-input ()
  % If the input buffer is empty and there is a default string, then stuff the
  % default string into the input buffer.

  (let ((input-buffer (=> nmode-input-window buffer)))
    (if (and (=> input-buffer at-buffer-start?)
	     (=> input-buffer at-buffer-end?)
	     nmode-input-default
	     (stringp nmode-input-default)
	     )
      (=> input-buffer insert-string nmode-input-default)
      )))

(de nmode-get-input-string ()
  % Return the contents of the input buffer as a string.  If the buffer contains
  % more than one line, only the current line is returned.

  (let ((input-buffer (=> nmode-input-window buffer)))
    (=> input-buffer current-line)
    ))

(de nmode-replace-input-string (s)
  % Replace the contents of the input buffer with the specified string.
  (let ((input-buffer (=> nmode-input-window buffer)))
    (=> input-buffer reset)
    (=> input-buffer insert-string s)
    ))

(de nmode-terminate-input ()
  % A command bound to this function will act to terminate string input.
  (exit-nmode-reader)
  )

(de nmode-yank-default-input ()
  % A command bound to this function will act to insert the default string into
  % the input buffer.
  (if nmode-input-default
    (insert-string nmode-input-default)
    (Ding)
    ))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Prompt line functions:
%
% NOTE: if your intent is to display a prompt string for user input, you should
% use a function defined in TERMINAL-INPUT rather than one of these.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de write-prompt (msg)
  % Write the specified string to the prompt line and refresh the prompt
  % line.  Note: the major windows are not refreshed.

  (cond
   (*NMODE-RUNNING
    (set-prompt msg)
    (nmode-refresh-virtual-screen nmode-prompt-screen)
    )
   (t
    (printf "%w%n" msg)
    )))

(de set-prompt (msg)
  % Write the specified string to the prompt window, but do not refresh.
  (setf nmode-prompt-cursor 0)
  (=> nmode-prompt-screen clear)
  (prompt-append-string msg)
  )

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Message line functions:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de write-message (msg)
  % Display a string to the message window and refresh the message window.
  % Note: the major windows are not refreshed.
  % Return the previous message string.

  (prog1
   (set-message msg)
   (nmode-refresh-virtual-screen nmode-message-screen)
   ))

(de rewrite-message ()
  % Rewrite the existing message (used when the default enhancement changes).
  (set-message nmode-message-string)
  )

(de set-message (msg)
  % Display a string in the "message" window, do not refresh.
  % Message will not appear until a refresh is done.
  % Return the previous message string.

  (let ((old-message nmode-message-string))
    (setf nmode-message-string msg)
    (setf nmode-message-cursor 0)
    (=> nmode-message-screen clear)
    (message-append-string msg)
    old-message
    ))

(de reset-message ()
  % Clear the "message" window, but do not refresh.
  (setf nmode-message-string "")
  (setf nmode-message-cursor 0)
  (=> nmode-message-screen clear)
  )

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Internal functions:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de prompt-append-string (s)
  (for (from i 0 (string-upper-bound s))
       (do (prompt-append-character (string-fetch s i)))))

(de prompt-append-character (ch)
  (cond 
   ((or (< ch #\space) (= ch #\rubout)) % Control Characters
    (=> nmode-prompt-screen write #/^ 0 nmode-prompt-cursor)
    (setf nmode-prompt-cursor (+ nmode-prompt-cursor 1))
    (=> nmode-prompt-screen write (^ ch 8#100) 0 nmode-prompt-cursor)
    (setf nmode-prompt-cursor (+ nmode-prompt-cursor 1)))
   (t (=> nmode-prompt-screen write ch 0 nmode-prompt-cursor) % Normal Char
      (setf nmode-prompt-cursor (+ nmode-prompt-cursor 1)))))

(de message-append-string (s)
  (for (from i 0 (string-upper-bound s))
       (do (message-append-character (string-fetch s i)))))

(de message-append-character (ch)
  (cond 
   ((or (< ch #\space) (= ch #\rubout)) % Control Characters
    (=> nmode-message-screen write #/^ 0 nmode-message-cursor)
    (setf nmode-message-cursor (+ nmode-message-cursor 1))
    (=> nmode-message-screen write (^ ch 8#100) 0 nmode-message-cursor)
    (setf nmode-message-cursor (+ nmode-message-cursor 1)))
   (t (=> nmode-message-screen write ch 0 nmode-message-cursor) % Normal Char
      (setf nmode-message-cursor (+ nmode-message-cursor 1)))))

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

(undeclare-flavor nmode-prompt-screen nmode-message-screen)
(undeclare-flavor nmode-input-window nmode-current-window)
(undeclare-flavor input-buffer)