diff options
Diffstat (limited to 'lisp/emacs-lisp/lisp.el')
| -rw-r--r-- | lisp/emacs-lisp/lisp.el | 169 |
1 files changed, 104 insertions, 65 deletions
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 4fd6fe7a17f..3fe2fd1813c 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -8,10 +8,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -19,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: @@ -176,9 +174,10 @@ normal recipe (see `beginning-of-defun'). Major modes can define this if defining `defun-prompt-regexp' is not sufficient to handle the mode's needs. -The function (of no args) should go to the line on which the current -defun starts, and return non-nil, or should return nil if it can't -find the beginning.") +The function takes the same argument as `beginning-of-defun' and should +behave similarly, returning non-nil if it found the beginning of a defun. +Ideally it should move to a point right before an open-paren which encloses +the body of the defun.") (defun beginning-of-defun (&optional arg) "Move backward to the beginning of a defun. @@ -219,12 +218,22 @@ is called as a function to find the defun's beginning." (unless arg (setq arg 1)) (cond (beginning-of-defun-function - (if (> arg 0) - (dotimes (i arg) - (funcall beginning-of-defun-function)) - ;; Better not call end-of-defun-function directly, in case - ;; it's not defined. - (end-of-defun (- arg)))) + (condition-case nil + (funcall beginning-of-defun-function arg) + ;; We used to define beginning-of-defun-function as taking no argument + ;; but that makes it impossible to implement correct forward motion: + ;; we used to use end-of-defun for that, but it's not supposed to do + ;; the same thing (it moves to the end of a defun not to the beginning + ;; of the next). + ;; In case the beginning-of-defun-function uses the old calling + ;; convention, fallback on the old implementation. + (wrong-number-of-arguments + (if (> arg 0) + (dotimes (i arg) + (funcall beginning-of-defun-function)) + ;; Better not call end-of-defun-function directly, in case + ;; it's not defined. + (end-of-defun (- arg)))))) ((or defun-prompt-regexp open-paren-in-column-0-is-defun-start) (and (< arg 0) (not (eobp)) (forward-char 1)) @@ -287,11 +296,11 @@ is called as a function to find the defun's beginning." (goto-char (if arg-+ve floor ceiling)) nil)))))))) -(defvar end-of-defun-function nil - "If non-nil, function for function `end-of-defun' to call. -This is used to find the end of the defun instead of using the normal -recipe (see `end-of-defun'). Major modes can define this if the -normal method is not appropriate.") +(defvar end-of-defun-function #'forward-sexp + "Function for `end-of-defun' to call. +This is used to find the end of the defun. +It is called with no argument, right after calling `beginning-of-defun-raw'. +So the function can assume that point is at the beginning of the defun body.") (defun buffer-end (arg) "Return the \"far end\" position of the buffer, in direction ARG. @@ -316,45 +325,38 @@ is called as a function to find the defun's end." (and transient-mark-mode mark-active) (push-mark)) (if (or (null arg) (= arg 0)) (setq arg 1)) - (if end-of-defun-function - (if (> arg 0) - (dotimes (i arg) - (funcall end-of-defun-function)) - ;; Better not call beginning-of-defun-function - ;; directly, in case it's not defined. - (beginning-of-defun (- arg))) - (let ((first t)) - (while (and (> arg 0) (< (point) (point-max))) - (let ((pos (point))) - (while (progn - (if (and first - (progn - (end-of-line 1) - (beginning-of-defun-raw 1))) - nil - (or (bobp) (forward-char -1)) - (beginning-of-defun-raw -1)) - (setq first nil) - (forward-list 1) - (skip-chars-forward " \t") - (if (looking-at "\\s<\\|\n") - (forward-line 1)) - (<= (point) pos)))) - (setq arg (1- arg))) - (while (< arg 0) - (let ((pos (point))) - (beginning-of-defun-raw 1) - (forward-sexp 1) - (forward-line 1) - (if (>= (point) pos) - (if (beginning-of-defun-raw 2) - (progn - (forward-list 1) - (skip-chars-forward " \t") - (if (looking-at "\\s<\\|\n") - (forward-line 1))) - (goto-char (point-min))))) - (setq arg (1+ arg)))))) + (while (> arg 0) + (let ((pos (point))) + (end-of-line 1) + (beginning-of-defun-raw 1) + (while (unless (eobp) + (funcall end-of-defun-function) + (skip-chars-forward " \t") + (if (looking-at "\\s<\\|\n") + (forward-line 1)) + ;; If we started after the end of the previous function, then + ;; try again with the next one. + (when (<= (point) pos) + (or (bobp) (forward-char -1)) + (beginning-of-defun-raw -1) + 'try-again)))) + (setq arg (1- arg))) + (while (< arg 0) + (let ((pos (point))) + (while (unless (bobp) + (beginning-of-line 1) + (beginning-of-defun-raw 1) + (let ((beg (point))) + (funcall end-of-defun-function) + (skip-chars-forward " \t") + (if (looking-at "\\s<\\|\n") + (forward-line 1)) + ;; If we started from within the function just found, then + ;; try again with the previous one. + (when (>= (point) pos) + (goto-char beg) + 'try-again))))) + (setq arg (1+ arg)))) (defun mark-defun (&optional allow-extend) "Put mark at end of this defun, point at beginning. @@ -563,12 +565,47 @@ character." ;; "Unbalanced parentheses", but those may not be so ;; accurate/helpful, e.g. quotes may actually be ;; mismatched. - (error "Unmatched bracket or quote")) - (error (cond ((eq 'scan-error (car data)) - (goto-char (nth 2 data)) - (error "Unmatched bracket or quote")) - (t (signal (car data) (cdr data))))))) + (error "Unmatched bracket or quote")))) +(defun field-complete (table &optional predicate) + (let* ((pattern (field-string-no-properties)) + (completion (try-completion pattern table predicate))) + (cond ((eq completion t)) + ((null completion) + (message "Can't find completion for \"%s\"" pattern) + (ding)) + ((not (string= pattern completion)) + (delete-region (field-beginning) (field-end)) + (insert completion) + ;; Don't leave around a completions buffer that's out of date. + (let ((win (get-buffer-window "*Completions*" 0))) + (if win (with-selected-window win (bury-buffer))))) + (t + (let ((minibuf-is-in-use + (eq (minibuffer-window) (selected-window)))) + (unless minibuf-is-in-use + (message "Making completion list...")) + (let ((list (all-completions pattern table 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)))) + (if (> (length list) 1) + (with-output-to-temp-buffer "*Completions*" + (display-completion-list list pattern)) + ;; Don't leave around a completions buffer that's + ;; out of date. + (let ((win (get-buffer-window "*Completions*" 0))) + (if win (with-selected-window win (bury-buffer)))))) + (unless minibuf-is-in-use + (message "Making completion list...%s" "done"))))))) + (defun lisp-complete-symbol (&optional predicate) "Perform completion on Lisp symbol preceding point. Compare that symbol against the known Lisp symbols. @@ -628,7 +665,9 @@ considered." (completion (try-completion pattern obarray predicate))) (cond ((eq completion t)) ((null completion) - (message "Can't find completion for \"%s\"" pattern) + (if (window-minibuffer-p (selected-window)) + (minibuffer-message (format " [No completions of \"%s\"]" pattern)) + (message "Can't find completion for \"%s\"" pattern)) (ding)) ((not (string= pattern completion)) (delete-region beg end) |