Artifact 64e36497fac47aeb8a561e3a8a757133a0fe20288d5c21496aa9b32404a5ee8f:

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

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

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Window.SL - Commands and Functions for manipulating windows.
% 
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        24 August 1982
% Revised:     30 December 1982
%
% 30-Dec-82 Alan Snyder
%  Change scrolling commands to Ding if no scrolling is actually done.  Fix bug
%  in backwards scroll by pages that failed to preserve relative cursor
%  position.  Change behavior of scroll-by-pages upon excessive request.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(CompileTime (load objects fast-int))

(fluid '(nmode-current-window
	 nmode-command-argument
	 nmode-command-number-given
	 nmode-command-argument-given
	 nmode-layout-mode
	 ))

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

(de current-window-height ()
  % Return the number of text lines displayable on the current window.
  (=> nmode-current-window height))

(de current-window-top-line ()
  % Return the index of the buffer line at the top of the current window.
  (=> nmode-current-window buffer-top)
  )

(de current-window-set-top-line (new-top-line)
  % Change which buffer line displays at the top of the current window.
  (=> nmode-current-window set-buffer-top new-top-line)
  )

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Window Scrolling Functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de scroll-window-according-to-command (w)
  % Scroll the contents of the specified window according to the command
  % argument.  If the command argument was set by C-U or C-U -, then scroll the
  % contents of the window up or down one page.  Otherwise, scroll the window up
  % or down the specified number of lines.

  (if (and (or (= nmode-command-argument 1) (= nmode-command-argument -1))
	   (not nmode-command-number-given))
    (scroll-window-by-pages w nmode-command-argument)
    (scroll-window-by-lines w nmode-command-argument)
    ))

(de scroll-window-by-lines (w n)
  % Scroll the contents of the window up (n > 0) or down (n < 0) by |n| lines.
  % The "window position" may be adjusted to keep it within the window.  Ding if
  % the window contents does not move.

  (let* ((old-top-line (=> w buffer-top))
	 (new-top-line (+ old-top-line n))
	 )

    % adjust to keep something in the window
    (let ((buffer-last-line (- (=> (=> w buffer) visible-size) 1)))
      (cond
       ((< new-top-line 0) (setf new-top-line 0))
       ((> new-top-line buffer-last-line) (setf new-top-line buffer-last-line))
       ))

    % adjust "window position" if no longer in window
    (let ((line (=> w line-position))
	  (max (+ new-top-line (- (=> w height) 1)))
	  )
      (cond
       ((< line new-top-line) (=> w set-line-position new-top-line))
       ((> line max) (=> w set-line-position max))
       ))

    (if (~= old-top-line new-top-line)
      (=> w set-buffer-top new-top-line)
      (Ding)
      )))

(de scroll-window-by-pages (w n)
  % Scroll the contents of the window up (n > 0) or down (n < 0) by |n|
  % screenfuls.  The "window position" may be adjusted to keep it within the
  % window.  Ding if the window contents does not move.

  (let* ((old-top-line (=> w buffer-top))
	 (window-height (=> w height))
	 (buffer-last-line (- (=> (=> w buffer) visible-size) 1))
	 (new-top-line old-top-line)
         )
    (if (>= n 0)
      % moving towards the end of the buffer
      (for (from i 1 n) % do as many complete screenfuls as possible
	   (do (let ((next-top-line (+ new-top-line window-height)))
		 (if (<= next-top-line buffer-last-line)
		   (setf new-top-line next-top-line)
		   (exit)
		   ))))
      % moving towards the beginning of the buffer
      (setf new-top-line (max 0 (+ new-top-line (* n window-height))))
      )
    (if (~= new-top-line old-top-line)
      % keep the cursor at the same relative location in the window!
      (let ((delta (- new-top-line old-top-line)))
	(=> w set-line-position
	    (min (+ (=> w line-position) delta) (+ buffer-last-line 1)))
	(=> w set-buffer-top new-top-line)
	)
      % otherwise (no change)
      (Ding)
      )))

(de scroll-window-horizontally (w n)

  % Scroll the contents of the specified window left (n > 0) or right (n < 0)
  % by |n| columns.

  (let ((old-buffer-left (=> w buffer-left)))
    (=> w set-buffer-left (+ old-buffer-left n))
    (if (= old-buffer-left (=> w buffer-left)) (Ding))
    ))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Window Scrolling Commands
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de next-screen-command ()
  (scroll-window-according-to-command nmode-current-window)
  )

(de previous-screen-command ()
  (setf nmode-command-argument (- 0 nmode-command-argument))
  (scroll-window-according-to-command nmode-current-window)
  )

(de scroll-other-window-command ()
  (selectq nmode-layout-mode
    (1 (Ding))
    (2 (scroll-window-according-to-command (nmode-other-window)))
    ))

(de scroll-window-up-line-command ()
  (scroll-window-by-lines nmode-current-window nmode-command-argument)
  )

(de scroll-window-down-line-command ()
  (scroll-window-by-lines nmode-current-window (- nmode-command-argument))
  )

(de scroll-window-up-page-command ()
  (scroll-window-by-pages nmode-current-window nmode-command-argument)
  )

(de scroll-window-down-page-command ()
  (scroll-window-by-pages nmode-current-window (- nmode-command-argument))
  )

(de scroll-window-right-command ()
  (scroll-window-horizontally nmode-current-window nmode-command-argument)
  )

(de scroll-window-left-command ()
  (scroll-window-horizontally nmode-current-window (- nmode-command-argument))
  )

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Window Adjusting Commands
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de nmode-adjust-window (w)
  % Adjust BUFFER-TOP to show current position.

  (=> w adjust-window)
  )

(de move-to-screen-edge-command ()
  (let* ((n nmode-command-argument)
	 (line (current-line-pos))
	 (top (current-window-top-line))
	 (height (current-window-height))
	 )
    (set-line-pos (+ top
		     (cond ((not nmode-command-argument-given) (/ height 2))
			   ((>= n 0) n)
			   (t (+ height n))
			   )))))