/[emacs]/emacs/lisp/emacs-lisp/lisp.el
ViewVC logotype

Diff of /emacs/lisp/emacs-lisp/lisp.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.43 by monnier, Mon Nov 19 22:06:10 2001 UTC revision 1.44 by rms, Fri Jan 11 21:22:28 2002 UTC
# Line 352  unbalanced character." Line 352  unbalanced character."
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'.
# Line 361  symbols with function definitions are co Line 363  symbols with function definitions are co
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

Legend:
Removed from v.1.43  
changed lines
  Added in v.1.44

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26