commit 704755a568300985caa9e143f46f17d364e5eda9 (HEAD, refs/remotes/origin/master) Author: Jim Porter Date: Wed May 5 16:05:25 2021 -0700 Shell-quote the directory when finding a project's files * lisp/progmodes/project.el (project--files-in-directory): Shell-quote the directory (bug48247). diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 24feeaf129..047f55ed1a 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -299,8 +299,9 @@ to find the list of ignores for each directory." (localdir (file-name-unquote (file-local-name (expand-file-name dir)))) (command (format "%s %s %s -type f %s -print0" find-program - ;; In case DIR is a symlink. - (file-name-as-directory localdir) + (shell-quote-argument + ;; In case DIR is a symlink. + (file-name-as-directory localdir)) (xref--find-ignores-arguments ignores localdir) (if files (concat (shell-quote-argument "(") commit 8616e4f747264da5699a9ac93961209f21f9dd6d Author: Dmitry Gutov Date: Thu May 6 20:43:02 2021 +0300 project--buffer-list: Tighten the check * lisp/progmodes/project.el (project--buffer-list): Tighten the check to speed up in the presence of multiple Tramp sessions, too. (https://lists.gnu.org/archive/html/emacs-devel/2021-05/msg00152.html) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 33827136a1..24feeaf129 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1120,11 +1120,13 @@ current project, it will be killed." (defun project--buffer-list (pr) "Return the list of all buffers in project PR." - (let ((remote-project-p (file-remote-p (project-root pr))) + (let ((conn (file-remote-p (project-root pr))) bufs) (dolist (buf (buffer-list)) - (when (and (let ((remote (file-remote-p (buffer-local-value 'default-directory buf)))) - (if remote-project-p remote (not remote))) + ;; For now we go with the assumption that a project must reside + ;; entirely on one host. We might relax that in the future. + (when (and (equal conn + (file-remote-p (buffer-local-value 'default-directory buf))) (equal pr (with-current-buffer buf (project-current)))) commit 8b7495a722a57071cb2a978665f95f8227db2863 Author: Mattias Engdegård Date: Thu May 6 17:23:44 2021 +0200 ; * test/lisp/image-tests.el: fix previous commit diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el index 317e85fe50..aa8600609c 100644 --- a/test/lisp/image-tests.el +++ b/test/lisp/image-tests.el @@ -57,11 +57,10 @@ (should (eq (image-type-from-file-name "foo.png") 'png))) (ert-deftest image-type/from-filename () - ;; On emba, `image-load-path' does not exist. - (skip-unless (bound-and-true-p image-load-path)) - (should (eq (image-type "gif.pbm") 'pbm)) - (when (memq 'jpeg image-types) ; jpeg may not be compiled in - (should (eq (image-type "foo.jpg") 'jpeg)))) + ;; On emba, `image-types' and `image-load-path' do not exist. + (skip-unless (and (bound-and-true-p image-types) + (bound-and-true-p image-load-path))) + (should (eq (image-type "foo.jpg") 'jpeg))) (ert-deftest image-type-from-file-header-test () "Test image-type-from-file-header." commit fbbcbed10ee89e0865bbddc6683ff626ec488ee9 Author: Andrea Corallo Date: Thu May 6 16:28:43 2021 +0200 Rename comp-eln-load-path → native-comp-eln-load-path * src/comp.c (Fcomp_el_to_eln_filename): Rename comp-eln-load-path → native-comp-eln-load-path. * src/lread.c (maybe_swap_for_eln): Likewise. * lisp/startup.el (native-comp-eln-load-path) (normal-top-level): Likewise. * lisp/emacs-lisp/comp.el (comp-spill-lap-function, comp-final) (comp-eln-load-path-eff, comp-trampoline-compile) (comp-clean-up-stale-eln, comp-run-async-workers) (comp-lookup-eln, batch-byte-native-compile-for-bootstrap): Likewise. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 434e0fb416..684b814292 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1333,7 +1333,7 @@ clashes." (setf (comp-ctxt-output comp-ctxt) (comp-el-to-eln-filename filename (when byte-native-for-bootstrap - (car (last comp-eln-load-path)))))) + (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 'native-comp-debug @@ -3653,7 +3653,7 @@ Prepare every function for final compilation and drive the C back-end." (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 + native-comp-eln-load-path ',native-comp-eln-load-path native-comp-driver-options ',native-comp-driver-options load-path ',load-path) @@ -3703,12 +3703,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." @@ -3772,14 +3772,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) @@ -3910,7 +3910,7 @@ display a message." native-comp-verbose ,native-comp-verbose comp-libgccjit-reproducer ,comp-libgccjit-reproducer comp-async-compilation t - comp-eln-load-path ',comp-eln-load-path + native-comp-eln-load-path ',native-comp-eln-load-path native-comp-driver-options ',native-comp-driver-options load-path ',load-path @@ -4123,10 +4123,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 @@ -4169,7 +4169,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) diff --git a/lisp/startup.el b/lisp/startup.el index 6bab9e364c..bb25c1b7b0 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -519,7 +519,7 @@ DIRS are relative." xdg-dir) (t emacs-d-dir)))) -(defvar comp-eln-load-path) +(defvar native-comp-eln-load-path) (defun normal-top-level () "Emacs calls this function when it first starts up. It sets `command-line-processed', processes the command-line, @@ -538,21 +538,21 @@ It is the default value of the variable `top-level'." (startup--xdg-or-homedot startup--xdg-config-home-emacs nil)) (when (featurep 'native-compile) - ;; Form `comp-eln-load-path'. + ;; Form `native-comp-eln-load-path'. (let ((path-env (getenv "EMACSNATIVELOADPATH"))) (when path-env (dolist (path (split-string path-env path-separator)) (unless (string= "" path) - (push path comp-eln-load-path))))) + (push path native-comp-eln-load-path))))) (push (expand-file-name "eln-cache/" user-emacs-directory) - comp-eln-load-path) + native-comp-eln-load-path) ;; When $HOME is set to '/nonexistent' means we are running the ;; testsuite, add a temporary folder in front to produce there ;; new compilations. (when (equal (getenv "HOME") "/nonexistent") (let ((tmp-dir (make-temp-file "emacs-testsuite-" t))) (add-hook 'kill-emacs-hook (lambda () (delete-directory tmp-dir t))) - (push tmp-dir comp-eln-load-path)))) + (push tmp-dir native-comp-eln-load-path)))) ;; Look in each dir in load-path for a subdirs.el file. If we ;; find one, load it, which will add the appropriate subdirs of ;; that dir into load-path. This needs to be done before setting @@ -640,12 +640,12 @@ It is the default value of the variable `top-level'." (decode-coding-string dir coding t)) path))))) (when (featurep 'native-compile) - (let ((npath (symbol-value 'comp-eln-load-path))) - (set 'comp-eln-load-path + (let ((npath (symbol-value 'native-comp-eln-load-path))) + (set 'native-comp-eln-load-path (mapcar (lambda (dir) ;; Call expand-file-name to remove all the ;; pesky ".." from the directyory names in - ;; comp-eln-load-path. + ;; native-comp-eln-load-path. (expand-file-name (decode-coding-string dir coding t))) npath)))) diff --git a/src/comp.c b/src/comp.c index 5cf94762a9..5128755bf1 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4095,11 +4095,11 @@ directory in `comp-eln-load-path' otherwise. */) Lisp_Object source_filename = filename; filename = Fcomp_el_to_eln_rel_filename (filename); - /* If base_dir was not specified search inside Vcomp_eln_load_path + /* If base_dir was not specified search inside Vnative_comp_eln_load_path for the first directory where we have write access. */ if (NILP (base_dir)) { - Lisp_Object eln_load_paths = Vcomp_eln_load_path; + Lisp_Object eln_load_paths = Vnative_comp_eln_load_path; FOR_EACH_TAIL (eln_load_paths) { Lisp_Object dir = XCAR (eln_load_paths); @@ -4630,7 +4630,7 @@ void eln_load_path_final_clean_up (void) { #ifdef WINDOWSNT - Lisp_Object dir_tail = Vcomp_eln_load_path; + Lisp_Object dir_tail = Vnative_comp_eln_load_path; FOR_EACH_TAIL (dir_tail) { Lisp_Object files_in_dir = @@ -4755,7 +4755,7 @@ void fixup_eln_load_path (Lisp_Object eln_filename) { Lisp_Object last_cell = Qnil; - Lisp_Object tem = Vcomp_eln_load_path; + Lisp_Object tem = Vnative_comp_eln_load_path; FOR_EACH_TAIL (tem) if (CONSP (tem)) last_cell = tem; @@ -5127,7 +5127,7 @@ static bool file_in_eln_sys_dir (Lisp_Object filename) { Lisp_Object eln_sys_dir = Qnil; - Lisp_Object tmp = Vcomp_eln_load_path; + Lisp_Object tmp = Vnative_comp_eln_load_path; FOR_EACH_TAIL (tmp) eln_sys_dir = XCAR (tmp); return !NILP (Fstring_match (Fregexp_quote (Fexpand_file_name (eln_sys_dir, @@ -5369,7 +5369,7 @@ For internal use. */); doc: /* Hash table eln-filename -> el-filename. */); Vcomp_eln_to_el_h = CALLN (Fmake_hash_table, QCtest, Qequal); - DEFVAR_LISP ("comp-eln-load-path", Vcomp_eln_load_path, + DEFVAR_LISP ("native-comp-eln-load-path", Vnative_comp_eln_load_path, doc: /* List of eln cache directories. If a directory is non absolute is assumed to be relative to @@ -5381,7 +5381,7 @@ The last directory of this list is assumed to be the system one. */); /* Temporary value in use for bootstrap. We can't do better as `invocation-directory' is still unset, will be fixed up during dump reload. */ - Vcomp_eln_load_path = Fcons (build_string ("../native-lisp/"), Qnil); + Vnative_comp_eln_load_path = Fcons (build_string ("../native-lisp/"), Qnil); DEFVAR_BOOL ("comp-enable-subr-trampolines", comp_enable_subr_trampolines, doc: /* If non-nil enable primitive trampoline synthesis. diff --git a/src/lread.c b/src/lread.c index 12e4ca66cd..d2e6323cb1 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1700,7 +1700,7 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd, return; /* Search eln in the eln-cache directories. */ - Lisp_Object eln_path_tail = Vcomp_eln_load_path; + Lisp_Object eln_path_tail = Vnative_comp_eln_load_path; Lisp_Object src_name = Fsubstring (*filename, Qnil, make_fixnum (-1)); if (NILP (Ffile_exists_p (src_name))) commit 901ce566037b27233b907a51a9cbd330c77830ba Author: Andrea Corallo Date: Thu May 6 15:00:00 2021 +0200 Rename comp-warning-on-missing-source * src/lread.c (maybe_swap_for_eln): Rename comp-warning-on-missing-source → native-comp-warning-on-missing-source. * src/comp.c (syms_of_comp): Likewise. * lisp/emacs-lisp/comp.el (native-comp-warning-on-missing-source): Likewise. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2b00faa069..434e0fb416 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -178,7 +178,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." diff --git a/src/comp.c b/src/comp.c index 9173dde220..5cf94762a9 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5272,7 +5272,8 @@ compiled one. */); DEFSYM (Qlambda_fixup, "lambda-fixup"); DEFSYM (Qgccjit, "gccjit"); DEFSYM (Qcomp_subr_trampoline_install, "comp-subr-trampoline-install"); - DEFSYM (Qcomp_warning_on_missing_source, "comp-warning-on-missing-source"); + DEFSYM (Qnative_comp_warning_on_missing_source, + "native-comp-warning-on-missing-source"); /* To be signaled by the compiler. */ DEFSYM (Qnative_compiler_error, "native-compiler-error"); diff --git a/src/lread.c b/src/lread.c index e53e1f65ab..12e4ca66cd 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1708,7 +1708,8 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd, src_name = concat2 (src_name, build_string (".gz")); if (NILP (Ffile_exists_p (src_name))) { - if (!NILP (find_symbol_value (Qcomp_warning_on_missing_source))) + if (!NILP (find_symbol_value ( + Qnative_comp_warning_on_missing_source))) call2 (intern_c_string ("display-warning"), Qcomp, CALLN (Fformat, commit 8c429a42c4ad8137dc932d5ba0f2f5c7bd8f7799 Author: Andrea Corallo Date: Thu May 6 14:57:48 2021 +0200 Rename comp-native-driver-options → native-comp-driver-options * src/comp.c (add_driver_options, syms_of_comp): Rename comp-native-driver-options → native-comp-driver-options. * lisp/emacs-lisp/comp.el (native-comp-driver-options) (comp-ctxt, comp-spill-lap-function, comp-final) (comp-run-async-workers): Likewise. * lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Likewise. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 16740e92d3..114c264fee 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2242,8 +2242,8 @@ With argument ARG, insert value in current buffer after the form." (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 comp-native-driver-options) - (push `(comp-native-driver-options . ,comp-native-driver-options) + (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/comp.el b/lisp/emacs-lisp/comp.el index 8a1f26be1f..2b00faa069 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -161,7 +161,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. @@ -747,7 +747,7 @@ Returns ELT." :documentation "Default speed for this compilation unit.") (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.") @@ -1338,7 +1338,7 @@ clashes." byte-native-qualities) (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 @@ -3654,8 +3654,8 @@ Prepare every function for final compilation and drive the C back-end." 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-driver-options + ',native-comp-driver-options load-path ',load-path) ,native-comp-async-env-modifier-form (message "Compiling %s..." ',output) @@ -3911,8 +3911,8 @@ display a message." 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-driver-options + ',native-comp-driver-options load-path ',load-path warning-fill-column most-positive-fixnum) ,native-comp-async-env-modifier-form diff --git a/src/comp.c b/src/comp.c index 3608167cad..9173dde220 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4358,7 +4358,7 @@ DEFUN ("comp-native-driver-options-effective-p", static void add_driver_options (void) { - Lisp_Object options = Fsymbol_value (Qcomp_native_driver_options); + Lisp_Object options = Fsymbol_value (Qnative_comp_driver_options); #if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) \ || defined (WINDOWSNT) @@ -5209,7 +5209,7 @@ compiled one. */); DEFSYM (Qnative_comp_speed, "native-comp-speed"); DEFSYM (Qnative_comp_debug, "native-comp-debug"); - DEFSYM (Qcomp_native_driver_options, "comp-native-driver-options"); + DEFSYM (Qnative_comp_driver_options, "native-comp-driver-options"); DEFSYM (Qcomp_libgccjit_reproducer, "comp-libgccjit-reproducer"); /* Limple instruction set. */ commit 419852a599ceac1d80eb578a9a6df707fc6f6c8e Author: Andrea Corallo Date: Thu May 6 14:55:30 2021 +0200 * Rename comp-async-query-on-exit → native-comp-async-query-on-exit * lisp/emacs-lisp/comp.el (native-comp-async-query-on-exit) (comp-run-async-workers): Rename comp-async-query-on-exit → native-comp-async-query-on-exit. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 908a71846a..8a1f26be1f 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -152,7 +152,7 @@ Set this variable to nil if these warnings annoy you." :type 'boolean :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 @@ -3953,7 +3953,7 @@ 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))) commit c90129c5e5404d12b538aa3b69c7af4b89a728cd Author: Andrea Corallo Date: Thu May 6 14:54:32 2021 +0200 * Rename comp-async-report-warnings-errors * lisp/emacs-lisp/comp.el (native-comp-async-report-warnings-errors) (comp-accept-and-process-async-output): Rename comp-async-report-warnings-errors → native-comp-async-report-warnings-errors. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 24b65424a1..908a71846a 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -134,7 +134,7 @@ Used to modify the compiler environment." :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 @@ -3873,7 +3873,7 @@ processes from `comp-async-compilations'" (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 + (if native-comp-async-report-warnings-errors (with-current-buffer (process-buffer process) (save-excursion (accept-process-output process) commit 4e01605efab2ad8521ed9783d64862a6459ec91f Author: Andrea Corallo Date: Thu May 6 14:53:28 2021 +0200 * Rename comp-async-env-modifier-form → native-comp-async-env-modifier-form * lisp/emacs-lisp/comp.el (native-comp-async-env-modifier-form) (comp-final, comp-run-async-workers): Rename comp-async-env-modifier-form → native-comp-async-env-modifier-form. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 9756d1f58a..24b65424a1 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -127,7 +127,7 @@ compilation." :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 @@ -3657,7 +3657,7 @@ Prepare every function for final compilation and drive the C back-end." comp-native-driver-options ',comp-native-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 @@ -3915,7 +3915,7 @@ display a message." ',comp-native-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 :/ commit 4e063bf8eb47cb87891a71021be636a33492f706 Author: Andrea Corallo Date: Thu May 6 14:52:43 2021 +0200 * Rename comp-async-all-done-hook → native-comp-async-all-done-hook * lisp/emacs-lisp/comp.el (native-comp-async-all-done-hook) (comp-run-async-workers): Rename comp-async-all-done-hook → native-comp-async-all-done-hook. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 93541fa6d8..9756d1f58a 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -122,7 +122,7 @@ 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") @@ -3886,7 +3886,7 @@ processes from `comp-async-compilations'" (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)) @@ -3958,7 +3958,7 @@ display a message." 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)) commit e73186a44644705ff50d2b819fd2eb213e713259 Author: Andrea Corallo Date: Thu May 6 14:49:31 2021 +0200 * Rename comp-async-cu-done-functions → native-comp-async-cu-done-functions * lisp/emacs-lisp/comp.el (native-comp-async-cu-done-functions) (comp-run-async-workers): Rename comp-async-cu-done-functions → native-comp-async-cu-done-functions. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 54c51c6e34..93541fa6d8 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -115,7 +115,7 @@ 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." @@ -3940,7 +3940,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)) commit d8f84a1c00ebf3020e201587e182cc8e4bc4a170 Author: Andrea Corallo Date: Thu May 6 10:27:57 2021 +0200 * Rename comp-async-jobs-number → native-comp-async-jobs-number * lisp/emacs-lisp/comp.el (native-comp-async-jobs-number) (comp-effective-async-max-jobs, native--compile-async) (native-compile-async): Rename comp-async-jobs-number → native-comp-async-jobs-number. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index b1b5591404..54c51c6e34 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -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." @@ -3851,7 +3851,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,7 +3867,7 @@ 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) @@ -4066,7 +4066,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 @@ -4200,7 +4200,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)))) commit 31ca1c3e81b26357692c4c2428744f7f2f153596 Author: Andrea Corallo Date: Thu May 6 10:26:33 2021 +0200 Rename comp-never-optimize-functions → native-comp-never-optimize-functions * lisp/emacs-lisp/nadvice.el (advice--add-function): Rename comp-never-optimize-functions → native-comp-never-optimize-functions. * lisp/emacs-lisp/comp.el (native-comp-never-optimize-functions) (comp-subr-trampoline-install, comp-call-optim-form-call): Likewise. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 621bb81455..b1b5591404 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -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. @@ -662,7 +662,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 @@ -3275,7 +3275,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)) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 747572a336..bf3e944639 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. commit 85b61c0c58c5198715e5b7bfff9d7319a6ab1a2c Author: Andrea Corallo Date: Thu May 6 10:19:35 2021 +0200 Rename comp-bootstrap-deny-list → native-comp-bootstrap-deny-list * lisp/emacs-lisp/comp.el (native-comp-bootstrap-deny-list) (batch-native-compile): Rename comp-bootstrap-deny-list → native-comp-bootstrap-deny-list. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index c9d1c94ec9..621bb81455 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -90,7 +90,7 @@ 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 @@ -4159,7 +4159,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))) commit 65952950780aacc7693d9f7ef9a80c76073e99b1 Author: Andrea Corallo Date: Thu May 6 10:18:32 2021 +0200 * Rename comp-always-compile → native-comp-always-compile * lisp/emacs-lisp/comp.el (native-comp-always-compile) (comp-run-async-workers): comp-always-compile → native-comp-always-compile. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 18920020e6..c9d1c94ec9 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -78,7 +78,7 @@ 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") @@ -3897,7 +3897,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 commit 6efd7885dbae1b430b65ed2bf13d4a7dfd9d08fd Author: Andrea Corallo Date: Thu May 6 10:17:12 2021 +0200 * Rename comp-verbose -> native-comp-verbose * lisp/emacs-lisp/comp.el (native-comp-verbose, comp-log) (comp-log-func, comp-final, comp-run-async-workers): Rename comp-verbose -> native-comp-verbose. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 4a8fee01c5..18920020e6 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -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. @@ -1037,9 +1037,9 @@ Assume allocation class 'd-default as default." (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)) @@ -1091,7 +1091,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) @@ -3650,7 +3650,7 @@ 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 @@ -3907,7 +3907,7 @@ display a message." `(setf backtrace-line-length ,backtrace-line-length)) (setf native-comp-speed ,native-comp-speed native-comp-debug ,native-comp-debug - comp-verbose ,comp-verbose + native-comp-verbose ,native-comp-verbose comp-libgccjit-reproducer ,comp-libgccjit-reproducer comp-async-compilation t comp-eln-load-path ',comp-eln-load-path commit 94c69eb1d7dfbe5a6a792c707de0bffe6cd11e28 Author: Andrea Corallo Date: Thu May 6 10:14:00 2021 +0200 Rename comp-debug -> native-comp-debug * src/comp.c (emit_ctxt_code, syms_of_comp): Rename comp-debug -> native-comp-debug. * lisp/emacs-lisp/comp.el (native-comp-debug, comp-ctxt) (comp-spill-lap-function, comp-run-async-workers): Likewise. * lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Likewise. * test/src/comp-tests.el (comp-tests-bootstrap): Likewise. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2a07ea79f5..16740e92d3 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2240,8 +2240,8 @@ With argument ARG, insert value in current buffer after the form." (when byte-native-compiling (defvar native-comp-speed) (push `(native-comp-speed . ,native-comp-speed) byte-native-qualities) - (defvar comp-debug) - (push `(comp-debug . ,comp-debug) byte-native-qualities) + (defvar native-comp-debug) + (push `(native-comp-debug . ,native-comp-debug) byte-native-qualities) (defvar comp-native-driver-options) (push `(comp-native-driver-options . ,comp-native-driver-options) byte-native-qualities) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index d02c3b0c23..4a8fee01c5 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -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. @@ -745,7 +745,7 @@ Returns ELT." :documentation "Target output file-name for the compilation.") (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 :documentation "Options for the GCC driver.") @@ -1336,7 +1336,7 @@ clashes." (car (last 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 byte-native-qualities) @@ -3906,7 +3906,7 @@ display a message." ,(when (boundp 'backtrace-line-length) `(setf backtrace-line-length ,backtrace-line-length)) (setf native-comp-speed ,native-comp-speed - comp-debug ,comp-debug + native-comp-debug ,native-comp-debug comp-verbose ,comp-verbose comp-libgccjit-reproducer ,comp-libgccjit-reproducer comp-async-compilation t diff --git a/src/comp.c b/src/comp.c index c87a3e6666..3608167cad 100644 --- a/src/comp.c +++ b/src/comp.c @@ -2746,7 +2746,7 @@ emit_ctxt_code (void) /* Emit optimize qualities. */ Lisp_Object opt_qly[] = { Fcons (Qnative_comp_speed, make_fixnum (comp.speed)), - Fcons (Qcomp_debug, make_fixnum (comp.debug)), + Fcons (Qnative_comp_debug, make_fixnum (comp.debug)), Fcons (Qgccjit, Fcomp_libgccjit_version ()) }; emit_static_object (TEXT_OPTIM_QLY_SYM, Flist (ARRAYELTS (opt_qly), opt_qly)); @@ -5208,7 +5208,7 @@ compiled one. */); comp_deferred_compilation = true; DEFSYM (Qnative_comp_speed, "native-comp-speed"); - DEFSYM (Qcomp_debug, "comp-debug"); + DEFSYM (Qnative_comp_debug, "native-comp-debug"); DEFSYM (Qcomp_native_driver_options, "comp-native-driver-options"); DEFSYM (Qcomp_libgccjit_reproducer, "comp-libgccjit-reproducer"); diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 9e9097c994..be02c30a75 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -59,7 +59,7 @@ Check that the resulting binaries do not differ." (comp1-src (make-temp-file "stage1-" nil ".el")) (comp2-src (make-temp-file "stage2-" nil ".el")) ;; Can't use debug symbols. - (comp-debug 0)) + (native-comp-debug 0)) (copy-file comp-src comp1-src t) (copy-file comp-src comp2-src t) (let ((load-no-native t)) commit 43f29696adc37ae75d87cd4b86d78e830e01e018 Author: Andrea Corallo Date: Thu May 6 10:12:48 2021 +0200 Rename comp-speed -> native-comp-speed * lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Rename comp-speed -> native-comp-speed. * lisp/emacs-lisp/comp.el (native-comp-speed, comp-ctxt, comp-func, comp-spill-lap-function, comp-trampoline-compile, comp-run-async-workers): Likewise. * src/comp.c (emit_ctxt_code, load_comp_unit, syms_of_comp): Likewise. * test/src/comp-tests.el (comp-tests-tco, comp-tests-fw-prop-1) (comp-tests-check-ret-type-spec, comp-tests-pure): Likewise. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e93cee9924..2a07ea79f5 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2238,8 +2238,8 @@ 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 native-comp-speed) + (push `(native-comp-speed . ,native-comp-speed) byte-native-qualities) (defvar comp-debug) (push `(comp-debug . ,comp-debug) byte-native-qualities) (defvar comp-native-driver-options) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 19a6d1eef9..d02c3b0c23 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. @@ -743,7 +743,7 @@ 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 :documentation "Default debug level for this compilation unit.") @@ -899,7 +899,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) @@ -1334,7 +1334,7 @@ clashes." filename (when byte-native-for-bootstrap (car (last comp-eln-load-path)))))) - (setf (comp-ctxt-speed comp-ctxt) (alist-get 'comp-speed + (setf (comp-ctxt-speed comp-ctxt) (alist-get 'native-comp-speed byte-native-qualities) (comp-ctxt-debug comp-ctxt) (alist-get 'comp-debug byte-native-qualities) @@ -3250,14 +3250,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. @@ -3756,7 +3756,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 @@ -3905,7 +3905,7 @@ 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 + (setf native-comp-speed ,native-comp-speed comp-debug ,comp-debug comp-verbose ,comp-verbose comp-libgccjit-reproducer ,comp-libgccjit-reproducer diff --git a/src/comp.c b/src/comp.c index 89667b2feb..c87a3e6666 100644 --- a/src/comp.c +++ b/src/comp.c @@ -2745,7 +2745,7 @@ emit_ctxt_code (void) { /* Emit optimize qualities. */ Lisp_Object opt_qly[] = - { Fcons (Qcomp_speed, make_fixnum (comp.speed)), + { Fcons (Qnative_comp_speed, make_fixnum (comp.speed)), Fcons (Qcomp_debug, make_fixnum (comp.debug)), Fcons (Qgccjit, Fcomp_libgccjit_version ()) }; @@ -4856,7 +4856,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, /* 'dlopen' returns the same handle when trying to load two times the same shared. In this case touching 'd_reloc' etc leads to fails in case a frame with a reference to it in a live reg is - active (comp-speed > 0). + active (native-comp-speed > 0). We must *never* mess with static pointers in an already loaded eln. */ @@ -5207,7 +5207,7 @@ After compilation, each function definition is updated to the native compiled one. */); comp_deferred_compilation = true; - DEFSYM (Qcomp_speed, "comp-speed"); + DEFSYM (Qnative_comp_speed, "native-comp-speed"); DEFSYM (Qcomp_debug, "comp-debug"); DEFSYM (Qcomp_native_driver_options, "comp-native-driver-options"); DEFSYM (Qcomp_libgccjit_reproducer, "comp-libgccjit-reproducer"); diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index e3e4bdd9b6..9e9097c994 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -786,7 +786,7 @@ Return a list of results." (comp-deftest tco () "Check for tail recursion elimination." - (let ((comp-speed 3) + (let ((native-comp-speed 3) ;; Disable ipa-pure otherwise `comp-tests-tco-f' gets ;; optimized-out. (comp-disabled-passes '(comp-ipa-pure)) @@ -814,7 +814,7 @@ Return a list of results." (comp-deftest fw-prop-1 () "Some tests for forward propagation." - (let ((comp-speed 2) + (let ((native-comp-speed 2) (comp-post-pass-hooks '((comp-final comp-tests-fw-prop-checker-1)))) (eval '(defun comp-tests-fw-prop-1-f () (let* ((a "xxx") @@ -828,7 +828,7 @@ Return a list of results." (defun comp-tests-check-ret-type-spec (func-form ret-type) (let ((lexical-binding t) - (comp-speed 2) + (native-comp-speed 2) (f-name (cl-second func-form))) (eval func-form t) (native-compile f-name) @@ -1399,7 +1399,7 @@ Return a list of results." (comp-deftest pure () "Some tests for pure functions optimization." - (let ((comp-speed 3) + (let ((native-comp-speed 3) (comp-post-pass-hooks '((comp-final comp-tests-pure-checker-1 comp-tests-pure-checker-2)))) (load (native-compile (ert-resource-file "comp-test-pure.el"))) commit 643cc3fa144e94b33a7b8f1d4965cec7b383ed35 Author: Andrea Corallo Date: Thu May 6 09:57:35 2021 +0200 * Rename comp-limple-mode -> native-comp-limple-mode * lisp/emacs-lisp/comp.el (comp-limple-lock-keywords): Doc update. (native-comp-limple-mode, comp-log-to-buffer): Rename comp-limple-mode -> native-comp-limple-mode. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index f700faa38b..19a6d1eef9 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1028,9 +1028,9 @@ 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))) @@ -1059,8 +1059,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 commit b6f5da3240170fb9750a3304e4b8fa04fe7f2268 Author: Michael Albinus Date: Thu May 6 17:15:30 2021 +0200 In Tramp, use scp "-T" argument if available * lisp/net/tramp-sh.el (tramp-scp-strict-file-name-checking): New defvar. (tramp-scp-strict-file-name-checking): New defun. (tramp-do-copy-or-rename-file-out-of-band): Use it. (tramp-methods) : Use "%x". (tramp-make-copy-program-file-name): Use local quoting. (tramp-sh-handle-make-process): Don't call `tramp-maybe-open-connection', this happens implicitly by `tramp-send-command'. * lisp/net/tramp.el (tramp-methods): Adapt docstring. * test/lisp/net/tramp-tests.el (tramp-test40-special-characters) (tramp-test40-special-characters-with-stat) (tramp-test40-special-characters-with-perl) (tramp-test40-special-characters-with-ls): Don't skip for `tramp--test-windows-nt-and-scp-p'. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index b51ba11247..57be9ecf00 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -125,6 +125,15 @@ depends on the installed local ssh version. The string is used in `tramp-methods'.") +(defvar tramp-scp-strict-file-name-checking nil + "Which scp strict file name checking argument to use. + +It is the string \"-T\" if supported by the local scp (since +release 8.0), otherwise the string \"\". If it is nil, it will +be auto-detected by Tramp. + +The string is used in `tramp-methods'.") + ;; Initialize `tramp-methods' with the supported methods. ;;;###tramp-autoload (tramp--with-startup @@ -160,8 +169,8 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")) (tramp-copy-program "scp") - (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") - ("-r") ("%c"))) + (tramp-copy-args (("-P" "%p") ("-p" "%k") + ("%x") ("-q") ("-r") ("%c"))) (tramp-copy-keep-date t) (tramp-copy-recursive t))) (add-to-list 'tramp-methods @@ -177,7 +186,7 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-args ("-c")) (tramp-copy-program "scp") (tramp-copy-args (("-P" "%p") ("-p" "%k") - ("-q") ("-r") ("%c"))) + ("%x") ("-q") ("-r") ("%c"))) (tramp-copy-keep-date t) (tramp-copy-recursive t))) (add-to-list 'tramp-methods @@ -2279,7 +2288,8 @@ The method used must be an out-of-band method." spec (list ?h (or host "") ?u (or user "") ?p (or port "") ?r listener ?c options ?k (if keep-date " " "") - ?n (concat "2>" (tramp-get-remote-null-device v))) + ?n (concat "2>" (tramp-get-remote-null-device v)) + ?x (tramp-scp-strict-file-name-checking v)) copy-program (tramp-get-method-parameter v 'tramp-copy-program) copy-keep-date (tramp-get-method-parameter v 'tramp-copy-keep-date) @@ -2867,14 +2877,11 @@ alternative implementation will be used." (if (symbolp coding) coding (cdr coding)))) (clear-visited-file-modtime) (narrow-to-region (point-max) (point-max)) - ;; We call `tramp-maybe-open-connection', in - ;; order to cleanup the prompt afterwards. (catch 'suppress - (tramp-maybe-open-connection v) - (setq p (tramp-get-connection-process v)) ;; Set the pid of the remote shell. This is ;; needed when sending signals remotely. (let ((pid (tramp-send-command-and-read v "echo $$"))) + (setq p (tramp-get-connection-process v)) (process-put p 'remote-pid pid) (tramp-set-connection-property p "remote-pid" pid)) ;; `tramp-maybe-open-connection' and @@ -4737,6 +4744,31 @@ Goes through the list `tramp-inline-compress-commands'." " -o ControlPersist=no"))))))))) tramp-ssh-controlmaster-options))) +(defun tramp-scp-strict-file-name-checking (vec) + "Return the strict file name checking argument of the local scp." + (cond + ;; No options to be computed. + ((null (assoc "%x" (tramp-get-method-parameter vec 'tramp-copy-args))) + "") + + ;; There is already a value to be used. + ((stringp tramp-scp-strict-file-name-checking) + tramp-scp-strict-file-name-checking) + + ;; Determine the options. + (t (setq tramp-scp-strict-file-name-checking "") + (let ((case-fold-search t)) + (ignore-errors + (when (executable-find "scp") + (with-tramp-progress-reporter + vec 4 "Computing strict file name argument" + (with-temp-buffer + (tramp-call-process vec "scp" nil t nil "-T") + (goto-char (point-min)) + (unless (search-forward-regexp "unknown option -- T" nil t) + (setq tramp-scp-strict-file-name-checking "-T"))))))) + tramp-scp-strict-file-name-checking))) + (defun tramp-timeout-session (vec) "Close the connection VEC after a session timeout. If there is just some editing, retry it after 5 seconds." @@ -5229,12 +5261,11 @@ Return ATTR." (directory-file-name (tramp-file-name-unquote-localname vec)))) (when (string-match-p tramp-ipv6-regexp host) (setq host (format "[%s]" host))) - ;; This does not work yet for MS Windows scp, if there are - ;; characters to be quoted. Win32 OpenSSH 7.9 is said to support - ;; this, see - ;; + ;; This does not work for MS Windows scp, if there are characters + ;; to be quoted. OpenSSH 8 supports disabling of strict file name + ;; checking in scp, we use it when available. (unless (string-match-p "ftp$" method) - (setq localname (tramp-shell-quote-argument localname))) + (setq localname (shell-quote-argument localname))) (cond ((tramp-get-method-parameter vec 'tramp-remote-copy-program) localname) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 015f458a63..741ea05cea 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -252,6 +252,8 @@ pair of the form (KEY VALUE). The following KEYs are defined: - \"%c\" adds additional `tramp-ssh-controlmaster-options' options for the first hop. - \"%n\" expands to \"2>/dev/null\". + - \"%x\" is replaced by the `tramp-scp-strict-file-name-checking' + argument if it is supported. The existence of `tramp-login-args', combined with the absence of `tramp-copy-args', is an indication that the diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 1eb0d0ec61..3a199469d6 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -6114,7 +6114,7 @@ This requires restrictions of file name syntax." "Check special characters in file names." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-rsync-p))) - (skip-unless (not (tramp--test-windows-nt-and-scp-p))) +; (skip-unless (not (tramp--test-windows-nt-and-scp-p))) (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p)))) (tramp--test-special-characters)) @@ -6126,7 +6126,7 @@ Use the `stat' command." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-rsync-p))) - (skip-unless (not (tramp--test-windows-nt-and-scp-p))) +; (skip-unless (not (tramp--test-windows-nt-and-scp-p))) ;; We cannot use `tramp-test-vec', because this fails during compilation. (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil (skip-unless (tramp-get-remote-stat v))) @@ -6145,7 +6145,7 @@ Use the `perl' command." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-rsync-p))) - (skip-unless (not (tramp--test-windows-nt-and-scp-p))) +; (skip-unless (not (tramp--test-windows-nt-and-scp-p))) ;; We cannot use `tramp-test-vec', because this fails during compilation. (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil (skip-unless (tramp-get-remote-perl v))) @@ -6167,7 +6167,7 @@ Use the `ls' command." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-rsync-p))) - (skip-unless (not (tramp--test-windows-nt-and-scp-p))) +; (skip-unless (not (tramp--test-windows-nt-and-scp-p))) (let ((tramp-connection-properties (append commit 7f317868c5a1be8dd591cd26815e2b34896d31f0 Author: Eli Zaretskii Date: Thu May 6 18:08:53 2021 +0300 ; * src/doc.c (syms_of_doc): Fix last change. diff --git a/src/doc.c b/src/doc.c index 63e0cbbb43..6be023bb93 100644 --- a/src/doc.c +++ b/src/doc.c @@ -720,18 +720,18 @@ syms_of_doc (void) DEFVAR_LISP ("text-quoting-style", Vtext_quoting_style, doc: /* Style to use for single quotes in help and messages. -This works by substituting certain single quotes for grave accent and -apostrophe. This is done in help output (but not for display of Info -manuals) and in functions like `message' and `format-message'. It is -not done in `format'. +The value of this variable determines substitution of grave accents +and apostrophes in help output (but not for display of Info +manuals) and in functions like `message' and `format-message', but not +in `format'. -Its value should be one of these symbols: +The value should be one of these symbols: `curve': quote with curved single quotes ‘like this’. `straight': quote with straight apostrophes \\='like this\\='. `grave': quote with grave accent and apostrophe \\=`like this\\='; - i.e., do not alter quote marks. + i.e., do not alter the original quote marks. nil: like `curve' if curved single quotes are displayable, - and like `grave' otherwise. */); + and like `grave' otherwise. This is the default. */); Vtext_quoting_style = Qnil; DEFVAR_BOOL ("internal--text-quoting-flag", text_quoting_flag, commit 74a4f3e043455364fddb1becc2da0c4be42e78e0 Author: Stefan Kangas Date: Thu May 6 16:31:20 2021 +0200 Improve formatting in text-quoting-style docstring * src/doc.c (syms_of_doc) : Doc fix; improve formatting for readability. diff --git a/src/doc.c b/src/doc.c index e179a12618..63e0cbbb43 100644 --- a/src/doc.c +++ b/src/doc.c @@ -719,17 +719,19 @@ syms_of_doc (void) DEFVAR_LISP ("text-quoting-style", Vtext_quoting_style, doc: /* Style to use for single quotes in help and messages. -Its value should be a symbol. It works by substituting certain single -quotes for grave accent and apostrophe. This is done in help output -\(but not for display of Info manuals) and in functions like `message' -and `format-message'. It is not done in `format'. - -`curve' means quote with curved single quotes ‘like this’. -`straight' means quote with straight apostrophes \\='like this\\='. -`grave' means quote with grave accent and apostrophe \\=`like this\\='; -i.e., do not alter quote marks. The default value nil acts like -`curve' if curved single quotes are displayable, and like `grave' -otherwise. */); + +This works by substituting certain single quotes for grave accent and +apostrophe. This is done in help output (but not for display of Info +manuals) and in functions like `message' and `format-message'. It is +not done in `format'. + +Its value should be one of these symbols: + `curve': quote with curved single quotes ‘like this’. + `straight': quote with straight apostrophes \\='like this\\='. + `grave': quote with grave accent and apostrophe \\=`like this\\='; + i.e., do not alter quote marks. + nil: like `curve' if curved single quotes are displayable, + and like `grave' otherwise. */); Vtext_quoting_style = Qnil; DEFVAR_BOOL ("internal--text-quoting-flag", text_quoting_flag, commit 220845be11acbb08f719d327c8088ea7a414ef59 Author: Stefan Kangas Date: Thu May 6 16:05:36 2021 +0200 Remove another variable alias obsolete since Emacs 23 * lisp/menu-bar.el (menu-bar-files-menu): Delete variable alias for `menu-bar-file-menu'. * etc/NEWS: Announce its deletion. diff --git a/etc/NEWS b/etc/NEWS index 737b64b0da..d5519de421 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2610,16 +2610,16 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. 'icalendar--datetime-to-noneuropean-date', 'image-mode-maybe', 'imenu-example--name-and-position', 'ispell-aspell-supports-utf8', 'lisp-mode-auto-fill', 'locate-file-completion', 'make-coding-system', -'minibuffer-local-must-match-filename-map', 'mouse-choose-completion', -'mouse-major-mode-menu', 'mouse-popup-menubar', -'mouse-popup-menubar-stuff', 'newsticker-groups-filename', -'nnir-swish-e-index-file', 'nnmail-fix-eudora-headers', -'non-iso-charset-alist', 'nonascii-insert-offset', -'nonascii-translation-table', 'password-read-and-add', -'pre-abbrev-expand-hook', 'princ-list', 'print-help-return-message', -'process-filter-multibyte-p', 'read-file-name-predicate', -'remember-buffer', 'rmail-highlight-face', 'rmail-message-filter', -'semantic-after-idle-scheduler-reparse-hooks', +'menu-bar-files-menu', 'minibuffer-local-must-match-filename-map', +'mouse-choose-completion', 'mouse-major-mode-menu', +'mouse-popup-menubar', 'mouse-popup-menubar-stuff', +'newsticker-groups-filename', 'nnir-swish-e-index-file', +'nnmail-fix-eudora-headers', 'non-iso-charset-alist', +'nonascii-insert-offset', 'nonascii-translation-table', +'password-read-and-add', 'pre-abbrev-expand-hook', 'princ-list', +'print-help-return-message', 'process-filter-multibyte-p', +'read-file-name-predicate', 'remember-buffer', 'rmail-highlight-face', +'rmail-message-filter', 'semantic-after-idle-scheduler-reparse-hooks', 'semantic-after-toplevel-bovinate-hook', 'semantic-before-idle-scheduler-reparse-hooks', 'semantic-before-toplevel-bovination-hook', diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 1ba4690aac..d8cdeb101a 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -79,9 +79,6 @@ :help "Print current buffer with page headings")) menu)) -;; Only declared obsolete (and only made a proper alias) in 23.3. -(define-obsolete-variable-alias - 'menu-bar-files-menu 'menu-bar-file-menu "22.1") (defvar menu-bar-file-menu (let ((menu (make-sparse-keymap "File"))) commit c3d029c923fa7492196d73669f860790184e48a0 Author: Mattias Engdegård Date: Thu May 6 15:15:55 2021 +0200 Don't fail image-tests if JPEG format isn't compiled in * test/lisp/image-tests.el (image-type/from-filename): Make jpeg test conditional. Test pbm (always present). diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el index 2f7afa2f38..317e85fe50 100644 --- a/test/lisp/image-tests.el +++ b/test/lisp/image-tests.el @@ -59,7 +59,9 @@ (ert-deftest image-type/from-filename () ;; On emba, `image-load-path' does not exist. (skip-unless (bound-and-true-p image-load-path)) - (should (eq (image-type "foo.jpg") 'jpeg))) + (should (eq (image-type "gif.pbm") 'pbm)) + (when (memq 'jpeg image-types) ; jpeg may not be compiled in + (should (eq (image-type "foo.jpg") 'jpeg)))) (ert-deftest image-type-from-file-header-test () "Test image-type-from-file-header." commit 12bab2092045876a8193402c9f69af196ea22969 Author: Mattias Engdegård Date: Thu May 6 15:50:39 2021 +0200 Tidy file-matching regexps and remove some ineffective backslashes * lisp/emacs-lisp/package.el (package--delete-directory): * lisp/net/tramp-cmds.el (tramp-recompile-elpa): Escape dot; replace $ with \'. * lisp/help.el (help-for-help): * lisp/transient.el (transient-font-lock-keywords): Remove useless backslashes. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index e133917751..b68ebfbd88 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2267,7 +2267,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/help.el b/lisp/help.el index e70041aea4..babaf4adc7 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -233,7 +233,7 @@ Do not call this in the scope of `with-help-window'." (make-help-screen help-for-help (purecopy "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or ?") (concat - "\(Type " + "(Type " (help--key-description-fontified (kbd "")) " or " (help--key-description-fontified (kbd "")) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index a3cf6f3211..1572c2f3e3 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -496,7 +496,7 @@ This is needed if there are compatibility problems." ((dir (tramp-compat-funcall 'package-desc-dir (car (alist-get 'tramp (bound-and-true-p package-alist)))))) - (dolist (elc (directory-files dir 'full "\\.elc$")) + (dolist (elc (directory-files dir 'full "\\.elc\\'")) (delete-file elc)) (with-current-buffer (get-buffer-create byte-compile-log-buffer) (let ((inhibit-read-only t)) diff --git a/lisp/transient.el b/lisp/transient.el index 6e7b5ea876..2ce7b7c30e 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -3569,7 +3569,7 @@ we stop there." "transient-define-argument" "transient-define-suffix") t) - "\\_>[ \t'\(]*" + "\\_>[ \t'(]*" "\\(\\(?:\\sw\\|\\s_\\)+\\)?") (1 'font-lock-keyword-face) (2 'font-lock-function-name-face nil t))))) commit 896384b542cabdc000eafb80c9082830f692bbb2 Author: Lars Ingebrigtsen Date: Thu May 6 13:30:52 2021 +0200 Make (setf (map-elt ...)) return the value in the alist/plist cases * lisp/emacs-lisp/map.el (map-elt): Return the value in the list case (which can signal a `map-not-inplace' error. (map-elt): Return the value in the list case, too (bug#47572). diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index c0cbc7b5a1..5c76fb9eb9 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -124,7 +124,9 @@ or array." (with-no-warnings (map-put! ,mgetter ,key ,v ,testfn)) (map-not-inplace ,(funcall msetter - `(map-insert ,mgetter ,key ,v)))))))))) + `(map-insert ,mgetter ,key ,v)) + ;; Always return the value. + ,v)))))))) ;; `testfn' is deprecated. (advertised-calling-convention (map key &optional default) "27.1")) ;; Can't use `cl-defmethod' with `advertised-calling-convention'. @@ -429,18 +431,22 @@ To insert an element without modifying MAP, use `map-insert'." ;; `testfn' only exists for backward compatibility with `map-put'! (declare (advertised-calling-convention (map key value) "27.1")) ;; Can't use `cl-defmethod' with `advertised-calling-convention'. - (map--dispatch map - :list - (if (map--plist-p map) - (plist-put map key value) - (let ((oldmap map)) - (setf (alist-get key map key nil (or testfn #'equal)) value) - (unless (eq oldmap map) - (signal 'map-not-inplace (list oldmap))))) - :hash-table (puthash key value map) - ;; FIXME: If `key' is too large, should we signal `map-not-inplace' - ;; and let `map-insert' grow the array? - :array (aset map key value))) + (map--dispatch + map + :list + (progn + (if (map--plist-p map) + (plist-put map key value) + (let ((oldmap map)) + (setf (alist-get key map key nil (or testfn #'equal)) value) + (unless (eq oldmap map) + (signal 'map-not-inplace (list oldmap))))) + ;; Always return the value. + value) + :hash-table (puthash key value map) + ;; FIXME: If `key' is too large, should we signal `map-not-inplace' + ;; and let `map-insert' grow the array? + :array (aset map key value))) (cl-defgeneric map-insert (map key value) "Return a new map like MAP except that it associates KEY with VALUE. commit 49aebfe93c43b4b7f54b4c45bfb269a381e75836 Author: Matt Armstrong Date: Thu May 6 13:29:33 2021 +0200 Add tests for `map-elt' * test/lisp/emacs-lisp/map-tests.el: Add (failing) tests for `map-elt' (bug#47572). diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el index 67666d8e7e..a04c6bef02 100644 --- a/test/lisp/emacs-lisp/map-tests.el +++ b/test/lisp/emacs-lisp/map-tests.el @@ -476,5 +476,42 @@ Evaluate BODY for each created map." (list one two)) '(1 2))))) +(ert-deftest test-map-setf-alist-insert-key () + (let ((alist)) + (should (equal (setf (map-elt alist 'key) 'value) + 'value)) + (should (equal alist '((key . value)))))) + +(ert-deftest test-map-setf-alist-overwrite-key () + (let ((alist '((key . value1)))) + (should (equal (setf (map-elt alist 'key) 'value2) + 'value2)) + (should (equal alist '((key . value2)))))) + +(ert-deftest test-map-setf-plist-insert-key () + (let ((plist '(key value))) + (should (equal (setf (map-elt plist 'key2) 'value2) + 'value2)) + (should (equal plist '(key value key2 value2))))) + +(ert-deftest test-map-setf-plist-overwrite-key () + (let ((plist '(key value))) + (should (equal (setf (map-elt plist 'key) 'value2) + 'value2)) + (should (equal plist '(key value2))))) + +(ert-deftest test-hash-table-setf-insert-key () + (let ((ht (make-hash-table))) + (should (equal (setf (map-elt ht 'key) 'value) + 'value)) + (should (equal (map-elt ht 'key) 'value)))) + +(ert-deftest test-hash-table-setf-overwrite-key () + (let ((ht (make-hash-table))) + (puthash 'key 'value1 ht) + (should (equal (setf (map-elt ht 'key) 'value2) + 'value2)) + (should (equal (map-elt ht 'key) 'value2)))) + (provide 'map-tests) ;;; map-tests.el ends here commit 5ec4a3dbbc81ef9ed51065189a19689c351e0e8d Author: Michael Albinus Date: Thu May 6 13:08:56 2021 +0200 Fix bug#47625 in dired * lisp/dired-aux.el (dired-create-files): Check, that `dired-do-symlink' does not create symlinks on different hosts. (Bug#47625) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 8fe612fa0b..8fce402c7a 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1962,6 +1962,11 @@ ESC or `q' to not overwrite any of the remaining files, (file-in-directory-p destname from) (error "Cannot copy `%s' into its subdirectory `%s'" from to))) + ;; Check, that `dired-do-symlink' does not create symlinks + ;; on different hosts. + (when (and (eq file-creator 'make-symbolic-link) + (not (equal (file-remote-p from) (file-remote-p to)))) + (error "Cannot symlink `%s' to `%s' on another host" from to)) (condition-case err (progn (funcall file-creator from to dired-overwrite-confirmed) commit c873d16af61ae9b956c6dd6d9e50ebad2bb7666e Author: Alan Mackenzie Date: Thu May 6 10:48:14 2021 +0000 Fix wrong handling of minibuffers when frames get iconified/made invisible This should fix bug #47766. * lisp/window.el (window-deletable-p): Add a quote where it was missing from minibuffer-follows-selected-frame. * src/frame.c (check_minibuf_window): Delete the function. (delete_frame): In place of calling check_minibuf_window, call move_minibuffers_onto_frame, possibly to move minibuffers onto the new current frame. (Fmake_frame_invisible, Ficonify_frame): Remove calls to check_minibuf_window. * src/minibuf.c (Factive_minibuffer_window): Search the frames for the active minibuffer rather than just assuming minibuf_window has been correctly updated. diff --git a/lisp/window.el b/lisp/window.el index cf5752113d..bba4992ca2 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -4117,7 +4117,7 @@ frame can be safely deleted." (let ((minibuf (active-minibuffer-window))) (and minibuf (eq frame (window-frame minibuf)) (not (eq (default-toplevel-value - minibuffer-follows-selected-frame) + 'minibuffer-follows-selected-frame) t))))) 'frame)) ((window-minibuffer-p window) diff --git a/src/frame.c b/src/frame.c index 738bfe9a5c..cb9d4f5210 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1929,52 +1929,6 @@ other_frames (struct frame *f, bool invisible, bool force) return false; } -/* Make sure that minibuf_window doesn't refer to FRAME's minibuffer - window. Preferably use the selected frame's minibuffer window - instead. If the selected frame doesn't have one, get some other - frame's minibuffer window. SELECT non-zero means select the new - minibuffer window. */ -static void -check_minibuf_window (Lisp_Object frame, int select) -{ - struct frame *f = decode_live_frame (frame); - - XSETFRAME (frame, f); - - if (WINDOWP (minibuf_window) && EQ (f->minibuffer_window, minibuf_window)) - { - Lisp_Object frames, this, window = make_fixnum (0); - - if (!EQ (frame, selected_frame) - && FRAME_HAS_MINIBUF_P (XFRAME (selected_frame))) - window = FRAME_MINIBUF_WINDOW (XFRAME (selected_frame)); - else - FOR_EACH_FRAME (frames, this) - { - if (!EQ (this, frame) && FRAME_HAS_MINIBUF_P (XFRAME (this))) - { - window = FRAME_MINIBUF_WINDOW (XFRAME (this)); - break; - } - } - - /* Don't abort if no window was found (Bug#15247). */ - if (WINDOWP (window)) - { - /* Use set_window_buffer instead of Fset_window_buffer (see - discussion of bug#11984, bug#12025, bug#12026). */ - set_window_buffer (window, XWINDOW (minibuf_window)->contents, 0, 0); - minibuf_window = window; - - /* SELECT non-zero usually means that FRAME's minibuffer - window was selected; select the new one. */ - if (select) - Fselect_window (minibuf_window, Qnil); - } - } -} - - /** * delete_frame: * @@ -1989,7 +1943,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force) struct frame *sf; struct kboard *kb; Lisp_Object frames, frame1; - int minibuffer_selected, is_tooltip_frame; + int is_tooltip_frame; bool nochild = !FRAME_PARENT_FRAME (f); Lisp_Object minibuffer_child_frame = Qnil; @@ -2097,7 +2051,6 @@ delete_frame (Lisp_Object frame, Lisp_Object force) /* At this point, we are committed to deleting the frame. There is no more chance for errors to prevent it. */ - minibuffer_selected = EQ (minibuf_window, selected_window); sf = SELECTED_FRAME (); /* Don't let the frame remain selected. */ if (f == sf) @@ -2155,9 +2108,10 @@ delete_frame (Lisp_Object frame, Lisp_Object force) do_switch_frame (frame1, 0, 1, Qnil); sf = SELECTED_FRAME (); } - - /* Don't allow minibuf_window to remain on a deleted frame. */ - check_minibuf_window (frame, minibuffer_selected); + else + /* Ensure any minibuffers on FRAME are moved onto the selected + frame. */ + move_minibuffers_onto_frame (f, true); /* Don't let echo_area_window to remain on a deleted frame. */ if (EQ (f->minibuffer_window, echo_area_window)) @@ -2788,9 +2742,6 @@ displayed in the terminal. */) if (NILP (force) && !other_frames (f, true, false)) error ("Attempt to make invisible the sole visible or iconified frame"); - /* Don't allow minibuf_window to remain on an invisible frame. */ - check_minibuf_window (frame, EQ (minibuf_window, selected_window)); - if (FRAME_WINDOW_P (f) && FRAME_TERMINAL (f)->frame_visible_invisible_hook) FRAME_TERMINAL (f)->frame_visible_invisible_hook (f, false); @@ -2833,9 +2784,6 @@ for how to proceed. */) } #endif /* HAVE_WINDOW_SYSTEM */ - /* Don't allow minibuf_window to remain on an iconified frame. */ - check_minibuf_window (frame, EQ (minibuf_window, selected_window)); - if (FRAME_WINDOW_P (f) && FRAME_TERMINAL (f)->iconify_frame_hook) FRAME_TERMINAL (f)->iconify_frame_hook (f); diff --git a/src/minibuf.c b/src/minibuf.c index c4482d7f1e..bc7d439398 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -212,7 +212,23 @@ DEFUN ("active-minibuffer-window", Factive_minibuffer_window, doc: /* Return the currently active minibuffer window, or nil if none. */) (void) { - return minibuf_level ? minibuf_window : Qnil; + Lisp_Object frames, frame; + struct frame *f; + Lisp_Object innermost_MB; + + if (!minibuf_level) + return Qnil; + + innermost_MB = nth_minibuffer (minibuf_level); + FOR_EACH_FRAME (frames, frame) + { + f = XFRAME (frame); + if (FRAME_LIVE_P (f) + && WINDOW_LIVE_P (f->minibuffer_window) + && EQ (XWINDOW (f->minibuffer_window)->contents, innermost_MB)) + return f->minibuffer_window; + } + return minibuf_window; /* "Can't happen." */ } DEFUN ("set-minibuffer-window", Fset_minibuffer_window, commit 9e0fc5321b6be3b9242f2668a37a95057b4d1e0b Author: Harald Jörg Date: Thu May 6 12:33:40 2021 +0200 cperl-mode: Eliminate bad interpretation of ?foo? * lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): Delete ?? from the allowed bare regexp delimiters. (cperl-short-docs): Delete ?...? from the documentation. * test/lisp/progmodes/cperl-mode-tests.el (cperl-bug-47598): Add tests for good, bad, and ambiguous use of ? as regex delimiter (bug#47598). diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index bff3e60e90..fa384bcad6 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3585,7 +3585,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" ; QUOTED CONSTRUCT "\\|" ;; 1+6+2+1=10 extra () before this: - "\\([?/<]\\)" ; /blah/ or ?blah? or + "\\([/<]\\)" ; /blah/ or "\\|" ;; 1+6+2+1+1=11 extra () before this "\\<" cperl-sub-regexp "\\>" ; sub with proto/attr @@ -3920,7 +3920,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', ;; 1+6+2=9 extra () before this: ;; "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" ;; "\\|" - ;; "\\([?/<]\\)" ; /blah/ or ?blah? or + ;; "\\([/<]\\)" ; /blah/ or (setq b1 (if (match-beginning 10) 10 11) argument (buffer-substring (match-beginning b1) (match-end b1)) @@ -3958,7 +3958,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (goto-char (match-beginning b1)) (cperl-backward-to-noncomment (point-min)) (or bb - (if (eq b1 11) ; bare /blah/ or ?blah? or + (if (eq b1 11) ; bare /blah/ or (setq argument "" b1 nil bb ; Not a regexp? @@ -3966,7 +3966,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', ;; What is below: regexp-p? (and (or (memq (preceding-char) - (append (if (memq c '(?\? ?\<)) + (append (if (char-equal c ?\<) ;; $a++ ? 1 : 2 "~{(=|&*!,;:[" "~{(=|&+-*!,;:[") nil)) @@ -3977,14 +3977,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (forward-sexp -1) ;; After these keywords `/' starts a RE. One should add all the ;; functions/builtins which expect an argument, but ... - (if (eq (preceding-char) ?-) - ;; -d ?foo? is a RE - (looking-at "[a-zA-Z]\\>") (and (not (memq (preceding-char) '(?$ ?@ ?& ?%))) (looking-at - "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\|return\\)\\>"))))) + "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\|return\\)\\>")))) (and (eq (preceding-char) ?.) (eq (char-after (- (point) 2)) ?.)) (bobp)) @@ -7232,8 +7229,7 @@ $~ The name of the current report format. ... >= ... Numeric greater than or equal to. ... >> ... Bitwise shift right. ... >>= ... Bitwise shift right assignment. -... ? ... : ... Condition=if-then-else operator. ?PAT? One-time pattern match. -?PATTERN? One-time pattern match. +... ? ... : ... Condition=if-then-else operator. @ARGV Command line arguments (not including the command name - see $0). @INC List of places to look for perl scripts during do/include/use. @_ Parameter array for subroutines; result of split() unless in list context. diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 9867aa884c..7cdfa45d6f 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -524,4 +524,31 @@ however, must not happen when the keyword occurs in a variable ;; No block should have been created here (should-not (search-forward-regexp "{" nil t)))) +(ert-deftest cperl-test-bug-47598 () + "Check that a file test followed by ? is no longer interpreted +as a regex." + ;; Testing the text from the bug report + (with-temp-buffer + (insert "my $f = -f ? 'file'\n") + (insert " : -l ? [readlink]\n") + (insert " : -d ? 'dir'\n") + (insert " : 'unknown';\n") + (funcall cperl-test-mode) + ;; Perl mode doesn't highlight file tests as functions, so we + ;; can't test for the function's face. But we can verify that the + ;; function is not a string. + (goto-char (point-min)) + (search-forward "?") + (should-not (nth 3 (syntax-ppss (point))))) + ;; Testing the actual targets for the regexp: m?foo? (still valid) + ;; and ?foo? (invalid since Perl 5.22) + (with-temp-buffer + (insert "m?foo?;") + (funcall cperl-test-mode) + (should (nth 3 (syntax-ppss 3)))) + (with-temp-buffer + (insert " ?foo?;") + (funcall cperl-test-mode) + (should-not (nth 3 (syntax-ppss 3))))) + ;;; cperl-mode-tests.el ends here commit b69e2699aaae6c13a14d8904b0b21e519c770336 Author: Lars Ingebrigtsen Date: Thu May 6 12:21:11 2021 +0200 Only look at the headers when computing the envelope from address * lisp/mail/smtpmail.el (smtpmail-send-it) (smtpmail-send-queued-mail, smtpmail-via-smtp): * lisp/mail/sendmail.el (sendmail-send-it): Only look at the headers when computing the envelope from (bug#47616). diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index cd07166756..9a4c8f3c66 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -30,6 +30,7 @@ (require 'mail-utils) (require 'rfc2047) (autoload 'message-make-date "message") +(autoload 'message-narrow-to-headers "message") (defgroup sendmail nil "Mail sending commands for Emacs." @@ -1177,7 +1178,12 @@ external program defined by `sendmail-program'." ;; local binding in the mail buffer will take effect. (envelope-from (and mail-specify-envelope-from - (or (mail-envelope-from) user-mail-address)))) + (or (save-restriction + ;; Only look at the headers when fetching the + ;; envelope address. + (message-narrow-to-headers) + (mail-envelope-from)) + user-mail-address)))) (unwind-protect (with-current-buffer tembuf (erase-buffer) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index ab58aa455e..c1e2280033 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -207,11 +207,15 @@ for `smtpmail-try-auth-method'.") ;; Examine this variable now, so that ;; local binding in the mail buffer will take effect. (smtpmail-mail-address - (or (and mail-specify-envelope-from (mail-envelope-from)) - (let ((from (mail-fetch-field "from"))) - (and from - (cadr (mail-extract-address-components from)))) - (smtpmail-user-mail-address))) + (save-restriction + ;; Only look at the headers when fetching the + ;; envelope address. + (message-narrow-to-headers) + (or (and mail-specify-envelope-from (mail-envelope-from)) + (let ((from (mail-fetch-field "from"))) + (and from + (cadr (mail-extract-address-components from)))) + (smtpmail-user-mail-address)))) (smtpmail-code-conv-from (if enable-multibyte-characters (let ((sendmail-coding-system smtpmail-code-conv-from)) @@ -434,7 +438,12 @@ for `smtpmail-try-auth-method'.") (let ((coding-system-for-read 'no-conversion)) (insert-file-contents file-data)) (let ((smtpmail-mail-address - (or (and mail-specify-envelope-from (mail-envelope-from)) + (or (and mail-specify-envelope-from + (save-restriction + ;; Only look at the headers when fetching the + ;; envelope address. + (message-narrow-to-headers) + (mail-envelope-from))) user-mail-address))) (if (not (null smtpmail-recipient-address-list)) (when (setq result (smtpmail-via-smtp @@ -677,13 +686,17 @@ Returns an error if the server cannot be contacted." ;; `smtpmail-mail-address' should be set to the appropriate ;; buffer-local value by the caller, but in case not: (envelope-from - (or smtpmail-mail-address - (and mail-specify-envelope-from - (mail-envelope-from)) - (let ((from (mail-fetch-field "from"))) - (and from - (cadr (mail-extract-address-components from)))) - (smtpmail-user-mail-address))) + (save-restriction + ;; Only look at the headers when fetching the + ;; envelope address. + (message-narrow-to-headers) + (or smtpmail-mail-address + (and mail-specify-envelope-from + (mail-envelope-from)) + (let ((from (mail-fetch-field "from"))) + (and from + (cadr (mail-extract-address-components from)))) + (smtpmail-user-mail-address)))) process-buffer result auth-mechanisms commit c8c27864aa5db2604304a6354ae441c7b0ca5474 Author: Dmitrii Kuragin Date: Thu May 6 11:45:06 2021 +0200 Fix ispell program comparison * lisp/textmodes/ispell.el (ispell-set-spellchecker-params): Compare strings with `equal', not `eq' (since the identity of the string may change) (bug#48246). Copyright-paperwork-exempt: yes diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 932308ee59..4dbc7640bc 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1245,7 +1245,7 @@ aspell is used along with Emacs).") (defun ispell-set-spellchecker-params () "Initialize some spellchecker parameters when changed or first used." - (unless (eq ispell-last-program-name ispell-program-name) + (unless (equal ispell-last-program-name ispell-program-name) (ispell-kill-ispell t) (if (and (condition-case () (progn commit f0648fef35e1923f477aef44b2d75e41e3d15d92 Author: Lars Ingebrigtsen Date: Thu May 6 11:24:39 2021 +0200 Make Info completion more robust * lisp/info.el (Info-build-node-completions): Don't signal an error if there are no nodes in the file we're computing completions over (bug#47771). diff --git a/lisp/info.el b/lisp/info.el index 67d27c7898..2757ed5782 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1882,10 +1882,17 @@ the Top node in FILENAME." (or (cdr (assoc filename Info-file-completions)) (with-temp-buffer (Info-mode) - (Info-goto-node (format "(%s)Top" filename)) - (Info-build-node-completions-1) - (push (cons filename Info-current-file-completions) Info-file-completions) - Info-current-file-completions)) + (condition-case nil + (Info-goto-node (format "(%s)Top" filename)) + ;; `Info-goto-node' signals a `user-error' when there + ;; are no nodes in the file in question (for instance, + ;; if it's not actually an Info file). + (user-error nil) + (:success + (Info-build-node-completions-1) + (push (cons filename Info-current-file-completions) + Info-file-completions) + Info-current-file-completions)))) (or Info-current-file-completions (Info-build-node-completions-1))))