diff options
author | Yuuki Harano <masm+github@masm11.me> | 2021-05-19 22:02:06 +0900 |
---|---|---|
committer | Yuuki Harano <masm+github@masm11.me> | 2021-05-19 22:02:06 +0900 |
commit | e48372f8e5722643e37185b004469acd174663f7 (patch) | |
tree | b77ec71bb51856f98d34182eca56322750533017 /lisp/emacs-lisp | |
parent | d0fa569b7303c2d893b54d0a7af7a521308a5ed4 (diff) | |
parent | 61291e06cc804de2075305c220d31ef6072f28c8 (diff) | |
download | emacs-e48372f8e5722643e37185b004469acd174663f7.tar.gz emacs-e48372f8e5722643e37185b004469acd174663f7.tar.bz2 emacs-e48372f8e5722643e37185b004469acd174663f7.zip |
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 26 | ||||
-rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 14 | ||||
-rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 5 | ||||
-rw-r--r-- | lisp/emacs-lisp/comp.el | 165 | ||||
-rw-r--r-- | lisp/emacs-lisp/edebug.el | 2 | ||||
-rw-r--r-- | lisp/emacs-lisp/eieio-core.el | 27 | ||||
-rw-r--r-- | lisp/emacs-lisp/eldoc.el | 2 | ||||
-rw-r--r-- | lisp/emacs-lisp/ert-x.el | 2 | ||||
-rw-r--r-- | lisp/emacs-lisp/gv.el | 2 | ||||
-rw-r--r-- | lisp/emacs-lisp/lisp-mode.el | 12 | ||||
-rw-r--r-- | lisp/emacs-lisp/nadvice.el | 16 | ||||
-rw-r--r-- | lisp/emacs-lisp/package.el | 7 | ||||
-rw-r--r-- | lisp/emacs-lisp/re-builder.el | 7 | ||||
-rw-r--r-- | lisp/emacs-lisp/rmc.el | 57 | ||||
-rw-r--r-- | lisp/emacs-lisp/rx.el | 21 | ||||
-rw-r--r-- | lisp/emacs-lisp/shortdoc.el | 2 | ||||
-rw-r--r-- | lisp/emacs-lisp/subr-x.el | 16 | ||||
-rw-r--r-- | lisp/emacs-lisp/text-property-search.el | 42 | ||||
-rw-r--r-- | lisp/emacs-lisp/thunk.el | 2 |
19 files changed, 252 insertions, 175 deletions
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 33b4d4b3c87..28b53d05890 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -951,12 +951,20 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") "Whether EXPR is a constant symbol." (and (macroexp-const-p expr) (symbolp (eval expr)))) +(defun byte-optimize--fixnump (o) + "Return whether O is guaranteed to be a fixnum in all Emacsen. +See Info node `(elisp) Integer Basics'." + (and (fixnump o) (<= -536870912 o 536870911))) + (defun byte-optimize-equal (form) - ;; Replace `equal' or `eql' with `eq' if at least one arg is a symbol. + ;; Replace `equal' or `eql' with `eq' if at least one arg is a + ;; symbol or fixnum. (byte-optimize-binary-predicate (if (= (length (cdr form)) 2) (if (or (byte-optimize--constant-symbol-p (nth 1 form)) - (byte-optimize--constant-symbol-p (nth 2 form))) + (byte-optimize--constant-symbol-p (nth 2 form)) + (byte-optimize--fixnump (nth 1 form)) + (byte-optimize--fixnump (nth 2 form))) (cons 'eq (cdr form)) form) ;; Arity errors reported elsewhere. @@ -964,14 +972,19 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (defun byte-optimize-member (form) ;; Replace `member' or `memql' with `memq' if the first arg is a symbol, - ;; or the second arg is a list of symbols. + ;; or the second arg is a list of symbols. Same with fixnums. (if (= (length (cdr form)) 2) (if (or (byte-optimize--constant-symbol-p (nth 1 form)) + (byte-optimize--fixnump (nth 1 form)) (let ((arg2 (nth 2 form))) (and (macroexp-const-p arg2) (let ((listval (eval arg2))) (and (listp listval) - (not (memq nil (mapcar #'symbolp listval)))))))) + (not (memq nil (mapcar + (lambda (o) + (or (symbolp o) + (byte-optimize--fixnump o))) + listval)))))))) (cons 'memq (cdr form)) form) ;; Arity errors reported elsewhere. @@ -979,11 +992,12 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (defun byte-optimize-assoc (form) ;; Replace 2-argument `assoc' with `assq', `rassoc' with `rassq', - ;; if the first arg is a symbol. + ;; if the first arg is a symbol or fixnum. (cond ((/= (length form) 3) form) - ((byte-optimize--constant-symbol-p (nth 1 form)) + ((or (byte-optimize--constant-symbol-p (nth 1 form)) + (byte-optimize--fixnump (nth 1 form))) (cons (if (eq (car form) 'assoc) 'assq 'rassq) (cdr form))) (t (byte-optimize-constant-args form)))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e93cee99249..86c5d32c726 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1758,7 +1758,7 @@ It is too wide if it has any lines longer than the largest of overriding-plist-environment))))) (defmacro displaying-byte-compile-warnings (&rest body) - (declare (debug t)) + (declare (debug (def-body))) `(let* ((--displaying-byte-compile-warnings-fn (lambda () ,@body)) (warning-series-started (and (markerp warning-series) @@ -2238,12 +2238,12 @@ With argument ARG, insert value in current buffer after the form." (setq byte-compile-noruntime-functions nil) (setq byte-compile-new-defuns nil) (when byte-native-compiling - (defvar comp-speed) - (push `(comp-speed . ,comp-speed) byte-native-qualities) - (defvar comp-debug) - (push `(comp-debug . ,comp-debug) byte-native-qualities) - (defvar comp-native-driver-options) - (push `(comp-native-driver-options . ,comp-native-driver-options) + (defvar native-comp-speed) + (push `(native-comp-speed . ,native-comp-speed) byte-native-qualities) + (defvar native-comp-debug) + (push `(native-comp-debug . ,native-comp-debug) byte-native-qualities) + (defvar native-comp-driver-options) + (push `(native-comp-driver-options . ,native-comp-driver-options) byte-native-qualities) (defvar no-native-compile) (push `(no-native-compile . ,no-native-compile) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index d7e6c307ed3..283c5e4a74e 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1924,7 +1924,8 @@ from OBARRAY. \(fn (VAR [OBARRAY [RESULT]]) BODY...)" (declare (indent 1) - (debug ((symbolp &optional form form) cl-declarations body))) + (debug ((symbolp &optional form form) cl-declarations + def-body))) ;; Apparently this doesn't have an implicit block. `(cl-block nil (let (,(car spec)) @@ -1964,7 +1965,7 @@ Each symbol in the first list is bound to the corresponding value in the second list (or to nil if VALUES is shorter than SYMBOLS); then the BODY forms are executed and their result is returned. This is much like a `let' form, except that the list of symbols can be computed at run-time." - (declare (indent 2) (debug (form form body))) + (declare (indent 2) (debug (form form def-body))) (let ((bodyfun (make-symbol "body")) (binds (make-symbol "binds")) (syms (make-symbol "syms")) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index f700faa38b3..8c638312b05 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -43,7 +43,7 @@ "Emacs Lisp native compiler." :group 'lisp) -(defcustom comp-speed 2 +(defcustom native-comp-speed 2 "Optimization level for native compilation, a number between -1 and 3. -1 functions are kept in bytecode form and no native compilation is performed. 0 native compilation is performed with no optimizations. @@ -55,7 +55,7 @@ :safe #'integerp :version "28.1") -(defcustom comp-debug (if (eq 'windows-nt system-type) 1 0) +(defcustom native-comp-debug (if (eq 'windows-nt system-type) 1 0) "Debug level for native compilation, a number between 0 and 3. This is intended for debugging the compiler itself. 0 no debug output. @@ -67,7 +67,7 @@ This is intended for debugging the compiler itself. :safe #'natnump :version "28.1") -(defcustom comp-verbose 0 +(defcustom native-comp-verbose 0 "Compiler verbosity for native compilation, a number between 0 and 3. This is intended for debugging the compiler itself. 0 no logging. @@ -78,19 +78,19 @@ This is intended for debugging the compiler itself. :risky t :version "28.1") -(defcustom comp-always-compile nil +(defcustom native-comp-always-compile nil "Non-nil means unconditionally (re-)compile all files." :type 'boolean :version "28.1") -(defcustom comp-deferred-compilation-deny-list +(defcustom native-comp-deferred-compilation-deny-list '() "List of regexps to exclude matching files from deferred native compilation. Files whose names match any regexp are excluded from native compilation." :type '(repeat regexp) :version "28.1") -(defcustom comp-bootstrap-deny-list +(defcustom native-comp-bootstrap-deny-list '() "List of regexps to exclude files from native compilation during bootstrap. Files whose names match any regexp are excluded from native compilation @@ -98,7 +98,7 @@ during bootstrap." :type '(repeat regexp) :version "28.1") -(defcustom comp-never-optimize-functions +(defcustom native-comp-never-optimize-functions '(;; The following two are mandatory for Emacs to be working ;; correctly (see comment in `advice--add-function'). DO NOT ;; REMOVE. @@ -107,7 +107,7 @@ during bootstrap." :type '(repeat symbol) :version "28.1") -(defcustom comp-async-jobs-number 0 +(defcustom native-comp-async-jobs-number 0 "Default number of subprocesses used for async native compilation. Value of zero means to use half the number of the CPU's execution units, or one if there's just one execution unit." @@ -115,26 +115,26 @@ or one if there's just one execution unit." :risky t :version "28.1") -(defcustom comp-async-cu-done-functions nil +(defcustom native-comp-async-cu-done-functions nil "List of functions to call after asynchronously compiling one compilation unit. Called with one argument FILE, the filename used as input to compilation." :type 'hook :version "28.1") -(defcustom comp-async-all-done-hook nil +(defcustom native-comp-async-all-done-hook nil "Hook run after completing asynchronous compilation of all input files." :type 'hook :version "28.1") -(defcustom comp-async-env-modifier-form nil +(defcustom native-comp-async-env-modifier-form nil "Form evaluated before compilation by each asynchronous compilation subprocess. Used to modify the compiler environment." :type 'sexp :risky t :version "28.1") -(defcustom comp-async-report-warnings-errors t +(defcustom native-comp-async-report-warnings-errors t "Whether to report warnings and errors from asynchronous native compilation. When native compilation happens asynchronously, it can produce @@ -148,11 +148,16 @@ As asynchronous native compilation always starts from a pristine environment, it is more sensitive to such omissions, and might be unable to compile such Lisp source files correctly. -Set this variable to nil if these warnings annoy you." - :type 'boolean +Set this variable to nil to suppress warnings altogether, or to +the symbol `silent' to log warnings but not pop up the *Warnings* +buffer." + :type '(choice + (const :tag "Do not report warnings" nil) + (const :tag "Report and display warnings" t) + (const :tag "Report but do not display warnings" 'silent)) :version "28.1") -(defcustom comp-async-query-on-exit nil +(defcustom native-comp-async-query-on-exit nil "Whether to query the user about killing async compilations when exiting. If this is non-nil, Emacs will ask for confirmation to exit and kill the asynchronous native compilations if any are running. If nil, when you @@ -161,7 +166,7 @@ if `confirm-kill-processes' is non-nil." :type 'boolean :version "28.1") -(defcustom comp-native-driver-options nil +(defcustom native-comp-driver-options nil "Options passed verbatim to the native compiler's back-end driver. Note that not all options are meaningful; typically only the options affecting the assembler and linker are likely to be useful. @@ -178,7 +183,7 @@ the .eln output directory." :type 'boolean :version "28.1") -(defcustom comp-warning-on-missing-source t +(defcustom native-comp-warning-on-missing-source t "Emit a warning if a byte-code file being loaded has no corresponding source. The source file is necessary for native code file look-up and deferred compilation mechanism." @@ -662,7 +667,7 @@ Useful to hook into pass checkers.") (defun comp-subr-trampoline-install (subr-name) "Make SUBR-NAME effectively advice-able when called from native code." (unless (or (null comp-enable-subr-trampolines) - (memq subr-name comp-never-optimize-functions) + (memq subr-name native-comp-never-optimize-functions) (gethash subr-name comp-installed-trampolines-h)) (cl-assert (subr-primitive-p (symbol-function subr-name))) (comp--install-trampoline @@ -743,11 +748,11 @@ Returns ELT." "Lisp side of the compiler context." (output nil :type string :documentation "Target output file-name for the compilation.") - (speed comp-speed :type number + (speed native-comp-speed :type number :documentation "Default speed for this compilation unit.") - (debug comp-debug :type number + (debug native-comp-debug :type number :documentation "Default debug level for this compilation unit.") - (driver-options comp-native-driver-options :type list + (driver-options native-comp-driver-options :type list :documentation "Options for the GCC driver.") (top-level-forms () :type list :documentation "List of spilled top level forms.") @@ -899,7 +904,7 @@ CFG is mutated by a pass.") (has-non-local nil :type boolean :documentation "t if non local jumps are present.") (speed nil :type number - :documentation "Optimization level (see `comp-speed').") + :documentation "Optimization level (see `native-comp-speed').") (pure nil :type boolean :documentation "t if pure nil otherwise.") (type nil :type (or null comp-mvar) @@ -1028,18 +1033,18 @@ Assume allocation class 'd-default as default." (,(rx-to-string `(seq "(" (group-n 1 (or ,@(mapcar #'symbol-name comp-limple-ops))))) (1 font-lock-keyword-face))) - "Highlights used by `comp-limple-mode'.") + "Highlights used by `native-comp-limple-mode'.") -(define-derived-mode comp-limple-mode fundamental-mode "LIMPLE" +(define-derived-mode native-comp-limple-mode fundamental-mode "LIMPLE" "Syntax-highlight LIMPLE IR." (setf font-lock-defaults '(comp-limple-lock-keywords))) (cl-defun comp-log (data &optional (level 1) quoted) "Log DATA at LEVEL. LEVEL is a number from 1-3, and defaults to 1; if it is less -than `comp-verbose', do nothing. If `noninteractive', log +than `native-comp-verbose', do nothing. If `noninteractive', log with `message'. Otherwise, log with `comp-log-to-buffer'." - (when (>= comp-verbose level) + (when (>= native-comp-verbose level) (if noninteractive (cl-typecase data (atom (message "%s" data)) @@ -1059,8 +1064,8 @@ with `message'. Otherwise, log with `comp-log-to-buffer'." (inhibit-read-only t) at-end-p) (with-current-buffer log-buffer - (unless (eq major-mode 'comp-limple-mode) - (comp-limple-mode)) + (unless (eq major-mode 'native-comp-limple-mode) + (native-comp-limple-mode)) (when (= (point) (point-max)) (setf at-end-p t)) (save-excursion @@ -1091,7 +1096,7 @@ with `message'. Otherwise, log with `comp-log-to-buffer'." (defun comp-log-func (func verbosity) "Log function FUNC at VERBOSITY. VERBOSITY is a number between 0 and 3." - (when (>= comp-verbose verbosity) + (when (>= native-comp-verbose verbosity) (comp-log (format "\nFunction: %s\n" (comp-func-name func)) verbosity) (cl-loop for block-name being each hash-keys of (comp-func-blocks func) @@ -1333,12 +1338,12 @@ clashes." (setf (comp-ctxt-output comp-ctxt) (comp-el-to-eln-filename filename (when byte-native-for-bootstrap - (car (last comp-eln-load-path)))))) - (setf (comp-ctxt-speed comp-ctxt) (alist-get 'comp-speed + (car (last native-comp-eln-load-path)))))) + (setf (comp-ctxt-speed comp-ctxt) (alist-get 'native-comp-speed byte-native-qualities) - (comp-ctxt-debug comp-ctxt) (alist-get 'comp-debug + (comp-ctxt-debug comp-ctxt) (alist-get 'native-comp-debug byte-native-qualities) - (comp-ctxt-driver-options comp-ctxt) (alist-get 'comp-native-driver-options + (comp-ctxt-driver-options comp-ctxt) (alist-get 'native-comp-driver-options byte-native-qualities) (comp-ctxt-top-level-forms comp-ctxt) (cl-loop @@ -3250,14 +3255,14 @@ Return t if something was changed." ;; funcall trampoline gets optimized into normal indirect calls. ;; This makes effectively this calls equivalent to all the subrs that got ;; dedicated byte-code ops. -;; Triggered at comp-speed >= 2. +;; Triggered at native-comp-speed >= 2. ;; - Recursive calls gets optimized into direct calls. -;; Triggered at comp-speed >= 2. +;; Triggered at native-comp-speed >= 2. ;; - Intra compilation unit procedure calls gets optimized into direct calls. ;; This can be a big win and even allow gcc to inline but does not make ;; function in the compilation unit re-definable safely without recompiling ;; the full compilation unit. -;; For this reason this is triggered only at comp-speed == 3. +;; For this reason this is triggered only at native-comp-speed == 3. (defun comp-func-in-unit (func) "Given FUNC return the `comp-fun' definition in the current context. @@ -3275,7 +3280,7 @@ FUNCTION can be a function-name or byte compiled function." (when (and callee (or (symbolp callee) (gethash callee (comp-ctxt-byte-func-to-func-h comp-ctxt))) - (not (memq callee comp-never-optimize-functions))) + (not (memq callee native-comp-never-optimize-functions))) (let* ((f (if (symbolp callee) (symbol-function callee) (cl-assert (byte-code-function-p callee)) @@ -3650,14 +3655,14 @@ Prepare every function for final compilation and drive the C back-end." (print-circle t) (print-escape-multibyte t) (expr `((require 'comp) - (setf comp-verbose ,comp-verbose + (setf native-comp-verbose ,native-comp-verbose comp-libgccjit-reproducer ,comp-libgccjit-reproducer comp-ctxt ,comp-ctxt - comp-eln-load-path ',comp-eln-load-path - comp-native-driver-options - ',comp-native-driver-options + native-comp-eln-load-path ',native-comp-eln-load-path + native-comp-driver-options + ',native-comp-driver-options load-path ',load-path) - ,comp-async-env-modifier-form + ,native-comp-async-env-modifier-form (message "Compiling %s..." ',output) (comp-final1))) (temp-file (make-temp-file @@ -3703,12 +3708,12 @@ Prepare every function for final compilation and drive the C back-end." (defun comp-eln-load-path-eff () "Return a list of effective eln load directories. -Account for `comp-eln-load-path' and `comp-native-version-dir'." +Account for `native-comp-eln-load-path' and `comp-native-version-dir'." (mapcar (lambda (dir) (expand-file-name comp-native-version-dir (file-name-as-directory (expand-file-name dir invocation-directory)))) - comp-eln-load-path)) + native-comp-eln-load-path)) (defun comp-trampoline-filename (subr-name) "Given SUBR-NAME return the filename containing the trampoline." @@ -3756,7 +3761,7 @@ Return the trampoline if found or nil otherwise." ;; Use speed 0 to maximize compilation speed and not to ;; optimize away funcall calls! (byte-optimize nil) - (comp-speed 1) + (native-comp-speed 1) (lexical-binding t)) (comp--native-compile form nil @@ -3772,14 +3777,14 @@ Return the trampoline if found or nil otherwise." when (file-writable-p f) do (cl-return f) finally (error "Cannot find suitable directory for output in \ -`comp-eln-load-path'"))))) +`native-comp-eln-load-path'"))))) ;; Some entry point support code. ;;;###autoload (defun comp-clean-up-stale-eln (file) - "Given FILE remove all its *.eln files in `comp-eln-load-path' + "Given FILE remove all its *.eln files in `native-comp-eln-load-path' sharing the original source filename (including FILE)." (when (string-match (rx "-" (group-n 1 (1+ hex)) "-" (1+ hex) ".eln" eos) file) @@ -3851,7 +3856,7 @@ processes from `comp-async-compilations'" (defvar comp-num-cpus nil) (defun comp-effective-async-max-jobs () "Compute the effective number of async jobs." - (if (zerop comp-async-jobs-number) + (if (zerop native-comp-async-jobs-number) (or comp-num-cpus (setf comp-num-cpus ;; FIXME: we already have a function to determine @@ -3867,26 +3872,30 @@ processes from `comp-async-compilations'" (shell-command-to-string "sysctl -n hw.ncpu"))) (t 1)) 2)))) - comp-async-jobs-number)) + native-comp-async-jobs-number)) (defvar comp-last-scanned-async-output nil) (make-variable-buffer-local 'comp-last-scanned-async-output) (defun comp-accept-and-process-async-output (process) "Accept PROCESS output and check for diagnostic messages." - (if comp-async-report-warnings-errors - (with-current-buffer (process-buffer process) - (save-excursion - (accept-process-output process) - (goto-char (or comp-last-scanned-async-output (point-min))) - (while (re-search-forward "^.*?\\(?:Error\\|Warning\\): .*$" - nil t) - (display-warning 'comp (match-string 0))) - (setq comp-last-scanned-async-output (point-max)))) + (if native-comp-async-report-warnings-errors + (let ((warning-suppress-types + (if (eq native-comp-async-report-warnings-errors 'silent) + (cons '(comp) warning-suppress-types) + warning-suppress-types))) + (with-current-buffer (process-buffer process) + (save-excursion + (accept-process-output process) + (goto-char (or comp-last-scanned-async-output (point-min))) + (while (re-search-forward "^.*?\\(?:Error\\|Warning\\): .*$" + nil t) + (display-warning 'comp (match-string 0))) + (setq comp-last-scanned-async-output (point-max))))) (accept-process-output process))) (defun comp-run-async-workers () "Start compiling files from `comp-files-queue' asynchronously. -When compilation is finished, run `comp-async-all-done-hook' and +When compilation is finished, run `native-comp-async-all-done-hook' and display a message." (if (or comp-files-queue (> (comp-async-runnings) 0)) @@ -3897,7 +3906,7 @@ display a message." do (cl-assert (string-match-p comp-valid-source-re source-file) nil "`comp-files-queue' should be \".el\" files: %s" source-file) - when (or comp-always-compile + when (or native-comp-always-compile load ; Always compile when the compilation is ; commanded for late load. (file-newer-than-file-p @@ -3905,17 +3914,17 @@ display a message." do (let* ((expr `((require 'comp) ,(when (boundp 'backtrace-line-length) `(setf backtrace-line-length ,backtrace-line-length)) - (setf comp-speed ,comp-speed - comp-debug ,comp-debug - comp-verbose ,comp-verbose + (setf native-comp-speed ,native-comp-speed + native-comp-debug ,native-comp-debug + native-comp-verbose ,native-comp-verbose comp-libgccjit-reproducer ,comp-libgccjit-reproducer comp-async-compilation t - comp-eln-load-path ',comp-eln-load-path - comp-native-driver-options - ',comp-native-driver-options + native-comp-eln-load-path ',native-comp-eln-load-path + native-comp-driver-options + ',native-comp-driver-options load-path ',load-path warning-fill-column most-positive-fixnum) - ,comp-async-env-modifier-form + ,native-comp-async-env-modifier-form (message "Compiling %s..." ,source-file) (comp--native-compile ,source-file ,(and load t)))) (source-file1 source-file) ;; Make the closure works :/ @@ -3940,7 +3949,7 @@ display a message." :sentinel (lambda (process _event) (run-hook-with-args - 'comp-async-cu-done-functions + 'native-comp-async-cu-done-functions source-file) (comp-accept-and-process-async-output process) (ignore-errors (delete-file temp-file)) @@ -3953,12 +3962,12 @@ display a message." (native-elisp-load eln-file (eq load1 'late)))) (comp-run-async-workers)) - :noquery (not comp-async-query-on-exit)))) + :noquery (not native-comp-async-query-on-exit)))) (puthash source-file process comp-async-compilations)) when (>= (comp-async-runnings) (comp-effective-async-max-jobs)) do (cl-return))) ;; No files left to compile and all processes finished. - (run-hooks 'comp-async-all-done-hook) + (run-hooks 'native-comp-async-all-done-hook) (with-current-buffer (get-buffer-create comp-async-buffer-name) (save-excursion (goto-char (point-max)) @@ -4044,11 +4053,11 @@ LOAD and SELECTOR work as described in `native--compile-async'." (t (error "SELECTOR must be a function a regexp or nil"))) ;; Also exclude files from deferred compilation if ;; any of the regexps in - ;; `comp-deferred-compilation-deny-list' matches. + ;; `native-comp-deferred-compilation-deny-list' matches. (and (eq load 'late) (cl-some (lambda (re) (string-match-p re file)) - comp-deferred-compilation-deny-list)))) + native-comp-deferred-compilation-deny-list)))) (defun native--compile-async (files &optional recursively load selector) "Compile FILES asynchronously. @@ -4066,7 +4075,7 @@ nil -- Select all files. a string -- A regular expression selecting files with matching names. a function -- A function selecting files with matching names. -The variable `comp-async-jobs-number' specifies the number +The variable `native-comp-async-jobs-number' specifies the number of (commands) to run simultaneously. LOAD can also be the symbol `late'. This is used internally if @@ -4123,10 +4132,10 @@ bytecode definition was not changed in the meantime)." ;;;###autoload (defun comp-lookup-eln (filename) "Given a Lisp source FILENAME return the corresponding .eln file if found. -Search happens in `comp-eln-load-path'." +Search happens in `native-comp-eln-load-path'." (cl-loop with eln-filename = (comp-el-to-eln-rel-filename filename) - for dir in comp-eln-load-path + for dir in native-comp-eln-load-path for f = (expand-file-name eln-filename (expand-file-name comp-native-version-dir (expand-file-name @@ -4159,7 +4168,7 @@ Native compilation equivalent to `batch-byte-compile'." (cl-loop for file in command-line-args-left if (or (null byte-native-for-bootstrap) (cl-notany (lambda (re) (string-match re file)) - comp-bootstrap-deny-list)) + native-comp-bootstrap-deny-list)) do (comp--native-compile file) else do (byte-compile-file file))) @@ -4169,7 +4178,7 @@ Native compilation equivalent to `batch-byte-compile'." "Like `batch-native-compile', but used for bootstrap. Generate .elc files in addition to the .eln files. Force the produced .eln to be outputted in the eln system -directory (the last entry in `comp-eln-load-path'). +directory (the last entry in `native-comp-eln-load-path'). If the environment variable 'NATIVE_DISABLED' is set, only byte compile." (comp-ensure-native-compiler) @@ -4200,7 +4209,7 @@ nil -- Select all files. a string -- A regular expression selecting files with matching names. a function -- A function selecting files with matching names. -The variable `comp-async-jobs-number' specifies the number +The variable `native-comp-async-jobs-number' specifies the number of (commands) to run simultaneously." ;; Normalize: we only want to pass t or nil, never e.g. `late'. (let ((load (not (not load)))) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index b08ee3c4a17..2aec8197dc9 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -88,6 +88,7 @@ using, but only when you also use Edebug." ;; because the byte compiler binds them; as a result, if edebug ;; is first loaded for a require in a compilation, they will be left unbound. +;;;###autoload (defcustom edebug-all-defs nil "If non-nil, evaluating defining forms instruments for Edebug. This applies to `eval-defun', `eval-region', `eval-buffer', and @@ -100,6 +101,7 @@ variable. You may wish to make it local to each buffer with `emacs-lisp-mode-hook'." :type 'boolean) +;;;###autoload (defcustom edebug-all-forms nil "Non-nil means evaluation of all forms will instrument for Edebug. This doesn't apply to loading or evaluations in the minibuffer. diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 2923dffd951..34b4575182e 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -347,19 +347,20 @@ See `defclass' for more information." (when eieio-backward-compatibility (let ((csym (intern (concat (symbol-name cname) "-list-p")))) (defalias csym - `(lambda (obj) - ,(format - "Test OBJ to see if it a list of objects which are a child of type %s" - cname) - (when (listp obj) - (let ((ans t)) ;; nil is valid - ;; Loop over all the elements of the input list, test - ;; each to make sure it is a child of the desired object class. - (while (and obj ans) - (setq ans (and (eieio-object-p (car obj)) - (object-of-class-p (car obj) ,cname))) - (setq obj (cdr obj))) - ans)))) + (lambda (obj) + (:documentation + (format + "Test OBJ to see if it a list of objects which are a child of type %s" + cname)) + (when (listp obj) + (let ((ans t)) ;; nil is valid + ;; Loop over all the elements of the input list, test + ;; each to make sure it is a child of the desired object class. + (while (and obj ans) + (setq ans (and (eieio-object-p (car obj)) + (object-of-class-p (car obj) 'cname))) + (setq obj (cdr obj))) + ans)))) (make-obsolete csym (format "use (cl-typep ... \\='(list-of %s)) instead" cname) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index b4f068cf3ae..cec89cf3bc5 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -538,7 +538,7 @@ documentation to potentially appear in the echo are is truncated." (and truncatedp (eq eldoc-echo-area-prefer-doc-buffer 'maybe))) - (get-buffer-window eldoc--doc-buffer))) + (get-buffer-window eldoc--doc-buffer 'visible))) (defun eldoc-display-in-echo-area (docs _interactive) "Display DOCS in echo area. diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 1191fb8f8de..59ec4d24849 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -98,7 +98,7 @@ To be used in ERT tests. If BODY finishes successfully, the test buffer is killed; if there is an error, the test buffer is kept around on error for further inspection. Its name is derived from the name of the test and the result of NAME-FORM." - (declare (debug ((":name" form) body)) + (declare (debug ((":name" form) def-body)) (indent 1)) `(ert--call-with-test-buffer ,name-form (lambda () ,@body))) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index ce48e578e0b..f08f7ac1153 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -135,7 +135,7 @@ The returned value will then be an Elisp expression that first evaluates all the parts of PLACE that can be evaluated and then runs E. \(fn (GETTER SETTER) PLACE &rest BODY)" - (declare (indent 2) (debug (sexp form body))) + (declare (indent 2) (debug (sexp form def-body))) `(gv-get ,place (lambda ,vars ,@body))) ;; Different ways to declare a generalized variable. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 67b75460941..59325d647d8 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -682,10 +682,16 @@ font-lock keywords will not be case sensitive." (defun lisp-outline-level () "Lisp mode `outline-level' function." + ;; Expects outline-regexp is ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(" + ;; and point is at the beginning of a matching line. (let ((len (- (match-end 0) (match-beginning 0)))) - (if (looking-at "(\\|;;;###autoload") - 1000 - len))) + (cond ((looking-at "(\\|;;;###autoload") + 1000) + ((looking-at ";;\\(;+\\) ") + (- (match-end 1) (match-beginning 1))) + ;; Above should match everything but just in case. + (t + len)))) (defun lisp-current-defun-name () "Return the name of the defun at point, or nil." diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 747572a3363..4804e859ebe 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -324,13 +324,13 @@ is also interactive. There are 3 cases: (subr-primitive-p (gv-deref ref))) (let ((subr-name (intern (subr-name (gv-deref ref))))) ;; Requiring the native compiler to advice `macroexpand' cause a - ;; circular dependency in eager macro expansion. - ;; uniquify is advising `rename-buffer' while being loaded in - ;; loadup.el. This would require the whole native compiler - ;; machinery but we don't want to include it in the dump. - ;; Because these two functions are already handled in - ;; `comp-never-optimize-functions' we hack the problem this way - ;; for now :/ + ;; circular dependency in eager macro expansion. uniquify is + ;; advising `rename-buffer' while being loaded in loadup.el. + ;; This would require the whole native compiler machinery but we + ;; don't want to include it in the dump. Because these two + ;; functions are already handled in + ;; `native-comp-never-optimize-functions' we hack the problem + ;; this way for now :/ (unless (memq subr-name '(macroexpand rename-buffer)) ;; Must require explicitly as during bootstrap we have no ;; autoloads. @@ -503,7 +503,7 @@ arguments. Note if NAME is nil the advice is anonymous; otherwise it is named `SYMBOL@NAME'. \(fn SYMBOL (WHERE LAMBDA-LIST &optional NAME DEPTH) &rest BODY)" - (declare (indent 2) (doc-string 3) (debug (sexp sexp body))) + (declare (indent 2) (doc-string 3) (debug (sexp sexp def-body))) (or (listp args) (signal 'wrong-type-argument (list 'listp args))) (or (<= 2 (length args) 4) (signal 'wrong-number-of-arguments (list 2 4 (length args)))) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index e1339177519..5df9b53657b 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1305,7 +1305,10 @@ is non-nil, don't propagate connection errors (does not apply to errors signaled by ERROR-FORM or by BODY). \(fn URL &key ASYNC FILE ERROR-FORM NOERROR &rest BODY)" - (declare (indent defun) (debug t)) + (declare (indent defun) + ;; FIXME: This should be something like + ;; `form def-body &rest form', but that doesn't work. + (debug (form &rest sexp))) (while (keywordp (car body)) (setq body (cdr (cdr body)))) `(package--with-response-buffer-1 ,url (lambda () ,@body) @@ -2267,7 +2270,7 @@ Clean-up the corresponding .eln files if Emacs is native compiled." (when (featurep 'native-compile) (cl-loop - for file in (directory-files-recursively dir ".el\\'") + for file in (directory-files-recursively dir "\\.el\\'") do (comp-clean-up-stale-eln (comp-el-to-eln-filename file)))) (delete-directory dir t)) diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 455fcac701f..7d042a9102e 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -341,7 +341,12 @@ the regexp builder. It displays a buffer named \"*RE-Builder*\" in another window, initially containing an empty regexp. As you edit the regexp in the \"*RE-Builder*\" buffer, the -matching parts of the target buffer will be highlighted." +matching parts of the target buffer will be highlighted. + +Case-sensitivity can be toggled with \\[reb-toggle-case]. The +regexp builder supports three different forms of input which can +be set with \\[reb-change-syntax]. More options and details are +provided in the Commentary section of this library." (interactive) (if (and (string= (buffer-name) reb-buffer) (reb-mode-buffer-p)) diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el index 6aa169c0323..8abe570e64b 100644 --- a/lisp/emacs-lisp/rmc.el +++ b/lisp/emacs-lisp/rmc.el @@ -27,36 +27,37 @@ ;;;###autoload (defun read-multiple-choice (prompt choices &optional help-string) - "Ask user a multiple choice question. -PROMPT should be a string that will be displayed as the prompt. - -CHOICES is a list of (KEY NAME [DESCRIPTION]). KEY is a -character to be entered. NAME is a short name for the entry to -be displayed while prompting (if there's room, it might be -shortened). DESCRIPTION is an optional longer explanation for -the entry that will be displayed in a help buffer if the user -requests more help. This help description has a fixed format in -columns, but, for greater flexibility, instead of passing a -DESCRIPTION, the user can use the optional argument HELP-STRING. -This argument is a string that contains the text with the -complete description of all choices. `read-multiple-choice' will -display that description in a help buffer if the user requests -it. + "Ask user to select an entry from CHOICES, promting with PROMPT. +This function allows to ask the user a multiple-choice question. + +CHOICES should be a list of the form (KEY NAME [DESCRIPTION]). +KEY is a character the user should type to select the entry. +NAME is a short name for the entry to be displayed while prompting +\(if there's no room, it might be shortened). +DESCRIPTION is an optional longer description of the entry; it will +be displayed in a help buffer if the user requests more help. This +help description has a fixed format in columns. For greater +flexibility, instead of passing a DESCRIPTION, the caller can pass +the optional argument HELP-STRING. This argument is a string that +should contain a more detailed description of all of the possible +choices. `read-multiple-choice' will display that description in a +help buffer if the user requests that. This function translates user input into responses by consulting the bindings in `query-replace-map'; see the documentation of -that variable for more information. In this case, the useful -bindings are `recenter', `scroll-up', `scroll-down', and `edit'. -If the user enters `recenter', `scroll-up', or `scroll-down' -responses, perform the requested window recentering or scrolling -and ask again. If the user enters `edit', start a recursive -edit. When the user exit the recursive edit, the multiple choice -prompt gains focus again. - -When `use-dialog-box' is t (the default), this function can pop -up a dialog window to collect the user input. That functionality -requires `display-popup-menus-p' to return t. Otherwise, a -text dialog will be used. +that variable for more information. The relevant bindings for the +purposes of this function are `recenter', `scroll-up', `scroll-down', +and `edit'. +If the user types the `recenter', `scroll-up', or `scroll-down' +responses, the function performs the requested window recentering or +scrolling, and then asks the question again. If the user enters `edit', +the function starts a recursive edit. When the user exit the recursive +edit, the multiple-choice prompt gains focus again. + +When `use-dialog-box' is t (the default), and the command using this +function was invoked via the mouse, this function pops up a GUI dialog +to collect the user input, but only if Emacs is capable of using GUI +dialogs. Otherwise, the function will always use text-mode dialogs. The return value is the matching entry from the CHOICES list. @@ -146,7 +147,7 @@ Usage example: (save-excursion (message "%s" (substitute-command-keys - "Recursive edit. Resume with \\[exit-recursive-edit]")) + "Recursive edit; type \\[exit-recursive-edit] to return to help screen")) (recursive-edit)))) (t tchar))) (when (eq tchar t) diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 1e3eb9c12b1..43bd84d9990 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -1445,12 +1445,23 @@ following constructs: (regexp (rx--to-expr (rx--pcase-transform (cons 'seq regexps)))) (nvars (length rx--pcase-vars))) `(and (pred stringp) - ,(if (zerop nvars) - ;; No variables bound: a single predicate suffices. - `(pred (string-match ,regexp)) + ,(pcase nvars + (0 + ;; No variables bound: a single predicate suffices. + `(pred (string-match ,regexp))) + (1 + ;; Create a match value that on a successful regexp match + ;; is the submatch value, 0 on failure. We can't use nil + ;; for failure because it is a valid submatch value. + `(app (lambda (s) + (if (string-match ,regexp s) + (match-string 1 s) + 0)) + (and ,(car rx--pcase-vars) (pred (not numberp))))) + (_ ;; Pack the submatches into a dotted list which is then ;; immediately destructured into individual variables again. - ;; This is of course slightly inefficient when NVARS > 1. + ;; This is of course slightly inefficient. ;; A dotted list is used to reduce the number of conses ;; to create and take apart. `(app (lambda (s) @@ -1463,7 +1474,7 @@ following constructs: (rx--reduce-right #'cons (mapcar (lambda (name) (list '\, name)) - (reverse rx--pcase-vars))))))))) + (reverse rx--pcase-vars)))))))))) ;; Obsolete internal symbol, used in old versions of the `flycheck' package. (define-obsolete-function-alias 'rx-submatch-n 'rx-to-string "27.1") diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 9b31d687035..0320e171825 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -625,7 +625,7 @@ There can be any number of :example/:result elements." (length> :eval (length> '(a b c) 1)) (length= - :eval (length> '(a b c) 3)) + :eval (length= '(a b c) 3)) (safe-length :eval (safe-length '(a b c)))) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 9c8c967ee9c..fb890509ad7 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -174,8 +174,8 @@ As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING) like \((SYMBOL SOMETHING)). This exists for backward compatibility with an old syntax that accepted only one binding." (declare (indent 2) - (debug ([&or (&rest [&or symbolp (symbolp form) (form)]) - (symbolp form)] + (debug ([&or (symbolp form) ; must be first, Bug#48489 + (&rest [&or symbolp (symbolp form) (form)])] form body))) (when (and (<= (length spec) 2) (not (listp (car spec)))) @@ -289,6 +289,18 @@ than this function." (let ((result nil) (result-length 0) (index (if end (1- (length string)) 0))) + ;; FIXME: This implementation, which uses encode-coding-char + ;; to encode the string one character at a time, is in general + ;; incorrect: coding-systems that produce prefix or suffix + ;; bytes, such as ISO-2022-based or UTF-8/16 with BOM, will + ;; produce those bytes for each character, instead of just + ;; once for the entire string. encode-coding-char attempts to + ;; remove those extra bytes at least in some situations, but + ;; it cannot do that in all cases. And in any case, producing + ;; what is supposed to be a UTF-16 or ISO-2022-CN encoded + ;; string which lacks the BOM bytes at the beginning and the + ;; charset designation sequences at the head and tail of the + ;; result will definitely surprise the callers in some cases. (while (let ((encoded (encode-coding-char (aref string index) coding-system))) (and (<= (+ (length encoded) result-length) length) diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el index 69943a83f1c..7da02a9cb2d 100644 --- a/lisp/emacs-lisp/text-property-search.el +++ b/lisp/emacs-lisp/text-property-search.el @@ -31,28 +31,40 @@ (defun text-property-search-forward (property &optional value predicate not-current) - "Search for the next region of text whose PROPERTY matches VALUE. - -If not found, return nil and don't move point. -If found, move point to the start of the region and return a -`prop-match' object describing the match. To access the details -of the match, use `prop-match-beginning' and `prop-match-end' for -the buffer positions that limit the region, and -`prop-match-value' for the value of PROPERTY in the region. - + "Search for the next region of text where PREDICATE is true. PREDICATE is used to decide whether a value of PROPERTY should be considered as matching VALUE. -If PREDICATE is t, that means a value must `equal' VALUE to be -considered a match. -If PREDICATE is nil, a value will match if it is non-nil and -is NOT `equal' to VALUE. + If PREDICATE is a function, it will be called with two arguments: VALUE and the value of PROPERTY. The function should return non-nil if these two values are to be considered a match. +Two special values of PREDICATE can also be used: +If PREDICATE is t, that means a value must `equal' VALUE to be +considered a match. +If PREDICATE is nil (which is the default value), a value will +match if is not `equal' to VALUE. Furthermore, a nil PREDICATE +means that the match region is ended if the value changes. For +instance, this means that if you loop with + + (while (setq prop (text-property-search-forward 'face)) + ...) + +you will get all distinct regions with non-nil `face' values in +the buffer, and the `prop' object will have the details about the +match. See the manual for more details and examples about how +VALUE and PREDICATE interact. + If NOT-CURRENT is non-nil, the function will search for the first region that doesn't include point and has a value of PROPERTY -that matches VALUE." +that matches VALUE. + +If no matches can be found, return nil and don't move point. +If found, move point to the end of the region and return a +`prop-match' object describing the match. To access the details +of the match, use `prop-match-beginning' and `prop-match-end' for +the buffer positions that limit the region, and +`prop-match-value' for the value of PROPERTY in the region." (interactive (list (let ((string (completing-read "Search for property: " obarray))) @@ -125,7 +137,7 @@ that matches VALUE." "Search for the previous region of text whose PROPERTY matches VALUE. Like `text-property-search-forward', which see, but searches backward, -and if a matching region is found, place point at its end." +and if a matching region is found, place point at the start of the region." (interactive (list (let ((string (completing-read "Search for property: " obarray))) diff --git a/lisp/emacs-lisp/thunk.el b/lisp/emacs-lisp/thunk.el index 83e0fa75aa7..7e349d22a49 100644 --- a/lisp/emacs-lisp/thunk.el +++ b/lisp/emacs-lisp/thunk.el @@ -52,7 +52,7 @@ (defmacro thunk-delay (&rest body) "Delay the evaluation of BODY." - (declare (debug t)) + (declare (debug (def-body))) (cl-assert lexical-binding) `(let (forced (val (lambda () ,@body))) |