reduce-historical/psl-1983/emode/edc.sl

% A simple desk calculator to run under EMODE.  In this mode all the
% numbers in the buffer are summed up, any other characters are inserted
% and ignored, the total is given as the last line of the OUT_WINDOW buffer..
(load useful)    % Need useful so that FOR loops work!

% Insert a character, and then sum up all the lines in the buffer.
(DE InsertAndTotal ()
  (progn
    (InsertSelfCharacter)
    (FindBufferTotal)))

(DE DeleteBackwardAndTotal ()
  (progn
    (!$DeleteBackwardCharacter)
    (FindBufferTotal)))

(DE DeleteForwardAndTotal ()
  (progn
    (!$DeleteForwardCharacter)
    (FindBufferTotal)))

(DE kill_line_and_total ()
  (progn
    (kill_line)
    (FindBufferTotal)))

(DE insert_kill_buffer_and_total ()
  (progn
    (insert_kill_buffer)
    (FindBufferTotal)))

(DE FindBufferTotal ()
  (prog (total save-point save-line-index itm)
    % Remember our spot in the buffer.
    (setf save-point point)
    (setf save-line-index CurrentLineIndex)

    (setf total 0)
    % Move to the start of the buffer.
    (!$BeginningOfBuffer)
    % Read from, and write to, EMODE buffers.
    (SelectEmodeChannels)

    % Find the total.
    (while (not (EndOfBufferP (NextIndex CurrentLineIndex)))
      (progn
        % NOTE that READ would loose badly here--since it calls
        % MakeInputAvailable here, and thus call EMODE recursively.
        (setf itm (ChannelRead IN*))
        (cond
          ((NumberP itm)
            (setf total (plus total itm))))))


    % Now, show the total in the OUT_WINDOW buffer.
    (prog (old-point old-line-index old-buffer)
      (setf old-buffer CurrentBufferName)
      (SelectBuffer 'OUT_WINDOW)
      (!$EndOfBuffer)      % Move to end of the buffer.
      (setf old-point point)
      (setf old-line-index CurrentLineIndex)
      % Move to beginning of previous line.
      (!$BackwardLine)
      (!$BeginningOfLine)
      % Delete the old text
      (delete_or_copy T CurrentLineIndex point old-line-index old-point)
      % Print the total (to the output buffer)
      (PRINT total)
      (SelectBuffer old-buffer))

    % Finally, restore the original point and mark.
    (SelectLine save-line-index)
    (setf point save-point)))

% Establish keyboard bindings for Desk Calculator mode.
(DE SetDCmode ()
  (progn
    % Make most characters insert and then find total.
    (for (from i 32 126 1)
      (do
        (SetKey i 'InsertAndTotal)))

    (SetKey (char TAB) 'InsertAndTotal)

    % Inherit the rest of the bindings from "text mode"
    (for (in itm TextDispatchList)
      (do
        (SetKey (car itm) (cdr itm))))

    % Then, rebind (some of?) the folks who actually modify stuff.
    (SetKey (char (cntrl D)) 'DeleteForwardAndTotal)
    (SetKey (char (cntrl K)) 'kill_line_and_total)
    (SetKey (char DELETE) 'DeleteBackwardAndTotal)
    (SetKey (char (cntrl Y)) 'insert_kill_buffer_and_total)))

(setf DCMode '(RlispInterfaceDispatch SetDCmode BasicDispatchSetup))

% This code must be run AFTER starting up EMODE.
(prog (old-buffer)
  (setf old-buffer CurrentBufferName)
  (CreateBuffer 'DC DCMode)
  (SelectBuffer 'DC)
  (!$CRLF)
  (insert_string "0")
  (!$CRLF)
  (!$BeginningOfBuffer)
  (SelectBuffer old-buffer))