commit 3480ca83510f1ad6026971c9031e2c65540d402a (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Tue May 28 20:49:55 2024 -0400 Rename `SUBR_NATIVE_COMPILED` to `NATIVE_COMP_FUNCTION` (bug#71123) Keep the name consistent with the naming used in the ELisp world. * src/pdumper.c (dump_object_emacs_ptr, dump_do_fixup): * src/eval.c (eval_sub, funcall_general, funcall_lambda): * src/alloc.c (CHECK_ALLOCATED_AND_LIVE_SYMBOL, survives_gc_p): * src/data.c (Fcl_type_of, Ffset, Fnative_comp_function_p) (Fsubr_native_lambda_list, Finteractive_form): * src/comp.c (check_comp_unit_relocs): * src/bytecode.c (exec_byte_code): * src/lisp.h (NATIVE_COMP_FUNCTIONP, NATIVE_COMP_FUNCTION_DYNP): Rename from `SUBR_NATIVE_COMPILEDP` and `SUBR_NATIVE_COMPILED_DYNP`. diff --git a/src/alloc.c b/src/alloc.c index 28e32554472..9304e4e42bb 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7350,7 +7350,7 @@ process_mark_stack (ptrdiff_t base_sp) case PVEC_SUBR: #ifdef HAVE_NATIVE_COMP - if (SUBR_NATIVE_COMPILEDP (obj)) + if (NATIVE_COMP_FUNCTIONP (obj)) { set_vector_marked (ptr); struct Lisp_Subr *subr = XSUBR (obj); @@ -7550,7 +7550,7 @@ survives_gc_p (Lisp_Object obj) case Lisp_Vectorlike: survives_p = - (SUBRP (obj) && !SUBR_NATIVE_COMPILEDP (obj)) || + (SUBRP (obj) && !NATIVE_COMP_FUNCTIONP (obj)) || vector_marked_p (XVECTOR (obj)); break; diff --git a/src/bytecode.c b/src/bytecode.c index 03443ed54ab..75f9f1d0ac7 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -808,7 +808,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, } Lisp_Object val; - if (SUBRP (call_fun) && !SUBR_NATIVE_COMPILED_DYNP (call_fun)) + if (SUBRP (call_fun) && !NATIVE_COMP_FUNCTION_DYNP (call_fun)) val = funcall_subr (XSUBR (call_fun), call_nargs, call_args); else val = funcall_general (original_fun, call_nargs, call_args); diff --git a/src/comp.c b/src/comp.c index 545a8046377..9ebb2f7fed6 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5297,7 +5297,7 @@ check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u) Lisp_Object x = data_imp_relocs[i]; if (EQ (x, Qlambda_fixup)) return false; - else if (SUBR_NATIVE_COMPILEDP (x)) + else if (NATIVE_COMP_FUNCTIONP (x)) { if (NILP (Fgethash (x, comp_u->lambda_gc_guard_h, Qnil))) return false; diff --git a/src/data.c b/src/data.c index e6106a1dbdf..3490d4985c9 100644 --- a/src/data.c +++ b/src/data.c @@ -239,7 +239,7 @@ a fixed set of types. */) case PVEC_WINDOW: return Qwindow; case PVEC_SUBR: return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form - : SUBR_NATIVE_COMPILEDP (object) ? Qnative_comp_function + : NATIVE_COMP_FUNCTIONP (object) ? Qnative_comp_function : Qprimitive_function; case PVEC_CLOSURE: return CONSP (AREF (object, CLOSURE_CODE)) @@ -908,7 +908,7 @@ signal a `cyclic-function-indirection' error. */) if (!NILP (Vnative_comp_enable_subr_trampolines) && SUBRP (function) - && !SUBR_NATIVE_COMPILEDP (function)) + && !NATIVE_COMP_FUNCTIONP (function)) CALLN (Ffuncall, Qcomp_subr_trampoline_install, symbol); #endif @@ -1059,7 +1059,7 @@ DEFUN ("native-comp-function-p", Fnative_comp_function_p, Snative_comp_function_ 0, doc: /* Return t if the object is native compiled Lisp function, nil otherwise. */) (Lisp_Object object) { - return SUBR_NATIVE_COMPILEDP (object) ? Qt : Qnil; + return NATIVE_COMP_FUNCTIONP (object) ? Qt : Qnil; } DEFUN ("subr-native-lambda-list", Fsubr_native_lambda_list, @@ -1071,7 +1071,7 @@ function or t otherwise. */) CHECK_SUBR (subr); #ifdef HAVE_NATIVE_COMP - if (SUBR_NATIVE_COMPILED_DYNP (subr)) + if (NATIVE_COMP_FUNCTION_DYNP (subr)) return XSUBR (subr)->lambda_list; #endif return Qt; @@ -1148,7 +1148,7 @@ Value, if non-nil, is a list (interactive SPEC). */) if (SUBRP (fun)) { - if (SUBR_NATIVE_COMPILEDP (fun) && !NILP (XSUBR (fun)->intspec.native)) + if (NATIVE_COMP_FUNCTIONP (fun) && !NILP (XSUBR (fun)->intspec.native)) return XSUBR (fun)->intspec.native; const char *spec = XSUBR (fun)->intspec.string; diff --git a/src/eval.c b/src/eval.c index 20b9ca9a0ec..1e0628b4aa3 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2534,7 +2534,7 @@ eval_sub (Lisp_Object form) else if (!NILP (fun) && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun))) fun = indirect_function (fun); - if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) + if (SUBRP (fun) && !NATIVE_COMP_FUNCTION_DYNP (fun)) { Lisp_Object args_left = original_args; ptrdiff_t numargs = list_length (args_left); @@ -2640,7 +2640,7 @@ eval_sub (Lisp_Object form) } } else if (CLOSUREP (fun) - || SUBR_NATIVE_COMPILED_DYNP (fun) + || NATIVE_COMP_FUNCTION_DYNP (fun) || MODULE_FUNCTIONP (fun)) return apply_lambda (fun, original_args, count); else @@ -3036,10 +3036,10 @@ funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args) && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun))) fun = indirect_function (fun); - if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) + if (SUBRP (fun) && !NATIVE_COMP_FUNCTION_DYNP (fun)) return funcall_subr (XSUBR (fun), numargs, args); else if (CLOSUREP (fun) - || SUBR_NATIVE_COMPILED_DYNP (fun) + || NATIVE_COMP_FUNCTION_DYNP (fun) || MODULE_FUNCTIONP (fun)) return funcall_lambda (fun, numargs, args); else @@ -3262,7 +3262,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector) return funcall_module (fun, nargs, arg_vector); #endif #ifdef HAVE_NATIVE_COMP - else if (SUBR_NATIVE_COMPILED_DYNP (fun)) + else if (NATIVE_COMP_FUNCTION_DYNP (fun)) { syms_left = XSUBR (fun)->lambda_list; lexenv = Qnil; @@ -3335,9 +3335,9 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector) Lisp_Object val; if (CONSP (fun)) val = Fprogn (XCDR (XCDR (fun))); - else if (SUBR_NATIVE_COMPILEDP (fun)) + else if (NATIVE_COMP_FUNCTIONP (fun)) { - eassert (SUBR_NATIVE_COMPILED_DYNP (fun)); + eassert (NATIVE_COMP_FUNCTION_DYNP (fun)); /* No need to use funcall_subr as we have zero arguments by construction. */ val = XSUBR (fun)->function.a0 (); diff --git a/src/lisp.h b/src/lisp.h index f8d59b1e9fd..67fcb146515 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5542,15 +5542,15 @@ extern void syms_of_textconv (void); #ifdef HAVE_NATIVE_COMP INLINE bool -SUBR_NATIVE_COMPILEDP (Lisp_Object a) +NATIVE_COMP_FUNCTIONP (Lisp_Object a) { return SUBRP (a) && !NILP (XSUBR (a)->native_comp_u); } INLINE bool -SUBR_NATIVE_COMPILED_DYNP (Lisp_Object a) +NATIVE_COMP_FUNCTION_DYNP (Lisp_Object a) { - return SUBR_NATIVE_COMPILEDP (a) && !NILP (XSUBR (a)->lambda_list); + return NATIVE_COMP_FUNCTIONP (a) && !NILP (XSUBR (a)->lambda_list); } INLINE Lisp_Object @@ -5567,13 +5567,13 @@ allocate_native_comp_unit (void) } #else INLINE bool -SUBR_NATIVE_COMPILEDP (Lisp_Object a) +NATIVE_COMP_FUNCTIONP (Lisp_Object a) { return false; } INLINE bool -SUBR_NATIVE_COMPILED_DYNP (Lisp_Object a) +NATIVE_COMP_FUNCTION_DYNP (Lisp_Object a) { return false; } diff --git a/src/pdumper.c b/src/pdumper.c index 3806953f2c2..8946c317bf9 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -931,7 +931,7 @@ dump_note_reachable (struct dump_context *ctx, Lisp_Object object) static void * dump_object_emacs_ptr (Lisp_Object lv) { - if (SUBRP (lv) && !SUBR_NATIVE_COMPILEDP (lv)) + if (SUBRP (lv) && !NATIVE_COMP_FUNCTIONP (lv)) return XSUBR (lv); if (dump_builtin_symbol_p (lv)) return XSYMBOL (lv); @@ -3988,7 +3988,7 @@ dump_do_fixup (struct dump_context *ctx, /* Dump wants a pointer to a Lisp object. If DUMP_FIXUP_LISP_OBJECT_RAW, we should stick a C pointer in the dump; otherwise, a Lisp_Object. */ - if (SUBRP (arg) && !SUBR_NATIVE_COMPILEDP (arg)) + if (SUBRP (arg) && !NATIVE_COMP_FUNCTIONP (arg)) { dump_value = emacs_offset (XSUBR (arg)); if (type == DUMP_FIXUP_LISP_OBJECT) commit fde8dc9287c0a81c6b942b5cf445f8f7aeba1207 Author: Stefan Monnier Date: Wed May 22 14:45:35 2024 -0400 Redirect calls to `subr-native-elisp-p` to `native-comp-function-p` * test/src/comp-tests.el (comp-tests-bootstrap, lambda-return) (lambda-return2, free-fun, free-fun2, free-fun-silly-name, speed--1) (compile-forms, comp-test-defsubst, primitive-redefine-compile-44221) (48029-1, 61917-1, tco, fw-prop-1, pure): * test/lisp/help-fns-tests.el (help-fns-test-lisp-defun): * lisp/subr.el (subr-primitive-p, primitive-function-p, symbol-file): * lisp/help-fns.el (find-lisp-object-file-name): * lisp/emacs-lisp/disass.el (disassemble-internal): * lisp/emacs-lisp/comp.el (comp--call-optim-form-call): * lisp/emacs-lisp/comp-run.el (comp-warn-primitives): * lisp/emacs-lisp/comp-common.el (comp-function-type-spec): * lisp/emacs-lisp/byte-opt.el (side-effect-free-fns): * lisp/emacs-lisp/bytecomp.el (): Rename `subr-native-elisp-p` to `native-comp-function-p`. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 4095726d276..c060c8d676b 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1876,9 +1876,10 @@ See Info node `(elisp) Integer Basics'." byteorder car-safe cdr-safe char-or-string-p char-table-p condition-variable-p consp eq floatp indirect-function integer-or-marker-p integerp keywordp listp markerp - module-function-p multibyte-string-p mutexp natnump nlistp null + module-function-p multibyte-string-p mutexp native-comp-function-p + natnump nlistp null number-or-marker-p numberp recordp remove-pos-from-symbol - sequencep stringp subr-native-elisp-p subrp symbol-with-pos-p symbolp + sequencep stringp subrp symbol-with-pos-p symbolp threadp type-of user-ptrp vector-or-char-table-p vectorp wholenump ;; editfns.c bobp bolp buffer-size buffer-string current-message emacs-pid diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 12b45f9f5b8..03cfbe6f4c9 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -6028,7 +6028,7 @@ and corresponding effects." (let ((byte-optimize nil) ; do it fast (byte-compile-warnings nil)) (mapc (lambda (x) - (unless (subr-native-elisp-p x) + (unless (native-comp-function-p x) (or noninteractive (message "compiling %s..." x)) (byte-compile x) (or noninteractive (message "compiling %s...done" x)))) diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index 355988838c7..ce6296953bf 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -518,7 +518,7 @@ itself." (if-let ((delc-type (function-get function 'function-type))) ;; Declared Lisp function (setf type-spec delc-type) - (when (subr-native-elisp-p f) + (when (native-comp-function-p f) ;; Native compiled inferred (setf kind 'inferred type-spec (subr-type f)))))) diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index 5cc61579030..f159c5b1911 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -341,7 +341,7 @@ display a message." (clrhash comp-deferred-pending-h))) (defconst comp-warn-primitives - '(null memq gethash and subrp not subr-native-elisp-p + '(null memq gethash and subrp not native-comp-function-p comp--install-trampoline concat if symbolp symbol-name make-string length aset aref length> mapcar expand-file-name file-name-as-directory file-exists-p native-elisp-load) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 4c76f95a0e9..32d4442ca1b 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -2847,7 +2847,7 @@ FUNCTION can be a function-name or byte compiled function." (subrp (subrp f)) (comp-func-callee (comp--func-in-unit callee))) (cond - ((and subrp (not (subr-native-elisp-p f))) + ((and subrp (not (native-comp-function-p f))) ;; Trampoline removal. (let* ((callee (intern (subr-name f))) ; Fix aliased names. (maxarg (cdr (subr-arity f))) diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index 91427166137..07072f2a2be 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -91,8 +91,8 @@ redefine OBJECT if it is a symbol." args) (setq obj (autoload-do-load obj name)) (if (subrp obj) - (if (and (fboundp 'subr-native-elisp-p) - (subr-native-elisp-p obj)) + (if (and (fboundp 'native-comp-function-p) + (native-comp-function-p obj)) (progn (require 'comp) (let ((eln (native-comp-unit-file (subr-native-comp-unit obj)))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index a202c2d247e..f2257cb9398 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -478,7 +478,7 @@ the C sources, too." (cond ((and (not file-name) (subrp type) - (not (subr-native-elisp-p type))) + (not (native-comp-function-p type))) ;; A built-in function. The form is from `describe-function-1'. (if (or (get-buffer " *DOC*") (and also-c-source diff --git a/lisp/subr.el b/lisp/subr.el index eda5b7ae31b..57c6f8a528f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -316,14 +316,14 @@ value of last one, or nil if there are none." Such objects can be functions or special forms." (declare (side-effect-free error-free)) (and (subrp object) - (not (subr-native-elisp-p object)))) + (not (native-comp-function-p object)))) (defsubst primitive-function-p (object) "Return t if OBJECT is a built-in primitive function. This excludes special forms, since they are not functions." (declare (side-effect-free error-free)) (and (subrp object) - (not (or (subr-native-elisp-p object) + (not (or (native-comp-function-p object) (eq (cdr (subr-arity object)) 'unevalled))))) (defsubst xor (cond1 cond2) @@ -3022,7 +3022,7 @@ This is to `put' what `defalias' is to `fset'." (defvar comp-native-version-dir) (defvar native-comp-eln-load-path) -(declare-function subr-native-elisp-p "data.c") +(declare-function native-comp-function-p "data.c") (declare-function native-comp-unit-file "data.c") (declare-function subr-native-comp-unit "data.c") (declare-function comp-el-to-eln-rel-filename "comp.c") @@ -3071,7 +3071,7 @@ instead." (symbolp symbol) (native-comp-available-p) ;; If it's a defun, we have a shortcut. - (subr-native-elisp-p (symbol-function symbol))) + (native-comp-function-p (symbol-function symbol))) ;; native-comp-unit-file returns unnormalized file names. (expand-file-name (native-comp-unit-file (subr-native-comp-unit (symbol-function symbol)))) diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index 82350a4bc71..7393a2624fe 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el @@ -67,7 +67,7 @@ Return first line of the output of (describe-function-1 FUNC)." (result (help-fns-tests--describe-function 'last))) (should (string-match regexp result)) (should (member (match-string 1 result) - '("subr-native-elisp" "byte-code-function"))))) + '("native-comp-function" "byte-code-function"))))) (ert-deftest help-fns-test-lisp-defsubst () (let ((regexp "a byte-code-function in .+subr\\.el") diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 5deff03fd84..dffb7097a3e 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -85,13 +85,13 @@ Check that the resulting binaries do not differ." (copy-file comp-src comp2-src t) (let ((load-no-native t)) (load (concat comp-src "c") nil nil t t)) - (should-not (subr-native-elisp-p (symbol-function 'native-compile))) + (should-not (native-comp-function-p (symbol-function 'native-compile))) (message "Compiling stage1...") (let* ((t0 (current-time)) (comp1-eln (native-compile comp1-src))) (message "Done in %d secs" (float-time (time-since t0))) (load comp1-eln nil nil t t) - (should (subr-native-elisp-p (symbol-function 'native-compile))) + (should (native-comp-function-p (symbol-function 'native-compile))) (message "Compiling stage2...") (let ((t0 (current-time)) (comp2-eln (native-compile comp2-src))) @@ -325,15 +325,15 @@ Check that the resulting binaries do not differ." (comp-deftest lambda-return () (let ((f (comp-tests-lambda-return-f))) - (should (subr-native-elisp-p f)) + (should (native-comp-function-p f)) (should (= (funcall f 3) 4)))) (comp-deftest lambda-return2 () "Check a nested lambda function gets native compiled." (let ((f (comp-tests-lambda-return-f2))) - (should (subr-native-elisp-p f)) + (should (native-comp-function-p f)) (let ((f2 (funcall f))) - (should (subr-native-elisp-p f2)) + (should (native-comp-function-p f2)) (should (= (funcall f2 3) 4))))) (comp-deftest recursive () @@ -391,7 +391,7 @@ Check that the resulting binaries do not differ." t) (native-compile #'comp-tests-free-fun-f) - (should (subr-native-elisp-p (symbol-function 'comp-tests-free-fun-f))) + (should (native-comp-function-p (symbol-function 'comp-tests-free-fun-f))) (should (= (comp-tests-free-fun-f) 3)) (should (string= (documentation #'comp-tests-free-fun-f) "Some doc.")) @@ -412,8 +412,8 @@ Check that the resulting binaries do not differ." (let* ((f (symbol-function 'comp-tests-free-fun-f2)) (f2 (funcall f))) - (should (subr-native-elisp-p f)) - (should (subr-native-elisp-p f2)) + (should (native-comp-function-p f)) + (should (native-comp-function-p f2)) (should (string= (documentation f2) "Some doc.")) (should (commandp f2)) (should (equal (interactive-form f2) '(interactive nil))) @@ -425,7 +425,7 @@ Check that the resulting binaries do not differ." "Check we are able to compile a single function." (eval '(defun comp-tests/free\fun-f ()) t) (native-compile #'comp-tests/free\fun-f) - (should (subr-native-elisp-p (symbol-function 'comp-tests/free\fun-f)))) + (should (native-comp-function-p (symbol-function 'comp-tests/free\fun-f)))) (comp-deftest bug-40187 () "Check function name shadowing. @@ -436,7 +436,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (comp-deftest speed--1 () "Check that at speed -1 we do not native compile." (should (= (comp-test-speed--1-f) 3)) - (should-not (subr-native-elisp-p (symbol-function 'comp-test-speed--1-f)))) + (should-not (native-comp-function-p (symbol-function 'comp-test-speed--1-f)))) (comp-deftest bug-42360 () "." @@ -497,22 +497,22 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (should-error (native-compile '(+ 1 foo))) (let ((lexical-binding t) (f (native-compile '(lambda (x) (1+ x))))) - (should (subr-native-elisp-p f)) + (should (native-comp-function-p f)) (should (= (funcall f 2) 3))) (let* ((lexical-binding nil) (f (native-compile '(lambda (x) (1+ x))))) - (should (subr-native-elisp-p f)) + (should (native-comp-function-p f)) (should (= (funcall f 2) 3)))) (comp-deftest comp-test-defsubst () ;; Bug#42664, Bug#43280, Bug#44209. - (should-not (subr-native-elisp-p (symbol-function 'comp-test-defsubst-f)))) + (should-not (native-comp-function-p (symbol-function 'comp-test-defsubst-f)))) (comp-deftest primitive-redefine-compile-44221 () "Test the compiler still works while primitives are redefined (bug#44221)." (cl-letf (((symbol-function 'delete-region) (lambda (_ _)))) - (should (subr-native-elisp-p + (should (native-comp-function-p (native-compile '(lambda () (delete-region (point-min) (point-max)))))))) @@ -564,7 +564,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (comp-deftest 48029-1 () "" - (should (subr-native-elisp-p + (should (native-comp-function-p (symbol-function 'comp-test-48029-nonascii-žžž-f)))) (comp-deftest 61917-1 () @@ -578,7 +578,7 @@ dedicated byte-op code." (setf x (native-compile '(lambda () (delete-region 1 2)))) - (should (subr-native-elisp-p x)) + (should (native-comp-function-p x)) (funcall x) (advice-remove #'delete-region f) (should (equal comp-test-primitive-redefine-args '(1 2)))))) @@ -874,7 +874,7 @@ Return a list of results." (comp-tests-tco-f (+ a b) a (- count 1)))) t) (native-compile #'comp-tests-tco-f) - (should (subr-native-elisp-p (symbol-function 'comp-tests-tco-f))) + (should (native-comp-function-p (symbol-function 'comp-tests-tco-f))) (should (= (comp-tests-tco-f 1 0 10) 55)))) (defun comp-tests-fw-prop-checker-1 (_) @@ -901,7 +901,7 @@ Return a list of results." (length c))) ; <= has to optimize t) (native-compile #'comp-tests-fw-prop-1-f) - (should (subr-native-elisp-p (symbol-function 'comp-tests-fw-prop-1-f))) + (should (native-comp-function-p (symbol-function 'comp-tests-fw-prop-1-f))) (should (= (comp-tests-fw-prop-1-f) 6)))) (defun comp-tests--type-lists-equal (l1 l2) @@ -1556,10 +1556,10 @@ folded." (declare-function comp-tests-pure-caller-f nil) (declare-function comp-tests-pure-fibn-entry-f nil) - (should (subr-native-elisp-p (symbol-function 'comp-tests-pure-caller-f))) + (should (native-comp-function-p (symbol-function 'comp-tests-pure-caller-f))) (should (= (comp-tests-pure-caller-f) 4)) - (should (subr-native-elisp-p (symbol-function 'comp-tests-pure-fibn-entry-f))) + (should (native-comp-function-p (symbol-function 'comp-tests-pure-fibn-entry-f))) (should (= (comp-tests-pure-fibn-entry-f) 6765)))) (defvar comp-tests-cond-rw-checked-function nil commit 1a1170cde7e847f4eb4d736a400f7325f2265a1c Author: Stefan Monnier Date: Wed May 22 13:45:39 2024 -0400 Rename `subr-native-elisp` to `native-comp-function` (bug#71123) Now that this type name is displayed in *Help*, it is more important to use a name that is less weird for the unsuspecting user. * lisp/emacs-lisp/cl-preloaded.el (cl-functionp): Adjust to new name of native function's type. (subr-native-elisp-p): Redefine as an obsolete alias. (native-comp-function): Rename from `subr-native-elisp` * src/data.c (Fcl_type_of): Return `Qnative_comp_function` i.s.o `Qsubr_native_elisp`. (Fnative_comp_function_p): Rename from `Fsubr_native_elisp_p`. (syms_of_data): Adjust accordingly. * src/doc.c (Fsubr_documentation): Use new `Fnative_comp_function_p` name. diff --git a/etc/NEWS b/etc/NEWS index abd347dfcb2..805962488d8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1891,6 +1891,10 @@ documentation and examples. * Incompatible Lisp Changes in Emacs 30.1 +--- +** 'subr-native-elisp-p' is renamed to 'native-comp-function-p'. +The previous name still exists but is marked as obsolete. + +++ ** Evaluating a 'lambda' returns an object of type 'interpreted-function'. Instead of representing interpreted functions as lists that start with diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index fa745396b02..4b1bd2a9aff 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -355,7 +355,7 @@ The `slots' (and hence `index-table') are currently unused." This is like `functionp' except that it returns nil for all lists and symbols, regardless if `funcall' would accept to call them." (memq (cl-type-of object) - '(primitive-function subr-native-elisp module-function + '(primitive-function native-comp-function module-function interpreted-function byte-code-function))) (cl--define-built-in-type t nil "Abstract supertype of everything.") @@ -465,7 +465,8 @@ The fields are used as follows: "Type of functions that have not been compiled.") (cl--define-built-in-type special-form (subr) "Type of the core syntactic elements of the Emacs Lisp language.") -(cl--define-built-in-type subr-native-elisp (subr compiled-function) +(define-obsolete-function-alias 'subr-native-elisp-p #'native-comp-function-p "30.1") +(cl--define-built-in-type native-comp-function (subr compiled-function) "Type of functions that have been compiled by the native compiler.") (cl--define-built-in-type primitive-function (subr compiled-function) "Type of functions hand written in C.") diff --git a/src/data.c b/src/data.c index be7ae023d8d..e6106a1dbdf 100644 --- a/src/data.c +++ b/src/data.c @@ -239,7 +239,7 @@ a fixed set of types. */) case PVEC_WINDOW: return Qwindow; case PVEC_SUBR: return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form - : SUBR_NATIVE_COMPILEDP (object) ? Qsubr_native_elisp + : SUBR_NATIVE_COMPILEDP (object) ? Qnative_comp_function : Qprimitive_function; case PVEC_CLOSURE: return CONSP (AREF (object, CLOSURE_CODE)) @@ -1055,9 +1055,8 @@ SUBR must be a built-in function. */) return build_string (name); } -DEFUN ("subr-native-elisp-p", Fsubr_native_elisp_p, Ssubr_native_elisp_p, 1, 1, - 0, doc: /* Return t if the object is native compiled lisp -function, nil otherwise. */) +DEFUN ("native-comp-function-p", Fnative_comp_function_p, Snative_comp_function_p, 1, 1, + 0, doc: /* Return t if the object is native compiled Lisp function, nil otherwise. */) (Lisp_Object object) { return SUBR_NATIVE_COMPILEDP (object) ? Qt : Qnil; @@ -4163,7 +4162,8 @@ syms_of_data (void) DEFSYM (Qsubr, "subr"); DEFSYM (Qspecial_form, "special-form"); DEFSYM (Qprimitive_function, "primitive-function"); - DEFSYM (Qsubr_native_elisp, "subr-native-elisp"); + DEFSYM (Qsubr_native_elisp, "subr-native-elisp"); /* Deprecated name. */ + DEFSYM (Qnative_comp_function, "native-comp-function"); DEFSYM (Qbyte_code_function, "byte-code-function"); DEFSYM (Qinterpreted_function, "interpreted-function"); DEFSYM (Qbuffer, "buffer"); @@ -4298,7 +4298,7 @@ syms_of_data (void) defsubr (&Sbyteorder); defsubr (&Ssubr_arity); defsubr (&Ssubr_name); - defsubr (&Ssubr_native_elisp_p); + defsubr (&Snative_comp_function_p); defsubr (&Ssubr_native_lambda_list); defsubr (&Ssubr_type); #ifdef HAVE_NATIVE_COMP diff --git a/src/doc.c b/src/doc.c index f516db3bbcc..7bff8bd8edb 100644 --- a/src/doc.c +++ b/src/doc.c @@ -392,7 +392,7 @@ DEFUN ("internal-subr-documentation", Fsubr_documentation, Ssubr_documentation, (Lisp_Object function) { #ifdef HAVE_NATIVE_COMP - if (!NILP (Fsubr_native_elisp_p (function))) + if (!NILP (Fnative_comp_function_p (function))) return native_function_doc (function); else #endif commit 0ae66c1917609832f2456b8207743468439926ae Author: Stefan Kangas Date: Wed May 29 00:34:37 2024 +0200 Mention direction when resizing a window fails * lisp/window.el (enlarge-window, shrink-window): When an attempt to resize a window fails, also mention the direction of the operation (i.e., horizontally or vertically). diff --git a/lisp/window.el b/lisp/window.el index e709e978cc9..b014be6a7cf 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -3687,7 +3687,9 @@ negative, shrink selected window by -DELTA lines or columns." (if horizontal 'enlarge-window-horizontally 'enlarge-window)) ;; For backward compatibility don't signal an error unless this ;; command is `enlarge-window(-horizontally)'. - (user-error "Cannot enlarge selected window")) + (if horizontal + (user-error "Cannot enlarge selected window horizontally") + (user-error "Cannot enlarge selected window vertically"))) (t (window-resize nil (if (> delta 0) @@ -3730,7 +3732,9 @@ negative, enlarge selected window by -DELTA lines or columns." (if horizontal 'shrink-window-horizontally 'shrink-window)) ;; For backward compatibility don't signal an error unless this ;; command is `shrink-window(-horizontally)'. - (user-error "Cannot shrink selected window")) + (if horizontal + (user-error "Cannot shrink selected window horizontally") + (user-error "Cannot shrink selected window vertically"))) (t (window-resize nil (if (> delta 0) commit 7e326b915f45346803edb52b5023db9b765ed07a Author: Jim Porter Date: Tue May 28 14:43:28 2024 -0700 Fix adding to history via 'eshell-command' * lisp/eshell/eshell.el (eshell-read-command): Don't handle history here. * lisp/eshell/em-hist.el (eshell-hist-initialize): Properly set up history for minibuffer. (eshell-add-command-to-history): Immediately save history. diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index b171a2850ff..2749749bb93 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -294,13 +294,13 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil." (make-local-variable 'eshell-save-history-index) (setq-local eshell-hist--new-items 0) + (setq-local eshell-history-ring nil) (if (minibuffer-window-active-p (selected-window)) - (setq-local eshell-save-history-on-exit nil) - (setq-local eshell-history-ring nil) + (progn + (setq-local eshell-history-append t) + (add-hook 'minibuffer-exit-hook #'eshell-add-command-to-history nil t)) (if eshell-history-file-name - (eshell-read-history nil t)) - - (add-hook 'eshell-exit-hook #'eshell--save-history nil t)) + (eshell-read-history nil t))) (unless eshell-history-ring (setq eshell-history-ring (make-ring eshell-history-size))) @@ -421,7 +421,8 @@ command. This function is supposed to be called from the minibuffer, presumably as a `minibuffer-exit-hook'." (eshell-add-input-to-history - (buffer-substring (minibuffer-prompt-end) (point-max)))) + (buffer-substring (minibuffer-prompt-end) (point-max))) + (eshell--save-history)) (defun eshell-add-to-history () "Add last Eshell command to the history ring. diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index 503f64add41..18e05a371a4 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -281,10 +281,7 @@ information on Eshell, see Info node `(eshell)Top'." (minibuffer-with-setup-hook (lambda () (eshell-mode) (eshell-command-mode +1)) - (let ((command (read-from-minibuffer prompt))) - (when (eshell-using-module 'eshell-hist) - (eshell-add-input-to-history command)) - command)))) + (read-from-minibuffer prompt)))) ;;;###autoload (defun eshell-command (command &optional to-current-buffer) commit 647de5e952c6ba806d3c36373cf8eb4f11034650 Author: Stefan Monnier Date: Tue May 28 17:42:27 2024 -0400 esh-mode.el: Refrain from hiding buffer modifications (bug#70966) We have not been able to discover why these functions let-bound `inhibit-modification-hooks`, but these let-bindings are undesired effects on other modes such as `diff-mode` which need to keep track of buffer modifications. Let's remove those let-bindings and hope for the best. * lisp/eshell/esh-mode.el (eshell-send-input) (eshell-interactive-filter): Don't bind `inhibit-modification-hooks`. diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 78a448a41a5..c4ae55afe3f 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -622,8 +622,7 @@ newline." (interactive "P") ;; Note that the input string does not include its terminal newline. (let* ((proc-running-p (eshell-head-process)) - (send-to-process-p (and proc-running-p (not queue-p))) - (inhibit-modification-hooks t)) + (send-to-process-p (and proc-running-p (not queue-p)))) (unless (and send-to-process-p (not (eq (process-status (eshell-head-process)) @@ -710,41 +709,40 @@ This is done after all necessary filtering has been done." (unless buffer (setq buffer (current-buffer))) (when (and string (buffer-live-p buffer)) - (let ((inhibit-modification-hooks t)) - (with-current-buffer buffer - (let ((functions eshell-preoutput-filter-functions)) - (while (and functions string) - (setq string (funcall (car functions) string)) - (setq functions (cdr functions)))) - (when string - (let (opoint obeg oend) - (setq opoint (point)) - (setq obeg (point-min)) - (setq oend (point-max)) - (let ((buffer-read-only nil) - (nchars (length string)) - (ostart nil)) - (widen) - (goto-char eshell-last-output-end) - (setq ostart (point)) - (if (<= (point) opoint) - (setq opoint (+ opoint nchars))) - (if (< (point) obeg) - (setq obeg (+ obeg nchars))) - (if (<= (point) oend) - (setq oend (+ oend nchars))) - ;; Let the ansi-color overlay hooks run. - (let ((inhibit-modification-hooks nil)) - (insert string)) - (if (= (window-start) (point)) - (set-window-start (selected-window) - (- (point) nchars))) - (set-marker eshell-last-output-start ostart) - (set-marker eshell-last-output-end (point)) - (force-mode-line-update)) - (narrow-to-region obeg oend) - (goto-char opoint) - (eshell-run-output-filters))))))) + (with-current-buffer buffer + (let ((functions eshell-preoutput-filter-functions)) + (while (and functions string) + (setq string (funcall (car functions) string)) + (setq functions (cdr functions)))) + (when string + (let (opoint obeg oend) + (setq opoint (point)) + (setq obeg (point-min)) + (setq oend (point-max)) + (let ((buffer-read-only nil) + (nchars (length string)) + (ostart nil)) + (widen) + (goto-char eshell-last-output-end) + (setq ostart (point)) + (if (<= (point) opoint) + (setq opoint (+ opoint nchars))) + (if (< (point) obeg) + (setq obeg (+ obeg nchars))) + (if (<= (point) oend) + (setq oend (+ oend nchars))) + ;; Let the ansi-color overlay hooks run. + (let ((inhibit-modification-hooks nil)) + (insert string)) + (if (= (window-start) (point)) + (set-window-start (selected-window) + (- (point) nchars))) + (set-marker eshell-last-output-start ostart) + (set-marker eshell-last-output-end (point)) + (force-mode-line-update)) + (narrow-to-region obeg oend) + (goto-char opoint) + (eshell-run-output-filters)))))) (defun eshell-run-output-filters () "Run the `eshell-output-filter-functions' on the current output." commit 0999c64fa861bf9b5200b6dae09e81563853a04c Author: Alan Mackenzie Date: Tue May 28 20:12:17 2024 +0000 Correct and clarify two doc strings in lisp/files.el lisp/files.el (major-mode-remap-alist) (major-mode-remap-defaults): Correct and clarify the doc strings. diff --git a/lisp/files.el b/lisp/files.el index ae6dc1d6b29..079d48e69fb 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3570,17 +3570,18 @@ we don't actually set it to the same mode the buffer already has." "Remember the mode we have set via `set-auto-mode-0'.") (defcustom major-mode-remap-alist nil - "Alist mapping file-specified mode to actual mode. -Every entry is of the form (MODE . FUNCTION) which means that in order -to activate the major mode MODE (specified via something like -`auto-mode-alist', file-local variables, ...) we should actually call -FUNCTION instead. -FUNCTION can be nil to hide other entries (either in this var or in -`major-mode-remap-defaults') and means that we should call MODE." + "Alist mapping file-specified modes to alternative modes. +Each entry is of the form (MODE . FUNCTION) which means that in place +of activating the major mode MODE (specified via something like +`auto-mode-alist', file-local variables, ...) we actually call FUNCTION +instead. +FUNCTION is typically a major mode which \"does the same thing\" as +MODE, but can also be nil to hide other entries (either in this var or +in `major-mode-remap-defaults') and means that we should call MODE." :type '(alist (symbol) (function))) (defvar major-mode-remap-defaults nil - "Alist mapping file-specified mode to actual mode. + "Alist mapping file-specified modes to alternative modes. This works like `major-mode-remap-alist' except it has lower priority and it is meant to be modified by packages rather than users.") commit 066e9b598858cc4c0b666b12242f07a7fdf3e073 Author: Kévin Le Gouguec Date: Fri Mar 22 20:24:46 2024 +0100 Use the current face foreground for read-passwd icons (bug#71213) * etc/images/conceal.svg: * etc/images/reveal.svg: Remove 'fill' attribute so that the current face's background is applied: this helps the icon's SVG representation remain legible regardless of how the mode-line is themed. diff --git a/etc/images/conceal.svg b/etc/images/conceal.svg index 172b73ed3d3..65695c0024e 100644 --- a/etc/images/conceal.svg +++ b/etc/images/conceal.svg @@ -1,4 +1,4 @@ - + diff --git a/etc/images/reveal.svg b/etc/images/reveal.svg index 41ae3733a53..f950311ac5a 100644 --- a/etc/images/reveal.svg +++ b/etc/images/reveal.svg @@ -1,4 +1,4 @@ - + commit 730b61c64b5d86cc3b38ee15d4530fdd2194619b Author: Juri Linkov Date: Tue May 28 19:51:21 2024 +0300 * lisp/image-mode.el (image-transform-fill-window): New command (bug#69565). (image-mode-menu): Add image-transform-fill-window to the menu. diff --git a/lisp/image-mode.el b/lisp/image-mode.el index fa64f1ac03e..7cf7845e935 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -559,6 +559,8 @@ image as text, when opening such images in `image-mode'." :help "Resize image to match the window height and width"] ["Fit Image to Window (Scale down only)" image-transform-fit-both :help "Scale image down to match the window height and width"] + ["Fill Window with Image" image-transform-fill-window + :help "Resize image to fill either width or height of the window"] ["Zoom In" image-increase-size :help "Enlarge the image"] ["Zoom Out" image-decrease-size @@ -1592,6 +1594,18 @@ The percentage is in relation to the original size of the image." (setq image-transform-resize 'fit-window) (image-toggle-display-image)) +(defun image-transform-fill-window () + "Fill the window with the image while keeping image proportions. +This means filling the window with the image as much as possible +without leaving empty space around image edges. Then you can use +either horizontal or vertical scrolling to see the remaining parts +of the image." + (interactive nil image-mode) + (let ((size (image-display-size (image-get-display-property) t))) + (setq image-transform-resize + (if (> (car size) (cdr size)) 'fit-height 'fit-width))) + (image-toggle-display-image)) + (defun image-transform-set-rotation (rotation) "Prompt for an angle ROTATION, and rotate the image by that amount. ROTATION should be in degrees." commit ebac4d4872829c44f65966b3268ceaf7ecbf43d9 Author: Juri Linkov Date: Tue May 28 19:31:55 2024 +0300 Provide a list of default values for M-n of project-find-file (bug#70996) * lisp/progmodes/project.el (project-find-file) (project-or-external-find-file): Provide a list of suggested filenames for the first arg of project-find-file-in. Use buffer-file-name first to make it more predictable for M-n. (project--read-file-cpd-relative): Handle mb-default as a list. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index dceca2eab48..8a8b4fc33d6 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1080,8 +1080,9 @@ for VCS directories listed in `vc-directory-exclusion-list'." (dirs (list root)) (project-files-relative-names t)) (project-find-file-in - (or (thing-at-point 'filename) - (and buffer-file-name (project--find-default-from buffer-file-name pr))) + (delq nil (list (and buffer-file-name (project--find-default-from + buffer-file-name pr)) + (thing-at-point 'filename))) dirs pr include-all))) ;;;###autoload @@ -1103,8 +1104,9 @@ for VCS directories listed in `vc-directory-exclusion-list'." (project-external-roots pr))) (project-file-history-behavior t)) (project-find-file-in - (or (thing-at-point 'filename) - (and buffer-file-name (project--find-default-from buffer-file-name pr))) + (delq nil (list (and buffer-file-name (project--find-default-from + buffer-file-name pr)) + (thing-at-point 'filename))) dirs pr include-all))) (defcustom project-read-file-name-function #'project--read-file-cpd-relative @@ -1166,11 +1168,14 @@ by the user at will." (setq all-files (delete common-parent-directory all-files)) t)) - (mb-default (if (and common-parent-directory - mb-default - (file-name-absolute-p mb-default)) - (file-relative-name mb-default common-parent-directory) - mb-default)) + (mb-default (mapcar (lambda (mb-default) + (if (and common-parent-directory + mb-default + (file-name-absolute-p mb-default)) + (file-relative-name + mb-default common-parent-directory) + mb-default)) + (if (listp mb-default) mb-default (list mb-default)))) (substrings (mapcar (lambda (s) (substring s cpd-length)) all-files)) (_ (when included-cpd (setq substrings (cons "./" substrings)))) commit d9512da49514623ef3e35524dc894c06f2c0ce20 Author: Eli Zaretskii Date: Tue May 28 19:03:00 2024 +0300 Avoid rare crashes in 'uncache_face' * src/xfaces.c (realize_face): Prevent rare crashes in 'uncache_face' because 'former_face' is NULL (i.e. the face corresponding to 'former_face_id' is no longer cached). (Bug#71243) diff --git a/src/xfaces.c b/src/xfaces.c index 258fbc52e64..e305cc7456f 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -6057,7 +6057,8 @@ realize_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE], { /* Remove the former face. */ struct face *former_face = cache->faces_by_id[former_face_id]; - uncache_face (cache, former_face); + if (former_face) + uncache_face (cache, former_face); free_realized_face (cache->f, former_face); SET_FRAME_GARBAGED (cache->f); } commit 9c7de10079bb5f803a1744ae1d56399ad7d42ac5 Author: Mattias Engdegård Date: Tue May 28 17:48:37 2024 +0200 Use same Python binary for test as in python mode (bug#70815) * test/lisp/progmodes/python-tests.el (python-tests-get-shell-interpreter): Try Python executable names in the same order as we do for `python-shell-interpreter`, so that we run the test with the one is most likely to be used. diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index b41688e9d48..0121486a3b9 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -3762,7 +3762,9 @@ If env string EMACS_PYTHON_INTERPRETER exists, use it as preferred one." (or (executable-find interpreter) (error "Couldn't find EMACS_PYTHON_INTERPRETER(%s) in path" interpreter))) - (cl-some #'executable-find '("python" "python3" "python2")))))) + ;; Use the same order as for the default value of + ;; `python-shell-interpreter'. + (cl-some #'executable-find '("python3" "python" "python2")))))) (ert-deftest python-shell-get-process-name-1 () "Check process name calculation sans `buffer-file-name'." commit 8b70093b369440ea96e2fd38efdd3a05b12f7ac5 Author: Michael Albinus Date: Tue May 28 13:23:12 2024 +0200 Fix tar-mode-test-tar-extract-zip-and-gz * test/lisp/tar-mode-tests.el (tar-mode-test-tar-extract-zip-and-gz): Check also for "unzip" executable. diff --git a/test/lisp/tar-mode-tests.el b/test/lisp/tar-mode-tests.el index bafe575fdda..d2f1978b314 100644 --- a/test/lisp/tar-mode-tests.el +++ b/test/lisp/tar-mode-tests.el @@ -48,6 +48,7 @@ (ert-deftest tar-mode-test-tar-extract-zip-and-gz () (skip-unless (executable-find "gzip")) + (skip-unless (executable-find "unzip")) (require 'arc-mode) (let* ((tar-file (expand-file-name "tzg.tar.gz" tar-mode-tests-data-directory)) tar-buffer zip-buffer gz-buffer)