1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-24 14:30:43 -08:00

(lisp-complete-symbol): Repeating the command

after displaying a completion list scrolls the list.
This commit is contained in:
Richard M. Stallman 2002-01-11 21:22:28 +00:00
parent 4a96a5e96a
commit 1fa1cb1bf6

View file

@ -352,6 +352,8 @@ unbalanced character."
(defun lisp-complete-symbol (&optional predicate) (defun lisp-complete-symbol (&optional predicate)
"Perform completion on Lisp symbol preceding point. "Perform completion on Lisp symbol preceding point.
Compare that symbol against the known Lisp symbols. Compare that symbol against the known Lisp symbols.
If no characters can be completed, display a list of possible completions.
Repeating the command at that point scrolls the list.
When called from a program, optional arg PREDICATE is a predicate When called from a program, optional arg PREDICATE is a predicate
determining which symbols are considered, e.g. `commandp'. determining which symbols are considered, e.g. `commandp'.
@ -361,56 +363,72 @@ symbols with function definitions are considered. Otherwise, all
symbols with function definitions, values or properties are symbols with function definitions, values or properties are
considered." considered."
(interactive) (interactive)
(let* ((end (point))
(beg (with-syntax-table emacs-lisp-mode-syntax-table (let ((window (get-buffer-window "*Completions*")))
(save-excursion (if (and (eq last-command this-command)
(backward-sexp 1) window (window-live-p window) (window-buffer window)
(while (= (char-syntax (following-char)) ?\') (buffer-name (window-buffer window)))
(forward-char 1)) ;; If this command was repeated, and
(point)))) ;; there's a fresh completion window with a live buffer,
(pattern (buffer-substring-no-properties beg end)) ;; and this command is repeated, scroll that window.
(predicate (with-current-buffer (window-buffer window)
(or predicate (if (pos-visible-in-window-p (point-max) window)
(save-excursion (set-window-start window (point-min))
(goto-char beg) (save-selected-window
(if (not (eq (char-before) ?\()) (select-window window)
(lambda (sym) ;why not just nil ? -sm (scroll-up))))
(or (boundp sym) (fboundp sym)
(symbol-plist sym))) ;; Do completion.
;; Looks like a funcall position. Let's double check. (let* ((end (point))
(if (condition-case nil (beg (with-syntax-table emacs-lisp-mode-syntax-table
(progn (up-list -2) (forward-char 1) (save-excursion
(eq (char-after) ?\()) (backward-sexp 1)
(error nil)) (while (= (char-syntax (following-char)) ?\')
;; If the first element of the parent list is an open (forward-char 1))
;; parenthesis we are probably not in a funcall position. (point))))
;; Maybe a `let' varlist or something. (pattern (buffer-substring-no-properties beg end))
nil (predicate
;; Else, we assume that a function name is expected. (or predicate
'fboundp))))) (save-excursion
(completion (try-completion pattern obarray predicate))) (goto-char beg)
(cond ((eq completion t)) (if (not (eq (char-before) ?\())
((null completion) (lambda (sym) ;why not just nil ? -sm
(message "Can't find completion for \"%s\"" pattern) (or (boundp sym) (fboundp sym)
(ding)) (symbol-plist sym)))
((not (string= pattern completion)) ;; Looks like a funcall position. Let's double check.
(delete-region beg end) (if (condition-case nil
(insert completion)) (progn (up-list -2) (forward-char 1)
(t (eq (char-after) ?\())
(message "Making completion list...") (error nil))
(let ((list (all-completions pattern obarray predicate))) ;; If the first element of the parent list is an open
(setq list (sort list 'string<)) ;; parenthesis we are probably not in a funcall position.
(or (eq predicate 'fboundp) ;; Maybe a `let' varlist or something.
(let (new) nil
(while list ;; Else, we assume that a function name is expected.
(setq new (cons (if (fboundp (intern (car list))) 'fboundp)))))
(list (car list) " <f>") (completion (try-completion pattern obarray predicate)))
(car list)) (cond ((eq completion t))
new)) ((null completion)
(setq list (cdr list))) (message "Can't find completion for \"%s\"" pattern)
(setq list (nreverse new)))) (ding))
(with-output-to-temp-buffer "*Completions*" ((not (string= pattern completion))
(display-completion-list list))) (delete-region beg end)
(message "Making completion list...%s" "done"))))) (insert completion))
(t
(message "Making completion list...")
(let ((list (all-completions pattern obarray predicate)))
(setq list (sort list 'string<))
(or (eq predicate 'fboundp)
(let (new)
(while list
(setq new (cons (if (fboundp (intern (car list)))
(list (car list) " <f>")
(car list))
new))
(setq list (cdr list)))
(setq list (nreverse new))))
(with-output-to-temp-buffer "*Completions*"
(display-completion-list list)))
(message "Making completion list...%s" "done")))))))
;;; lisp.el ends here ;;; lisp.el ends here