Artifact 8eea19dd9a7b8b70bf0b149587b8383f76532d4429a0c44812ace247a0dfd4f3:

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

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

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% NMODE-BREAK.SL - NMODE Break Handler
% 
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        26 August 1982
%
% Adapted from Will Galway's EMODE
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(CompileTime (load objects))
(fluid '(*NMODE-RUNNING
	 *nmode-init-running
	 *OutWindow
	 nmode-terminal
	 nmode-command-argument
	 nmode-buffer-channel))

(fluid '(BreakLevel* *QuitBreak BreakEval* BreakName* ERROUT* ErrorForm*))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% We redefine BREAK (the break handler) and YESP.
% Grab the original versions (if we can find them!).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(if (FUnboundP 'pre-nmode-break)
    (CopyD 'pre-nmode-break
	   (if (FUnboundP 'pre_rawio_break)
		'break
		'pre_rawio_break
		)))

(if (FUnboundP 'pre-nmode-yesp)
    (CopyD 'pre-nmode-yesp 'yesp))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Initialization:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de enable-nmode-break ()
  (let ((*usermode NIL)
	(*redefmsg NIL)
	)
    (CopyD 'break 'nmode-break)
    (CopyD 'yesp 'nmode-yesp)
    ))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Break handler:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de nmode-break ()
  (cond (*NMODE-RUNNING (nmode-break-handler))
	(t
	 (let ((old-raw-mode (=> nmode-terminal raw-mode)))
	   (leave-raw-mode)
	   (prog1
	    (pre-nmode-break)
	    (if old-raw-mode (enter-raw-mode))
	    )))))

(de nmode-break-handler ()
  (let* ((BreakLevel* (+ BreakLevel* 1))
	 (*QuitBreak T)
	 (BreakEval* 'Eval)
	 (BreakName* "NMODE Break")
	 (OldIN* IN*)
	 (OldOUT* OUT*)
	 (nmode-error? (eq in* 0))
	 (nmode-channel? (eq in* nmode-buffer-channel))
	 (init-error? *nmode-init-running)
	 (old-raw-mode (=> nmode-terminal raw-mode))
	 (*OutWindow T) % always pop up on a break
	 (*nmode-init-running NIL) % ditto
	 (*NMODE-RUNNING (not nmode-error?))
	 )
    (cond (nmode-error?
	   (leave-raw-mode)
	   (RDS 0)
	   (WRS 1)
	   )
	  (t
	   (RDS nmode-buffer-channel)
	   (WRS nmode-buffer-channel)
	   (enter-raw-mode)
	   ))
    (when init-error?
      (Printf "Error occurred while executing your NMODE INIT file!%n")
      (Ding)
      )
    (unwind-protect
      (Catch '$Break$
	(TopLoop 'Read 'Print 'BreakEval BreakName* "NMODE Break loop")
	)
      (RDS OldIN*)
      (WRS OldOUT*)
      (if old-raw-mode (enter-raw-mode))
      )
    (if *QuitBreak
	(let ((*Break NIL)
	      (*EmsgP NIL)
	      )
	  (StdError "Exit to ErrorSet")))
    )
  (Eval ErrorForm*)
  )

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Break command functions:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de lisp-quit-command ()
  (cond ((ensure-in-break)
	 (setf *QuitBreak T)
	 (throw '$Break$ NIL)
	 )))

(de lisp-retry-command ()
  (cond ((ensure-in-break)
	 (cond (*ContinuableError
		 (setf *QuitBreak NIL)
		 (throw '$Break$ NIL)
		 )
	       (t
		(write-prompt "Cannot retry: error is not continuable.")
		(Ding)))
	 )))

(de lisp-continue-command ()
  (cond ((ensure-in-break)
	 (cond (*ContinuableError
		 (setf ErrorForm* (MkQuote BreakValue*))
		 (setf *QuitBreak NIL)
		 (throw '$Break$ NIL)
		 )
	       (t
		(write-prompt "Cannot continue: error is not continuable.")
		(Ding)))
	 )))

(de lisp-abort-command ()
  (cond ((ensure-in-break)
	 (reset))))

(de lisp-backtrace-command ()
  (cond ((ensure-in-break)
	 (nmode-select-buffer-channel)
	 (cond ((>= nmode-command-argument 16) (VerboseBackTrace))
	       ((>= nmode-command-argument 4) (InterpBackTrace))
	       (t (BackTrace)))
	 (nmode-select-old-channels)
	 )))

(de lisp-help-command ()
  (write-message
   (if (> BreakLevel* 0)
    "Lisp break commands: Q-quit;A-abort;R-retry;C-continue;B-backtrace"
    "Lisp commands: E-execute form;Y-yank last output;L-invoke Lisp Listener"
    )))

(de ensure-in-break ()
  (if (> BreakLevel* 0)
      T
      (write-prompt "Not in a break loop!")
      (Ding)
      NIL
      ))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Query functions:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de nmode-yesp (message)
  (cond ((and *NMODE-RUNNING (=> nmode-terminal raw-mode))
	 (nmode-yes-or-no? message))
	(t (pre-nmode-yesp message))
	))

(de nmode-yes-or-no? (message)
  (let ((response (prompt-for-string message NIL)))
    (while T
      (cond ((string-equal response "Yes") (exit T))
	    ((string-equal response "No") (exit NIL))
	    (t (Ding)
	       (write-prompt "Please answer YES or NO.")
	       (sleep-until-timeout-or-input 60)
	       (setf response (prompt-for-string message NIL))
	       )))))

(de nmode-y-or-n? (message)
  (write-message message)
  (nmode-set-immediate-prompt "Y or N: ")
  (let ((answer
	 (while T
	   (let ((ch (char-upcase (input-direct-terminal-character))))
	     (when (= ch #/Y) (nmode-complete-prompt "Y") (exit T))
	     (when (= ch #/N) (nmode-complete-prompt "N") (exit NIL))
	     (when (= ch #\BELL) (exit 'ABORT))
	     (Ding)
	     ))))
    (set-prompt "")
    (write-message "")
    (if (eq answer 'ABORT) (throw 'ABORT NIL))
    answer
    ))