procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'savannah/master' into HEAD

Browse source
This commit is contained in:
Andrea Corallo 2020-02-04 11:40:12 +00:00
commit 15aedf3e3d
380 changed files with 7448 additions and 7560 deletions
Download patch file Download diff file Expand all files Collapse all files

3
lisp/emacs-lisp/bindat.el
View file

@ -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).

22
lisp/emacs-lisp/byte-opt.el
View file

@ -498,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
@ -521,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

159
lisp/emacs-lisp/bytecomp.el
View file

@ -736,14 +736,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)
@ -1218,7 +1219,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)
@ -2174,36 +2175,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.
@ -2235,11 +2236,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"
@ -2247,6 +2244,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)
@ -4568,96 +4566,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)

34
lisp/emacs-lisp/cconv.el
View file

@ -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))

118
lisp/emacs-lisp/checkdoc.el
View file

@ -849,7 +849,7 @@ otherwise stop after the first error."
;; every test is responsible for returning the cursor.
(or (and buffer-file-name ;; only check comments in a file
(checkdoc-comments))
(checkdoc-start)
(checkdoc-start take-notes)
(checkdoc-message-text)
(checkdoc-rogue-spaces)
(when checkdoc-package-keywords-flag
@ -902,7 +902,7 @@ buffer and save warnings in a separate buffer."
;; the user is navigating down through the buffer.
(while (and (not wrong) (checkdoc-next-docstring))
;; OK, let's look at the doc string.
(setq msg (checkdoc-this-string-valid))
(setq msg (checkdoc-this-string-valid take-notes))
(if msg (setq wrong (point)))))
(if wrong
(progn
@ -1284,12 +1284,15 @@ checking of documentation strings.
;;; Checking engines
;;
(defun checkdoc-this-string-valid ()
(defun checkdoc-this-string-valid (&optional take-notes)
"Return a message string if the current doc string is invalid.
Check for style only, such as the first line always being a complete
sentence, whitespace restrictions, and making sure there are no
hard-coded key-codes such as C-[char] or mouse-[number] in the comment.
See the style guide in the Emacs Lisp manual for more details."
See the style guide in the Emacs Lisp manual for more details.
With a non-nil TAKE-NOTES, store all errors found in a warnings
buffer, otherwise stop after the first error."
;; Jump over comments between the last object and the doc string
(while (looking-at "[ \t\n]*;")
@ -1366,13 +1369,16 @@ documentation string")
(point) (+ (point) 1) t)))))
(if (and (not err) (= (following-char) ?\"))
(with-syntax-table checkdoc-syntax-table
(checkdoc-this-string-valid-engine fp))
(checkdoc-this-string-valid-engine fp take-notes))
err)))
(defun checkdoc-this-string-valid-engine (fp)
(defun checkdoc-this-string-valid-engine (fp &optional take-notes)
"Return an error list or string if the current doc string is invalid.
Depends on `checkdoc-this-string-valid' to reset the syntax table so that
regexp short cuts work. FP is the function defun information."
regexp short cuts work. FP is the function defun information.
With a non-nil TAKE-NOTES, store all errors found in a warnings
buffer, otherwise stop after the first error."
(let ((case-fold-search nil)
;; Use a marker so if an early check modifies the text,
;; we won't accidentally lose our place. This could cause
@ -1864,7 +1870,7 @@ Replace with \"%s\"? " original replace)
;; Make sure the doc string has correctly spelled English words
;; in it. This function is extracted due to its complexity,
;; and reliance on the Ispell program.
(checkdoc-ispell-docstring-engine e)
(checkdoc-ispell-docstring-engine e take-notes)
;; User supplied checks
(save-excursion (checkdoc-run-hooks 'checkdoc-style-functions fp e))
;; Done!
@ -2090,6 +2096,10 @@ If the offending word is in a piece of quoted text, then it is skipped."
;;
(defvar ispell-process)
(declare-function ispell-buffer-local-words "ispell" ())
(declare-function ispell-correct-p "ispell" ())
(declare-function ispell-set-spellchecker-params "ispell" ())
(declare-function ispell-accept-buffer-local-defs "ispell" ())
(declare-function ispell-error-checking-word "ispell" (word))
(defun checkdoc-ispell-init ()
"Initialize Ispell process (default version) with Lisp words.
@ -2100,58 +2110,66 @@ nil."
(unless ispell-process
(condition-case nil
(progn
(ispell-buffer-local-words)
(ispell-set-spellchecker-params) ; Initialize variables and dict alists.
(ispell-accept-buffer-local-defs) ; Use the correct dictionary.
;; This code copied in part from ispell.el Emacs 19.34
(dolist (w checkdoc-ispell-lisp-words)
(process-send-string ispell-process (concat "@" w "\n"))))
(error (setq checkdoc-spellcheck-documentation-flag nil)))))
(defun checkdoc-ispell-docstring-engine (end)
(defun checkdoc-ispell-docstring-engine (end &optional take-notes)
"Run the Ispell tools on the doc string between point and END.
Since Ispell isn't Lisp-smart, we must pre-process the doc string
before using the Ispell engine on it."
(if (or (not checkdoc-spellcheck-documentation-flag)
;; If the user wants no questions or fixing, then we must
;; disable spell checking as not useful.
(not checkdoc-autofix-flag)
(eq checkdoc-autofix-flag 'never))
nil
before using the Ispell engine on it.
With a non-nil TAKE-NOTES, store all errors found in a warnings
buffer, otherwise stop after the first error."
(when (and checkdoc-spellcheck-documentation-flag
;; If the user wants no questions or fixing, then we must
;; disable spell checking as not useful.
(or take-notes
(and checkdoc-autofix-flag
(not (eq checkdoc-autofix-flag 'never)))))
(checkdoc-ispell-init)
(unless checkdoc-spellcheck-documentation-flag
;; this happens when (checkdoc-ispell-init) can't start `ispell-program-name'
(user-error "No spellchecker installed: check the variable `ispell-program-name'."))
(save-excursion
(skip-chars-forward "^a-zA-Z")
(let ((word nil) (sym nil) (case-fold-search nil) (err nil))
(while (and (not err) (< (point) end))
(if (save-excursion (forward-char -1) (looking-at "[('`]"))
;; Skip lists describing meta-syntax, or bound variables
(forward-sexp 1)
(setq word (buffer-substring-no-properties
(point) (progn
(skip-chars-forward "a-zA-Z-")
(point)))
sym (intern-soft word))
(if (and sym (or (boundp sym) (fboundp sym)))
;; This is probably repetitive in most cases, but not always.
nil
;; Find out how we spell-check this word.
(if (or
;; All caps w/ option th, or s tacked on the end
;; for pluralization or number.
(string-match "^[A-Z][A-Z]+\\(s\\|th\\)?$" word)
(looking-at "}") ; a keymap expression
)
nil
(save-excursion
(if (not (eq checkdoc-autofix-flag 'never))
(let ((lk last-input-event))
(ispell-word nil t)
(if (not (equal last-input-event lk))
(progn
(sit-for 0)
(message "Continuing..."))))
;; Nothing here.
)))))
(skip-chars-forward "^a-zA-Z"))
err))))
(let (word sym case-fold-search err word-beginning word-end)
(while (and (not err) (< (point) end))
(if (save-excursion (forward-char -1) (looking-at "[('`]"))
;; Skip lists describing meta-syntax, or bound variables
(forward-sexp 1)
(setq word-beginning (point)
word-end (progn
(skip-chars-forward "a-zA-Z-")
(point))
word (buffer-substring-no-properties word-beginning word-end)
sym (intern-soft word))
(unless (and sym (or (boundp sym) (fboundp sym)))
;; Find out how we spell-check this word.
(unless (or
;; All caps w/ option th, or s tacked on the end
;; for pluralization or number.
(string-match "^[A-Z][A-Z]+\\(s\\|th\\)?$" word)
(looking-at "}") ; a keymap expression
)
(save-excursion
(let ((lk last-input-event))
(if take-notes
(progn
(unless (ispell-correct-p)
(checkdoc-create-error
(ispell-error-checking-word word)
word-beginning word-end)))
(ispell-word nil t))
(if (not (equal last-input-event lk))
(progn
(sit-for 0)
(message "Continuing..."))))))))
(skip-chars-forward "^a-zA-Z"))
err))))
;;; Rogue space checking engine
;;

5
lisp/emacs-lisp/cl-macs.el
View file

@ -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--"))

292
lisp/emacs-lisp/debug.el
View file

@ -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

24
lisp/emacs-lisp/edebug.el
View file

@ -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)
@ -4518,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
@ -4564,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)

9
lisp/emacs-lisp/eieio-opt.el
View file

@ -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

6
lisp/emacs-lisp/eieio-speedbar.el
View file

@ -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)

13
lisp/emacs-lisp/lisp-mnt.el
View file

@ -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."

1
lisp/emacs-lisp/lisp-mode.el
View file

@ -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]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")

42
lisp/emacs-lisp/package.el
View file

@ -606,8 +606,10 @@ EXP should be a form read from a foo-pkg.el file.
Convert EXP into a `package-desc' object using the
`package-desc-from-define' constructor before pushing it to
`package-alist'.
If there already exists a package by that name in
`package-alist', replace that definition with the new one."
If there already exists a package by the same name in
`package-alist', insert this object there such that the packages
are sorted with the highest version first."
(when (eq (car-safe exp) 'define-package)
(let* ((new-pkg-desc (apply #'package-desc-from-define (cdr exp)))
(name (package-desc-name new-pkg-desc))
@ -924,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
@ -953,7 +954,7 @@ untar into a directory named DIR; otherwise, signal an error."
pkg-dir))
(defun package-generate-description-file (pkg-desc pkg-file)
"Create the foo-pkg.el file for single-file packages."
"Create the foo-pkg.el file PKG-FILE for single-file package PKG-DESC."
(let* ((name (package-desc-name pkg-desc)))
(let ((print-level nil)
(print-quoted t)
@ -997,6 +998,7 @@ untar into a directory named DIR; otherwise, signal an error."
(defvar version-control)
(defun package-generate-autoloads (name pkg-dir)
"Generate autoloads in PKG-DIR for package named NAME."
(let* ((auto-name (format "%s-autoloads.el" name))
;;(ignore-name (concat name "-pkg.el"))
(generated-autoload-file (expand-file-name auto-name pkg-dir))
@ -1177,12 +1179,14 @@ The return result is a `package-desc'."
;; signature checking.
(defun package--write-file-no-coding (file-name)
"Write file FILE-NAME without encoding using coding system."
(let ((buffer-file-coding-system 'no-conversion))
(write-region (point-min) (point-max) file-name nil 'silent)))
(declare-function url-http-file-exists-p "url-http" (url))
(defun package--archive-file-exists-p (location file)
"Return t if FILE exists in remote LOCATION."
(let ((http (string-match "\\`https?:" location)))
(if http
(progn
@ -2372,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.
@ -2578,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
@ -2820,6 +2809,7 @@ of these dependencies, similar to the list returned by
(push dep out)))))))))))
(defun package-desc-status (pkg-desc)
"Return the status of `package-desc' object PKG-DESC."
(let* ((name (package-desc-name pkg-desc))
(dir (package-desc-dir pkg-desc))
(lle (assq name package-load-list))

2
lisp/emacs-lisp/rx.el
View file

@ -273,7 +273,7 @@ Return (REGEXP . PRECEDENCE)."
;; (or (+ digit) "CHARLIE" "CHAN" (+ blank))
;; -> (or (+ digit) (or "CHARLIE" "CHAN") (+ blank))
;;
;; - Optimise single-character alternatives better:
;; - Optimize single-character alternatives better:
;; * classes: space, alpha, ...
;; * (syntax S), for some S (whitespace, word)
;; so that (or "@" "%" digit (any "A-Z" space) (syntax word))

8
lisp/emacs-lisp/tabulated-list.el
View file

@ -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)))