Artifact d8079889cdb2f164d535d43e7fb7988769cc0c395e79c31cae9f715230259030:

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

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Commands.SL - Miscellaneous NMODE commands
% 
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        24 August 1982
% Revised:     3 December 1982
%
% 3-Dec-82 Alan Snyder
%   Changed Insert-Self-Command to handle control- and meta- characters.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

% External variables used:

(fluid '(nmode-current-buffer nmode-command-argument nmode-current-window
         nmode-command-argument-given nmode-current-command
	 nmode-terminal nmode-allow-refresh-breakout
	 Text-Mode
	 ))

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

(de insert-self-command ()
  (if (FixP nmode-current-command)
    (let ((ch (x-base nmode-current-command)))
      (if (x-control? nmode-current-command)
	(let ((nch (char-upcase ch)))
	  (if (and (>= nch #/@) (<= nch #/_))
	    (setf ch (^ nch #/@))
	    )))
      (for (from i 1 nmode-command-argument)
	   (do (insert-character ch)))
      )
    % otherwise
    (Ding)
    ))

(de insert-next-character-command ()
  (nmode-append-separated-prompt "C-Q")
  (let ((ch (x-base (input-direct-terminal-character))))
    (nmode-complete-prompt (string-concat " " (x-char-name ch)))
    (for (from i 1 nmode-command-argument)
	 (do (insert-character ch)))))

(de return-command ()
  % Insert an EOL, unless we are at the end of thee current line and the
  % next line is empty.  Repeat as directed.

  (for (from i 1 nmode-command-argument)
       (do (cond ((and (at-line-end?) (not (at-buffer-end?)))
		  (move-to-next-line)
		  (cond ((not (current-line-empty?))
			 (insert-eol)
			 (move-to-previous-line)
			 )))
		 (t (insert-eol))))))

(de select-buffer-command ()
  (buffer-select (prompt-for-selectable-buffer)))

(de prompt-for-selectable-buffer ()
  (let ((default-b (=> nmode-current-buffer previous-buffer)))
    (if (and default-b (not (buffer-is-selectable? default-b)))
      (setf default-b NIL))
    (prompt-for-buffer "Select Buffer: " default-b)))

(de kill-buffer-command ()
  (let ((b (prompt-for-existing-buffer "Kill buffer: " nmode-current-buffer)))
    (if (or (not (=> b modified?))
	    (YesP "Kill unsaved buffer?"))
	(buffer-kill-and-detach b))))

(de insert-buffer-command ()
  (let ((b (prompt-for-existing-buffer "Insert Buffer:" nmode-current-buffer)))
    (insert-buffer-into-buffer b nmode-current-buffer)
    ))

(de select-previous-buffer-command ()
  (let ((old-buffer nmode-current-buffer))
    (buffer-select-previous nmode-current-buffer)
    (if (eq old-buffer nmode-current-buffer) (Ding)) % nothing visible happened
    ))

(de visit-in-other-window-command ()
  (nmode-2-windows)
  (selectq (char-upcase (input-base-character))
    (#/B (let ((b (prompt-for-selectable-buffer)))
	   (window-select-buffer (nmode-other-window) b)))
    (#/F (find-file-in-window
	  (nmode-other-window)
	  (prompt-for-file-name "Find file: " NIL)
	  ))
    (t (Ding))
    ))

(de nmode-refresh-command ()
  (if nmode-command-argument-given
    (let* ((arg nmode-command-argument)
	   (w nmode-current-window)
	   (height (=> w height))
	   (line (current-line-pos))
	   )
      (if (>= arg 0)
	  (=> w set-buffer-top (- line arg))
	  (=> w set-buffer-top (- (- line height) arg)))
      (nmode-refresh)
      )
    % Otherwise
    (=> nmode-current-window readjust-window)
    (nmode-full-refresh)
    ))

(de open-line-command ()
  (for (from i 1 nmode-command-argument)
       (do (insert-eol)
	   (move-backward)
	   )))

(de Ding ()
  (=> nmode-terminal ring-bell))

(de buffer-not-modified-command ()
  (=> nmode-current-buffer set-modified? NIL)
  )

(de set-mark-command ()
  (cond (nmode-command-argument-given
	 (buffer-set-position (current-mark))
	 (previous-mark)
	 )
	(t
	 (set-mark-from-point)
	 )))

(de mark-beginning-command ()
  (let ((old-pos (buffer-get-position)))
    (move-to-buffer-start)
    (set-mark-from-point)
    (buffer-set-position old-pos)
    ))

(de mark-end-command ()
  (let ((old-pos (buffer-get-position)))
    (move-to-buffer-end)
    (set-mark-from-point)
    (buffer-set-position old-pos)
    ))

(de transpose-characters-command ()
  (cond ((or (at-line-start?) (< (current-line-length) 2))
	 (Ding)
	 )
	(t
	 (if (at-line-end?) % We are at the end of a non-empty line.
	     (move-backward)
	     )
	 % We are in the middle of a line.
	 (let ((ch (previous-character)))
	   (delete-previous-character)
	   (move-forward)
	   (insert-character ch)
	   )
	 )))

(de mark-word-command ()
  (let ((old-pos (buffer-get-position)))
    (move-forward-word-command)
    (set-mark-from-point)
    (buffer-set-position old-pos)
    ))

(de mark-form-command ()
  (let ((old-pos (buffer-get-position)))
    (move-forward-form-command)
    (set-mark-from-point)
    (buffer-set-position old-pos)
    ))

(de mark-whole-buffer-command ()
  (move-to-buffer-end)
  (set-mark-from-point)
  (move-to-buffer-start)
  )

(de nmode-abort-command ()
  (throw 'abort NIL)
  )

(de start-scripting-command ()
  (let ((b (prompt-for-buffer "Script Input to Buffer:" NIL)))
    (nmode-script-terminal-input b)
    ))

(de stop-scripting-command ()
  (nmode-script-terminal-input nil)
  )

(de execute-buffer-command ()
  (let ((b (prompt-for-buffer "Execute from Buffer:" NIL)))
    (setf nmode-allow-refresh-breakout nmode-command-argument-given)
    (nmode-execute-buffer b)
    ))

(de execute-file-command ()
  (nmode-execute-file (prompt-for-file-name "Execute File:" NIL)))

(de nmode-execute-file (fn)
  (let ((b (buffer-create-unselectable "FOO" Text-Mode)))
    (read-file-into-buffer b fn)
    (setf nmode-allow-refresh-breakout nmode-command-argument-given)
    (nmode-execute-buffer b)
    ))

(de apropos-command ()
  (let ((s (prompt-for-string
	    "Show commands whose names contain the string:"
	    NIL
	    )))
    (nmode-begin-typeout)
    (print-matching-dispatch s)
    (printf "-----")
    (nmode-end-typeout)
    ))