Artifact 88b3316c73668621ef9292f2adce7adf22376734fd68db2251823dfc291b5de3:

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

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

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Case-Commands.SL - NMODE Case Conversion commands
% 
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        6 October 1982
%
% The original code was contributed by Jeff Soreff.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(CompileTime (load fast-int fast-vectors fast-strings))

(fluid '(
  nmode-command-argument
  nmode-current-buffer
  ))

% Global variables:

(fluid '(shifted-digits-association-list))
(setf shifted-digits-association-list NIL)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Case Conversion Commands:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de uppercase-word-command ()
  (transform-region-with-next-word-or-fragment #'string-upcase))

(de lowercase-word-command ()
  (transform-region-with-next-word-or-fragment #'string-downcase))

(de uppercase-initial-command ()
  (transform-region-with-next-word-or-fragment #'string-capitalize))

(de uppercase-region-command ()
  (transform-marked-region #'string-upcase))

(de lowercase-region-command ()
  (transform-marked-region #'string-downcase))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Upcase Digit Command:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de upcase-digit-command ()
  % Convert the previous digit to the corresponding "shifted character"
  % on the keyboard.  Search only within the current line or the previous
  % line.  Ding if no digit found.


  (let ((point (buffer-get-position))
	(limit-line-pos (- (current-line-pos) 1))
	(ok NIL)
	)
    (while (and (>= (current-line-pos) limit-line-pos)
		(not (at-buffer-start?))
		(not (setf ok (digitp (previous-character))))
		)
      (move-backward)
      )
    (cond ((and ok (set-up-shifted-digits-association-list))
	   (let* ((old (previous-character))
		  (new (cdr (assoc old shifted-digits-association-list)))
		  )
	     (delete-previous-character)
	     (insert-character new)
	     ))
	  (t (Ding))
	  )
    (buffer-set-position point)
    ))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% General Transformation Functions:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de transform-region (string-conversion-function bp1 bp2)
  % Transform the region in the current buffer between the positions
  % BP1 and BP2 by applying the specified function to each partial or
  % complete line.  The function should accept a single string argument
  % and return the transformed string.  Return 1 if BP2 > BP1;
  % return -1 if BP2 < BP1.  The buffer pointer is left at the "end"
  % of the transformed region (the greater of BP1 and BP2).

  (let* ((modified-flag (=> nmode-current-buffer modified?))
	 (extracted-pair (extract-region t bp1 bp2))
	 (newregion (cdr extracted-pair))
	 (oldregion (if (not modified-flag) (copyvector newregion)))
	 )
    (for (from index 0 (vector-upper-bound newregion) 1)
	 (do (vector-store newregion index 
	       (apply string-conversion-function
		      (list (vector-fetch newregion index))))))
    (insert-text newregion)
    (if (and (not modified-flag) (text-equal newregion oldregion))
	(=> nmode-current-buffer set-modified? nil)
	)
    (car extracted-pair)
    ))
		
(de transform-region-with-next-word-or-fragment (string-conversion-function)
  % Transform the region consisting of the following N words, where N is
  % the command argument.  N may be negative, meaning previous words.

  (let ((start (buffer-get-position)))
    (move-over-words nmode-command-argument)
    (transform-region string-conversion-function start (buffer-get-position))
    ))

(de transform-marked-region (string-conversion-function)
  % Transform the region defined by point and mark.

  (let ((point (buffer-get-position))
	(mark (current-mark))
	)
    (when (= (transform-region string-conversion-function point mark) 1)
      % The mark was at the end of the region. If the transformation changed
      % the length of the region, the mark may need to be updated.
      (previous-mark) % pop off old mark
      (set-mark-from-point) % set the mark to the end of the transformed region
      (buffer-set-position point)
      )))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Auxiliary Function:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de set-up-shifted-digits-association-list ()
  % Ensure that the "shifted digits association list" is set up properly.
  % If necessary, ask the user for the required information.  Returns the
  % association list if properly set up, NIL if an error occurred.

  (if (not shifted-digits-association-list)
    (let ((shifted-digits
	   (prompt-for-string 
	    "Type the digits 1, 2, ... 9, 0, holding down Shift:" nil)))
      (cond ((= (string-length shifted-digits) 10) 
	     (setq shifted-digits-association-list
		   (pair 
		    (string-to-list "1234567890")
		    (string-to-list shifted-digits))))
	    ((> (string-length shifted-digits) 10)
	     (nmode-error "Typed too many shifted digits!"))
	    (t
	     (nmode-error "Typed too few shifted digits!"))
	    )))
  shifted-digits-association-list
  )