Artifact e8e5e5e384c49784578009254d984f703a2eda58c280b4bb8f551c4a8f5a41c2:

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

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Dabbrevs.SL - Dynamic Abbreviations for NMODE
% 
% Author:      Mark R. Swanson
%              University of Utah
% Date:        15 June 1983
%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Methods provided: (all internal, really)
%   initial-expansion
%   expand-aux
%   find-next-expansion
%   get-expansion-from-buffer
%   expand
%   save-expansion
%
% Commands defined:
%   instant-abbrev-command
%     Tries to "expand" the word (or prefix) before point by searching for other
%     words with the same prefix.  The search goes back from point (or from the
%     location of the last expansion found for the current abbreviation); if
%     unsuccessful, a search is done forward from point.  Re-issuing the command
%     causes a search for the next possible expansion.  The command is initially
%     bound to the M-<space> key.

(CompileTime
 (load objects fast-int))

(fluid '(current-abbrev-expansion))
(setf current-abbrev-expansion nil)

(defflavor abbrev-expansion 
 (abbrev                    % original abbreviation string 
  abbrev-start-pos           
  abbrev-end-pos
  (expansion-list nil)      % list of all expansions tried (including abbrev)
  expansion-start-pos       % start of latest expansion
  expansion-end-pos         % end of latest expansion
  last-pos                  % position of end of latest expansion/abbrev in 
                            %  buffer
  (direction -1)            % initially look backwards (-1)
  (word-delim-list '(#\!( #\!) #\!' #\- #\space #\<)) % word delimitors
  )
  ()
)

(defmethod (abbrev-expansion initial-expansion) ()
% Initial attempt to find an expansion for "word" before point.  Search goes
%  first backward, then forward, through buffer for an appropriate expansion.

  (setf last-pos (setf abbrev-end-pos (buffer-get-position)))
  (if (not (move-backward-word)) % is there a word to expand?
    (ding)                       % no
    % else                         yes
    (setf abbrev-start-pos (buffer-get-position)) % bracket its position
    (setf abbrev (cdr (extract-region nil abbrev-start-pos abbrev-end-pos)))
    (=> self save-expansion abbrev) % abbrev is its own initial "expansion"
    (=> self expand-aux)
    ))

(defmethod (abbrev-expansion expand-aux) ()
% Actually do the expansion (or re-expansion); search backwards first, then
%  forwards if necessary;  do not re-present duplicate expansions which have
%  already been tried.

  (write-message (concat "Expanding " (vector-fetch abbrev 0)))
  (let ((found-one nil)
	 new-expansion)
    (while (and (~= direction 0)	% if zero we have searched in both directions
	     (not found-one))
      (setf new-expansion (=> self find-next-expansion direction))
      (if new-expansion % then 
	(progn 
	  (if (< direction 0)	% move ptr for next search (may not be necessary)
	    (move-backward) (move-forward))
	  (setf found-one (not (member new-expansion expansion-list))))
%else
	(setf direction (if (= direction -1) 1 0))	% change directions
	(buffer-set-position last-pos)	% and start from original location
	))
% Finally insert expansion and add it to history
    (if found-one
      (progn
	(extract-region T abbrev-start-pos last-pos)	%remove old abbrev/expans.
	(insert-string (vector-fetch new-expansion 0))	% put in new expans.
	(setf last-pos (buffer-get-position))	% note end of expans.
	(=> self save-expansion new-expansion))
% else
      (buffer-set-position last-pos)	% put point back where we started
      (ding)	% let user know we failed
      )))

(defmethod (abbrev-expansion find-next-expansion) (dir)
% Search backward/forward from current location for an expansion (string match of
%  abbreviation preceded by a word delimitor. Returns NIL on failure, 
%  expansion-string on success; leaves point at start of last string match.

  (let ((found-one nil))
    (while (and (not found-one)
		(buffer-text-search? abbrev dir))
      (if (or (=> nmode-current-buffer at-line-start?)
	      (member (=> nmode-current-buffer previous-character) 
		      word-delim-list))
	(setf found-one T)
	(if (< dir 0)
	  (move-backward)
	  (move-forward))))
    (if found-one
      (=> self get-expansion-from-buffer))))

(defmethod (abbrev-expansion get-expansion-from-buffer) ()
  % Extracts the expansion from the buffer; on entry point should be at start
  %  of expansion, on exit it will be returned to that position.  Form of
  %  result should be a vector containing 1 string.

  (let (expans)
    (setf expansion-start-pos (buffer-get-position))
    (move-forward-word)
    (setf expansion-end-pos (buffer-get-position))
    (setf expans (cdr (extract-region NIL expansion-start-pos expansion-end-pos)))
    (buffer-set-position expansion-start-pos)
    expans))

(defmethod (abbrev-expansion expand) ()
  % Attempt to re-expand last expansion.  Point must be at end of previous
  %  expansion, word itself should not have been changed.

  (let ((cur-pos (buffer-get-position)))
    (if (and
	 (equal last-pos (buffer-get-position))
	 (move-backward-word)
	 (equal abbrev-start-pos (buffer-get-position))
	 (equal (car expansion-list)
		(cdr (extract-region nil abbrev-start-pos last-pos))))
      (progn
       (buffer-set-position expansion-start-pos)
       (=> nmode-current-buffer move-backward)
       (=> self expand-aux))
      (buffer-set-position cur-pos)
      nil
      )))

(defmethod (abbrev-expansion save-expansion) (expansion)
	(setf expansion-list (adjoin expansion expansion-list)))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% dynamic abbreviation command and its installation
%

(de instant-abbrev-command ()
  (cond ((or 
	  (null current-abbrev-expansion)
	  (null (=> current-abbrev-expansion expand)))
	 (setf current-abbrev-expansion (make-instance 'abbrev-expansion))
	 (=> current-abbrev-expansion initial-expansion))))

(setf Text-Command-List
  (NConc Text-Command-List
	 (list
	  (cons (x-char M-!  ) 'instant-abbrev-command)
	  )))