Artifact dc9918369d0a707f745d55942fa240ea24de83c551a59ed253d8c5d676dd2643:

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

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

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Structure-Functions.SL - NMODE functions for moving about structured text
% 
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        12 November 1982
% Revised:     18 February 1983
%
% This file contains functions for moving about structured text, such as Lisp
% source code.  The functions are based on the primitives in the module
% NMODE-Parsing; the variable NMODE-CURRENT-PARSER determines the actual syntax
% (e.g., Lisp, RLISP, etc.). See the document NMODE-PARSING.TXT for a
% description of the parsing strategy.
%
% 18-Feb-83 Alan Snyder
%  Replaced move-down-list with move-forward-down-list and
%  move-backward-down-list.
% 6-Jan-83 Alan Snyder
%  Use LOAD instead of FASLIN to get macros (for portability); reformat source.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(CompileTime (load objects fast-int nmode-parsing))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Form Movement Functions
%
% A form is an ATOM or a nested structure.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de move-forward-form ()
  % Move to the end (just past the last character) of the current (if any) or
  % the next (otherwise) complete form or unmatched closing bracket.  Returns
  % either NIL (no complete form found), 'ATOM, 'CLOSER (unmatched closing
  % bracket), or 'STRUCTURE (complete structure).  If NIL is returned, then
  % point is unchanged.

  (let* ((old-pos (buffer-get-position)) % save current position
         (first-item (move-forward-item)) % find next item (see below)
         )
    (if (eq first-item 'OPENER) % it is an opening bracket
      (while T % scan past complete forms until an unmatched closing bracket
	(selectq (move-forward-form)
	  (NIL (buffer-set-position old-pos) (exit NIL)) % end of text
	  (CLOSER (exit 'STRUCTURE)) % found the matching closing bracket
	  ))
      first-item % Otherwise, just return the information.
      )))

(de move-backward-form ()
  % Move backward at least one character to the preceding character that is not
  % part of whitespace; then move to the beginning of the smallest form that
  % contains that character.  If no form is found, return NIL and leave point
  % unchanged.  Otherwise, return either 'ATOM, 'STRUCTURE (passed over complete
  % structure), or 'OPENER (passed over unmatched open bracket).

  (let* ((old-pos (buffer-get-position)) % save current position
         (first-item (move-backward-item)) % find previous item (see below)
         )
    (if (eq first-item 'CLOSER) % it is a closing bracket
      (while T % scan past complete forms until an unmatched opening bracket
	(selectq (move-backward-form)
	  (NIL (buffer-set-position old-pos) (exit NIL)) % beginning of text
	  (OPENER (exit 'STRUCTURE)) % found the matching opening bracket
	  ))
      first-item % Otherwise, just return the information.
      )))

(de move-backward-form-interruptible ()
  % This function is like move-backward-form, except it can be interrupted by
  % user type-ahead.  If it is interrupted, it returns 'INTERRUPT and restores
  % the old position.

  (let ((old-pos (buffer-get-position))
	(paren-depth 0)
	)
    (while T
      (when (input-available?) (buffer-set-position old-pos) (exit 'INTERRUPT))
      (let ((item (move-backward-item)))
	(selectq item
	  (NIL (buffer-set-position old-pos) (exit NIL))
	  (OPENER (setf paren-depth (- paren-depth 1))
		  (if (= paren-depth 0) (exit 'STRUCTURE))
		  )
	  (CLOSER (setf paren-depth (+ paren-depth 1)))
	  )
	(if (<= paren-depth 0) (exit item))
	))))

(de move-backward-form-within-line ()
  % This is the same as MOVE-BACKWARD-FORM, except that it looks only within the
  % current line.

  (let* ((old-pos (buffer-get-position)) % save current position
         (first-item (move-backward-item-within-line)) % find previous item
         )
    (if (eq first-item 'CLOSER) % it is a closing bracket
      (while T % scan past complete forms until an unmatched opening bracket
	(selectq (move-backward-form-within-line)
	  (NIL (buffer-set-position old-pos) (exit NIL)) % beginning of text
	  (OPENER (exit 'STRUCTURE)) % found the matching opening bracket
	  ))
      first-item % Otherwise, just return the information.
      )))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Item Movement Functions
%
% An item is an ATOM or a structure bracket.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de move-forward-item ()
  % Move to the end (just past the last character) of the current (if any) or
  % the next (otherwise) atom or bracket.  Returns either NIL (no item found),
  % 'ATOM, 'OPENER, or 'CLOSER.  If NIL is returned, then point is unchanged.

  (let ((item-type (move-forward-to LAST NOT-SPACE)))
    (if item-type (move-forward-character))
    item-type
    ))

(de move-backward-item ()
  % Move backward at least one character to the preceding character that is not
  % part of whitespace; then move to the beginning of the atom or bracket that
  % contains that character.  Returns either NIL (no item found), 'ATOM,
  % 'OPENER, or 'CLOSER.  If NIL is returned, then point is unchanged.

  (let ((old-pos (buffer-get-position))
	(item-type nil)
	)
    (if (move-backward-character)
      (setf item-type (move-backward-to FIRST NOT-SPACE)))
    (if (not item-type) (buffer-set-position old-pos))
    item-type
    ))

(de move-backward-item-within-line ()
  % This is the same as MOVE-BACKWARD-ITEM, except that it looks only within the
  % current line.

  (if (not (at-line-start?))
    (let ((old-pos (buffer-get-position))
	  (item-type nil)
	  )
      (move-backward-character)
      (setf item-type (move-backward-within-line-to FIRST NOT-SPACE))
      (if (not item-type) (buffer-set-position old-pos))
      item-type
      )))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Move-Up-Forms Functions
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de move-forward-up-list ()
  % Move to the right of the current structure (e.g. list).  In other words,
  % find the next closing structure bracket whose matching opening structure
  % bracket is before point.  If no such bracket can be found, return NIL and
  % leave point unchanged.

  (forward-scan-for-right-paren -1)
  )

(de move-backward-up-list ()
  % Move to the beginning of the current structure (e.g. list).  In other words,
  % find the previous opening structure bracket whose matching closing structure
  % bracket is after point.  If no such bracket can be found, return NIL and
  % leave point unchanged.

  (reverse-scan-for-left-paren 1)
  )
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% List Movement Functions
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de move-forward-list ()
  % Move to the right of the current or next structure (e.g. list).  In other
  % words, find the next closing structure bracket whose matching opening
  % structure bracket is before point or is the first opening structure bracket
  % after point.  If no such bracket can be found, return NIL and leave point
  % unchanged.

  (forward-scan-for-right-paren 0)
  )

(de move-backward-list ()
  % Move to the beginning of the current or previous structure (e.g. list).  In
  % other words, find the previous opening structure bracket whose matching
  % closing structure bracket is after point or is the first closing structure
  % bracket before point.  If no such bracket can be found, return NIL and leave
  % point unchanged.

  (reverse-scan-for-left-paren 0)
  )

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Display Commands
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de display-matching-opener ()
  % If the previous character is the last character of a closing bracket, then
  % move backward to the beginning of the form, wait a while so that the user
  % can see where it is, then return to the previous position.
  (let ((old-pos (buffer-get-position)))
    (unwind-protect
     (unsafe-display-matching-opener)
     (buffer-set-position old-pos)
     )))

(de unsafe-display-matching-opener ()
  (move-backward-character)
  (when (test-current-attributes LAST CLOSER)
    (move-forward-character)
    (selectq (move-backward-form-interruptible)
      (STRUCTURE
       (nmode-refresh) % Show the user where we are.
       (sleep-until-timeout-or-input 30) % wait a while
       )
      (INTERRUPT)
      (t (Ding))
      )))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Internal List Scanning Primitives
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de reverse-scan-for-left-paren (depth)
  % Scan backwards (starting with the character before point) for a left paren
  % at depth >= the specified depth.  If found, the left paren will be after
  % point and T will be returned.  Otherwise, point will not change and NIL will
  % be returned.
  (let ((old-pos (buffer-get-position))
	(paren-depth 0)
	)
    (while T
      (selectq (move-backward-item)
	(NIL (buffer-set-position old-pos) (exit NIL))
	(CLOSER (setf paren-depth (- paren-depth 1)))
	(OPENER (setf paren-depth (+ paren-depth 1))
		(if (>= paren-depth depth) (exit T))
		)
	))))

(de forward-scan-for-right-paren (depth)
  % Scan forward (starting with the character after point) for a right paren at
  % depth <= the specified depth.  If found, the right paren will be before
  % point and T will be returned.  Otherwise, point will not change and NIL will
  % be returned.
  (let ((old-pos (buffer-get-position))
	(paren-depth 0)
	)
    (while T
      (selectq (move-forward-item)
	(NIL (buffer-set-position old-pos) (exit NIL))
	(CLOSER (setf paren-depth (- paren-depth 1))
		(if (<= paren-depth depth) (exit T))
		)
	(OPENER (setf paren-depth (+ paren-depth 1)))
	))))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Move-Down-List functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de move-forward-down-list ()
  % Move forward past the next open bracket at the current level.
  (let ((old-pos (buffer-get-position)))
    (while T
      (selectq (move-forward-item)
	((NIL CLOSER) (buffer-set-position old-pos) (exit NIL))
	(OPENER (exit T))
	))))

(de move-backward-down-list ()
  % Move backward past the previous close bracket at the current level.
  (let ((old-pos (buffer-get-position)))
    (while T
      (selectq (move-backward-item)
	((NIL OPENER) (buffer-set-position old-pos) (exit NIL))
	(CLOSER (exit T))
	))))

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

(de skip-prefixes ()
  % Skip over any "prefix characters" (like ' in Lisp).
  (while (test-current-attributes PREFIX) (move-forward))
  )