summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/advice.el14
-rw-r--r--lisp/emacs-lisp/cl-macs.el4
-rw-r--r--lisp/emacs-lisp/debug.el107
-rw-r--r--lisp/emacs-lisp/lisp-mode.el1
-rw-r--r--lisp/emacs-lisp/rx.el6
5 files changed, 74 insertions, 58 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index cfaac96bbb1..171b68e457c 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1,6 +1,6 @@
;;; advice.el --- an overloading mechanism for Emacs Lisp functions
-;; Copyright (C) 1993,1994,2000,01,2004 Free Software Foundation, Inc.
+;; Copyright (C) 1993,1994,2000,01,2004,2005 Free Software Foundation, Inc.
;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
;; Maintainer: FSF
@@ -2173,7 +2173,7 @@ Redefining advices affect the construction of an advised definition."
;; ============================================
;; The advice-info of an advised function contains its `origname' which is
;; a symbol that is fbound to the original definition available at the first
-;; proper activation of the function after a legal re/definition. If the
+;; proper activation of the function after a valid re/definition. If the
;; original was defined via fcell indirection then `origname' will be defined
;; just so. Hence, to get hold of the actual original definition of a function
;; we need to use `ad-real-orig-definition'.
@@ -2238,7 +2238,7 @@ which PREDICATE returns non-nil)."
ad-advice-classes))
(defun ad-read-advice-class (function &optional prompt default)
- "Read a legal advice class with completion from the minibuffer.
+ "Read a valid advice class with completion from the minibuffer.
An optional PROMPT will be used to prompt for the class. DEFAULT will
be returned on empty input (defaults to the first non-empty advice
class of FUNCTION)."
@@ -2312,7 +2312,7 @@ be used to prompt for the function."
(defun ad-find-some-advice (function class name)
"Find the first of FUNCTION's advices in CLASS matching NAME.
NAME can be a symbol or a regular expression matching part of an advice name.
-If CLASS is `any' all legal advice classes will be checked."
+If CLASS is `any' all valid advice classes will be checked."
(if (ad-is-advised function)
(let (found-advice)
(ad-dolist (advice-class ad-advice-classes)
@@ -2332,7 +2332,7 @@ If CLASS is `any' all legal advice classes will be checked."
"Set enable FLAG of FUNCTION's advices in CLASS matching NAME.
If NAME is a string rather than a symbol then it's interpreted as a regular
expression and all advices whose name contain a match for it will be
-affected. If CLASS is `any' advices in all legal advice classes will be
+affected. If CLASS is `any' advices in all valid advice classes will be
considered. The number of changed advices will be returned (or nil if
FUNCTION was not advised)."
(if (ad-is-advised function)
@@ -2369,7 +2369,7 @@ FUNCTION was not advised)."
(defun ad-enable-regexp-internal (regexp class flag)
"Set enable FLAGs of all CLASS advices whose name contains a REGEXP match.
-If CLASS is `any' all legal advice classes are considered. The number of
+If CLASS is `any' all valid advice classes are considered. The number of
affected advices will be returned."
(let ((matched-advices 0))
(ad-do-advised-functions (advised-function)
@@ -3755,7 +3755,7 @@ deactivation, which might run hooks and get into other trouble."
(error nil))))
-;; Completion alist of legal `defadvice' flags
+;; Completion alist of valid `defadvice' flags
(defvar ad-defadvice-flags
'(("protect") ("disable") ("activate")
("compile") ("preactivate") ("freeze")))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index cbab83184e1..305f0dd9587 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1,6 +1,6 @@
;;; cl-macs.el --- Common Lisp macros -*-byte-compile-dynamic: t;-*-
-;; Copyright (C) 1993, 2003, 2004 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2003, 2004, 2005 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Version: 2.02
@@ -2219,7 +2219,7 @@ copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors.
(if type
(progn
(or (memq type '(vector list))
- (error "Illegal :type specifier: %s" type))
+ (error "Invalid :type specifier: %s" type))
(if named (setq tag name)))
(setq type 'vector named 'true)))
(or named (setq descs (delq (assq 'cl-tag-slot descs) descs)))
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index e97e9012fc1..2149cba8720 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -584,10 +584,9 @@ Applies to the frame whose line point is on in the backtrace."
(terpri))
(with-current-buffer (get-buffer debugger-record-buffer)
- (save-excursion
- (forward-line -1)
- (message
- (buffer-substring (point) (progn (end-of-line) (point)))))))
+ (message "%s"
+ (buffer-substring (line-beginning-position 0)
+ (line-end-position 0)))))
(put 'debugger-mode 'mode-class 'special)
@@ -633,24 +632,31 @@ which must be written in Lisp, not predefined.
Use \\[cancel-debug-on-entry] to cancel the effect of this command.
Redefining FUNCTION also cancels it."
(interactive "aDebug on entry (to function): ")
- ;; Handle a function that has been aliased to some other function.
- (if (and (subrp (symbol-function function))
- (eq (cdr (subr-arity (symbol-function function))) 'unevalled))
- (error "Function %s is a special form" function))
- (if (or (symbolp (symbol-function function))
+ (when (and (subrp (symbol-function function))
+ (eq (cdr (subr-arity (symbol-function function))) 'unevalled))
+ (error "Function %s is a special form" function))
+ (if (or (symbolp (symbol-function function))
(subrp (symbol-function function)))
- ;; Create a wrapper in which we can then add the necessary debug call.
+ ;; The function is built-in or aliased to another function.
+ ;; Create a wrapper in which we can add the debug call.
(fset function `(lambda (&rest debug-on-entry-args)
,(interactive-form (symbol-function function))
- (apply ',(symbol-function function)
- debug-on-entry-args))))
- (or (consp (symbol-function function))
- (debug-convert-byte-code function))
- (or (consp (symbol-function function))
- (error "Definition of %s is not a list" function))
+ (apply ',(symbol-function function)
+ debug-on-entry-args)))
+ (when (eq (car-safe (symbol-function function)) 'autoload)
+ ;; The function is autoloaded. Load its real definition.
+ (load (cadr (symbol-function function)) nil noninteractive nil t))
+ (when (or (not (consp (symbol-function function)))
+ (and (eq (car (symbol-function function)) 'macro)
+ (not (consp (cdr (symbol-function function))))))
+ ;; The function is byte-compiled. Create a wrapper in which
+ ;; we can add the debug call.
+ (debug-convert-byte-code function)))
+ (unless (consp (symbol-function function))
+ (error "Definition of %s is not a list" function))
(fset function (debug-on-entry-1 function t))
- (or (memq function debug-function-list)
- (push function debug-function-list))
+ (unless (memq function debug-function-list)
+ (push function debug-function-list))
function)
;;;###autoload
@@ -665,45 +671,52 @@ If argument is nil or an empty string, cancel for all functions."
(if name (intern name)))))
(if (and function (not (string= function "")))
(progn
- (let ((f (debug-on-entry-1 function nil)))
+ (let ((defn (debug-on-entry-1 function nil)))
(condition-case nil
- (if (and (equal (nth 1 f) '(&rest debug-on-entry-args))
- (eq (car (nth 3 f)) 'apply))
- ;; `f' is a wrapper introduced in debug-on-entry.
- ;; Get rid of it since we don't need it any more.
- (setq f (nth 1 (nth 1 (nth 3 f)))))
+ (when (and (equal (nth 1 defn) '(&rest debug-on-entry-args))
+ (eq (car (nth 3 defn)) 'apply))
+ ;; `defn' is a wrapper introduced in debug-on-entry.
+ ;; Get rid of it since we don't need it any more.
+ (setq defn (nth 1 (nth 1 (nth 3 defn)))))
(error nil))
- (fset function f))
+ (fset function defn))
(setq debug-function-list (delq function debug-function-list))
function)
(message "Cancelling debug-on-entry for all functions")
(mapcar 'cancel-debug-on-entry debug-function-list)))
(defun debug-convert-byte-code (function)
- (let ((defn (symbol-function function)))
- (if (not (consp defn))
- ;; Assume a compiled code object.
- (let* ((contents (append defn nil))
- (body
- (list (list 'byte-code (nth 1 contents)
- (nth 2 contents) (nth 3 contents)))))
- (if (nthcdr 5 contents)
- (setq body (cons (list 'interactive (nth 5 contents)) body)))
- (if (nth 4 contents)
- ;; Use `documentation' here, to get the actual string,
- ;; in case the compiled function has a reference
- ;; to the .elc file.
- (setq body (cons (documentation function) body)))
- (fset function (cons 'lambda (cons (car contents) body)))))))
+ (let* ((defn (symbol-function function))
+ (macro (eq (car-safe defn) 'macro)))
+ (when macro (setq defn (cdr defn)))
+ (unless (consp defn)
+ ;; Assume a compiled code object.
+ (let* ((contents (append defn nil))
+ (body
+ (list (list 'byte-code (nth 1 contents)
+ (nth 2 contents) (nth 3 contents)))))
+ (if (nthcdr 5 contents)
+ (setq body (cons (list 'interactive (nth 5 contents)) body)))
+ (if (nth 4 contents)
+ ;; Use `documentation' here, to get the actual string,
+ ;; in case the compiled function has a reference
+ ;; to the .elc file.
+ (setq body (cons (documentation function) body)))
+ (setq defn (cons 'lambda (cons (car contents) body))))
+ (when macro (setq defn (cons 'macro defn)))
+ (fset function defn))))
(defun debug-on-entry-1 (function flag)
(let* ((defn (symbol-function function))
(tail defn))
- (if (subrp tail)
- (error "%s is a built-in function" function)
- (if (eq (car tail) 'macro) (setq tail (cdr tail)))
- (if (eq (car tail) 'lambda) (setq tail (cdr tail))
- (error "%s not user-defined Lisp function" function))
+ (when (eq (car-safe tail) 'macro)
+ (setq tail (cdr tail)))
+ (if (not (eq (car-safe tail) 'lambda))
+ ;; Only signal an error when we try to set debug-on-entry.
+ ;; When we try to clear debug-on-entry, we are now done.
+ (when flag
+ (error "%s is not a user-defined Lisp function" function))
+ (setq tail (cdr tail))
;; Skip the docstring.
(when (and (stringp (cadr tail)) (cddr tail))
(setq tail (cdr tail)))
@@ -714,8 +727,8 @@ If argument is nil or an empty string, cancel for all functions."
;; Add/remove debug statement as needed.
(if flag
(setcdr tail (cons '(implement-debug-on-entry) (cdr tail)))
- (setcdr tail (cddr tail))))
- defn)))
+ (setcdr tail (cddr tail)))))
+ defn))
(defun debugger-list-functions ()
"Display a list of all the functions now set to debug on entry."
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 2e829080c9c..8f4245cb9a1 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -91,6 +91,7 @@
'("defun" "defun*" "defsubst" "defmacro"
"defadvice" "define-skeleton"
"define-minor-mode" "define-derived-mode"
+ "define-generic-mode"
"define-compiler-macro" "define-modify-macro"
"defsetf" "define-setf-expander"
"define-method-combination"
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index d4a10104eea..49196f17ef0 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -1,6 +1,6 @@
;;; rx.el --- sexp notation for regular expressions
-;; Copyright (C) 2001, 03, 2004 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
;; Maintainer: FSF
@@ -169,6 +169,8 @@
(eow . word-end) ; SRE
(word-boundary . "\\b")
(not-word-boundary . "\\B") ; sregex
+ (symbol-start . "\\_<")
+ (symbol-end . "\\_>")
(syntax . (rx-syntax 1 1))
(not-syntax . (rx-not-syntax 1 1)) ; sregex
(category . (rx-category 1 1 rx-check-category))
@@ -969,5 +971,5 @@ enclosed in `(and ...)'.
(provide 'rx)
-;;; arch-tag: 12d01a63-0008-42bb-ab8c-1c7d63be370b
+;; arch-tag: 12d01a63-0008-42bb-ab8c-1c7d63be370b
;;; rx.el ends here
generated by cgit v1.2.3 (git 2.39.1) at 2025-05-07 22:38:45 +0000