Re: function and variable name completetion.

[Repenning Alexander <ralex@tigger.Colorado.EDU>]

pazzani@ICS.UCI.EDU (Michael Pazzani) writes on function and variable          
name completetion.                                                         
                                                                                
> ..It redefines defun, defmacro, defvar, defconstant, and defparameter to  
> record the names being defined.  Any definitions performed after          
> loading this file will are stored and available for completion.          
                                                                          
Redefining the built-in def.. forms has the advantage of getting a         
more fine tuned control over completeable symbols. However, this              
method doesn't work for already compiled or dumped stuff. Also, I kind         
of hesitate to actually redefine built-in functions/macros; one never       
knows.                                                                 
                 
I was also missing the completion functionality in MACL and therefore
hacked up some code a while ago. It is based on the appropos-list
function provided by CL and is nontheless fast enough (to my surprise).

I'm interested in more advanced predicates MACL users can come up with
to filter matches.

As I said, it's an old hack, but you may give it try anyway.
~~~~~~~~~~~~~~~~~~ symbol-complete.lisp ~~~~~~~~~~~~~~~~~~~~~
#| V 1.0   07/24/90  Alex Repenning, last update: 12/06/90
 Copyright : (C) 07/24/90 University of Colorado at Boulder, Computer Science Department
   Boulder, CO 80303

 
Adds three symbol completion commands to every FRED window (1 is very generic, 3 quite specific):

1) Substring Completion: <option-space> Match every symbol in ALL packages being SUBSTRINGS;
   don't include low level %.. symbols

2) Prefix Completion: <option-control-space> Match every symbol in ALL packages 
   of which current symbol is a PREFIX

3) Package Restricted Prefix Completion: <control-space> Match every symbol in WINDOW 
   package of which current symbol is a PREFIX.                                           |#

(in-package :ccl)

(defvar *Maximum-Pop-up-Size* 40 "if the number of matches exceeds this number then warn user")


(defobfun (REPLACE-OR-QUERY *fred-window*) (Symbol Choices)
  (declare (special *Maximum-Pop-up-Size*))
  (if (= (length Choices) 1)
    (ed-replace-symbol Symbol (first Choices))
    (if (> (length Choices) *Maximum-Pop-up-Size*)
      (princ "too many matches..")
      (if Choices
        (ed-replace-symbol Symbol (first (select-item-from-list Choices :table-print-function #'prin1)))
        (ed-beep)))))


(defobfun (COMPLETE-LINE *fred-window*) () "
  Match every symbol in ALL packages being SUBSTRINGS; don't include low level %.. symbols"
  (let ((Symbol (ed-current-symbol)))
    (replace-or-query Symbol (remove-if #'(lambda (Item) (char= (char (string Item) 0) #\%))
                                        (apropos-list Symbol)))))


(defobfun (COMPLETE-LINE-SAME-START *fred-window*) () "
  Match every symbol in ALL packages where current symbol is a PREFIX."
  (let* ((Symbol (ed-current-symbol)) (String (string Symbol)) (Length (length String)))
    (replace-or-query 
     Symbol
     (remove-if #'(lambda (Item) (string/= (string Item) String :end1 Length :end2 Length))
                (apropos-list Symbol)))))
  

(defobfun (COMPLETE-LINE-SAME-START-CURRENT-PACKAGE *fred-window*) () "
  Match every symbol in WINDOW package where current symbol is a PREFIX."
  (let (Package (Window-Package (or (window-package) *Package*)))
    (unwind-protect  ; just in case!
      (let* ((Symbol (ed-current-symbol)) (String (string Symbol)) (Length (length String)))
        (shiftf Package *Package* Window-Package)
        (replace-or-query 
         Symbol
         (remove-if #'(lambda (Item) (string/= (string Item) String :end1 Length :end2 Length))
                    (apropos-list Symbol Window-Package)))
        (setq *Package* Package)))))


(defobfun (ED-REPLACE-SYMBOL *Fred-Window*) (Old-Symbol New-Symbol)
  (dotimes (I (length (string Old-Symbol))) (ed-rubout-char))
  (let ((String (write-to-string New-Symbol)))
    (if (char= (char String 0) #\*)
      (nstring-capitalize String)
      (if (or (fboundp New-Symbol) (special-form-p New-Symbol) (macro-function New-Symbol))
        (nstring-downcase String)
        (nstring-capitalize String)))
    (dotimes (I (length String))
      (setq *current-character* (aref String I))
      (ed-self-insert))))


(comtab-set-key *comtab* '(:meta #\space) 'COMPLETE-LINE)
(comtab-set-key *comtab* '(:control :meta #\space) 'COMPLETE-LINE-SAME-START)
(comtab-set-key *comtab* '(:control #\space) 'COMPLETE-LINE-SAME-START-CURRENT-PACKAGE)