;;; -*-Emacs-Lisp-*- ;;; Rcs_Info: ilisp-cmp.el,v 1.19 1993/09/03 02:05:07 ivan Rel $ ;;;%Header ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell, ccm@cs.cmu.edu. ;;; ;;; Send mail to ilisp-bug@darwin.bu.edu if you have problems. ;;; ;;; Send mail to ilisp-request@darwin.bu.edu if you want to be on the ;;; ilisp mailing list. ;;; ;;; ;;; ;;; ILISP completion ;;; ;;; ;;;%Completion ;;; The basic idea behind the completion stuff is to use as much of ;;; the standard Emacs stuff as possible. The extensions here go out ;;; to the inferior LISP to complete symbols if necessary. ;;; (defun ilisp-display-choices (symbol choices) "Display the possible choices for SYMBOL in alist CHOICES." (with-output-to-temp-buffer " *Completions*" (display-completion-list (sort (all-completions (lisp-symbol-name symbol) choices) 'string-lessp)))) ;;;%%ilisp-can-complete (defun ilisp-can-complete (symbol function-p) "Return T if ilisp completion can complete SYMBOL from the current table." (and ilisp-original (string= (lisp-symbol-package ilisp-original) (lisp-symbol-package symbol)) (string= (lisp-symbol-delimiter ilisp-original) (lisp-symbol-delimiter symbol)) (lisp-prefix-p (lisp-symbol-name ilisp-original) (lisp-symbol-name symbol)) (eq function-p ilisp-original-function-p))) ;;;%%ilisp-complete (defun ilisp-complete (symbol &optional function-p) "Return a list of the possible completions for symbol from the inferior LISP. If FUNCTION-P is T, only symbols with function bindings will be considered. If no package is specified the buffer package will be used." (let* ((choices (ilisp-send (format (ilisp-value 'ilisp-complete-command) (lisp-symbol-name symbol) (lisp-symbol-package symbol) function-p (string= (lisp-symbol-delimiter symbol) ":") ilisp-prefix-match) (if (not ilisp-complete) (concat "Complete " (if function-p "function ") (lisp-buffer-symbol symbol))) 'complete))) (if (ilisp-value 'comint-errorp t) (progn (lisp-display-output choices) (error "Error completing %s" (lisp-buffer-symbol symbol))) (setq choices (read choices) choices (if (eq choices 'NIL) nil choices))) (setq ilisp-original symbol ilisp-original-function-p function-p ilisp-original-table choices))) ;;;%%ilisp-completion-table (defun ilisp-completion-table (symbol function-p) "Return the completion table for SYMBOL trying to use the current one. If FUNCTION-P is T, only symbols with function cells will be returned." (if (ilisp-can-complete symbol function-p) ilisp-original-table (ilisp-complete symbol function-p))) ;;;%%Minibuffer completion (defun ilisp-restore-prefix () "Restore the prefix from ilisp-mini-prefix at the start of the minibuffer." (if ilisp-mini-prefix (save-excursion (goto-char (point-min)) (insert ilisp-mini-prefix) (setq ilisp-mini-prefix nil)))) ;;; (defun ilisp-current-choice () "Set up the minibuffer completion table for the current symbol. If there is a paren at the start of the minibuffer, or there is not an ilisp-table, this will be from the inferior LISP. Otherwise, it will be the ilisp-table." (if (or (null ilisp-table) (eq (char-after 1) ?\()) (progn (let* ((symbol-info (lisp-previous-symbol)) (symbol (car symbol-info))) (setq minibuffer-completion-table (ilisp-completion-table symbol ilisp-completion-function-p))) (save-excursion (skip-chars-backward "^: \(") (setq ilisp-mini-prefix (buffer-substring (point-min) (point))) (delete-region (point-min) (point))) ;; Nothing can match this table (if (not minibuffer-completion-table) (setq minibuffer-completion-table '((" "))))) (setq minibuffer-completion-table ilisp-table minibuffer-completion-predicate nil))) ;;;%%Commands (defvar ilisp-completion-help (lookup-key minibuffer-local-must-match-map "?")) (defun ilisp-completion-help () "Inferior LISP minibuffer completion help." (interactive) (ilisp-current-choice) (funcall ilisp-completion-help) (ilisp-restore-prefix)) ;;; (defvar ilisp-completion (lookup-key minibuffer-local-must-match-map "\t")) (defun ilisp-completion () "Inferior LISP minibuffer complete." (interactive) (ilisp-current-choice) (funcall ilisp-completion) (ilisp-restore-prefix)) ;;; (defvar ilisp-completion-word (lookup-key minibuffer-local-must-match-map " ")) (defun ilisp-completion-word () "Inferior LISP minibuffer complete word." (interactive) (if (eq (char-after 1) ?\() (insert " ") (ilisp-current-choice) (funcall ilisp-completion-word) (ilisp-restore-prefix))) ;;; (defun ilisp-completion-paren () "Only allow a paren if ilisp-paren is T." (interactive) (if ilisp-paren (if (or (eq last-input-char ?\() (eq (char-after 1) ?\()) (insert last-input-char) (beep)) (beep))) ;;; (defvar ilisp-completion-exit (lookup-key minibuffer-local-must-match-map "\n")) (defun ilisp-completion-exit () "Inferior LISP completion complete and exit." (interactive) (if (eq (char-after 1) ?\() (progn (find-unbalanced-lisp nil) (exit-minibuffer)) (if ilisp-no-complete (exit-minibuffer) (if (= (point-min) (point-max)) (exit-minibuffer) (ilisp-current-choice) (unwind-protect (funcall ilisp-completion-exit) (ilisp-restore-prefix)))))) ;;;%%ilisp-completer (defun ilisp-completer (symbol function-p) "Complete SYMBOL from the inferior LISP using only function symbols if FUNCTION-P is T. Return (SYMBOL LCS-SYMBOL CHOICES UNIQUEP)." (let* ((name (lisp-symbol-name symbol)) (table (ilisp-completion-table symbol function-p)) (choice (and table (try-completion name table)))) (cond ((eq choice t) ;Name is it (list symbol symbol nil t)) ((string= name choice) ;Name is LCS (list symbol symbol (all-completions name table) nil)) (choice ;New LCS (let ((symbol (lisp-symbol (lisp-symbol-package symbol) (lisp-symbol-delimiter symbol) choice))) (list symbol symbol (all-completions choice table) nil))) ((and (not ilisp-prefix-match) table) ;Try partial matches (let ((matches (completer name table nil (regexp-quote completer-words)))) (cons (lisp-symbol (lisp-symbol-package symbol) (lisp-symbol-delimiter symbol) (car matches)) (cons (lisp-symbol (lisp-symbol-package symbol) (lisp-symbol-delimiter symbol) (car (cdr matches))) (cdr (cdr matches))))))))) ;;;%%ilisp-read (defun ilisp-completion-map () "Set up the ilisp-completion-map from lisp-mode-map for the ilisp readers and return it." (if (not ilisp-completion-map) (progn (if (fboundp 'set-keymap-parent) (progn (setq ilisp-completion-map (make-sparse-keymap)) (set-keymap-parent ilisp-completion-map lisp-mode-map)) (setq ilisp-completion-map (copy-keymap lisp-mode-map))) (define-key ilisp-completion-map " " 'ilisp-completion-word) (define-key ilisp-completion-map "\t" 'ilisp-completion) (define-key ilisp-completion-map "?" 'ilisp-completion-help) (define-key ilisp-completion-map "\M-\t" 'ilisp-completion) (define-key ilisp-completion-map "\n" 'ilisp-completion-exit) (define-key ilisp-completion-map "\r" 'ilisp-completion-exit) (define-key ilisp-completion-map "\C-g" 'abort-recursive-edit) (define-key ilisp-completion-map "(" 'ilisp-completion-paren) (define-key ilisp-completion-map ")" 'ilisp-completion-paren) (define-key ilisp-completion-map "'" nil) (define-key ilisp-completion-map "#" nil) (define-key ilisp-completion-map "\"" nil))) ilisp-completion-map) ;;; (defun ilisp-read (prompt &optional initial-contents) "PROMPT in the minibuffer with optional INITIAL-CONTENTS and return the result. Completion of symbols though the inferior LISP is allowed." (let ((ilisp-complete t) (ilisp-paren t) (ilisp-no-complete t) (ilisp-completion-package (lisp-buffer-package))) (read-from-minibuffer prompt initial-contents (ilisp-completion-map)))) ;;;%%lisp-read-program (defvar lisp-program-map nil "Minibuffer map for reading a program and arguments.") ;;; (defun lisp-read-program (prompt &optional initial) "Read a program with PROMPT and INITIAL. TAB or Esc-TAB will complete filenames." (if (null lisp-program-map) (progn (if (fboundp 'set-keymap-parent) (progn (setq lisp-program-map (make-sparse-keymap)) (set-keymap-parent lisp-program-map minibuffer-local-map)) (setq lisp-program-map (copy-keymap minibuffer-local-map))) (define-key lisp-program-map "\M-\t" 'comint-dynamic-complete) (define-key lisp-program-map "\t" 'comint-dynamic-complete) (define-key lisp-program-map "?" 'comint-dynamic-list-completions))) (read-from-minibuffer prompt initial lisp-program-map)) ;;;%%ilisp-read-symbol (defun ilisp-read-symbol (prompt &optional default function-p no-complete) "PROMPT in the minibuffer with optional DEFAULT and return a symbol from the inferior LISP. If FUNCTION-P is T, only symbols with function values will be returned. If NO-COMPLETE is T, then uncompleted symbols will be allowed." (let* ((ilisp-complete t) (ilisp-no-complete no-complete) (ilisp-completion-package (lisp-buffer-package)) (ilisp-completion-function-p function-p) (string (read-from-minibuffer prompt nil (ilisp-completion-map)))) (if (equal string "") default (lisp-string-to-symbol string)))) ;;;%%ilisp-completing-read (defun ilisp-completing-read (prompt table &optional default) "Read with PROMPT from an alist of TABLE. No input returns DEFAULT. Symbols are from table, other specs are in parentheses." (let* ((ilisp-complete t) (ilisp-table table) (ilisp-completion-package (lisp-buffer-package)) (ilisp-paren (let ((entry table) (done nil)) (while (and entry (not done)) (setq done (= (elt (car (car entry)) 0) ?\() entry (cdr entry))) done)) (string (read-from-minibuffer prompt nil (ilisp-completion-map)))) (if (string= string "") default string))) ;;;%%complete-lisp (autoload 'complete "completion" "Complete previous symbol." t) (defun complete-lisp (mode) "Complete the current symbol using information from the current ILISP buffer. If in a string, complete as a filename. If called with a positive prefix force all symbols to be considered. If called with a negative prefix, undo the last completion. Partial completion is allowed unless ilisp-prefix-match is T. If a symbol starts after a left paren or #', then only function symbols will be considered. Package specifications are also allowed and the distinction between internal and exported symbols is considered." (interactive "P") (if (< (prefix-numeric-value mode) 0) (completer-undo) (let* ((filep (save-excursion (skip-chars-backward "^ \t\n") (= (char-after (point)) ?\")))) (if filep (comint-dynamic-complete) (let* ((symbol-info (lisp-previous-symbol)) (symbol (car symbol-info)) (name (lisp-symbol-name symbol)) (choice (ilisp-completer symbol (if (not mode) (car (cdr symbol-info))))) (match (lisp-buffer-symbol (car choice))) (lcs (lisp-buffer-symbol (car (cdr choice)))) (choices (car (cdr (cdr choice)))) (unique (car (cdr (cdr (cdr choice)))))) (skip-chars-backward " \t\n") (completer-goto match lcs choices unique (ilisp-value 'ilisp-symbol-delimiters) completer-words))) (message "Completed")))) (provide 'ilisp-cmp )