reduce-historical/psl-1983/nmode/window.sl

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 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))
			   )))))