summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/bindat.el3
-rw-r--r--lisp/emacs-lisp/byte-opt.el29
-rw-r--r--lisp/emacs-lisp/bytecomp.el161
-rw-r--r--lisp/emacs-lisp/cconv.el34
-rw-r--r--lisp/emacs-lisp/cl-macs.el5
-rw-r--r--lisp/emacs-lisp/debug.el292
-rw-r--r--lisp/emacs-lisp/edebug.el28
-rw-r--r--lisp/emacs-lisp/eieio-opt.el9
-rw-r--r--lisp/emacs-lisp/eieio-speedbar.el6
-rw-r--r--lisp/emacs-lisp/generator.el2
-rw-r--r--lisp/emacs-lisp/lisp-mnt.el13
-rw-r--r--lisp/emacs-lisp/lisp-mode.el1
-rw-r--r--lisp/emacs-lisp/package.el30
-rw-r--r--lisp/emacs-lisp/tabulated-list.el8
14 files changed, 248 insertions, 373 deletions
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 850af93571f..b5d99e34518 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -149,9 +149,6 @@
;; | ip -- 4 byte vector
;; | bits LEN -- List with bits set in LEN bytes.
;;
-;; -- Note: 32 bit values may be limited by emacs' INTEGER
-;; implementation limits.
-;;
;; -- Example: `bits 2' will unpack 0x28 0x1c to (2 3 4 11 13)
;; and 0x1c 0x28 to (3 5 10 11 12).
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 90ab8911c39..fe0930c684b 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -480,6 +480,13 @@
backwards)))))
(cons fn (mapcar 'byte-optimize-form (cdr form)))))
+ ((eq fn 'while)
+ (unless (consp (cdr form))
+ (byte-compile-warn "too few arguments for `while'"))
+ (cons fn
+ (cons (byte-optimize-form (cadr form) nil)
+ (byte-optimize-body (cddr form) t))))
+
((eq fn 'interactive)
(byte-compile-warn "misplaced interactive spec: `%s'"
(prin1-to-string form))
@@ -491,15 +498,12 @@
form)
((eq fn 'condition-case)
- (if byte-compile--use-old-handlers
- ;; Will be optimized later.
- form
- `(condition-case ,(nth 1 form) ;Not evaluated.
- ,(byte-optimize-form (nth 2 form) for-effect)
- ,@(mapcar (lambda (clause)
- `(,(car clause)
- ,@(byte-optimize-body (cdr clause) for-effect)))
- (nthcdr 3 form)))))
+ `(condition-case ,(nth 1 form) ;Not evaluated.
+ ,(byte-optimize-form (nth 2 form) for-effect)
+ ,@(mapcar (lambda (clause)
+ `(,(car clause)
+ ,@(byte-optimize-body (cdr clause) for-effect)))
+ (nthcdr 3 form))))
((eq fn 'unwind-protect)
;; the "protected" part of an unwind-protect is compiled (and thus
@@ -514,12 +518,7 @@
((eq fn 'catch)
(cons fn
(cons (byte-optimize-form (nth 1 form) nil)
- (if byte-compile--use-old-handlers
- ;; The body of a catch is compiled (and thus
- ;; optimized) as a top-level form, so don't do it
- ;; here.
- (cdr (cdr form))
- (byte-optimize-body (cdr form) for-effect)))))
+ (byte-optimize-body (cdr form) for-effect))))
((eq fn 'ignore)
;; Don't treat the args to `ignore' as being
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 73bbc2fe182..d35ce663507 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -719,14 +719,15 @@ otherwise pop it")
"to make a binding to record entire window configuration")
(byte-defop 140 0 byte-save-restriction
"to make a binding to record the current buffer clipping restrictions")
-(byte-defop 141 -1 byte-catch
+(byte-defop 141 -1 byte-catch-OBSOLETE ; Not generated since Emacs 25.
"for catch. Takes, on stack, the tag and an expression for the body")
(byte-defop 142 -1 byte-unwind-protect
"for unwind-protect. Takes, on stack, an expression for the unwind-action")
;; For condition-case. Takes, on stack, the variable to bind,
;; an expression for the body, and a list of clauses.
-(byte-defop 143 -2 byte-condition-case)
+;; Not generated since Emacs 25.
+(byte-defop 143 -2 byte-condition-case-OBSOLETE)
(byte-defop 144 0 byte-temp-output-buffer-setup-OBSOLETE)
(byte-defop 145 -1 byte-temp-output-buffer-show-OBSOLETE)
@@ -1201,7 +1202,7 @@ message buffer `default-directory'."
byte-compile-last-warned-form))))
(insert (format "\nIn %s:\n" form)))
(when level
- (insert (format "%s%s" file pos))))
+ (insert (format "%s%s " file pos))))
(setq byte-compile-last-logged-file byte-compile-current-file
byte-compile-last-warned-form byte-compile-current-form)
entry)
@@ -2152,36 +2153,36 @@ With argument ARG, insert value in current buffer after the form."
(when (< (point-max) (position-bytes (point-max)))
(goto-char (point-min))
;; Find the comment that describes the version condition.
- (search-forward "\n;;; This file uses")
- (narrow-to-region (line-beginning-position) (point-max))
- ;; Find the first line of ballast semicolons.
- (search-forward ";;;;;;;;;;")
- (beginning-of-line)
- (narrow-to-region (point-min) (point))
- (let ((old-header-end (point))
- (minimum-version "23")
- delta)
- (delete-region (point-min) (point-max))
- (insert
- ";;; This file contains utf-8 non-ASCII characters,\n"
- ";;; and so cannot be loaded into Emacs 22 or earlier.\n"
- ;; Have to check if emacs-version is bound so that this works
- ;; in files loaded early in loadup.el.
- "(and (boundp 'emacs-version)\n"
- ;; If there is a name at the end of emacs-version,
- ;; don't try to check the version number.
- " (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
- (format " (string-lessp emacs-version \"%s\")\n" minimum-version)
- ;; Because the header must fit in a fixed width, we cannot
- ;; insert arbitrary-length file names (Bug#11585).
- " (error \"`%s' was compiled for "
- (format "Emacs %s or later\" #$))\n\n" minimum-version))
- ;; Now compensate for any change in size, to make sure all
- ;; positions in the file remain valid.
- (setq delta (- (point-max) old-header-end))
- (goto-char (point-max))
- (widen)
- (delete-char delta))))
+ (when (search-forward "\n;;; This file does not contain utf-8" nil t)
+ (narrow-to-region (line-beginning-position) (point-max))
+ ;; Find the first line of ballast semicolons.
+ (search-forward ";;;;;;;;;;")
+ (beginning-of-line)
+ (narrow-to-region (point-min) (point))
+ (let ((old-header-end (point))
+ (minimum-version "23")
+ delta)
+ (delete-region (point-min) (point-max))
+ (insert
+ ";;; This file contains utf-8 non-ASCII characters,\n"
+ ";;; and so cannot be loaded into Emacs 22 or earlier.\n"
+ ;; Have to check if emacs-version is bound so that this works
+ ;; in files loaded early in loadup.el.
+ "(and (boundp 'emacs-version)\n"
+ ;; If there is a name at the end of emacs-version,
+ ;; don't try to check the version number.
+ " (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
+ (format " (string-lessp emacs-version \"%s\")\n" minimum-version)
+ ;; Because the header must fit in a fixed width, we cannot
+ ;; insert arbitrary-length file names (Bug#11585).
+ " (error \"`%s' was compiled for "
+ (format "Emacs %s or later\" #$))\n\n" minimum-version))
+ ;; Now compensate for any change in size, to make sure all
+ ;; positions in the file remain valid.
+ (setq delta (- (point-max) old-header-end))
+ (goto-char (point-max))
+ (widen)
+ (delete-char delta)))))
(defun byte-compile-insert-header (_filename outbuffer)
"Insert a header at the start of OUTBUFFER.
@@ -2213,11 +2214,7 @@ Call from the source buffer."
".\n"
(if dynamic ";;; Function definitions are lazy-loaded.\n"
"")
- "\n;;; This file uses "
- (if dynamic-docstrings
- "dynamic docstrings, first added in Emacs 19.29"
- "opcodes that do not exist in Emacs 18")
- ".\n\n"
+ "\n"
;; Note that byte-compile-fix-header may change this.
";;; This file does not contain utf-8 non-ASCII characters,\n"
";;; and so can be loaded in Emacs versions earlier than 23.\n\n"
@@ -2225,6 +2222,7 @@ Call from the source buffer."
;; can delete them so as to keep the buffer positions
;; constant for the actual compiled code.
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
+ ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))))
(defun byte-compile-output-file-form (form)
@@ -3462,7 +3460,7 @@ for symbols generated by the byte compiler itself."
(if (equal-including-properties (car elt) ,const)
(setq result elt)))
result)
- (assq ,const byte-compile-constants))
+ (assoc ,const byte-compile-constants #'eql))
(car (setq byte-compile-constants
(cons (list ,const) byte-compile-constants)))))
@@ -4529,96 +4527,25 @@ binding slots have been popped."
;; (byte-defop-compiler-1 save-window-excursion) ;Obsolete: now a macro.
;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro.
-(defvar byte-compile--use-old-handlers nil
- "If nil, use new byte codes introduced in Emacs-24.4.")
-
(defun byte-compile-catch (form)
(byte-compile-form (car (cdr form)))
- (if (not byte-compile--use-old-handlers)
- (let ((endtag (byte-compile-make-tag)))
- (byte-compile-goto 'byte-pushcatch endtag)
- (byte-compile-body (cddr form) nil)
- (byte-compile-out 'byte-pophandler)
- (byte-compile-out-tag endtag))
- (pcase (cddr form)
- (`(:fun-body ,f)
- (byte-compile-form `(list 'funcall ,f)))
- (body
- (byte-compile-push-constant
- (byte-compile-top-level (cons 'progn body) byte-compile--for-effect))))
- (byte-compile-out 'byte-catch 0)))
+ (let ((endtag (byte-compile-make-tag)))
+ (byte-compile-goto 'byte-pushcatch endtag)
+ (byte-compile-body (cddr form) nil)
+ (byte-compile-out 'byte-pophandler)
+ (byte-compile-out-tag endtag)))
(defun byte-compile-unwind-protect (form)
(pcase (cddr form)
(`(:fun-body ,f)
- (byte-compile-form
- (if byte-compile--use-old-handlers `(list (list 'funcall ,f)) f)))
+ (byte-compile-form f))
(handlers
- (if byte-compile--use-old-handlers
- (byte-compile-push-constant
- (byte-compile-top-level-body handlers t))
- (byte-compile-form `#'(lambda () ,@handlers)))))
+ (byte-compile-form `#'(lambda () ,@handlers))))
(byte-compile-out 'byte-unwind-protect 0)
(byte-compile-form-do-effect (car (cdr form)))
(byte-compile-out 'byte-unbind 1))
(defun byte-compile-condition-case (form)
- (if byte-compile--use-old-handlers
- (byte-compile-condition-case--old form)
- (byte-compile-condition-case--new form)))
-
-(defun byte-compile-condition-case--old (form)
- (let* ((var (nth 1 form))
- (fun-bodies (eq var :fun-body))
- (byte-compile-bound-variables
- (if (and var (not fun-bodies))
- (cons var byte-compile-bound-variables)
- byte-compile-bound-variables)))
- (byte-compile-set-symbol-position 'condition-case)
- (unless (symbolp var)
- (byte-compile-warn
- "`%s' is not a variable-name or nil (in condition-case)" var))
- (if fun-bodies (setq var (make-symbol "err")))
- (byte-compile-push-constant var)
- (if fun-bodies
- (byte-compile-form `(list 'funcall ,(nth 2 form)))
- (byte-compile-push-constant
- (byte-compile-top-level (nth 2 form) byte-compile--for-effect)))
- (let ((compiled-clauses
- (mapcar
- (lambda (clause)
- (let ((condition (car clause)))
- (cond ((not (or (symbolp condition)
- (and (listp condition)
- (let ((ok t))
- (dolist (sym condition)
- (if (not (symbolp sym))
- (setq ok nil)))
- ok))))
- (byte-compile-warn
- "`%S' is not a condition name or list of such (in condition-case)"
- condition))
- ;; (not (or (eq condition 't)
- ;; (and (stringp (get condition 'error-message))
- ;; (consp (get condition
- ;; 'error-conditions)))))
- ;; (byte-compile-warn
- ;; "`%s' is not a known condition name
- ;; (in condition-case)"
- ;; condition))
- )
- (if fun-bodies
- `(list ',condition (list 'funcall ,(cadr clause) ',var))
- (cons condition
- (byte-compile-top-level-body
- (cdr clause) byte-compile--for-effect)))))
- (cdr (cdr (cdr form))))))
- (if fun-bodies
- (byte-compile-form `(list ,@compiled-clauses))
- (byte-compile-push-constant compiled-clauses)))
- (byte-compile-out 'byte-condition-case 0)))
-
-(defun byte-compile-condition-case--new (form)
(let* ((var (nth 1 form))
(body (nth 2 form))
(depth byte-compile-depth)
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index e2e59337d7b..351a097ad19 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -462,20 +462,7 @@ places where they originally did not directly appear."
;; and may be an invalid expression (e.g. ($# . 678)).
(cdr forms)))))
- ;condition-case
- ((and `(condition-case ,var ,protected-form . ,handlers)
- (guard byte-compile--use-old-handlers))
- (let ((newform (cconv--convert-function
- () (list protected-form) env form)))
- `(condition-case :fun-body ,newform
- ,@(mapcar (lambda (handler)
- (list (car handler)
- (cconv--convert-function
- (list (or var cconv--dummy-var))
- (cdr handler) env form)))
- handlers))))
-
- ; condition-case with new byte-codes.
+ ; condition-case
(`(condition-case ,var ,protected-form . ,handlers)
`(condition-case ,var
,(cconv-convert protected-form env extend)
@@ -496,10 +483,8 @@ places where they originally did not directly appear."
`((let ((,var (list ,var))) ,@body))))))
handlers))))
- (`(,(and head (or (and 'catch (guard byte-compile--use-old-handlers))
- 'unwind-protect))
- ,form . ,body)
- `(,head ,(cconv-convert form env extend)
+ (`(unwind-protect ,form . ,body)
+ `(unwind-protect ,(cconv-convert form env extend)
:fun-body ,(cconv--convert-function () body env form)))
(`(setq . ,forms) ; setq special form
@@ -718,15 +703,6 @@ and updates the data stored in ENV."
(`(quote . ,_) nil) ; quote form
(`(function . ,_) nil) ; same as quote
- ((and `(condition-case ,var ,protected-form . ,handlers)
- (guard byte-compile--use-old-handlers))
- ;; FIXME: The bytecode for condition-case forces us to wrap the
- ;; form and handlers in closures.
- (cconv--analyze-function () (list protected-form) env form)
- (dolist (handler handlers)
- (cconv--analyze-function (if var (list var)) (cdr handler)
- env form)))
-
(`(condition-case ,var ,protected-form . ,handlers)
(cconv-analyze-form protected-form env)
(when (and var (symbolp var) (byte-compile-not-lexical-var-p var))
@@ -741,9 +717,7 @@ and updates the data stored in ENV."
form "variable"))))
;; FIXME: The bytecode for unwind-protect forces us to wrap the unwind.
- (`(,(or (and 'catch (guard byte-compile--use-old-handlers))
- 'unwind-protect)
- ,form . ,body)
+ (`(unwind-protect ,form . ,body)
(cconv-analyze-form form env)
(cconv--analyze-function () body env form))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index c4f69120ff7..9d0fd15bc3d 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1318,7 +1318,10 @@ For more details, see Info node `(cl)Loop Facility'.
(nreverse cl--loop-conditions)))
,then ,var))
loop-for-steps))
- (push `(,var (if ,first-assign ,start ,then)) loop-for-sets))))
+ (push (if (eq start then)
+ `(,var ,then)
+ `(,var (if ,first-assign ,start ,then)))
+ loop-for-sets))))
((memq word '(across across-ref))
(let ((temp-vec (make-symbol "--cl-vec--"))
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index f67aa897283..ed28997292f 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -168,158 +168,150 @@ first will be printed into the backtrace buffer.
If `inhibit-redisplay' is non-nil when this function is called,
the debugger will not be entered."
(interactive)
- (cond
- (inhibit-redisplay
- ;; Don't really try to enter debugger within an eval from redisplay.
- debugger-value)
- ((and (eq t (framep (selected-frame)))
- (equal "initial_terminal" (terminal-name)))
- ;; We're in the initial-frame (where `message' just outputs to stdout) so
- ;; there's no tty or GUI frame to display the backtrace and interact with
- ;; it: just dump a backtrace to stdout.
- ;; This happens for example while handling an error in code from
- ;; early-init.el with --debug-init.
- (message "Error: %S" args)
- (let ((print-escape-newlines t)
- (print-escape-control-characters t)
- (print-level 8)
- (print-length 50)
- (skip t)) ;Skip the first frame (i.e. the `debug' frame)!
- (mapbacktrace (lambda (_evald func args _flags)
- (if skip
- (setq skip nil)
- (message " %S" (cons func args))))
- 'debug)))
- (t
- (unless noninteractive
- (message "Entering debugger..."))
- (let (debugger-value
- (debugger-previous-state
- (if (get-buffer "*Backtrace*")
- (with-current-buffer (get-buffer "*Backtrace*")
- (debugger--save-buffer-state))))
- (debugger-args args)
- (debugger-buffer (get-buffer-create "*Backtrace*"))
- (debugger-old-buffer (current-buffer))
- (debugger-window nil)
- (debugger-step-after-exit nil)
- (debugger-will-be-back nil)
- ;; Don't keep reading from an executing kbd macro!
- (executing-kbd-macro nil)
- ;; Save the outer values of these vars for the `e' command
- ;; before we replace the values.
- (debugger-outer-match-data (match-data))
- (debugger-with-timeout-suspend (with-timeout-suspend)))
- ;; Set this instead of binding it, so that `q'
- ;; will not restore it.
- (setq overriding-terminal-local-map nil)
- ;; Don't let these magic variables affect the debugger itself.
- (let ((last-command nil) this-command track-mouse
- (inhibit-trace t)
- unread-command-events
- unread-post-input-method-events
- last-input-event last-command-event last-nonmenu-event
- last-event-frame
- overriding-local-map
- load-read-function
- ;; If we are inside a minibuffer, allow nesting
- ;; so that we don't get an error from the `e' command.
- (enable-recursive-minibuffers
- (or enable-recursive-minibuffers (> (minibuffer-depth) 0)))
- (standard-input t) (standard-output t)
- inhibit-redisplay
- (cursor-in-echo-area nil)
- (window-configuration (current-window-configuration)))
- (unwind-protect
- (save-excursion
- (when (eq (car debugger-args) 'debug)
- ;; Skip the frames for backtrace-debug, byte-code,
- ;; debug--implement-debug-on-entry and the advice's `apply'.
- (backtrace-debug 4 t)
- ;; Place an extra debug-on-exit for macro's.
- (when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
- (backtrace-debug 5 t)))
- (with-current-buffer debugger-buffer
- (unless (derived-mode-p 'debugger-mode)
- (debugger-mode))
- (debugger-setup-buffer debugger-args)
- (when noninteractive
- ;; If the backtrace is long, save the beginning
- ;; and the end, but discard the middle.
- (when (> (count-lines (point-min) (point-max))
- debugger-batch-max-lines)
- (goto-char (point-min))
- (forward-line (/ 2 debugger-batch-max-lines))
- (let ((middlestart (point)))
- (goto-char (point-max))
- (forward-line (- (/ 2 debugger-batch-max-lines)
- debugger-batch-max-lines))
- (delete-region middlestart (point)))
- (insert "...\n"))
- (goto-char (point-min))
- (message "%s" (buffer-string))
- (kill-emacs -1)))
- (pop-to-buffer
- debugger-buffer
- `((display-buffer-reuse-window
- display-buffer-in-previous-window
- display-buffer-below-selected)
- . ((window-min-height . 10)
- (window-height . fit-window-to-buffer)
- ,@(when (and (window-live-p debugger-previous-window)
- (frame-visible-p
- (window-frame debugger-previous-window)))
- `((previous-window . ,debugger-previous-window))))))
- (setq debugger-window (selected-window))
- (if (eq debugger-previous-window debugger-window)
- (when debugger-jumping-flag
- ;; Try to restore previous height of debugger
- ;; window.
- (condition-case nil
- (window-resize
- debugger-window
- (- debugger-previous-window-height
- (window-total-height debugger-window)))
- (error nil)))
- (setq debugger-previous-window debugger-window))
- (message "")
- (let ((standard-output nil)
- (buffer-read-only t))
- (message "")
- ;; Make sure we unbind buffer-read-only in the right buffer.
- (save-excursion
- (recursive-edit))))
- (when (and (window-live-p debugger-window)
- (eq (window-buffer debugger-window) debugger-buffer))
- ;; Record height of debugger window.
- (setq debugger-previous-window-height
- (window-total-height debugger-window)))
- (if debugger-will-be-back
- ;; Restore previous window configuration (Bug#12623).
- (set-window-configuration window-configuration)
+ (if inhibit-redisplay
+ ;; Don't really try to enter debugger within an eval from redisplay.
+ debugger-value
+ (let ((non-interactive-frame
+ (or noninteractive ;FIXME: Presumably redundant.
+ ;; If we're in the initial-frame (where `message' just
+ ;; outputs to stdout) so there's no tty or GUI frame to
+ ;; display the backtrace and interact with it: just dump a
+ ;; backtrace to stdout. This happens for example while
+ ;; handling an error in code from early-init.el with
+ ;; --debug-init.
+ (and (eq t (framep (selected-frame)))
+ (equal "initial_terminal" (terminal-name)))))
+ ;; Don't let `inhibit-message' get in our way (especially important if
+ ;; `non-interactive-frame' evaluated to a non-nil value.
+ (inhibit-message nil))
+ (unless non-interactive-frame
+ (message "Entering debugger..."))
+ (let (debugger-value
+ (debugger-previous-state
+ (if (get-buffer "*Backtrace*")
+ (with-current-buffer (get-buffer "*Backtrace*")
+ (debugger--save-buffer-state))))
+ (debugger-args args)
+ (debugger-buffer (get-buffer-create "*Backtrace*"))
+ (debugger-old-buffer (current-buffer))
+ (debugger-window nil)
+ (debugger-step-after-exit nil)
+ (debugger-will-be-back nil)
+ ;; Don't keep reading from an executing kbd macro!
+ (executing-kbd-macro nil)
+ ;; Save the outer values of these vars for the `e' command
+ ;; before we replace the values.
+ (debugger-outer-match-data (match-data))
+ (debugger-with-timeout-suspend (with-timeout-suspend)))
+ ;; Set this instead of binding it, so that `q'
+ ;; will not restore it.
+ (setq overriding-terminal-local-map nil)
+ ;; Don't let these magic variables affect the debugger itself.
+ (let ((last-command nil) this-command track-mouse
+ (inhibit-trace t)
+ unread-command-events
+ unread-post-input-method-events
+ last-input-event last-command-event last-nonmenu-event
+ last-event-frame
+ overriding-local-map
+ load-read-function
+ ;; If we are inside a minibuffer, allow nesting
+ ;; so that we don't get an error from the `e' command.
+ (enable-recursive-minibuffers
+ (or enable-recursive-minibuffers (> (minibuffer-depth) 0)))
+ (standard-input t) (standard-output t)
+ inhibit-redisplay
+ (cursor-in-echo-area nil)
+ (window-configuration (current-window-configuration)))
+ (unwind-protect
+ (save-excursion
+ (when (eq (car debugger-args) 'debug)
+ ;; Skip the frames for backtrace-debug, byte-code,
+ ;; debug--implement-debug-on-entry and the advice's `apply'.
+ (backtrace-debug 4 t)
+ ;; Place an extra debug-on-exit for macro's.
+ (when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
+ (backtrace-debug 5 t)))
+ (with-current-buffer debugger-buffer
+ (unless (derived-mode-p 'debugger-mode)
+ (debugger-mode))
+ (debugger-setup-buffer debugger-args)
+ (when non-interactive-frame
+ ;; If the backtrace is long, save the beginning
+ ;; and the end, but discard the middle.
+ (let ((inhibit-read-only t))
+ (when (> (count-lines (point-min) (point-max))
+ debugger-batch-max-lines)
+ (goto-char (point-min))
+ (forward-line (/ debugger-batch-max-lines 2))
+ (let ((middlestart (point)))
+ (goto-char (point-max))
+ (forward-line (- (/ debugger-batch-max-lines 2)))
+ (delete-region middlestart (point)))
+ (insert "...\n")))
+ (message "%s" (buffer-string))
+ (kill-emacs -1)))
+ (pop-to-buffer
+ debugger-buffer
+ `((display-buffer-reuse-window
+ display-buffer-in-previous-window
+ display-buffer-below-selected)
+ . ((window-min-height . 10)
+ (window-height . fit-window-to-buffer)
+ ,@(when (and (window-live-p debugger-previous-window)
+ (frame-visible-p
+ (window-frame debugger-previous-window)))
+ `((previous-window . ,debugger-previous-window))))))
+ (setq debugger-window (selected-window))
+ (if (eq debugger-previous-window debugger-window)
+ (when debugger-jumping-flag
+ ;; Try to restore previous height of debugger
+ ;; window.
+ (condition-case nil
+ (window-resize
+ debugger-window
+ (- debugger-previous-window-height
+ (window-total-height debugger-window)))
+ (error nil)))
+ (setq debugger-previous-window debugger-window))
+ (message "")
+ (let ((standard-output nil)
+ (buffer-read-only t))
+ (message "")
+ ;; Make sure we unbind buffer-read-only in the right buffer.
+ (save-excursion
+ (recursive-edit))))
(when (and (window-live-p debugger-window)
(eq (window-buffer debugger-window) debugger-buffer))
- (progn
- ;; Unshow debugger-buffer.
- (quit-restore-window debugger-window debugger-bury-or-kill)
- ;; Restore current buffer (Bug#12502).
- (set-buffer debugger-old-buffer)))
- ;; Forget debugger window, it won't be back (Bug#17882).
- (setq debugger-previous-window nil))
- ;; Restore previous state of debugger-buffer in case we were
- ;; in a recursive invocation of the debugger, otherwise just
- ;; erase the buffer.
- (when (buffer-live-p debugger-buffer)
- (with-current-buffer debugger-buffer
- (if debugger-previous-state
- (debugger--restore-buffer-state debugger-previous-state)
- (setq backtrace-insert-header-function nil)
- (setq backtrace-frames nil)
- (backtrace-print))))
- (with-timeout-unsuspend debugger-with-timeout-suspend)
- (set-match-data debugger-outer-match-data)))
- (setq debug-on-next-call debugger-step-after-exit)
- debugger-value))))
+ ;; Record height of debugger window.
+ (setq debugger-previous-window-height
+ (window-total-height debugger-window)))
+ (if debugger-will-be-back
+ ;; Restore previous window configuration (Bug#12623).
+ (set-window-configuration window-configuration)
+ (when (and (window-live-p debugger-window)
+ (eq (window-buffer debugger-window) debugger-buffer))
+ (progn
+ ;; Unshow debugger-buffer.
+ (quit-restore-window debugger-window debugger-bury-or-kill)
+ ;; Restore current buffer (Bug#12502).
+ (set-buffer debugger-old-buffer)))
+ ;; Forget debugger window, it won't be back (Bug#17882).
+ (setq debugger-previous-window nil))
+ ;; Restore previous state of debugger-buffer in case we were
+ ;; in a recursive invocation of the debugger, otherwise just
+ ;; erase the buffer.
+ (when (buffer-live-p debugger-buffer)
+ (with-current-buffer debugger-buffer
+ (if debugger-previous-state
+ (debugger--restore-buffer-state debugger-previous-state)
+ (setq backtrace-insert-header-function nil)
+ (setq backtrace-frames nil)
+ (backtrace-print))))
+ (with-timeout-unsuspend debugger-with-timeout-suspend)
+ (set-match-data debugger-outer-match-data)))
+ (setq debug-on-next-call debugger-step-after-exit)
+ debugger-value))))
(defun debugger--print (obj &optional stream)
(condition-case err
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index e6aed3a1202..85cc8c8e7ad 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1714,6 +1714,7 @@ contains a circular object."
(cl-macrolet-body . edebug-match-cl-macrolet-body)
(&not . edebug-match-&not)
(&key . edebug-match-&key)
+ (&error . edebug-match-&error)
(place . edebug-match-place)
(gate . edebug-match-gate)
;; (nil . edebug-match-nil) not this one - special case it.
@@ -1847,6 +1848,15 @@ contains a circular object."
(car (cdr pair))))
specs))))
+(defun edebug-match-&error (cursor specs)
+ ;; Signal an error, using the following string in the spec as argument.
+ (let ((error-string (car specs))
+ (edebug-error-point (edebug-before-offset cursor)))
+ (goto-char edebug-error-point)
+ (error "%s"
+ (if (stringp error-string)
+ error-string
+ "String expected after &error in edebug-spec"))))
(defun edebug-match-gate (_cursor)
;; Simply set the gate to prevent backtracking at this level.
@@ -2216,6 +2226,8 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'."
(def-edebug-spec nested-backquote-form
(&or
+ ("`" &error "Triply nested backquotes (without commas \"between\" them) \
+are too difficult to instrument")
;; Allow instrumentation of any , or ,@ contained within the (\, ...) or
;; (\,@ ...) matched on the next line.
([&or "," ",@"] backquote-form)
@@ -3708,7 +3720,6 @@ Return the result of the last expression."
(prin1-to-string edebug-arg))
(cdr value) ", ")))
-(defvar print-readably) ; defined by lemacs
;; Alternatively, we could change the definition of
;; edebug-safe-prin1-to-string to only use these if defined.
@@ -3716,8 +3727,7 @@ Return the result of the last expression."
(let ((print-escape-newlines t)
(print-length (or edebug-print-length print-length))
(print-level (or edebug-print-level print-level))
- (print-circle (or edebug-print-circle print-circle))
- (print-readably nil)) ; lemacs uses this.
+ (print-circle (or edebug-print-circle print-circle)))
(edebug-prin1-to-string value)))
(defun edebug-compute-previous-result (previous-value)
@@ -4520,17 +4530,6 @@ With prefix argument, make it a temporary breakpoint."
(edebug-modify-breakpoint t condition arg))
(easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
-
-;;; Autoloading of Edebug accessories
-
-;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu
-(defun edebug--require-cl-read ()
- (require 'edebug-cl-read))
-
-(if (featurep 'cl-read)
- (add-hook 'edebug-setup-hook #'edebug--require-cl-read)
- ;; The following causes edebug-cl-read to be loaded when you load cl-read.el.
- (add-hook 'cl-read-load-hooks #'edebug--require-cl-read))
;;; Finalize Loading
@@ -4566,7 +4565,6 @@ With prefix argument, make it a temporary breakpoint."
(run-with-idle-timer 0 nil #'(lambda () (unload-feature 'edebug)))))
(remove-hook 'called-interactively-p-functions
#'edebug--called-interactively-skip)
- (remove-hook 'cl-read-load-hooks #'edebug--require-cl-read)
(edebug-uninstall-read-eval-functions)
;; Continue standard unloading.
nil)
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index dda90373069..59af7e12d21 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -278,14 +278,7 @@ are not abstract."
(if eieio-class-speedbar-key-map
nil
- (if (not (featurep 'speedbar))
- (add-hook 'speedbar-load-hook (lambda ()
- (eieio-class-speedbar-make-map)
- (speedbar-add-expansion-list
- '("EIEIO"
- eieio-class-speedbar-menu
- eieio-class-speedbar-key-map
- eieio-class-speedbar))))
+ (with-eval-after-load 'speedbar
(eieio-class-speedbar-make-map)
(speedbar-add-expansion-list '("EIEIO"
eieio-class-speedbar-menu
diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el
index c11608da5d8..5c6e0e516d1 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -140,11 +140,7 @@ MENU-VAR is the symbol containing an easymenu compatible menu part to use.
MODENAME is a string used to identify this browser mode.
FETCHER is a generic function used to fetch the base object list used when
creating the speedbar display."
- (if (not (featurep 'speedbar))
- (add-hook 'speedbar-load-hook
- (list 'lambda nil
- (list 'eieio-speedbar-create-engine
- map-fn map-var menu-var modename fetcher)))
+ (with-eval-after-load 'speedbar
(eieio-speedbar-create-engine map-fn map-var menu-var modename fetcher)))
(defun eieio-speedbar-create-engine (map-fn map-var menu-var modename fetcher)
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index 8a9b01d580f..27ed29925b3 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -155,7 +155,7 @@ DYNAMIC-VAR bound to STATIC-VAR."
(defun cps--add-state (kind body)
"Create a new CPS state with body BODY and return the state's name."
(declare (indent 1))
- (let* ((state (cps--gensym "cps-state-%s-" kind)))
+ (let ((state (cps--gensym "cps-state-%s-" kind)))
(push (list state body cps--cleanup-function) cps--states)
(push state cps--bindings)
state))
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index ceb9b6bea5f..0d57bc16a3a 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -485,7 +485,18 @@ absent, return nil."
(lm-with-file file
(let ((start (lm-commentary-start)))
(when start
- (buffer-substring-no-properties start (lm-commentary-end))))))
+ (replace-regexp-in-string ; Get rid of...
+ "[[:blank:]]*$" "" ; trailing white-space
+ (replace-regexp-in-string
+ (format "%s\\|%s\\|%s"
+ ;; commentary header
+ (concat "^;;;[[:blank:]]*\\("
+ lm-commentary-header
+ "\\):[[:blank:]\n]*")
+ "^;;[[:blank:]]*" ; double semicolon prefix
+ "[[:blank:]\n]*\\'") ; trailing new-lines
+ "" (buffer-substring-no-properties
+ start (lm-commentary-end))))))))
(defun lm-homepage (&optional file)
"Return the homepage in file FILE, or current buffer if FILE is nil."
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index fbbd389bf96..f66122d6d72 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -747,6 +747,7 @@ Blank lines separate paragraphs. Semicolons start comments.
Note that `run-lisp' may be used either to start an inferior Lisp job
or to switch back to an existing one."
(lisp-mode-variables nil t)
+ (setq-local lisp-indent-function 'common-lisp-indent-function)
(setq-local find-tag-default-function 'lisp-find-tag-default)
(setq-local comment-start-skip
"\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index afe42c7d723..a9508c1bdc5 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -926,7 +926,6 @@ untar into a directory named DIR; otherwise, signal an error."
(if (> (length file-list) 1) 'tar 'single))))
('tar
(make-directory package-user-dir t)
- ;; FIXME: should we delete PKG-DIR if it exists?
(let* ((default-directory (file-name-as-directory package-user-dir)))
(package-untar-buffer dirname)))
('single
@@ -2377,18 +2376,9 @@ The description is read from the installed package files."
result
;; Look for Commentary header.
- (let ((mainsrcfile (expand-file-name (format "%s.el" (package-desc-name desc))
- srcdir)))
- (when (file-readable-p mainsrcfile)
- (with-temp-buffer
- (insert (or (lm-commentary mainsrcfile) ""))
- (goto-char (point-min))
- (when (re-search-forward "^;;; Commentary:\n" nil t)
- (replace-match ""))
- (while (re-search-forward "^\\(;+ ?\\)" nil t)
- (replace-match ""))
- (buffer-string))))
- )))
+ (lm-commentary (expand-file-name
+ (format "%s.el" (package-desc-name desc)) srcdir))
+ "")))
(defun describe-package-1 (pkg)
"Insert the package description for PKG.
@@ -2583,16 +2573,10 @@ Helper function for `describe-package'."
(if built-in
;; For built-in packages, get the description from the
;; Commentary header.
- (let ((fn (locate-file (format "%s.el" name) load-path
- load-file-rep-suffixes))
- (opoint (point)))
- (insert (or (lm-commentary fn) ""))
- (save-excursion
- (goto-char opoint)
- (when (re-search-forward "^;;; Commentary:\n" nil t)
- (replace-match ""))
- (while (re-search-forward "^\\(;+ ?\\)" nil t)
- (replace-match ""))))
+ (insert (or (lm-commentary (locate-file (format "%s.el" name)
+ load-path
+ load-file-rep-suffixes))
+ ""))
(if (package-installed-p desc)
;; For installed packages, get the description from the
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 501cc3a29e0..b13f609f882 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -547,10 +547,10 @@ Return the column number after insertion."
;; Don't truncate to `width' if the next column is align-right
;; and has some space left, truncate to `available-space' instead.
(when (and not-last-col
- (> label-width available-space)
- (setq label (truncate-string-to-width
- label available-space nil nil t t)
- label-width available-space)))
+ (> label-width available-space))
+ (setq label (truncate-string-to-width
+ label available-space nil nil t t)
+ label-width available-space))
(setq label (bidi-string-mark-left-to-right label))
(when (and right-align (> width label-width))
(let ((shift (- width label-width)))
generated by cgit v1.2.3 (git 2.39.1) at 2025-05-23 19:36:01 +0000