352 |
(defun lisp-complete-symbol (&optional predicate) |
(defun lisp-complete-symbol (&optional predicate) |
353 |
"Perform completion on Lisp symbol preceding point. |
"Perform completion on Lisp symbol preceding point. |
354 |
Compare that symbol against the known Lisp symbols. |
Compare that symbol against the known Lisp symbols. |
355 |
|
If no characters can be completed, display a list of possible completions. |
356 |
|
Repeating the command at that point scrolls the list. |
357 |
|
|
358 |
When called from a program, optional arg PREDICATE is a predicate |
When called from a program, optional arg PREDICATE is a predicate |
359 |
determining which symbols are considered, e.g. `commandp'. |
determining which symbols are considered, e.g. `commandp'. |
363 |
symbols with function definitions, values or properties are |
symbols with function definitions, values or properties are |
364 |
considered." |
considered." |
365 |
(interactive) |
(interactive) |
366 |
(let* ((end (point)) |
|
367 |
(beg (with-syntax-table emacs-lisp-mode-syntax-table |
(let ((window (get-buffer-window "*Completions*"))) |
368 |
(save-excursion |
(if (and (eq last-command this-command) |
369 |
(backward-sexp 1) |
window (window-live-p window) (window-buffer window) |
370 |
(while (= (char-syntax (following-char)) ?\') |
(buffer-name (window-buffer window))) |
371 |
(forward-char 1)) |
;; If this command was repeated, and |
372 |
(point)))) |
;; there's a fresh completion window with a live buffer, |
373 |
(pattern (buffer-substring-no-properties beg end)) |
;; and this command is repeated, scroll that window. |
374 |
(predicate |
(with-current-buffer (window-buffer window) |
375 |
(or predicate |
(if (pos-visible-in-window-p (point-max) window) |
376 |
(save-excursion |
(set-window-start window (point-min)) |
377 |
(goto-char beg) |
(save-selected-window |
378 |
(if (not (eq (char-before) ?\()) |
(select-window window) |
379 |
(lambda (sym) ;why not just nil ? -sm |
(scroll-up)))) |
380 |
(or (boundp sym) (fboundp sym) |
|
381 |
(symbol-plist sym))) |
;; Do completion. |
382 |
;; Looks like a funcall position. Let's double check. |
(let* ((end (point)) |
383 |
(if (condition-case nil |
(beg (with-syntax-table emacs-lisp-mode-syntax-table |
384 |
(progn (up-list -2) (forward-char 1) |
(save-excursion |
385 |
(eq (char-after) ?\()) |
(backward-sexp 1) |
386 |
(error nil)) |
(while (= (char-syntax (following-char)) ?\') |
387 |
;; If the first element of the parent list is an open |
(forward-char 1)) |
388 |
;; parenthesis we are probably not in a funcall position. |
(point)))) |
389 |
;; Maybe a `let' varlist or something. |
(pattern (buffer-substring-no-properties beg end)) |
390 |
nil |
(predicate |
391 |
;; Else, we assume that a function name is expected. |
(or predicate |
392 |
'fboundp))))) |
(save-excursion |
393 |
(completion (try-completion pattern obarray predicate))) |
(goto-char beg) |
394 |
(cond ((eq completion t)) |
(if (not (eq (char-before) ?\()) |
395 |
((null completion) |
(lambda (sym) ;why not just nil ? -sm |
396 |
(message "Can't find completion for \"%s\"" pattern) |
(or (boundp sym) (fboundp sym) |
397 |
(ding)) |
(symbol-plist sym))) |
398 |
((not (string= pattern completion)) |
;; Looks like a funcall position. Let's double check. |
399 |
(delete-region beg end) |
(if (condition-case nil |
400 |
(insert completion)) |
(progn (up-list -2) (forward-char 1) |
401 |
(t |
(eq (char-after) ?\()) |
402 |
(message "Making completion list...") |
(error nil)) |
403 |
(let ((list (all-completions pattern obarray predicate))) |
;; If the first element of the parent list is an open |
404 |
(setq list (sort list 'string<)) |
;; parenthesis we are probably not in a funcall position. |
405 |
(or (eq predicate 'fboundp) |
;; Maybe a `let' varlist or something. |
406 |
(let (new) |
nil |
407 |
(while list |
;; Else, we assume that a function name is expected. |
408 |
(setq new (cons (if (fboundp (intern (car list))) |
'fboundp))))) |
409 |
(list (car list) " <f>") |
(completion (try-completion pattern obarray predicate))) |
410 |
(car list)) |
(cond ((eq completion t)) |
411 |
new)) |
((null completion) |
412 |
(setq list (cdr list))) |
(message "Can't find completion for \"%s\"" pattern) |
413 |
(setq list (nreverse new)))) |
(ding)) |
414 |
(with-output-to-temp-buffer "*Completions*" |
((not (string= pattern completion)) |
415 |
(display-completion-list list))) |
(delete-region beg end) |
416 |
(message "Making completion list...%s" "done"))))) |
(insert completion)) |
417 |
|
(t |
418 |
|
(message "Making completion list...") |
419 |
|
(let ((list (all-completions pattern obarray predicate))) |
420 |
|
(setq list (sort list 'string<)) |
421 |
|
(or (eq predicate 'fboundp) |
422 |
|
(let (new) |
423 |
|
(while list |
424 |
|
(setq new (cons (if (fboundp (intern (car list))) |
425 |
|
(list (car list) " <f>") |
426 |
|
(car list)) |
427 |
|
new)) |
428 |
|
(setq list (cdr list))) |
429 |
|
(setq list (nreverse new)))) |
430 |
|
(with-output-to-temp-buffer "*Completions*" |
431 |
|
(display-completion-list list))) |
432 |
|
(message "Making completion list...%s" "done"))))))) |
433 |
|
|
434 |
;;; lisp.el ends here |
;;; lisp.el ends here |