File psl-1983/3-1/nmode/m-x.sl artifact 8b4757015f part of check-in 5f584e9b52


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% M-X.SL - NMODE Extended Command Support
% 
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        20 September 1982
% Revised:     29 December 1982
%
% 29-Dec-82 Alan Snyder
%  Revise PROMPT-FOR-EXTENDED-COMMAND to use new prompted input.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(CompileTime (load objects fast-int fast-strings extended-char))

(fluid '(nmode-input-buffer))

% Internal variables:

(fluid '(prompt-for-extended-command-command-list
	 current-extended-command-list
	 ))

(setf prompt-for-extended-command-command-list
  (list
   (cons (x-char SPACE) 'complete-input-command-name)
   (cons (x-char CR) 'complete-and-terminate-input-command-name)
   (cons (x-char LF) 'complete-and-terminate-input-command-name)
   ))

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

(de prompt-for-extended-command (prompt)
  % Ask the user for the name of an extended command.  Return the full command
  % name from the dispatch table (so that EQ can be used to compare).

  (setf current-extended-command-list (lookup-prefix-character (x-char M-X)))
  (let* ((input-name (prompt-for-string-special
		      prompt
		      nil
		      prompt-for-extended-command-command-list))
	 (matching-names (extended-command-names-that-match input-name))
	 )
    (first matching-names)
    ))

% Internal functions:

(de complete-input-command-name ()
  % Extend the string in the input buffer by at most one word to match
  % the existing extended command names.  Ring the bell if the string
  % is not extended.

  (let ((original-length (string-length (nmode-get-input-string))))
    (complete-input-extended-command-name NIL)
    (if (= original-length (string-length (nmode-get-input-string)))
      (Ding)
      )))

(de complete-and-terminate-input-command-name ()
  % Extend the string in the input buffer as far as possible to match the
  % existing extended command names.  If the resulting string uniquely
  % identifies a single command name, refresh and terminate input.  Otherwise,
  % if the string was not extended, ring the bell.

  (let* ((original-length (string-length (nmode-get-input-string)))
	 (name (complete-input-extended-command-name T))
	 )
    (if name
      (progn (nmode-refresh) (nmode-terminate-input))
      (if (= original-length (string-length (nmode-get-input-string)))
	(Ding)
	))))

(de complete-input-extended-command-name (many-ok)
  % Extend the string in the input buffer BY WORDS.  If MANY-OK is non-nil, then
  % extend by as many words as possible; otherwise, by only one word.  If the
  % extended name matches exactly one command name, return that command name.
  % Otherwise, return NIL.

  (let* ((name (nmode-get-input-string))
	 (names (extended-command-names-that-match name))
	 )
    (cond
     ((string-equal name "E")
      (nmode-replace-input-string "Edit ")
      NIL
      )
     ((string-equal name "L")
      (nmode-replace-input-string "List ")
      NIL
      )
     ((string-equal name "K")
      (nmode-replace-input-string "Kill ")
      NIL
      )
     ((string-equal name "V")
      (nmode-replace-input-string "View ")
      NIL
      )
     ((string-equal name "W")
      (nmode-replace-input-string "What ")
      NIL
      )
     ((null names) % The name matches no command.
      NIL
      )
     ((null (cdr names)) % The name matches exactly one command.
      (nmode-replace-input-string (extend-name-by-words name names many-ok))
      (car names)
      )
     (t % The name matches more than one command.
      (nmode-replace-input-string (extend-name-by-words name names many-ok))
      NIL
      ))
    ))

(de extend-name-by-words (name names many-ok)
  % NAME is the current contents of the input buffer.  Extend it "by words" as
  % long as it matches all of the specified NAMES.  NAMES must be a list
  % containing one or more strings.  If MANY-OK is non-NIL, then extend it by as
  % many words as possible.  Otherwise, extend it by at most one word.
  % Extending by words means that you do not append a new partial word, although
  % you may partially complete a word already started.  Return the extended
  % string.

  (let* ((match-prefix (strings-largest-common-prefix names))
	 (partial-word
	  (not (or
		(string-empty? name)
		(= (string-fetch name (string-upper-bound name)) #\space)
		)))
	 (bound (string-length name))
	 )
    % Try to increase the "bound":
    (for (from i bound (string-upper-bound match-prefix))
	 (do (when (= (string-fetch match-prefix i) #\space)
	       (setf bound (+ i 1)) % this far is OK
	       (setf partial-word NIL) % further words will extend only in full
	       (if (not many-ok) (exit))
	       ))
	 (finally
	  (if (or partial-word (null (cdr names)))
	    (setf bound (string-length match-prefix))
	    )))
    (substring match-prefix 0 bound)
    ))

(de extended-command-names-that-match (name)
  (for (in pair (cdr current-extended-command-list))
       (when (name-matches-prefix name (car pair)))
       (collect (car pair))
       ))

(de name-matches-prefix (test-name name)
  (let ((test-len (string-length test-name))
	(name-len (string-length name))
	)
    (and
      (>= name-len test-len)
      (string-equal (substring name 0 test-len) test-name)
      )))


REDUCE Historical
REDUCE Sourceforge Project | Historical SVN Repository | GitHub Mirror | SourceHut Mirror | NotABug Mirror | Chisel Mirror | Chisel RSS ]