Merge remote-tracking branch 'savannah/master' into native-comp

This commit is contained in:
Andrea Corallo 2021-04-19 18:46:50 +02:00
commit b5c76530fa
256 changed files with 3180 additions and 2083 deletions

View file

@ -167,7 +167,7 @@
(defun bindat--unpack-strz (len)
(let ((i 0) s)
(while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0))
(while (and (if len (< i len) t) (/= (aref bindat-raw (+ bindat-idx i)) 0))
(setq i (1+ i)))
(setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
(setq bindat-idx (+ bindat-idx len))
@ -439,6 +439,12 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(aset bindat-raw (+ bindat-idx i) (aref v i)))
(setq bindat-idx (+ bindat-idx len)))
(defun bindat--pack-strz (v)
(let ((len (length v)))
(dotimes (i len)
(aset bindat-raw (+ bindat-idx i) (aref v i)))
(setq bindat-idx (+ bindat-idx len 1))))
(defun bindat--pack-bits (len v)
(let ((bnum (1- (* 8 len))) j m)
(while (>= bnum 0)
@ -677,14 +683,23 @@ is the name of a variable that will hold the value we need to pack.")
(`(length . ,_) `(cl-incf bindat-idx ,len))
(`(pack . ,args) `(bindat--pack-str ,len . ,args))))
(cl-defmethod bindat--type (op (_ (eql strz)) len)
(cl-defmethod bindat--type (op (_ (eql strz)) &optional len)
(bindat--pcase op
('unpack `(bindat--unpack-strz ,len))
(`(length . ,_) `(cl-incf bindat-idx ,len))
;; Here we don't add the terminating zero because we rely
;; on the fact that `bindat-raw' was presumably initialized with
;; all-zeroes before we started.
(`(pack . ,args) `(bindat--pack-str ,len . ,args))))
(`(length ,val)
`(cl-incf bindat-idx ,(cond
((null len) `(length ,val))
((numberp len) len)
(t `(or ,len (length ,val))))))
(`(pack . ,args)
(macroexp-let2 nil len len
`(if ,len
;; Same as non-zero terminated strings since we don't actually add
;; the terminating zero anyway (because we rely on the fact that
;; `bindat-raw' was presumably initialized with all-zeroes before
;; we started).
(bindat--pack-str ,len . ,args)
(bindat--pack-strz . ,args))))))
(cl-defmethod bindat--type (op (_ (eql bits)) len)
(bindat--pcase op
@ -812,7 +827,7 @@ is the name of a variable that will hold the value we need to pack.")
'(&or ["uint" def-form]
["uintr" def-form]
["str" def-form]
["strz" def-form]
["strz" &optional def-form]
["bits" def-form]
["fill" def-form]
["align" def-form]
@ -832,7 +847,7 @@ TYPE is a Bindat type expression. It can take the following forms:
uint BITLEN - Big-endian unsigned integer
uintr BITLEN - Little-endian unsigned integer
str LEN - Byte string
strz LEN - Zero-terminated byte-string
strz [LEN] - Zero-terminated byte-string
bits LEN - Bit vector (LEN is counted in bytes)
fill LEN - Just a filler
align LEN - Fill up to the next multiple of LEN bytes

View file

@ -4715,10 +4715,15 @@ binding slots have been popped."
(defun byte-compile-condition-case (form)
(let* ((var (nth 1 form))
(body (nth 2 form))
(handlers (nthcdr 3 form))
(depth byte-compile-depth)
(success-handler (assq :success handlers))
(failure-handlers (if success-handler
(remq success-handler handlers)
handlers))
(clauses (mapcar (lambda (clause)
(cons (byte-compile-make-tag) clause))
(nthcdr 3 form)))
failure-handlers))
(endtag (byte-compile-make-tag)))
(byte-compile-set-symbol-position 'condition-case)
(unless (symbolp var)
@ -4744,30 +4749,40 @@ binding slots have been popped."
(byte-compile-form body) ;; byte-compile--for-effect
(dolist (_ clauses) (byte-compile-out 'byte-pophandler))
(byte-compile-goto 'byte-goto endtag)
(while clauses
(let ((clause (pop clauses))
(byte-compile-bound-variables byte-compile-bound-variables)
(byte-compile--lexical-environment
byte-compile--lexical-environment))
(setq byte-compile-depth (1+ depth))
(byte-compile-out-tag (pop clause))
(dolist (_ clauses) (byte-compile-out 'byte-pophandler))
(cond
((null var) (byte-compile-discard))
(lexical-binding
(push (cons var (1- byte-compile-depth))
byte-compile--lexical-environment))
(t (byte-compile-dynamic-variable-bind var)))
(byte-compile-body (cdr clause)) ;; byte-compile--for-effect
(cond
((null var) nil)
(lexical-binding (byte-compile-discard 1 'preserve-tos))
(t (byte-compile-out 'byte-unbind 1)))
(byte-compile-goto 'byte-goto endtag)))
(let ((compile-handler-body
(lambda (body)
(let ((byte-compile-bound-variables byte-compile-bound-variables)
(byte-compile--lexical-environment
byte-compile--lexical-environment))
(cond
((null var) (byte-compile-discard))
(lexical-binding
(push (cons var (1- byte-compile-depth))
byte-compile--lexical-environment))
(t (byte-compile-dynamic-variable-bind var)))
(byte-compile-out-tag endtag)))
(byte-compile-body body) ;; byte-compile--for-effect
(cond
((null var))
(lexical-binding (byte-compile-discard 1 'preserve-tos))
(t (byte-compile-out 'byte-unbind 1)))))))
(when success-handler
(funcall compile-handler-body (cdr success-handler)))
(byte-compile-goto 'byte-goto endtag)
(while clauses
(let ((clause (pop clauses)))
(setq byte-compile-depth (1+ depth))
(byte-compile-out-tag (pop clause))
(dolist (_ clauses) (byte-compile-out 'byte-pophandler))
(funcall compile-handler-body (cdr clause))
(byte-compile-goto 'byte-goto endtag)))
(byte-compile-out-tag endtag))))
(defun byte-compile-save-excursion (form)
(if (and (eq 'set-buffer (car-safe (car-safe (cdr form))))

View file

@ -1,4 +1,4 @@
;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t -*-
;;; cconv.el --- Closure conversion for statically scoped Emacs Lisp. -*- lexical-binding: t -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.

View file

@ -328,4 +328,4 @@ Returns non-nil if any false statements are found."
(provide 'check-declare)
;;; check-declare.el ends here.
;;; check-declare.el ends here

View file

@ -27,7 +27,7 @@
;; This package supplies a single entry point, common-lisp-indent-function,
;; which performs indentation in the preferred style for Common Lisp code.
;; It is also a suitable function for indenting Emacs lisp code.
;; It is also a suitable function for indenting Emacs Lisp code.
;;
;; To enable it:
;;

View file

@ -2144,7 +2144,9 @@ Like `cl-flet' but the definitions can refer to previous ones.
((and `(condition-case ,err-var ,bodyform . ,handlers)
(guard (not (eq err-var var))))
`(condition-case ,err-var
(progn (setq ,retvar ,bodyform) nil)
,(if (assq :success handlers)
bodyform
`(progn (setq ,retvar ,bodyform) nil))
. ,(mapcar (lambda (h)
(cons (car h) (funcall opt-exps (cdr h))))
handlers)))

View file

@ -213,7 +213,7 @@ the debugger will not be entered."
last-input-event last-command-event last-nonmenu-event
last-event-frame
overriding-local-map
load-read-function
(load-read-function #'read)
;; If we are inside a minibuffer, allow nesting
;; so that we don't get an error from the `e' command.
(enable-recursive-minibuffers

View file

@ -116,7 +116,7 @@ it is disabled.")
doc nil nil 1)))))
;;;###autoload
(defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
(defalias 'easy-mmode-define-minor-mode #'define-minor-mode)
;;;###autoload
(defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body)
"Define a new minor mode MODE.
@ -143,9 +143,9 @@ BODY contains code to execute each time the mode is enabled or disabled.
It is executed after toggling the mode, and before running MODE-hook.
Before the actual body code, you can write keyword arguments, i.e.
alternating keywords and values. If you provide BODY, then you must
provide at least one keyword argument. The following special
keywords are supported (other keywords are passed to `defcustom' if
the minor mode is global):
provide at least one keyword argument (e.g. `:lighter nil`).
The following special keywords are supported (other keywords are passed
to `defcustom' if the minor mode is global):
:global GLOBAL If non-nil specifies that the minor mode is not meant to be
buffer-local, so don't make the variable MODE buffer-local.
@ -186,9 +186,11 @@ For example, you could write
...BODY CODE...)
For backward compatibility with the Emacs<21 calling convention,
BODY can also start with the triplet INIT-VALUE LIGHTER KEYMAP."
the keywords can also be preceded by the obsolete triplet
INIT-VALUE LIGHTER KEYMAP.
\(fn MODE DOC [KEYWORD VAL ... &rest BODY])"
(declare (doc-string 2)
(advertised-calling-convention (mode doc &rest body) "28.1")
(debug (&define name string-or-null-p
[&optional [&not keywordp] sexp
&optional [&not keywordp] sexp
@ -267,7 +269,7 @@ BODY can also start with the triplet INIT-VALUE LIGHTER KEYMAP."
(unless set (setq set '(:set #'custom-set-minor-mode)))
(unless initialize
(setq initialize '(:initialize 'custom-initialize-default)))
(setq initialize '(:initialize #'custom-initialize-default)))
;; TODO? Mark booleans as safe if booleanp? Eg abbrev-mode.
(unless type (setq type '(:type 'boolean)))
@ -405,9 +407,9 @@ No problems result if this variable is not bound.
;;;
;;;###autoload
(defalias 'easy-mmode-define-global-mode 'define-globalized-minor-mode)
(defalias 'easy-mmode-define-global-mode #'define-globalized-minor-mode)
;;;###autoload
(defalias 'define-global-minor-mode 'define-globalized-minor-mode)
(defalias 'define-global-minor-mode #'define-globalized-minor-mode)
;;;###autoload
(defmacro define-globalized-minor-mode (global-mode mode turn-on &rest body)
"Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
@ -509,12 +511,12 @@ disable it. If called from Lisp, enable the mode if ARG is omitted or nil.\n\n"
(if ,global-mode
(progn
(add-hook 'after-change-major-mode-hook
',MODE-enable-in-buffers)
(add-hook 'find-file-hook ',MODE-check-buffers)
(add-hook 'change-major-mode-hook ',MODE-cmhh))
(remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers)
(remove-hook 'find-file-hook ',MODE-check-buffers)
(remove-hook 'change-major-mode-hook ',MODE-cmhh))
#',MODE-enable-in-buffers)
(add-hook 'find-file-hook #',MODE-check-buffers)
(add-hook 'change-major-mode-hook #',MODE-cmhh))
(remove-hook 'after-change-major-mode-hook #',MODE-enable-in-buffers)
(remove-hook 'find-file-hook #',MODE-check-buffers)
(remove-hook 'change-major-mode-hook #',MODE-cmhh))
;; Go through existing buffers.
(dolist (buf (buffer-list))
@ -554,7 +556,7 @@ list."
;; A function which checks whether MODE has been disabled in the major
;; mode hook which has just been run.
(add-hook ',minor-MODE-hook ',MODE-set-explicitly)
(add-hook ',minor-MODE-hook #',MODE-set-explicitly)
;; List of buffers left to process.
(defvar ,MODE-buffers nil)
@ -581,13 +583,13 @@ list."
(defun ,MODE-check-buffers ()
(,MODE-enable-in-buffers)
(remove-hook 'post-command-hook ',MODE-check-buffers))
(remove-hook 'post-command-hook #',MODE-check-buffers))
(put ',MODE-check-buffers 'definition-name ',global-mode)
;; The function that catches kill-all-local-variables.
(defun ,MODE-cmhh ()
(add-to-list ',MODE-buffers (current-buffer))
(add-hook 'post-command-hook ',MODE-check-buffers))
(add-hook 'post-command-hook #',MODE-check-buffers))
(put ',MODE-cmhh 'definition-name ',global-mode))))
(defun easy-mmode--globalized-predicate-p (predicate)

View file

@ -459,6 +459,9 @@ invoked without a prefix argument.
If acting on a `defun' for FUNCTION, and the function was instrumented,
`Edebug: FUNCTION' is printed in the minibuffer. If not instrumented,
just FUNCTION is printed."
;; Re-install our advice, in case `debug' re-bound `load-read-function' to
;; its default value.
(add-function :around load-read-function #'edebug--read)
(let* ((edebug-all-forms (not (eq (not edebug-it) (not edebug-all-defs))))
(edebug-all-defs edebug-all-forms))
(funcall orig-fun nil)))

View file

@ -169,7 +169,7 @@ Return nil if that option doesn't exist."
(and (recordp obj)
(eieio--class-p (eieio--object-class obj))))
(define-obsolete-function-alias 'object-p 'eieio-object-p "25.1")
(define-obsolete-function-alias 'object-p #'eieio-object-p "25.1")
(defun class-abstract-p (class)
"Return non-nil if CLASS is abstract.
@ -242,9 +242,9 @@ use \\='%s or turn off `eieio-backward-compatibility' instead" cname)
(cl-deftype list-of (elem-type)
`(and list
(satisfies (lambda (list)
(cl-every (lambda (elem) (cl-typep elem ',elem-type))
list)))))
(satisfies ,(lambda (list)
(cl-every (lambda (elem) (cl-typep elem elem-type))
list)))))
(defun eieio-make-class-predicate (class)
@ -787,7 +787,7 @@ Fills in OBJ's SLOT with its default value."
(cond
;; Is it a function call? If so, evaluate it.
((eieio-eval-default-p val)
(eval val))
(eval val t))
;;;; check for quoted things, and unquote them
;;((and (consp val) (eq (car val) 'quote))
;; (car (cdr val)))
@ -1029,7 +1029,7 @@ method invocation orders of the involved classes."
(eieio--class-precedence-c3 class))))))
(define-obsolete-function-alias
'class-precedence-list 'eieio--class-precedence-list "24.4")
'class-precedence-list #'eieio--class-precedence-list "24.4")
;;; Here are some special types of errors

View file

@ -1,4 +1,4 @@
;;; eieio-custom.el -- eieio object customization -*- lexical-binding:t -*-
;;; eieio-custom.el --- eieio object customization -*- lexical-binding:t -*-
;; Copyright (C) 1999-2001, 2005, 2007-2021 Free Software Foundation,
;; Inc.

View file

@ -1,4 +1,4 @@
;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar) -*- lexical-binding: t; -*-
;;; eieio-opt.el --- eieio optional functions (debug, printing, speedbar) -*- lexical-binding: t; -*-
;; Copyright (C) 1996, 1998-2003, 2005, 2008-2021 Free Software
;; Foundation, Inc.

View file

@ -1,4 +1,4 @@
;;; eieio-speedbar.el -- Classes for managing speedbar displays. -*- lexical-binding:t -*-
;;; eieio-speedbar.el --- Classes for managing speedbar displays. -*- lexical-binding:t -*-
;; Copyright (C) 1999-2002, 2005, 2007-2021 Free Software Foundation,
;; Inc.

View file

@ -981,4 +981,4 @@ of `eq'."
(provide 'eieio)
;;; eieio ends here
;;; eieio.el ends here

View file

@ -1170,11 +1170,6 @@ Intended to be called when a file is loaded."
;; File is being evaluated using, for example, `eval-buffer'.
default-directory)))
;; ----------------------------------------------------------------------
;; The end
;;
(provide 'faceup)
;;; faceup.el ends here

View file

@ -109,11 +109,6 @@
;; * Footer line --- marks end-of-file so it can be distinguished from
;; an expanded formfeed or the results of truncation.
;;; Change Log:
;; Tue Jul 14 23:44:17 1992 ESR
;; * Created.
;;; Code:
;;; Variables:

View file

@ -248,8 +248,6 @@ If SEQ is already a ring, return it."
(ring-insert-at-beginning ring (elt seq count))))
ring)))
;;; provide ourself:
(provide 'ring)
;;; ring.el ends here

View file

@ -1,4 +1,4 @@
;;;; testcover-ses.el -- Example use of `testcover' to test "SES" -*- lexical-binding: t; -*-
;;; tcover-ses.el --- Example use of `testcover' to test "SES" -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@ -716,4 +716,4 @@ spreadsheet files with invalid formatting."
;;Could do this here: (testcover-end "ses.el")
(message "Done"))
;;; testcover-ses.el ends here.
;;; tcover-ses.el ends here

View file

@ -1,4 +1,4 @@
;;;; testcover.el -- Visual code-coverage tool -*- lexical-binding:t -*-
;;; testcover.el --- Visual code-coverage tool -*- lexical-binding:t -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@ -675,4 +675,4 @@ The list is 1valued if all of its constituent elements are also 1valued."
(testcover-analyze-coverage (cadr form)))
(t (testcover-analyze-coverage-backquote form))))
;; testcover.el ends here.
;;; testcover.el ends here

View file

@ -214,3 +214,5 @@ and if a matching region is found, place point at its end."
(funcall predicate value prop-value))
(provide 'text-property-search)
;;; text-property-search.el ends here

View file

@ -1,4 +1,4 @@
;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate -*- lexical-binding: t; -*-
;;; unsafep.el --- Determine whether a Lisp form is safe to evaluate -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.