;;; lisp.el --- Lisp editing commands for Emacs
;; Copyright (C) 1985, 1986, 1994, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: lisp, languages
;; 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
;; 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:
;; Note that this variable is used by non-lisp modes too.
(defcustom defun-prompt-regexp nil
- "*If non-nil, a regexp to ignore before a defun.
+ "If non-nil, a regexp to ignore before a defun.
This is only necessary if the opening paren or brace is not in column 0.
See function `beginning-of-defun'."
:type '(choice (const nil)
(defun forward-sexp (&optional arg)
"Move forward across one balanced expression (sexp).
With ARG, do it that many times. Negative arg -N means
-move backward across N balanced expressions."
- (interactive "p")
+move backward across N balanced expressions.
+This command assumes point is not in a string or comment."
+ (interactive "^p")
(or arg (setq arg 1))
(if forward-sexp-function
(funcall forward-sexp-function arg)
(defun backward-sexp (&optional arg)
"Move backward across one balanced expression (sexp).
With ARG, do it that many times. Negative arg -N means
-move forward across N balanced expressions."
- (interactive "p")
+move forward across N balanced expressions.
+This command assumes point is not in a string or comment."
+ (interactive "^p")
(or arg (setq arg 1))
(forward-sexp (- arg)))
move to with the same argument.
Interactively, if this command is repeated
or (in Transient Mark mode) if the mark is active,
-it marks the next ARG sexps after the ones already marked."
+it marks the next ARG sexps after the ones already marked.
+This command assumes point is not in a string or comment."
(interactive "P\np")
(cond ((and allow-extend
(or (and (eq last-command this-command) (mark t))
(defun forward-list (&optional arg)
"Move forward across one balanced group of parentheses.
With ARG, do it that many times.
-Negative arg -N means move backward across N groups of parentheses."
- (interactive "p")
+Negative arg -N means move backward across N groups of parentheses.
+This command assumes point is not in a string or comment."
+ (interactive "^p")
(or arg (setq arg 1))
(goto-char (or (scan-lists (point) arg 0) (buffer-end arg))))
(defun backward-list (&optional arg)
"Move backward across one balanced group of parentheses.
With ARG, do it that many times.
-Negative arg -N means move forward across N groups of parentheses."
- (interactive "p")
+Negative arg -N means move forward across N groups of parentheses.
+This command assumes point is not in a string or comment."
+ (interactive "^p")
(or arg (setq arg 1))
(forward-list (- arg)))
(defun down-list (&optional arg)
"Move forward down one level of parentheses.
With ARG, do this that many times.
-A negative argument means move backward but still go down a level."
- (interactive "p")
+A negative argument means move backward but still go down a level.
+This command assumes point is not in a string or comment."
+ (interactive "^p")
(or arg (setq arg 1))
(let ((inc (if (> arg 0) 1 -1)))
(while (/= arg 0)
(defun backward-up-list (&optional arg)
"Move backward out of one level of parentheses.
With ARG, do this that many times.
-A negative argument means move forward but still to a less deep spot."
- (interactive "p")
+A negative argument means move forward but still to a less deep spot.
+This command assumes point is not in a string or comment."
+ (interactive "^p")
(up-list (- (or arg 1))))
(defun up-list (&optional arg)
"Move forward out of one level of parentheses.
With ARG, do this that many times.
-A negative argument means move backward but still to a less deep spot."
- (interactive "p")
+A negative argument means move backward but still to a less deep spot.
+This command assumes point is not in a string or comment."
+ (interactive "^p")
(or arg (setq arg 1))
(let ((inc (if (> arg 0) 1 -1)))
(while (/= arg 0)
(defun kill-sexp (&optional arg)
"Kill the sexp (balanced expression) following point.
With ARG, kill that many sexps after point.
-Negative arg -N means kill N sexps before point."
+Negative arg -N means kill N sexps before point.
+This command assumes point is not in a string or comment."
(interactive "p")
(let ((opoint (point)))
(forward-sexp (or arg 1))
(defun backward-kill-sexp (&optional arg)
"Kill the sexp (balanced expression) preceding point.
With ARG, kill that many sexps before point.
-Negative arg -N means kill N sexps after point."
+Negative arg -N means kill N sexps after point.
+This command assumes point is not in a string or comment."
(interactive "p")
(kill-sexp (- (or arg 1))))
(defun kill-backward-up-list (&optional arg)
"Kill the form containing the current sexp, leaving the sexp itself.
A prefix argument ARG causes the relevant number of surrounding
-forms to be removed."
+forms to be removed.
+This command assumes point is not in a string or comment."
(interactive "*p")
(let ((current-sexp (thing-at-point 'sexp)))
(if current-sexp
(defun beginning-of-defun (&optional arg)
"Move backward to the beginning of a defun.
-With ARG, do it that many times. Negative arg -N
-means move forward to Nth following beginning of defun.
-Returns t unless search stops due to beginning or end of buffer.
-
-If variable `beginning-of-defun-function' is non-nil, its value
-is called as a function to find the defun's beginning.
-
-Normally a defun is assumed to start where there is a char with
-open-parenthesis syntax at the beginning of a line. If
-`defun-prompt-regexp' is non-nil, then a string which matches
-that regexp may precede the open-parenthesis, and point ends up
-at the beginning of the line.
-
-If `defun-prompt-regexp' and `open-paren-in-column-0-is-defun-start'
-are both nil, the function instead finds an open-paren at the
-outermost level."
- (interactive "p")
+With ARG, do it that many times. Negative ARG means move forward
+to the ARGth following beginning of defun.
+
+If search is successful, return t; point ends up at the beginning
+of the line where the search succeeded. Otherwise, return nil.
+
+When `open-paren-in-column-0-is-defun-start' is non-nil, a defun
+is assumed to start where there is a char with open-parenthesis
+syntax at the beginning of a line. If `defun-prompt-regexp' is
+non-nil, then a string which matches that regexp may also precede
+the open-parenthesis. If `defun-prompt-regexp' and
+`open-paren-in-column-0-is-defun-start' are both nil, this
+function instead finds an open-paren at the outermost level.
+
+If the variable `beginning-of-defun-function' is non-nil, its
+value is called as a function, with argument ARG, to find the
+defun's beginning.
+
+Regardless of the values of `defun-prompt-regexp' and
+`beginning-of-defun-function', point always moves to the
+beginning of the line whenever the search is successful."
+ (interactive "^p")
(or (not (eq this-command 'beginning-of-defun))
(eq last-command 'beginning-of-defun)
(and transient-mark-mode mark-active)
If variable `beginning-of-defun-function' is non-nil, its value
is called as a function to find the defun's beginning."
- (interactive "p") ; change this to "P", maybe, if we ever come to pass ARG
+ (interactive "^p") ; change this to "P", maybe, if we ever come to pass ARG
; to beginning-of-defun-function.
(unless arg (setq arg 1))
(cond
"\\(?:" defun-prompt-regexp "\\)\\s(")
"^\\s(")
nil 'move arg)
- (progn (goto-char (1- (match-end 0)))) t))
+ (progn (goto-char (1- (match-end 0)))
+ t)))
;; If open-paren-in-column-0-is-defun-start and defun-prompt-regexp
;; are both nil, column 0 has no significance - so scan forward
(goto-char (if arg-+ve floor ceiling))
nil))))))))
-(defvar end-of-defun-function #'forward-sexp
+(defvar end-of-defun-function
+ (lambda () (forward-sexp 1))
"Function for `end-of-defun' to call.
-This is used to find the end of the defun.
+This is used to find the end of the defun at point.
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.")
+So the function can assume that point is at the beginning of the defun body.
+It should move point to the first position after the defun.")
(defun buffer-end (arg)
"Return the \"far end\" position of the buffer, in direction ARG.
If variable `end-of-defun-function' is non-nil, its value
is called as a function to find the defun's end."
- (interactive "p")
+ (interactive "^p")
(or (not (eq this-command 'end-of-defun))
(eq last-command 'end-of-defun)
(and transient-mark-mode mark-active)
(push-mark))
(if (or (null arg) (= arg 0)) (setq arg 1))
- (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))))
+ (let ((pos (point))
+ (beg (progn (end-of-line 1) (beginning-of-defun-raw 1) (point))))
+ (funcall end-of-defun-function)
+ ;; When comparing point against pos, we want to consider that if
+ ;; point was right after the end of the function, it's still
+ ;; considered as "in that function".
+ ;; E.g. `eval-defun' from right after the last close-paren.
+ (unless (bolp)
+ (skip-chars-forward " \t")
+ (if (looking-at "\\s<\\|\n")
+ (forward-line 1)))
+ (cond
+ ((> arg 0)
+ ;; Moving forward.
+ (if (> (point) pos)
+ ;; We already moved forward by one because we started from
+ ;; within a function.
+ (setq arg (1- arg))
+ ;; We started from after the end of the previous function.
+ (goto-char pos))
+ (unless (zerop arg)
+ (beginning-of-defun-raw (- arg))
+ (funcall end-of-defun-function)))
+ ((< arg 0)
+ ;; Moving backward.
+ (if (< (point) pos)
+ ;; We already moved backward because we started from between
+ ;; two functions.
+ (setq arg (1+ arg))
+ ;; We started from inside a function.
+ (goto-char beg))
+ (unless (zerop arg)
+ (beginning-of-defun-raw (- arg))
+ (funcall end-of-defun-function))))
+ (unless (bolp)
+ (skip-chars-forward " \t")
+ (if (looking-at "\\s<\\|\n")
+ (forward-line 1)))))
(defun mark-defun (&optional allow-extend)
"Put mark at end of this defun, point at beginning.
from the variable `insert-pair-alist' according to the last input
character with or without modifiers. If no character pair is
found in the variable `insert-pair-alist', then the last input
-character is inserted ARG times."
+character is inserted ARG times.
+
+This command assumes point is not in a string or comment."
(interactive "P")
(if (not (and open close))
- (let ((pair (or (assq last-command-char insert-pair-alist)
+ (let ((pair (or (assq last-command-event insert-pair-alist)
(assq (event-basic-type last-command-event)
insert-pair-alist))))
(if pair
No argument is equivalent to zero: just insert `()' and leave point between.
If `parens-require-spaces' is non-nil, this command also inserts a space
before and after, depending on the surrounding characters.
-If region is active, insert enclosing characters at region boundaries."
+If region is active, insert enclosing characters at region boundaries.
+
+This command assumes point is not in a string or comment."
(interactive "P")
(insert-pair arg ?\( ?\)))
(error "Unmatched bracket or quote"))))
\f
(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")))))))
+ (let ((minibuffer-completion-table table)
+ (minibuffer-completion-predicate predicate)
+ ;; This made sense for lisp-complete-symbol, but for
+ ;; field-complete, this is out of place. --Stef
+ ;; (completion-annotate-function
+ ;; (unless (eq predicate 'fboundp)
+ ;; (lambda (str)
+ ;; (if (fboundp (intern-soft str)) " <f>"))))
+ )
+ (call-interactively 'minibuffer-complete)))
(defun lisp-complete-symbol (&optional predicate)
"Perform completion on Lisp symbol preceding point.
symbols with function definitions, values or properties are
considered."
(interactive)
- (let ((window (get-buffer-window "*Completions*" 0)))
- (if (and (eq last-command this-command)
- window (window-live-p window) (window-buffer window)
- (buffer-name (window-buffer window)))
- ;; If this command was repeated, and
- ;; there's a fresh completion window with a live buffer,
- ;; and this command is repeated, scroll that window.
- (with-current-buffer (window-buffer window)
- (if (pos-visible-in-window-p (point-max) window)
- (set-window-start window (point-min))
- (save-selected-window
- (select-window window)
- (scroll-up))))
-
- ;; Do completion.
- (let* ((end (point))
- (beg (with-syntax-table emacs-lisp-mode-syntax-table
- (save-excursion
- (backward-sexp 1)
- (while (= (char-syntax (following-char)) ?\')
- (forward-char 1))
- (point))))
- (pattern (buffer-substring-no-properties beg end))
- (predicate
- (or predicate
- (save-excursion
- (goto-char beg)
- (if (not (eq (char-before) ?\())
- (lambda (sym) ;why not just nil ? -sm
- (or (boundp sym) (fboundp sym)
- (symbol-plist sym)))
- ;; Looks like a funcall position. Let's double check.
- (if (condition-case nil
- (progn (up-list -2) (forward-char 1)
- (eq (char-after) ?\())
- (error nil))
- ;; If the first element of the parent list is an open
- ;; parenthesis we are probably not in a funcall position.
- ;; Maybe a `let' varlist or something.
- nil
- ;; Else, we assume that a function name is expected.
- 'fboundp)))))
- (completion (try-completion pattern obarray predicate)))
- (cond ((eq completion t))
- ((null completion)
- (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)
- (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 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))))
- (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")))))))))
+ (let* ((end (point))
+ (beg (with-syntax-table emacs-lisp-mode-syntax-table
+ (save-excursion
+ (backward-sexp 1)
+ (while (= (char-syntax (following-char)) ?\')
+ (forward-char 1))
+ (point))))
+ (predicate
+ (or predicate
+ (save-excursion
+ (goto-char beg)
+ (if (not (eq (char-before) ?\())
+ (lambda (sym) ;why not just nil ? -sm
+ (or (boundp sym) (fboundp sym)
+ (symbol-plist sym)))
+ ;; Looks like a funcall position. Let's double check.
+ (if (condition-case nil
+ (progn (up-list -2) (forward-char 1)
+ (eq (char-after) ?\())
+ (error nil))
+ ;; If the first element of the parent list is an open
+ ;; parenthesis we are probably not in a funcall position.
+ ;; Maybe a `let' varlist or something.
+ nil
+ ;; Else, we assume that a function name is expected.
+ 'fboundp))))))
+ (let ((completion-annotate-function
+ (unless (eq predicate 'fboundp)
+ (lambda (str) (if (fboundp (intern-soft str)) " <f>")))))
+ (completion-in-region beg end obarray predicate))))
;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e
;;; lisp.el ends here
HCoop / bpt / emacs.git / blobdiff