commit 1aa83da46d1af60260b17522608eeca28efff151 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Tue Jun 11 14:40:46 2024 +0800 ; * etc/NEWS: Rename read-process-output-fast here also. diff --git a/etc/NEWS b/etc/NEWS index 94557fdd255..a0223fb2dc6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -131,7 +131,7 @@ The round-trip through the Lisp function 'internal-default-process-filter' is skipped when the process filter is the default one. It's reimplemented in native code, reducing GC churn. -To undo the change, set 'read-process-output-fast' to nil. +To undo the change, set 'fast-read-process-output' to nil. * Changes in Emacs 30.1 commit 677f082b0feda295e6a710b5dac6040f57cfad8b Author: Po Lu Date: Tue Jun 11 14:39:40 2024 +0800 Eliminate some redundant synchronization on Android * java/org/gnu/emacs/EmacsService.java (resetIC): Return on all versions of Android if the connection need not be reset. * java/org/gnu/emacs/EmacsView.java (getICMode, setICMode): Remove needless synchronization. diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 2dcaad16e50..cfe9e42de4d 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -899,11 +899,19 @@ invocation of app_process (through android-emacs) can if (DEBUG_IC) Log.d (TAG, "resetIC: " + window + ", " + icMode); - if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.TIRAMISU - && (oldMode = window.view.getICMode ()) == icMode - /* Don't do this if there is currently no input - connection. */ - && oldMode != IC_MODE_NULL) + oldMode = window.view.getICMode (); + + /* If it's not necessary to reset the input connection for ICMODE to + take effect, return immediately. */ + if (oldMode == IC_MODE_NULL && icMode == IC_MODE_NULL) + { + if (DEBUG_IC) + Log.d (TAG, "resetIC: redundant invocation ignored"); + return; + } + + if (oldMode == icMode + && Build.VERSION.SDK_INT >= Build.VERSION_CODES.TIRAMISU) { if (DEBUG_IC) Log.d (TAG, "resetIC: calling invalidateInput"); diff --git a/java/org/gnu/emacs/EmacsView.java b/java/org/gnu/emacs/EmacsView.java index 244a3a02166..4a505b3c0dc 100644 --- a/java/org/gnu/emacs/EmacsView.java +++ b/java/org/gnu/emacs/EmacsView.java @@ -891,13 +891,13 @@ else if (child.getVisibility () != GONE) return true; } - public synchronized void + public void setICMode (int icMode) { this.icMode = icMode; } - public synchronized int + public int getICMode () { return icMode; commit bac8a70f454d022d8352200d85eacd27017d4f12 Author: Dmitry Gutov Date: Tue Jun 11 05:54:57 2024 +0300 fast-read-process-output: Make safer * src/process.c (read_process_output): Move the call to 'read_and_insert_process_output' from here. (read_and_dispose_of_process_output): To here (bug#66020). So that any Lisp code invoked through modification hook from the former function also benefit from safety guards like running_asynch_code, saved match data, inhibit_quot, etc. diff --git a/src/process.c b/src/process.c index 60264d367b8..b6ec114e2b3 100644 --- a/src/process.c +++ b/src/process.c @@ -6263,10 +6263,7 @@ read_process_output (Lisp_Object proc, int channel) friends don't expect current-buffer to be changed from under them. */ record_unwind_current_buffer (); - if (fast_read_process_output && EQ (p->filter, Qinternal_default_process_filter)) - read_and_insert_process_output (p, chars, nbytes, coding); - else - read_and_dispose_of_process_output (p, chars, nbytes, coding); + read_and_dispose_of_process_output (p, chars, nbytes, coding); /* Handling the process output should not deactivate the mark. */ Vdeactivate_mark = odeactivate; @@ -6479,19 +6476,27 @@ read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars, save the match data in a special nonrecursive fashion. */ running_asynch_code = 1; - decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt); - text = coding->dst_object; + if (fast_read_process_output && EQ (p->filter, Qinternal_default_process_filter)) + { + read_and_insert_process_output (p, chars, nbytes, coding); + } + else + { + decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt); + text = coding->dst_object; - read_process_output_set_last_coding_system (p, coding); + read_process_output_set_last_coding_system (p, coding); - if (SBYTES (text) > 0) - /* FIXME: It's wrong to wrap or not based on debug-on-error, and - sometimes it's simply wrong to wrap (e.g. when called from - accept-process-output). */ - internal_condition_case_1 (read_process_output_call, - list3 (outstream, make_lisp_proc (p), text), - !NILP (Vdebug_on_error) ? Qnil : Qerror, - read_process_output_error_handler); + if (SBYTES (text) > 0) + /* FIXME: It's wrong to wrap or not based on debug-on-error, and + sometimes it's simply wrong to wrap (e.g. when called from + accept-process-output). */ + internal_condition_case_1 (read_process_output_call, + list3 (outstream, make_lisp_proc (p), text), + !NILP (Vdebug_on_error) ? Qnil : Qerror, + read_process_output_error_handler); + + } /* If we saved the match data nonrecursively, restore it now. */ restore_search_regs (); commit d9890bb87063b402853ff0e4ea8bbfc92e5d6e00 Author: Dmitry Gutov Date: Tue Jun 11 05:36:51 2024 +0300 read_process_output_set_last_coding_system: Extract, reuse * src/process.c (read_process_output_set_last_coding_system): New function, extracted from read_and_dispose_of_process_output. (read_and_dispose_of_process_output): Update accordingly. (read_and_insert_process_output): Use it here instead of just transferring carryover (bug#66020, also mentioned in bug#71452). diff --git a/src/process.c b/src/process.c index c00eba086a2..60264d367b8 100644 --- a/src/process.c +++ b/src/process.c @@ -6344,6 +6344,48 @@ read_process_output_after_insert (struct Lisp_Process *p, Lisp_Object *old_read_ SET_PT_BOTH (opoint, opoint_byte); } +static void +read_process_output_set_last_coding_system (struct Lisp_Process *p, + struct coding_system *coding) +{ + Vlast_coding_system_used = CODING_ID_NAME (coding->id); + /* A new coding system might be found. */ + if (!EQ (p->decode_coding_system, Vlast_coding_system_used)) + { + pset_decode_coding_system (p, Vlast_coding_system_used); + + /* Don't call setup_coding_system for + proc_decode_coding_system[channel] here. It is done in + detect_coding called via decode_coding above. */ + + /* If a coding system for encoding is not yet decided, we set + it as the same as coding-system for decoding. + + But, before doing that we must check if + proc_encode_coding_system[p->outfd] surely points to a + valid memory because p->outfd will be changed once EOF is + sent to the process. */ + eassert (p->outfd < FD_SETSIZE); + if (NILP (p->encode_coding_system) && p->outfd >= 0 + && proc_encode_coding_system[p->outfd]) + { + pset_encode_coding_system + (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil)); + setup_coding_system (p->encode_coding_system, + proc_encode_coding_system[p->outfd]); + } + } + + if (coding->carryover_bytes > 0) + { + if (SCHARS (p->decoding_buf) < coding->carryover_bytes) + pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes)); + memcpy (SDATA (p->decoding_buf), coding->carryover, + coding->carryover_bytes); + p->decoding_carryover = coding->carryover_bytes; + } +} + static void read_and_insert_process_output (struct Lisp_Process *p, char *buf, ssize_t nread, @@ -6373,7 +6415,6 @@ read_and_insert_process_output (struct Lisp_Process *p, char *buf, else { /* We have to decode the input. */ Lisp_Object curbuf; - int carryover = 0; specpdl_ref count1 = SPECPDL_INDEX (); XSETBUFFER (curbuf, current_buffer); @@ -6387,14 +6428,12 @@ read_and_insert_process_output (struct Lisp_Process *p, char *buf, (unsigned char *) buf, nread, curbuf); unbind_to (count1, Qnil); + read_process_output_set_last_coding_system (p, process_coding); + TEMP_SET_PT_BOTH (PT + process_coding->produced_char, PT_BYTE + process_coding->produced); signal_after_change (PT - process_coding->produced_char, 0, process_coding->produced_char); - carryover = process_coding->carryover_bytes; - if (carryover > 0) - memcpy (buf, process_coding->carryover, - process_coding->carryover_bytes); } read_process_output_after_insert (p, &old_read_only, old_begv, old_zv, @@ -6442,42 +6481,9 @@ read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars, decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt); text = coding->dst_object; - Vlast_coding_system_used = CODING_ID_NAME (coding->id); - /* A new coding system might be found. */ - if (!EQ (p->decode_coding_system, Vlast_coding_system_used)) - { - pset_decode_coding_system (p, Vlast_coding_system_used); - /* Don't call setup_coding_system for - proc_decode_coding_system[channel] here. It is done in - detect_coding called via decode_coding above. */ + read_process_output_set_last_coding_system (p, coding); - /* If a coding system for encoding is not yet decided, we set - it as the same as coding-system for decoding. - - But, before doing that we must check if - proc_encode_coding_system[p->outfd] surely points to a - valid memory because p->outfd will be changed once EOF is - sent to the process. */ - eassert (p->outfd < FD_SETSIZE); - if (NILP (p->encode_coding_system) && p->outfd >= 0 - && proc_encode_coding_system[p->outfd]) - { - pset_encode_coding_system - (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil)); - setup_coding_system (p->encode_coding_system, - proc_encode_coding_system[p->outfd]); - } - } - - if (coding->carryover_bytes > 0) - { - if (SCHARS (p->decoding_buf) < coding->carryover_bytes) - pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes)); - memcpy (SDATA (p->decoding_buf), coding->carryover, - coding->carryover_bytes); - p->decoding_carryover = coding->carryover_bytes; - } if (SBYTES (text) > 0) /* FIXME: It's wrong to wrap or not based on debug-on-error, and sometimes it's simply wrong to wrap (e.g. when called from commit f33806dd6624e874d5cff3cd02ab370f518c0629 Author: Po Lu Date: Tue Jun 11 10:15:28 2024 +0800 * src/filelock.c (pid_strtoimax) [!WINDOWSNT]: Define correctly. diff --git a/src/filelock.c b/src/filelock.c index f625b594d93..268aec84dc7 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -60,7 +60,7 @@ along with GNU Emacs. If not, see . */ #define pidintmax intmax_t #define EPRIdMAX PRIdMAX #define getpid_for_lock() getpid () -#define strtoimax strtoimax +#define pid_strtoimax strtoimax #endif /* WIDNOWSNT */ #ifndef MSDOS commit 9e96fbfd855bf0acc005b2b0973c2a9aef7cdcd2 Author: Po Lu Date: Tue Jun 11 10:04:16 2024 +0800 Provide for negative PIDs on MS Windows * src/filelock.c (pid_t, getpid_for_lock, pidintmax, EPRIdMAX): New macros; define to unsigned long or corresponding values if WINDOWSNT. (lock_file_1, current_lock_owner): Replace intmax_t, getpid, pid_t and the like with the aforementioned macros. (bug#71477) diff --git a/src/filelock.c b/src/filelock.c index 050cac565c9..f625b594d93 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -47,7 +47,21 @@ along with GNU Emacs. If not, see . */ #ifdef WINDOWSNT #include #include /* for fcntl */ -#endif + +/* getpid is liable to return negative values, which the lock string + parser cannot grok, but Windows process IDs are DWORDS, i.e., + representable as unsigned longs. (bug#71477) */ +#define pid_t unsigned long +#define getpid_for_lock() ((unsigned long) getpid ()) +#define pidintmax unsigned long +#define EPRIdMAX "lu" +#define pid_strtoimax strtoul +#else /* !WINDOWSNT */ +#define pidintmax intmax_t +#define EPRIdMAX PRIdMAX +#define getpid_for_lock() getpid () +#define strtoimax strtoimax +#endif /* WIDNOWSNT */ #ifndef MSDOS @@ -281,11 +295,11 @@ lock_file_1 (Lisp_Object lfname, bool force) char const *user_name = STRINGP (luser_name) ? SSDATA (luser_name) : ""; char const *host_name = STRINGP (lhost_name) ? SSDATA (lhost_name) : ""; char lock_info_str[MAX_LFINFO + 1]; - intmax_t pid = getpid (); + pidintmax pid = getpid_for_lock (); char const *lock_info_fmt = (boot - ? "%s@%s.%"PRIdMAX":%"PRIdMAX - : "%s@%s.%"PRIdMAX); + ? "%s@%s.%"EPRIdMAX":%"PRIdMAX + : "%s@%s.%"EPRIdMAX); int len = snprintf (lock_info_str, sizeof lock_info_str, lock_info_fmt, user_name, host_name, pid, boot); if (! (0 <= len && len < sizeof lock_info_str)) @@ -367,7 +381,8 @@ current_lock_owner (lock_info_type *owner, Lisp_Object lfname) { lock_info_type local_owner; ptrdiff_t lfinfolen; - intmax_t pid, boot_time; + intmax_t boot_time; + pidintmax pid; char *at, *dot, *lfinfo_end; /* Even if the caller doesn't want the owner info, we still have to @@ -396,7 +411,7 @@ current_lock_owner (lock_info_type *owner, Lisp_Object lfname) if (! c_isdigit (dot[1])) return EINVAL; errno = 0; - pid = strtoimax (dot + 1, &owner->colon, 10); + pid = pid_strtoimax (dot + 1, &owner->colon, 10); if (errno == ERANGE) pid = -1; @@ -441,7 +456,7 @@ current_lock_owner (lock_info_type *owner, Lisp_Object lfname) /* Protect against the extremely unlikely case of the host name containing an @ character. */ else if (strchr (SSDATA (system_name), '@')) - system_name = CALLN (Ffuncall, intern ("string-replace"), + system_name = CALLN (Ffuncall, Qstring_replace, build_string ("@"), build_string ("-"), system_name); /* On current host? */ @@ -449,7 +464,7 @@ current_lock_owner (lock_info_type *owner, Lisp_Object lfname) && dot - (at + 1) == SBYTES (system_name) && memcmp (at + 1, SSDATA (system_name), SBYTES (system_name)) == 0) { - if (pid == getpid ()) + if (pid == getpid_for_lock ()) return I_OWN_IT; else if (0 < pid && pid <= TYPE_MAXIMUM (pid_t) && (kill (pid, 0) >= 0 || errno == EPERM) commit 5a576069fcd803a6a5260a2da8ce0862be982eb4 Author: Dmitry Gutov Date: Tue Jun 11 04:51:25 2024 +0300 read_and_insert_process_output: Call 'prepare_to_modify_buffer' first * src/process.c (read_and_insert_process_output): Call 'prepare_to_modify_buffer' before any insertions (bug#71452). diff --git a/src/process.c b/src/process.c index 547cdbb0c45..c00eba086a2 100644 --- a/src/process.c +++ b/src/process.c @@ -6362,6 +6362,8 @@ read_and_insert_process_output (struct Lisp_Process *p, char *buf, &opoint_byte); /* Adapted from call_process. */ + prepare_to_modify_buffer (PT, PT, NULL); + if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)) && ! CODING_MAY_REQUIRE_DECODING (process_coding)) { commit f74f4089fd2f2d317b993e842556608833791de3 Author: Po Lu Date: Tue Jun 11 09:09:35 2024 +0800 ; * src/process.c (syms_of_process): Fix ommission. diff --git a/src/process.c b/src/process.c index df2a0bc1a6e..547cdbb0c45 100644 --- a/src/process.c +++ b/src/process.c @@ -8879,7 +8879,7 @@ On GNU/Linux systems, the value should not exceed /proc/sys/fs/pipe-max-size. See pipe(7) manpage for details. */); read_process_output_max = 65536; - DEFVAR_BOOL ("read-process-output-fast", fast_read_process_output, + DEFVAR_BOOL ("fast-read-process-output", fast_read_process_output, doc: /* Non-nil to optimize the insertion of process output. We skip calling `internal-default-process-filter' and don't allocate the Lisp string that would be used as its argument. Only affects the commit 37a715c609a10493d981fd4badca3d9c7dd872f8 Author: Stefan Kangas Date: Mon Jun 10 22:17:35 2024 +0200 Fix recently added eshell test * test/lisp/eshell/esh-cmd-tests.el (esh-cmd-test/empty-background-command): Fix failing test. diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el index 865a1aadcd4..166a0ba1fff 100644 --- a/test/lisp/eshell/esh-cmd-tests.el +++ b/test/lisp/eshell/esh-cmd-tests.el @@ -507,13 +507,14 @@ NAME is the name of the test case." (ert-deftest esh-cmd-test/empty-background-command () "Test that Eshell reports an error when trying to background a nil command." - (with-temp-eshell - (eshell-match-command-output "echo hi & &" - "\\`Empty command before `&'\n") - ;; Make sure the next Eshell prompt has the original input so the - ;; user can fix it. - (should (equal (buffer-substring eshell-last-output-end (point)) - "echo hi & &")))) + (let ((text-quoting-style 'grave)) + (with-temp-eshell + (eshell-match-command-output "echo hi & &" + "\\`Empty command before `&'\n") + ;; Make sure the next Eshell prompt has the original input so the + ;; user can fix it. + (should (equal (buffer-substring eshell-last-output-end (point)) + "echo hi & &"))))) (ert-deftest esh-cmd-test/throw () "Test that calling `throw' as an Eshell command unwinds everything properly." commit 7c97d05b56a90251cbe94099d211225b330449b1 Author: Eli Zaretskii Date: Mon Jun 10 22:13:29 2024 +0300 Avoid rare assertion violations when deleting a frame * src/dispnew.c (adjust_frame_glyphs): Allow nrows = 0 when deleting a frame. (Bug#71475) diff --git a/src/dispnew.c b/src/dispnew.c index e74147f1456..8bbb818bc19 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -1851,6 +1851,7 @@ adjust_frame_glyphs (struct frame *f) eassert (FRAME_INITIAL_P (f) || noninteractive || !initialized + || !f->terminal->name /* frame is being deleted */ || (f->current_matrix && f->current_matrix->nrows > 0 && f->current_matrix->rows commit 2ac85aa6139b151920b08385e7f943e072a1503c Author: Eli Zaretskii Date: Mon Jun 10 21:24:51 2024 +0300 ; * src/treesit.c (treesit_check_node): Don't use non-ASCII comments. diff --git a/src/treesit.c b/src/treesit.c index 9f0eb061056..54b16eb1bb3 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -433,7 +433,7 @@ static Lisp_Object Vtreesit_str_pred; If we think of programs and AST, it is very rare for any program to have a very deep AST. For example, you would need 1000+ levels of nested if-statements, or a struct somehow nested for 1000+ levels. - It’s hard for me to imagine any hand-written or machine generated + It's hard for me to imagine any hand-written or machine generated program to be like that. So I think 1000 is already generous. If we look at xdisp.c, its AST only have 30 levels. */ #define TREESIT_RECURSION_LIMIT 1000 commit ffd2c492a0e0f70a66f113fe4ea9c50081818a44 Author: Eli Zaretskii Date: Mon Jun 10 21:22:47 2024 +0300 Fix treesit-tests * test/src/treesit-tests.el (treesit-node-api): Adapt the test to changes in 'treesit_check_node'. (Bug#71012) diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index 5d0c92ae8a6..ce5dc76794a 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -183,7 +183,8 @@ parser)) (should (equal t (treesit-node-check root-node 'live))) (kill-buffer) - (should (equal nil (treesit-node-check root-node 'live)))))) + (should-error (treesit-node-check root-node 'live) + :type 'treesit-node-buffer-killed)))) ;;; Indirect buffer commit aca5de19b86c973bf303de936bdd06dbb86c023e Author: Eli Zaretskii Date: Mon Jun 10 21:12:12 2024 +0300 Allow to print treesit objects from GDB * src/.gdbinit (xtsparser, xtsnode, xtsquery): New functions. (xpr): Call them for treesit objects. diff --git a/src/.gdbinit b/src/.gdbinit index 7645d466a5e..0f55cc18699 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -926,6 +926,36 @@ Set $ as a hash table pointer. This command assumes that $ is an Emacs Lisp hash table value. end +define xtsparser + xgetptr $ + print (struct Lisp_TS_Parser *) $ptr + output *$ + echo \n +end +document xtsparser +Print the address of the treesit-parser which the Lisp_Object $ points to. +end + +define xtsnode + xgetptr $ + print (struct Lisp_TS_Node *) $ptr + output *$ + echo \n +end +document xtsnode +Print the address of the treesit-node which the Lisp_Object $ points to. +end + +define xtsquery + xgetptr $ + print (struct Lisp_TS_Query *) $ptr + output *$ + echo \n +end +document xtsquery +Print the address of the treesit-query which the Lisp_Object $ points to. +end + define xcons xgetptr $ print (struct Lisp_Cons *) $ptr @@ -1069,6 +1099,15 @@ define xpr if $vec == PVEC_HASH_TABLE xhashtable end + if $vec == PVEC_TS_PARSER + xtsparser + end + if $vec == PVEC_TS_NODE + xtsnode + end + if $vec == PVEC_TS_QUERY + xtsquery + end else xvector end commit ce4e5e6a28182b4559802cd6fa62c68c2b035bc8 Author: Mattias Engdegård Date: Mon Jun 10 18:49:28 2024 +0200 * src/print.c (print_vectorlike_unreadable): Fix merge accident. diff --git a/src/print.c b/src/print.c index 6a27ceac5f0..bd1d76b3b1b 100644 --- a/src/print.c +++ b/src/print.c @@ -2036,7 +2036,7 @@ print_vectorlike_unreadable (Lisp_Object obj, Lisp_Object printcharfun, if (!treesit_node_buffer_live_p (obj)) { print_c_string ("-in-killed-buffer>", printcharfun); - break; + return; } printchar (' ', printcharfun); /* Now the node must be up-to-date, and calling functions like commit 6d0b1db518855b446ee49ab93f8faa0c24a81510 Author: Mattias Engdegård Date: Mon Jun 10 18:47:00 2024 +0200 * etc/emacs_lldb.py (Lisp_Object): Add TS types. diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py index 9865fe391a2..ba80d3431f3 100644 --- a/etc/emacs_lldb.py +++ b/etc/emacs_lldb.py @@ -74,7 +74,10 @@ class Lisp_Object: "PVEC_SUB_CHAR_TABLE": "void", "PVEC_RECORD": "struct Lisp_Vector", "PVEC_FONT": "struct font", - "PVEC_NORMAL_VECTOR": "struct Lisp_Vector" + "PVEC_NORMAL_VECTOR": "struct Lisp_Vector", + "PVEC_TS_NODE": "struct Lisp_TS_Node", + "PVEC_TS_PARSER": "struct Lisp_TS_Parser", + "PVEC_TS_COMPILED_QUERY": "struct Lisp_TS_Query", } # Object construction/initialization. commit e6b771570e064e7e8f34b715eab74a013f713712 Author: Andrea Corallo Date: Mon Jun 10 18:00:27 2024 +0200 ; Silence a byte-compiler warning in typescript-ts-mode.el * lisp/progmodes/typescript-ts-mode.el (treesit-node-child): Declare. diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index ed60819388f..74ed6aa2f94 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -32,6 +32,7 @@ (eval-when-compile (require 'rx)) (require 'c-ts-common) ; For comment indent and filling. +(declare-function treesit-node-child "treesit.c") (declare-function treesit-node-start "treesit.c") (declare-function treesit-node-end "treesit.c") (declare-function treesit-parser-create "treesit.c") commit 3003d6a0c046a8f94dfb276f1856a5b298044387 Author: kobarity Date: Mon Jun 10 23:50:11 2024 +0900 ; Fix recent change to python-tests.el * test/lisp/progmodes/python-tests.el (python-tests--pythonstartup-file): Use already bound 'python-shell-interpreter'. (Bug#70815) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index ce103921454..31b1c80a571 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -4974,7 +4974,7 @@ def foo(): "Return Jedi readline setup file if PYTHONSTARTUP is not set." (or (getenv "PYTHONSTARTUP") (with-temp-buffer - (if (eql 0 (call-process (python-tests-get-shell-interpreter) + (if (eql 0 (call-process python-shell-interpreter nil t nil "-m" "jedi" "repl")) (string-trim (buffer-string)) "")))) commit 84653558fe4c6c54f8aba922302895ab9cd61de6 Author: Eli Zaretskii Date: Mon Jun 10 18:10:03 2024 +0300 ; Another fix of non-ASCII characters in Emacs manual. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 78738e0c22b..6bf4cbe00df 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1988,7 +1988,7 @@ sequences. For example, to bind @kbd{C-c h} to the string @end example Non-@acronym{ASCII} characters can be specified directly in the -string. To bind to e.g. @samp{olá}, use: +string. To bind to e.g. @samp{ol@'a}, use: @example (keymap-global-set "C-c h" (key-description "ol@'a")) commit 0c459b11cdb530e2ba882e215f205435ca71a726 Author: Eli Zaretskii Date: Mon Jun 10 18:06:50 2024 +0300 ; Fix recent change in Emacs manual * doc/emacs/custom.texi (Init Rebinding): Fix non-ASCII characters. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 21e7e6be98b..78738e0c22b 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1991,7 +1991,7 @@ sequences. For example, to bind @kbd{C-c h} to the string string. To bind to e.g. @samp{olá}, use: @example -(keymap-global-set "C-c h" (key-description "olá")) +(keymap-global-set "C-c h" (key-description "ol@'a")) @end example However, be aware that language and coding systems may cause problems commit d3524560ee3cb075125f0af158d4af01cb2ab546 Author: Stefan Monnier Date: Mon Jun 10 10:58:46 2024 -0400 * lisp/org/ox.el (org-export-filters-alist): Don't define as constant... ...since we modify it (set it to nil) in `orgtbl-to-generic`. diff --git a/lisp/org/ox.el b/lisp/org/ox.el index b28fe21795f..1c52ca2905e 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -185,7 +185,7 @@ All these properties should be backend agnostic. Backend specific properties are set through `org-export-define-backend'. Properties redefined there have precedence over these.") -(defconst org-export-filters-alist +(defvar org-export-filters-alist '((:filter-body . org-export-filter-body-functions) (:filter-bold . org-export-filter-bold-functions) (:filter-babel-call . org-export-filter-babel-call-functions) commit 018a6d2ee903e0d09cda1d9e3b65bab73eda998f Author: Stefan Monnier Date: Mon Jun 10 10:43:14 2024 -0400 (rng-do-some-validation): Fix dangerous use of `with-silent-modifications` * lisp/nxml/rng-valid.el (rng-do-some-validation): Don't let-bind `inhibit-modification-hooks` around code which can wait. (rng-cache-state): Bind it here instead. diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el index 1c9998345fb..9a44356835e 100644 --- a/lisp/nxml/rng-valid.el +++ b/lisp/nxml/rng-valid.el @@ -444,8 +444,7 @@ The schema is set like `rng-auto-set-schema'." (condition-case-unless-debug err (and (rng-validate-prepare) (let ((rng-dt-namespace-context-getter '(nxml-ns-get-context))) - (with-silent-modifications - (rng-do-some-validation-1 continue-p-function)))) + (rng-do-some-validation-1 continue-p-function))) ;; errors signaled from a function run by an idle timer ;; are ignored; if we don't catch them, validation ;; will get mysteriously stuck at a single place @@ -585,10 +584,8 @@ Return t if there is work to do, nil otherwise." (defun rng-cache-state (pos) "Save the current state in a text property on the character at pos." - (put-text-property pos - (1+ pos) - 'rng-state - (rng-get-state))) + (with-silent-modifications + (put-text-property pos (1+ pos) 'rng-state (rng-get-state)))) (defun rng-state-matches-current (state) (and state commit 8a55f4d0b06c96c95a2a2a7eb4a9a7fedb105e70 Author: Po Lu Date: Mon Jun 10 21:56:56 2024 +0800 Correct documentation build warnings and errors with Texinfo 4.13 * doc/emacs/custom.texi (Init Rebinding): Avoid @U command. * doc/emacs/dired.texi (Image-Dired): EXIF, PNG and JPEG are acronyms. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index deac2c6c0ff..21e7e6be98b 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1988,10 +1988,10 @@ sequences. For example, to bind @kbd{C-c h} to the string @end example Non-@acronym{ASCII} characters can be specified directly in the -string. To bind to e.g. @samp{ol@U{00E1}}, use: +string. To bind to e.g. @samp{olá}, use: @example -(keymap-global-set "C-c h" (key-description "ol@U{00E1}")) +(keymap-global-set "C-c h" (key-description "olá")) @end example However, be aware that language and coding systems may cause problems diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 720d27ab3bb..c251a6dc2be 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -1689,7 +1689,7 @@ thumbnails, controlled by the value of the option @vindex image-dired-dir @vindex image-dired-thumb-naming @item image-dired -This method stores thumbnails as @sc{JPEG} images in a single directory +This method stores thumbnails as JPEG images in a single directory specified by the variable @code{image-dired-dir}. This is the default. The names of the thumbnail files are in this case constructed according to the value of @code{image-dired-thumb-naming}. @@ -1699,13 +1699,14 @@ to the value of @code{image-dired-thumb-naming}. @itemx standard-xx-large These methods, mandated by the @url{https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html, -Thumbnail Managing Standard}, store thumbnails as @sc{PNG} images under -the @file{thumbnails} subdirectory of the directory specified by the -environment variable @env{XDG_CACHE_HOME} (which defaults to +Thumbnail Managing Standard}, store thumbnails as @acronym{PNG} images +under the @file{thumbnails} subdirectory of the directory specified by +the environment variable @env{XDG_CACHE_HOME} (which defaults to @file{~/.cache}). @item per-directory This method stores the thumbnails of each directory in a -@file{.image-dired} subdirectory of that directory, as @sc{JPEG} images. +@file{.image-dired} subdirectory of that directory, as @acronym{jpeg} +images. @end table @vindex image-dired-thumb-size @@ -1777,10 +1778,10 @@ a comment from Dired (@code{image-dired-dired-comment-files}). @findex image-dired-thumbnail-set-image-description If you have the @command{exiftool} program installed, you can set the -@sc{EXIF} @samp{ImageDescription} tag of an image file by invoking the -@code{image-dired-thumbnail-set-image-description} command with point at -the thumbnail of the image file. This command prompts for the -description of the image, and adds the @sc{EXIF} tag to it. +@acronym{EXIF} @samp{ImageDescription} tag of an image file by invoking +the @code{image-dired-thumbnail-set-image-description} command with +point at the thumbnail of the image file. This command prompts for the +description of the image, and adds the @acronym{EXIF} tag to it. @vindex image-dired-thumb-visible-marks Files that are marked in Dired will also be marked in Image-Dired if commit 485b01429f1ed54aae617a6fff1d4371d2247beb Author: Po Lu Date: Mon Jun 10 21:15:45 2024 +0800 ; * src/process.c (read_process_output): Check in missing hunk. diff --git a/src/process.c b/src/process.c index a857e59ae06..df2a0bc1a6e 100644 --- a/src/process.c +++ b/src/process.c @@ -6263,7 +6263,7 @@ read_process_output (Lisp_Object proc, int channel) friends don't expect current-buffer to be changed from under them. */ record_unwind_current_buffer (); - if (read_process_output_fast && EQ (p->filter, Qinternal_default_process_filter)) + if (fast_read_process_output && EQ (p->filter, Qinternal_default_process_filter)) read_and_insert_process_output (p, chars, nbytes, coding); else read_and_dispose_of_process_output (p, chars, nbytes, coding); commit 5df7506a4923bb5b7fa47f62b4af41075b1ba7c5 Author: Po Lu Date: Mon Jun 10 21:12:56 2024 +0800 Rename new variable in process.c * src/process.c (syms_of_process): Rename read_process_output_fast to fast_read_process_output. diff --git a/src/process.c b/src/process.c index 9670be64279..a857e59ae06 100644 --- a/src/process.c +++ b/src/process.c @@ -8879,12 +8879,12 @@ On GNU/Linux systems, the value should not exceed /proc/sys/fs/pipe-max-size. See pipe(7) manpage for details. */); read_process_output_max = 65536; - DEFVAR_BOOL ("read-process-output-fast", read_process_output_fast, + DEFVAR_BOOL ("read-process-output-fast", fast_read_process_output, doc: /* Non-nil to optimize the insertion of process output. We skip calling `internal-default-process-filter' and don't allocate the Lisp string that would be used as its argument. Only affects the case of asynchronous process with the default filter. */); - read_process_output_fast = true; + fast_read_process_output = true; DEFVAR_INT ("process-error-pause-time", process_error_pause_time, doc: /* The number of seconds to pause after handling process errors. commit 9b12854743ad4c9fdd44bd9ce2f9b309e0c674cf Author: Michael Albinus Date: Mon Jun 10 14:37:48 2024 +0200 Refactor tramp-*-make-process functions * lisp/net/tramp.el (tramp-handle-make-process): * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): * lisp/net/tramp-androidsu.el (tramp-androidsu-handle-make-process): * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Use `tramp-skeleton-make-process'. * lisp/net/tramp-container.el (tramp-actions-before-shell): Don't declare. * lisp/net/tramp-sh.el (tramp-actions-before-shell): Add ;;;###tramp-autoload cookie. * lisp/net/tramp.el (tramp-file-local-name): Adapt docstring. (tramp-skeleton-make-process): New defmacro. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 9db313e3ed0..89695793f3b 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -842,187 +842,139 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; terminated. (defun tramp-adb-handle-make-process (&rest args) "Like `make-process' for Tramp files. -If method parameter `tramp-direct-async' and connection property -\"direct-async-process\" are non-nil, an alternative -implementation will be used." +STDERR can also be a remote file name. If method parameter +`tramp-direct-async' and connection-local variable +`tramp-direct-async-process' are non-nil, an alternative implementation +will be used." (if (tramp-direct-async-process-p args) (apply #'tramp-handle-make-process args) - (when args - (with-parsed-tramp-file-name (expand-file-name default-directory) nil - (let ((name (plist-get args :name)) - (buffer (plist-get args :buffer)) - (command (plist-get args :command)) - (coding (plist-get args :coding)) - (noquery (plist-get args :noquery)) - (connection-type - (or (plist-get args :connection-type) process-connection-type)) - (filter (plist-get args :filter)) - (sentinel (plist-get args :sentinel)) - (stderr (plist-get args :stderr))) - (unless (stringp name) - (signal 'wrong-type-argument (list #'stringp name))) - (unless (or (bufferp buffer) (string-or-null-p buffer)) - (signal 'wrong-type-argument (list #'bufferp buffer))) - (unless (consp command) - (signal 'wrong-type-argument (list #'consp command))) - (unless (or (null coding) - (and (symbolp coding) (memq coding coding-system-list)) - (and (consp coding) - (memq (car coding) coding-system-list) - (memq (cdr coding) coding-system-list))) - (signal 'wrong-type-argument (list #'symbolp coding))) - (when (eq connection-type t) - (setq connection-type 'pty)) - (unless (or (and (consp connection-type) - (memq (car connection-type) '(nil pipe pty)) - (memq (cdr connection-type) '(nil pipe pty))) - (memq connection-type '(nil pipe pty))) - (signal 'wrong-type-argument (list #'symbolp connection-type))) - (unless (or (null filter) (eq filter t) (functionp filter)) - (signal 'wrong-type-argument (list #'functionp filter))) - (unless (or (null sentinel) (functionp sentinel)) - (signal 'wrong-type-argument (list #'functionp sentinel))) - (unless (or (bufferp stderr) (string-or-null-p stderr)) - (signal 'wrong-type-argument (list #'bufferp stderr))) - (when (and (stringp stderr) (tramp-tramp-file-p stderr) - (not (tramp-equal-remote default-directory stderr))) - (signal 'file-error (list "Wrong stderr" stderr))) - - (let* ((buffer - (if buffer - (get-buffer-create buffer) - ;; BUFFER can be nil. We use a temporary buffer. - (generate-new-buffer tramp-temp-buffer-name))) - ;; STDERR can also be a file name. - (tmpstderr - (and stderr - (if (and (stringp stderr) (tramp-tramp-file-p stderr)) - (tramp-unquote-file-local-name stderr) - (tramp-make-tramp-temp-file v)))) - (remote-tmpstderr - (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) - (orig-command command) - (program (car command)) - (args (cdr command)) - (command - (format "cd %s && exec %s %s" - (tramp-shell-quote-argument localname) - (if tmpstderr (format "2>'%s'" tmpstderr) "") - (mapconcat #'tramp-shell-quote-argument - (cons program args) " "))) - (tramp-process-connection-type - (or (null program) tramp-process-connection-type)) - (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) - (name1 name) - (i 0) - p) - - (when (string-match-p (rx multibyte) command) - (tramp-error - v 'file-error "Cannot apply multibyte command `%s'" command)) - - (while (get-process name1) - ;; NAME must be unique as process name. - (setq i (1+ i) - name1 (format "%s<%d>" name i))) - (setq name name1) - - (with-tramp-saved-connection-properties - v '("process-name" "process-buffer") - ;; Set the new process properties. - (tramp-set-connection-property v "process-name" name) - (tramp-set-connection-property v "process-buffer" buffer) - (with-current-buffer (tramp-get-connection-buffer v) - (unwind-protect - ;; We catch this event. Otherwise, `make-process' - ;; could be called on the local host. - (save-excursion - (save-restriction - ;; Activate narrowing in order to save BUFFER - ;; contents. Clear also the modification - ;; time; otherwise we might be interrupted by - ;; `verify-visited-file-modtime'. - (let ((buffer-undo-list t) - (inhibit-read-only t) - (coding-system-for-write - (if (symbolp coding) coding (car coding))) - (coding-system-for-read - (if (symbolp coding) coding (cdr coding)))) - (clear-visited-file-modtime) - (narrow-to-region (point-max) (point-max)) - ;; We call `tramp-adb-maybe-open-connection', - ;; in order to cleanup the prompt afterwards. - (tramp-adb-maybe-open-connection v) - (delete-region (point-min) (point-max)) - ;; Send the command. - (setq p (tramp-get-connection-process v)) - (tramp-adb-send-command v command nil t) ; nooutput - ;; Set sentinel and filter. - (when sentinel - (set-process-sentinel p sentinel)) - (when filter - (set-process-filter p filter)) - (process-put p 'remote-command orig-command) - (tramp-set-connection-property - p "remote-command" orig-command) - ;; Set query flag and process marker for - ;; this process. We ignore errors, because - ;; the process could have finished already. - (ignore-errors - (set-process-query-on-exit-flag p (null noquery)) - (set-marker (process-mark p) (point)) - ;; We must flush them here already; - ;; otherwise `rename-file', `delete-file' - ;; or `insert-file-contents' will fail. - (tramp-flush-connection-property v "process-name") - (tramp-flush-connection-property - v "process-buffer") - ;; Copy tmpstderr file. - (when (and (stringp stderr) - (not (tramp-tramp-file-p stderr))) - (add-function - :after (process-sentinel p) - (lambda (_proc _msg) - (rename-file remote-tmpstderr stderr)))) - ;; Read initial output. Remove the first - ;; line, which is the command echo. - (unless (eq filter t) - (while - (progn - (goto-char (point-min)) - (not (search-forward "\n" nil t))) - (tramp-accept-process-output p)) - (delete-region (point-min) (point))) - ;; Provide error buffer. This shows only - ;; initial error messages; messages - ;; arriving later on will be inserted when - ;; the process is deleted. The temporary - ;; file will exist until the process is - ;; deleted. - (when (bufferp stderr) - (ignore-errors - (tramp-taint-remote-process-buffer stderr) - (with-current-buffer stderr - (insert-file-contents-literally - remote-tmpstderr 'visit))) - ;; Delete tmpstderr file. - (add-function - :after (process-sentinel p) - (lambda (_proc _msg) - (ignore-errors - (with-current-buffer stderr - (insert-file-contents-literally - remote-tmpstderr 'visit nil nil 'replace)) - (delete-file remote-tmpstderr))))) - ;; Return process. - p)))) - - ;; Save exit. - (if (string-prefix-p tramp-temp-buffer-name (buffer-name)) + (tramp-skeleton-make-process args nil t + (let* ((program (car command)) + (args (cdr command)) + ;; STDERR can also be a file name. + (tmpstderr + (and stderr + (if (and (stringp stderr) (tramp-tramp-file-p stderr)) + (tramp-unquote-file-local-name stderr) + (tramp-make-tramp-temp-file v)))) + (remote-tmpstderr + (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) + (command + (format "cd %s && exec %s %s" + (tramp-shell-quote-argument localname) + (if tmpstderr (format "2>'%s'" tmpstderr) "") + (mapconcat #'tramp-shell-quote-argument + (cons program args) " "))) + (tramp-process-connection-type + (or (null program) tramp-process-connection-type)) + (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) + (name1 name) + (i 0) + p) + + (when (string-match-p (rx multibyte) command) + (tramp-error + v 'file-error "Cannot apply multibyte command `%s'" command)) + + (while (get-process name1) + ;; NAME must be unique as process name. + (setq i (1+ i) + name1 (format "%s<%d>" name i))) + (setq name name1) + + (with-tramp-saved-connection-properties + v '("process-name" "process-buffer") + ;; Set the new process properties. + (tramp-set-connection-property v "process-name" name) + (tramp-set-connection-property v "process-buffer" buffer) + (with-current-buffer (tramp-get-connection-buffer v) + (unwind-protect + ;; We catch this event. Otherwise, `make-process' + ;; could be called on the local host. + (save-excursion + (save-restriction + ;; Activate narrowing in order to save BUFFER + ;; contents. Clear also the modification time; + ;; otherwise we might be interrupted by + ;; `verify-visited-file-modtime'. + (let ((buffer-undo-list t) + (inhibit-read-only t) + (coding-system-for-write + (if (symbolp coding) coding (car coding))) + (coding-system-for-read + (if (symbolp coding) coding (cdr coding)))) + (clear-visited-file-modtime) + (narrow-to-region (point-max) (point-max)) + ;; We call `tramp-adb-maybe-open-connection', in + ;; order to cleanup the prompt afterwards. + (tramp-adb-maybe-open-connection v) + (delete-region (point-min) (point-max)) + ;; Send the command. + (setq p (tramp-get-connection-process v)) + (tramp-adb-send-command v command nil t) ; nooutput + ;; Set sentinel and filter. + (when sentinel + (set-process-sentinel p sentinel)) + (when filter + (set-process-filter p filter)) + (process-put p 'remote-command orig-command) + (tramp-set-connection-property + p "remote-command" orig-command) + ;; Set query flag and process marker for this + ;; process. We ignore errors, because the + ;; process could have finished already. (ignore-errors - (set-process-buffer p nil) - (kill-buffer (current-buffer))) - (set-buffer-modified-p bmp))))))))))) + (set-process-query-on-exit-flag p (null noquery)) + (set-marker (process-mark p) (point)) + ;; We must flush them here already; + ;; otherwise `rename-file', `delete-file' + ;; or `insert-file-contents' will fail. + (tramp-flush-connection-property v "process-name") + (tramp-flush-connection-property v "process-buffer") + ;; Copy tmpstderr file. + (when (and (stringp stderr) + (not (tramp-tramp-file-p stderr))) + (add-function + :after (process-sentinel p) + (lambda (_proc _msg) + (rename-file remote-tmpstderr stderr)))) + ;; Read initial output. Remove the first + ;; line, which is the command echo. + (unless (eq filter t) + (while (progn + (goto-char (point-min)) + (not (search-forward "\n" nil t))) + (tramp-accept-process-output p)) + (delete-region (point-min) (point))) + ;; Provide error buffer. This shows only + ;; initial error messages; messages arriving + ;; later on will be inserted when the process + ;; is deleted. The temporary file will exist + ;; until the process is deleted. + (when (bufferp stderr) + (ignore-errors + (tramp-taint-remote-process-buffer stderr) + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit))) + ;; Delete tmpstderr file. + (add-function + :after (process-sentinel p) + (lambda (_proc _msg) + (ignore-errors + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit nil nil 'replace)) + (delete-file remote-tmpstderr))))) + ;; Return process. + p)))) + + ;; Save exit. + (if (string-prefix-p tramp-temp-buffer-name (buffer-name)) + (ignore-errors + (set-process-buffer p nil) + (kill-buffer (current-buffer))) + (set-buffer-modified-p bmp))))))))) (defun tramp-adb-handle-exec-path () "Like `exec-path' for Tramp files." diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index b2f0bab650d..dae90202478 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -302,133 +302,84 @@ FUNCTION." (defun tramp-androidsu-handle-make-process (&rest args) "Like `tramp-handle-make-process', but modified for Android." - (when args - (with-parsed-tramp-file-name (expand-file-name default-directory) nil - (let ((default-directory tramp-compat-temporary-file-directory) - (name (plist-get args :name)) - (buffer (plist-get args :buffer)) - (command (plist-get args :command)) - (coding (plist-get args :coding)) - (noquery (plist-get args :noquery)) - (connection-type - (or (plist-get args :connection-type) process-connection-type)) - (filter (plist-get args :filter)) - (sentinel (plist-get args :sentinel)) - (stderr (plist-get args :stderr))) - (unless (stringp name) - (signal 'wrong-type-argument (list #'stringp name))) - (unless (or (bufferp buffer) (string-or-null-p buffer)) - (signal 'wrong-type-argument (list #'bufferp buffer))) - (unless (consp command) - (signal 'wrong-type-argument (list #'consp command))) - (unless (or (null coding) - (and (symbolp coding) (memq coding coding-system-list)) - (and (consp coding) - (memq (car coding) coding-system-list) - (memq (cdr coding) coding-system-list))) - (signal 'wrong-type-argument (list #'symbolp coding))) - (when (eq connection-type t) - (setq connection-type 'pty)) - (unless (or (and (consp connection-type) - (memq (car connection-type) '(nil pipe pty)) - (memq (cdr connection-type) '(nil pipe pty))) - (memq connection-type '(nil pipe pty))) - (signal 'wrong-type-argument (list #'symbolp connection-type))) - (unless (or (null filter) (eq filter t) (functionp filter)) - (signal 'wrong-type-argument (list #'functionp filter))) - (unless (or (null sentinel) (functionp sentinel)) - (signal 'wrong-type-argument (list #'functionp sentinel))) - (unless (or (null stderr) (bufferp stderr)) - (signal 'wrong-type-argument (list #'bufferp stderr))) - (let* ((buffer - (if buffer - (get-buffer-create buffer) - ;; BUFFER can be nil. We use a temporary buffer. - (generate-new-buffer tramp-temp-buffer-name))) - (orig-command command) - (env (mapcar - (lambda (elt) - (when (tramp-compat-string-search "=" elt) elt)) - tramp-remote-process-environment)) - ;; We use as environment the difference to toplevel - ;; `process-environment'. - (env (dolist (elt process-environment env) - (when - (and - (tramp-compat-string-search "=" elt) - (not - (member - elt (default-toplevel-value 'process-environment)))) - (setq env (cons elt env))))) - ;; Add remote path if exists. - (env (let ((remote-path - (string-join (tramp-get-remote-path v) ":"))) - (setenv-internal env "PATH" remote-path 'keep))) - (env (setenv-internal - env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) - (env (mapcar #'tramp-shell-quote-argument (delq nil env))) - ;; Quote command. - (command (mapconcat #'tramp-shell-quote-argument command " ")) - ;; Set cwd and environment variables. - (command - (append - `("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env") - env `(,command ")"))) - ;; Add remote shell if needed. - (command - (if (consp (tramp-get-method-parameter v 'tramp-direct-async)) - (append - (tramp-get-method-parameter v 'tramp-direct-async) - `(,(string-join command " "))) - command)) - p) - ;; Generate a command to start the process using `su' with - ;; suitable options for specifying the mount namespace and - ;; suchlike. - ;; Suppress `internal-default-process-sentinel', which is - ;; set when :sentinel is nil. (Bug#71049) - (setq - p (let ((android-use-exec-loader nil)) - (make-process - :name name - :buffer buffer - :command - (if (equal user "root") - ;; Invoke su in the simplest manner possible, that - ;; is to say, without specifying the user, which - ;; certain implementations cannot parse when a - ;; command is also present, if it may be omitted, so - ;; that starting inferior shells on systems with - ;; such implementations does not needlessly fail. - (if (tramp-get-connection-property v "remote-namespace") - (append (list "su" "-mm" "-c") command) - (append (list "su" "-c") command)) - (if (tramp-get-connection-property v "remote-namespace") - (append (list "su" "-mm" "-" user "-c") command) - (append (list "su" "-" user "-c") command))) - :coding coding - :noquery noquery - :connection-type connection-type - :sentinel (or sentinel #'ignore) - :stderr stderr))) - ;; Set filter. Prior Emacs 29.1, it doesn't work reliably - ;; to provide it as `make-process' argument when filter is - ;; t. See Bug#51177. - (when filter - (set-process-filter p filter)) - (tramp-post-process-creation p v) - ;; Query flag is overwritten in `tramp-post-process-creation', - ;; so we reset it. - (set-process-query-on-exit-flag p (null noquery)) - ;; This is needed for ssh or PuTTY based processes, and - ;; only if the respective options are set. Perhaps, the - ;; setting could be more fine-grained. - ;; (process-put p 'tramp-shared-socket t) - (process-put p 'remote-command orig-command) - (tramp-set-connection-property p "remote-command" orig-command) - (when (bufferp stderr) - (tramp-taint-remote-process-buffer stderr)) - p))))) + (tramp-skeleton-make-process args nil nil + (let* ((env (mapcar + (lambda (elt) + (when (tramp-compat-string-search "=" elt) elt)) + tramp-remote-process-environment)) + ;; We use as environment the difference to toplevel + ;; `process-environment'. + (env (dolist (elt process-environment env) + (when + (and + (tramp-compat-string-search "=" elt) + (not + (member + elt (default-toplevel-value 'process-environment)))) + (setq env (cons elt env))))) + ;; Add remote path if exists. + (env (let ((remote-path (string-join (tramp-get-remote-path v) ":"))) + (setenv-internal env "PATH" remote-path 'keep))) + (env (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) + (env (mapcar #'tramp-shell-quote-argument (delq nil env))) + ;; Quote command. + (command (mapconcat #'tramp-shell-quote-argument command " ")) + ;; Set cwd and environment variables. + (command + (append + `("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env") + env `(,command ")"))) + ;; Add remote shell if needed. + (command + (if (consp (tramp-get-method-parameter v 'tramp-direct-async)) + (append + (tramp-get-method-parameter v 'tramp-direct-async) + `(,(string-join command " "))) + command)) + p) + ;; Generate a command to start the process using `su' with + ;; suitable options for specifying the mount namespace and + ;; suchlike. + ;; Suppress `internal-default-process-sentinel', which is set + ;; when :sentinel is nil. (Bug#71049) + (setq + p (let ((android-use-exec-loader nil)) + (make-process + :name name + :buffer buffer + :command + (if (equal user "root") + ;; Invoke su in the simplest manner possible, that + ;; is to say, without specifying the user, which + ;; certain implementations cannot parse when a + ;; command is also present, if it may be omitted, so + ;; that starting inferior shells on systems with + ;; such implementations does not needlessly fail. + (if (tramp-get-connection-property v "remote-namespace") + (append (list "su" "-mm" "-c") command) + (append (list "su" "-c") command)) + (if (tramp-get-connection-property v "remote-namespace") + (append (list "su" "-mm" "-" user "-c") command) + (append (list "su" "-" user "-c") command))) + :coding coding + :noquery noquery + :connection-type connection-type + :sentinel (or sentinel #'ignore) + :stderr stderr))) + ;; Set filter. Prior Emacs 29.1, it doesn't work reliably to + ;; provide it as `make-process' argument when filter is t. See + ;; Bug#51177. + (when filter + (set-process-filter p filter)) + (tramp-post-process-creation p v) + ;; Query flag is overwritten in `tramp-post-process-creation', + ;; so we reset it. + (set-process-query-on-exit-flag p (null noquery)) + (process-put p 'remote-command orig-command) + (tramp-set-connection-property p "remote-command" orig-command) + (when (bufferp stderr) + (tramp-taint-remote-process-buffer stderr)) + p))) (defalias 'tramp-androidsu-handle-make-symbolic-link #'tramp-sh-handle-make-symbolic-link) diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index f29d55d78d9..02512e64ef6 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -118,7 +118,6 @@ ;;; Code: (require 'tramp) -(defvar tramp-actions-before-shell) ;;;###tramp-autoload (defcustom tramp-docker-program "docker" diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 106149f5dce..b72a2382ed5 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -591,6 +591,7 @@ shell from reading its init file." :version "30.1" :type '(alist :key-type regexp :value-type string)) +;;;###tramp-autoload (defconst tramp-actions-before-shell '((tramp-login-prompt-regexp tramp-action-login) (tramp-password-prompt-regexp tramp-action-password) @@ -2580,9 +2581,9 @@ The method used must be an out-of-band method." (tramp-get-connection-name v) (tramp-get-connection-buffer v) copy-program copy-args))) - ;; This is needed for ssh or PuTTY based processes, and - ;; only if the respective options are set. Perhaps, - ;; the setting could be more fine-grained. + ;; This is needed for ssh or PuTTY based processes, + ;; and only if the respective options are set. + ;; Perhaps, the setting could be more fine-grained. ;; (process-put p 'tramp-shared-socket t) (tramp-post-process-creation p v) @@ -2963,280 +2964,226 @@ This is used in `make-process' with `connection-type' `pipe'." (defun tramp-sh-handle-make-process (&rest args) "Like `make-process' for Tramp files. STDERR can also be a remote file name. If method parameter -`tramp-direct-async' and connection property -\"direct-async-process\" are non-nil, an alternative -implementation will be used." +`tramp-direct-async' and connection-local variable +`tramp-direct-async-process' are non-nil, an alternative implementation +will be used." (if (tramp-direct-async-process-p args) (apply #'tramp-handle-make-process args) - (when args - (with-parsed-tramp-file-name (expand-file-name default-directory) nil - (let ((name (plist-get args :name)) - (buffer (plist-get args :buffer)) - (command (plist-get args :command)) - (coding (plist-get args :coding)) - (noquery (plist-get args :noquery)) - (connection-type - (or (plist-get args :connection-type) process-connection-type)) - (filter (plist-get args :filter)) - (sentinel (plist-get args :sentinel)) - (stderr (plist-get args :stderr))) - (unless (stringp name) - (signal 'wrong-type-argument (list #'stringp name))) - (unless (or (bufferp buffer) (string-or-null-p buffer)) - (signal 'wrong-type-argument (list #'bufferp buffer))) - (unless (or (null command) (consp command)) - (signal 'wrong-type-argument (list #'consp command))) - (unless (or (null coding) - (and (symbolp coding) (memq coding coding-system-list)) - (and (consp coding) - (memq (car coding) coding-system-list) - (memq (cdr coding) coding-system-list))) - (signal 'wrong-type-argument (list #'symbolp coding))) - (when (eq connection-type t) - (setq connection-type 'pty)) - (unless (or (and (consp connection-type) - (memq (car connection-type) '(nil pipe pty)) - (memq (cdr connection-type) '(nil pipe pty))) - (memq connection-type '(nil pipe pty))) - (signal 'wrong-type-argument (list #'symbolp connection-type))) - (unless (or (null filter) (eq filter t) (functionp filter)) - (signal 'wrong-type-argument (list #'functionp filter))) - (unless (or (null sentinel) (functionp sentinel)) - (signal 'wrong-type-argument (list #'functionp sentinel))) - (unless (or (bufferp stderr) (string-or-null-p stderr)) - (signal 'wrong-type-argument (list #'bufferp stderr))) - (when (and (stringp stderr) - (not (tramp-equal-remote default-directory stderr))) - (signal 'file-error (list "Wrong stderr" stderr))) - - (let* ((buffer - (if buffer - (get-buffer-create buffer) - ;; BUFFER can be nil. We use a temporary buffer. - (generate-new-buffer tramp-temp-buffer-name))) - ;; STDERR can also be a file name. - (tmpstderr - (and stderr - (tramp-unquote-file-local-name - (if (stringp stderr) - stderr (tramp-make-tramp-temp-name v))))) - (remote-tmpstderr - (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) - (orig-command command) - (program (car command)) - (args (cdr command)) - ;; When PROGRAM matches "*sh", and the first arg is - ;; "-c", it might be that the arguments exceed the - ;; command line length. Therefore, we modify the - ;; command. - (heredoc (and (not (bufferp stderr)) - (stringp program) - (string-match-p (rx "sh" eol) program) - (tramp-compat-length= args 2) - (string-equal "-c" (car args)) - ;; Don't if there is a quoted string. - (not - (string-match-p (rx (any "'\"")) (cadr args))) - ;; Check, that /dev/tty is usable. - (tramp-get-remote-dev-tty v))) - ;; When PROGRAM is nil, we just provide a tty. - (args (if (not heredoc) args - (let ((i 250)) - (while (and (not (tramp-compat-length< (cadr args) i)) - (string-match " " (cadr args) i)) - (setcdr - args - (list - (replace-match " \\\\\n" nil nil (cadr args)))) - (setq i (+ i 250)))) - (cdr args))) - ;; Use a human-friendly prompt, for example for - ;; `shell'. We discard hops, if existing, that's why - ;; we cannot use `file-remote-p'. - (prompt (format "PS1=%s %s" - (tramp-make-tramp-file-name v) - tramp-initial-end-of-output)) - ;; We use as environment the difference to toplevel - ;; `process-environment'. - env uenv - (env (dolist (elt (cons prompt process-environment) env) - (or (member - elt (default-toplevel-value 'process-environment)) - (if (tramp-compat-string-search "=" elt) - (setq env (append env `(,elt))) - (setq uenv (cons elt uenv)))))) - (env (setenv-internal - env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) - (command - (when (stringp program) - (format "cd %s && %s exec %s %s env %s %s" - (tramp-shell-quote-argument localname) - (if uenv - (format - "unset %s &&" - (mapconcat - #'tramp-shell-quote-argument uenv " ")) - "") - (if heredoc - (format "<<'%s'" tramp-end-of-heredoc) "") - (if tmpstderr (format "2>'%s'" tmpstderr) "") - (mapconcat #'tramp-shell-quote-argument env " ") - (if heredoc - (format "%s\n(\n%s\n) " name i))) - (setq name name1) - - (with-tramp-saved-connection-properties - v '("process-name" "process-buffer") - ;; Set the new process properties. - (tramp-set-connection-property v "process-name" name) - (tramp-set-connection-property v "process-buffer" buffer) - (with-current-buffer (tramp-get-connection-buffer v) - (unwind-protect - ;; We catch this event. Otherwise, `make-process' - ;; could be called on the local host. - (save-excursion - (save-restriction - ;; Activate narrowing in order to save BUFFER - ;; contents. Clear also the modification - ;; time; otherwise we might be interrupted by - ;; `verify-visited-file-modtime'. - (let ((buffer-undo-list t) - (inhibit-read-only t) - (mark (point-max)) - (coding-system-for-write - (if (symbolp coding) coding (car coding))) - (coding-system-for-read - (if (symbolp coding) coding (cdr coding)))) - (clear-visited-file-modtime) - (narrow-to-region (point-max) (point-max)) - (catch 'suppress - ;; 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)) - (when (memq connection-type '(nil pipe)) - ;; Disable carriage return to newline - ;; translation. This does not work on - ;; macOS, see Bug#50748. - ;; We must also disable buffering, - ;; otherwise strings larger than 4096 - ;; bytes, sent by the process, could - ;; block, see termios(3) and Bug#61341. - ;; In order to prevent blocking read - ;; from pipe processes, "stty -icanon" - ;; is used. By default, it expects at - ;; least one character to read. When a - ;; process does not read from stdin, - ;; like magit, it should set a timeout - ;; instead. See`tramp-pipe-stty-settings'. - ;; (Bug#62093) - ;; FIXME: Shall we rather use "stty raw"? - (tramp-send-command - v (format - "stty %s %s" - (if (tramp-check-remote-uname v "Darwin") - "" "-icrnl") - tramp-pipe-stty-settings))) - ;; `tramp-maybe-open-connection' and - ;; `tramp-send-command-and-read' could - ;; have trashed the connection buffer. - ;; Remove this. - (widen) - (delete-region mark (point-max)) - (narrow-to-region (point-max) (point-max)) - ;; Now do it. - (if command - ;; Send the command. - (tramp-send-command v command nil t) ; nooutput - ;; Check, whether a pty is associated. - (unless (process-get p 'remote-tty) - (tramp-error - v 'file-error - "pty association is not supported for `%s'" - name)))) - ;; Set sentinel and filter. - (when sentinel - (set-process-sentinel p sentinel)) - (when filter - (set-process-filter p filter)) - (process-put p 'remote-command orig-command) - (tramp-set-connection-property - p "remote-command" orig-command) - ;; Set query flag and process marker for - ;; this process. We ignore errors, because - ;; the process could have finished already. - (ignore-errors - (set-process-query-on-exit-flag p (null noquery)) - (set-marker (process-mark p) (point))) - ;; We must flush them here already; - ;; otherwise `delete-file' will fail. - (tramp-flush-connection-property v "process-name") - (tramp-flush-connection-property v "process-buffer") - ;; Kill stderr process and delete named pipe. - (when (bufferp stderr) - (add-function - :after (process-sentinel p) - (lambda (_proc _msg) - (ignore-errors - (while (accept-process-output - (get-buffer-process stderr) 0 nil t)) - (delete-process (get-buffer-process stderr))) - (ignore-errors - (delete-file remote-tmpstderr))))) - ;; Return process. - p))) - - ;; Save exit. - (if (string-prefix-p tramp-temp-buffer-name (buffer-name)) + (tramp-skeleton-make-process args t t + (let* ((program (car command)) + (args (cdr command)) + ;; STDERR can also be a file name. + (tmpstderr + (and stderr + (tramp-unquote-file-local-name + (if (stringp stderr) + stderr (tramp-make-tramp-temp-name v))))) + (remote-tmpstderr + (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) + ;; When PROGRAM matches "*sh", and the first arg is "-c", + ;; it might be that the arguments exceed the command line + ;; length. Therefore, we modify the command. + (heredoc (and (not (bufferp stderr)) + (stringp program) + (string-match-p (rx "sh" eol) program) + (tramp-compat-length= args 2) + (string-equal "-c" (car args)) + ;; Don't if there is a quoted string. + (not (string-match-p (rx (any "'\"")) (cadr args))) + ;; Check, that /dev/tty is usable. + (tramp-get-remote-dev-tty v))) + ;; When PROGRAM is nil, we just provide a tty. + (args (if (not heredoc) args + (let ((i 250)) + (while (and (not (tramp-compat-length< (cadr args) i)) + (string-match " " (cadr args) i)) + (setcdr + args + (list (replace-match " \\\\\n" nil nil (cadr args)))) + (setq i (+ i 250)))) + (cdr args))) + ;; Use a human-friendly prompt, for example for `shell'. + ;; We discard hops, if existing, that's why we cannot use + ;; `file-remote-p'. + (prompt (format "PS1=%s %s" + (tramp-make-tramp-file-name v) + tramp-initial-end-of-output)) + ;; We use as environment the difference to toplevel + ;; `process-environment'. + env uenv + (env (dolist (elt (cons prompt process-environment) env) + (or (member + elt (default-toplevel-value 'process-environment)) + (if (tramp-compat-string-search "=" elt) + (setq env (append env `(,elt))) + (setq uenv (cons elt uenv)))))) + (env (setenv-internal + env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) + (command + (when (stringp program) + (format "cd %s && %s exec %s %s env %s %s" + (tramp-shell-quote-argument localname) + (if uenv + (format + "unset %s &&" + (mapconcat + #'tramp-shell-quote-argument uenv " ")) + "") + (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "") + (if tmpstderr (format "2>'%s'" tmpstderr) "") + (mapconcat #'tramp-shell-quote-argument env " ") + (if heredoc + (format "%s\n(\n%s\n) " name i))) + (setq name name1) + + (with-tramp-saved-connection-properties + v '("process-name" "process-buffer") + ;; Set the new process properties. + (tramp-set-connection-property v "process-name" name) + (tramp-set-connection-property v "process-buffer" buffer) + (with-current-buffer (tramp-get-connection-buffer v) + (unwind-protect + ;; We catch this event. Otherwise, `make-process' + ;; could be called on the local host. + (save-excursion + (save-restriction + ;; Activate narrowing in order to save BUFFER + ;; contents. Clear also the modification time; + ;; otherwise we might be interrupted by + ;; `verify-visited-file-modtime'. + (let ((buffer-undo-list t) + (inhibit-read-only t) + (mark (point-max)) + (coding-system-for-write + (if (symbolp coding) coding (car coding))) + (coding-system-for-read + (if (symbolp coding) coding (cdr coding)))) + (clear-visited-file-modtime) + (narrow-to-region (point-max) (point-max)) + (catch 'suppress + ;; 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)) + (when (memq connection-type '(nil pipe)) + ;; Disable carriage return to newline + ;; translation. This does not work on + ;; macOS, see Bug#50748. + ;; We must also disable buffering, otherwise + ;; strings larger than 4096 bytes, sent by + ;; the process, could block, see termios(3) + ;; and Bug#61341. + ;; In order to prevent blocking read from + ;; pipe processes, "stty -icanon" is used. + ;; By default, it expects at least one + ;; character to read. When a process does + ;; not read from stdin, like magit, it + ;; should set a timeout + ;; instead. See`tramp-pipe-stty-settings'. + ;; (Bug#62093) + ;; FIXME: Shall we rather use "stty raw"? + (tramp-send-command + v (format + "stty %s %s" + (if (tramp-check-remote-uname v "Darwin") + "" "-icrnl") + tramp-pipe-stty-settings))) + ;; `tramp-maybe-open-connection' and + ;; `tramp-send-command-and-read' could have + ;; trashed the connection buffer. Remove + ;; this. + (widen) + (delete-region mark (point-max)) + (narrow-to-region (point-max) (point-max)) + ;; Now do it. + (if command + ;; Send the command. + (tramp-send-command v command nil t) ; nooutput + ;; Check, whether a pty is associated. + (unless (process-get p 'remote-tty) + (tramp-error + v 'file-error + "pty association is not supported for `%s'" name)))) + ;; Set sentinel and filter. + (when sentinel + (set-process-sentinel p sentinel)) + (when filter + (set-process-filter p filter)) + (process-put p 'remote-command orig-command) + (tramp-set-connection-property + p "remote-command" orig-command) + ;; Set query flag and process marker for this + ;; process. We ignore errors, because the + ;; process could have finished already. (ignore-errors - (set-process-buffer p nil) - (kill-buffer (current-buffer))) - (set-buffer-modified-p bmp))))))))))) + (set-process-query-on-exit-flag p (null noquery)) + (set-marker (process-mark p) (point))) + ;; We must flush them here already; otherwise + ;; `delete-file' will fail. + (tramp-flush-connection-property v "process-name") + (tramp-flush-connection-property v "process-buffer") + ;; Kill stderr process and delete named pipe. + (when (bufferp stderr) + (add-function + :after (process-sentinel p) + (lambda (_proc _msg) + (ignore-errors + (while (accept-process-output + (get-buffer-process stderr) 0 nil t)) + (delete-process (get-buffer-process stderr))) + (ignore-errors + (delete-file remote-tmpstderr))))) + ;; Return process. + p))) + + ;; Save exit. + (if (string-prefix-p tramp-temp-buffer-name (buffer-name)) + (ignore-errors + (set-process-buffer p nil) + (kill-buffer (current-buffer))) + (set-buffer-modified-p bmp))))))))) (defun tramp-sh-get-signal-strings (vec) "Strings to return by `process-file' in case of signals." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 5c90f3680c1..b8a3c3fd557 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1635,12 +1635,12 @@ entry does not exist, return DEFAULT." ;;;###tramp-autoload (defun tramp-file-local-name (name) "Return the local name component of NAME. -This function removes from NAME the specification of the remote -host and the method of accessing the host, leaving only the part -that identifies NAME locally on the remote system. If NAME does -not match `tramp-file-name-regexp', just `file-local-name' is -called. The returned file name can be used directly as argument -of `process-file', `start-file-process', or `shell-command'." +This function removes from NAME the specification of the remote host and +the method of accessing the host, leaving only the part that identifies +NAME locally on the remote system. If NAME does not match +`tramp-file-name-regexp', just `file-local-name' is called. The +returned file name can be used directly as argument of `make-process', +`process-file', `start-file-process', or `shell-command'." (or (and (tramp-tramp-file-p name) (string-match (nth 0 tramp-file-name-structure) name) (match-string (nth 4 tramp-file-name-structure) name)) @@ -2688,8 +2688,8 @@ not in completion mode." (let ((tramp-verbose 0) (vec (tramp-ensure-dissected-file-name vec-or-filename))) (or ;; We check this for the process related to - ;; `tramp-buffer-name'; otherwise `start-file-process' - ;; wouldn't run ever when `non-essential' is non-nil. + ;; `tramp-buffer-name'; otherwise `make-process' wouldn't run + ;; ever when `non-essential' is non-nil. (process-live-p (tramp-get-process vec)) (not non-essential)))) @@ -3520,6 +3520,63 @@ BODY is the backend specific code." ,@body nil)))) +(defmacro tramp-skeleton-make-process (args null-command stderr-file &rest body) + "Skeleton for `tramp-*-handle-make-process'. +NULL-COMMAND indicates a possible empty command. STDERR-FILE means, +that a stederr file is supported. BODY is the backend specific code." + (declare (indent 3) (debug t)) + `(when ,args + (with-parsed-tramp-file-name (expand-file-name default-directory) nil + (let ((name (plist-get ,args :name)) + (buffer (plist-get ,args :buffer)) + (command (plist-get ,args :command)) + (coding (plist-get ,args :coding)) + (noquery (plist-get ,args :noquery)) + (connection-type + (or (plist-get ,args :connection-type) process-connection-type)) + (filter (plist-get ,args :filter)) + (sentinel (plist-get ,args :sentinel)) + (stderr (plist-get ,args :stderr))) + (unless (stringp name) + (signal 'wrong-type-argument (list #'stringp name))) + (unless (or (bufferp buffer) (string-or-null-p buffer)) + (signal 'wrong-type-argument (list #'bufferp buffer))) + (unless (or (consp command) (and ,null-command (null command))) + (signal 'wrong-type-argument (list #'consp command))) + (unless (or (null coding) + (and (symbolp coding) (memq coding coding-system-list)) + (and (consp coding) + (memq (car coding) coding-system-list) + (memq (cdr coding) coding-system-list))) + (signal 'wrong-type-argument (list #'symbolp coding))) + (when (eq connection-type t) + (setq connection-type 'pty)) + (unless (or (and (consp connection-type) + (memq (car connection-type) '(nil pipe pty)) + (memq (cdr connection-type) '(nil pipe pty))) + (memq connection-type '(nil pipe pty))) + (signal 'wrong-type-argument (list #'symbolp connection-type))) + (unless (or (null filter) (eq filter t) (functionp filter)) + (signal 'wrong-type-argument (list #'functionp filter))) + (unless (or (null sentinel) (functionp sentinel)) + (signal 'wrong-type-argument (list #'functionp sentinel))) + (unless (or (null stderr) (bufferp stderr) + (and ,stderr-file (stringp stderr))) + (signal 'wrong-type-argument (list #'bufferp stderr))) + (when (and (stringp stderr) + (not (tramp-equal-remote default-directory stderr))) + (signal 'file-error (list "Wrong stderr" stderr))) + + (let ((default-directory tramp-compat-temporary-file-directory) + (buffer + (if buffer + (get-buffer-create buffer) + ;; BUFFER can be nil. We use a temporary buffer. + (generate-new-buffer tramp-temp-buffer-name))) + (orig-command command)) + + ,@body))))) + (defmacro tramp-skeleton-make-symbolic-link (target linkname &optional ok-if-already-exists &rest body) "Skeleton for `tramp-*-handle-make-symbolic-link'. @@ -4893,177 +4950,131 @@ should be set connection-local.") (defun tramp-handle-make-process (&rest args) "An alternative `make-process' implementation for Tramp files." - (when args - (with-parsed-tramp-file-name (expand-file-name default-directory) nil - (let ((default-directory tramp-compat-temporary-file-directory) - (name (plist-get args :name)) - (buffer (plist-get args :buffer)) - (command (plist-get args :command)) - (coding (plist-get args :coding)) - (noquery (plist-get args :noquery)) - (connection-type - (or (plist-get args :connection-type) process-connection-type)) - (filter (plist-get args :filter)) - (sentinel (plist-get args :sentinel)) - (stderr (plist-get args :stderr))) - (unless (stringp name) - (signal 'wrong-type-argument (list #'stringp name))) - (unless (or (bufferp buffer) (string-or-null-p buffer)) - (signal 'wrong-type-argument (list #'bufferp buffer))) - (unless (consp command) - (signal 'wrong-type-argument (list #'consp command))) - (unless (or (null coding) - (and (symbolp coding) (memq coding coding-system-list)) - (and (consp coding) - (memq (car coding) coding-system-list) - (memq (cdr coding) coding-system-list))) - (signal 'wrong-type-argument (list #'symbolp coding))) - (when (eq connection-type t) - (setq connection-type 'pty)) - (unless (or (and (consp connection-type) - (memq (car connection-type) '(nil pipe pty)) - (memq (cdr connection-type) '(nil pipe pty))) - (memq connection-type '(nil pipe pty))) - (signal 'wrong-type-argument (list #'symbolp connection-type))) - (unless (or (null filter) (eq filter t) (functionp filter)) - (signal 'wrong-type-argument (list #'functionp filter))) - (unless (or (null sentinel) (functionp sentinel)) - (signal 'wrong-type-argument (list #'functionp sentinel))) - (unless (or (null stderr) (bufferp stderr)) - (signal 'wrong-type-argument (list #'bufferp stderr))) - - ;; Check for `tramp-sh-file-name-handler', because something - ;; is different between tramp-sh.el, and tramp-adb.el or - ;; tramp-sshfs.el. - (let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v)) - (adb-file-name-handler-p (tramp-adb-file-name-p v)) - (buffer - (if buffer - (get-buffer-create buffer) - ;; BUFFER can be nil. We use a temporary buffer. - (generate-new-buffer tramp-temp-buffer-name))) - (orig-command command) - (env (mapcar - (lambda (elt) - (when (tramp-compat-string-search "=" elt) elt)) - tramp-remote-process-environment)) - ;; We use as environment the difference to toplevel - ;; `process-environment'. - (env (dolist (elt process-environment env) - (when - (and - (tramp-compat-string-search "=" elt) - (not - (member - elt (default-toplevel-value 'process-environment)))) - (setq env (cons elt env))))) - ;; Add remote path if exists. - (env (if-let ((sh-file-name-handler-p) - (remote-path - (string-join (tramp-get-remote-path v) ":"))) - (setenv-internal env "PATH" remote-path 'keep) - env)) - ;; Add HISTFILE if indicated. - (env (if-let ((sh-file-name-handler-p)) - (cond - ((stringp tramp-histfile-override) - (setenv-internal env "HISTFILE" tramp-histfile-override 'keep)) - (tramp-histfile-override - (setq env (setenv-internal env "HISTFILE" "''" 'keep)) - (setq env (setenv-internal env "HISTSIZE" "0" 'keep)) - (setenv-internal env "HISTFILESIZE" "0" 'keep)) - (t env)) - env)) - ;; Add INSIDE_EMACS. - (env (setenv-internal - env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) - (env (mapcar #'tramp-shell-quote-argument (delq nil env))) - ;; Quote command. - (command (mapconcat #'tramp-shell-quote-argument command " ")) - ;; Set cwd and environment variables. - (command - (append - `("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env") - env `(,command ")"))) - ;; Add remote shell if needed. - (command - (if (consp (tramp-get-method-parameter v 'tramp-direct-async)) - (append - (tramp-get-method-parameter v 'tramp-direct-async) - `(,(string-join command " "))) - command)) - (login-program - (tramp-get-method-parameter v 'tramp-login-program)) - ;; We don't create the temporary file. In fact, it is - ;; just a prefix for the ControlPath option of ssh; the - ;; real temporary file has another name, and it is - ;; created and protected by ssh. It is also removed by - ;; ssh when the connection is closed. The temporary - ;; file name is cached in the main connection process, - ;; therefore we cannot use - ;; `tramp-get-connection-process'. - (tmpfile - (when sh-file-name-handler-p - (with-tramp-connection-property - (tramp-get-process v) "temp-file" - (tramp-compat-make-temp-name)))) - (options - (when sh-file-name-handler-p - (tramp-compat-funcall - 'tramp-ssh-controlmaster-options v))) - (device - (when adb-file-name-handler-p - (tramp-compat-funcall - 'tramp-adb-get-device v))) - (pta (unless (eq connection-type 'pipe) "-t")) - login-args p) - - ;; Command could be too long, for example due to a longish PATH. - (when (and sh-file-name-handler-p - (tramp-compat-length> - (string-join command) (tramp-get-remote-pipe-buf v))) - (signal 'error (cons "Command too long:" command))) - - (setq - ;; Replace `login-args' place holders. Split ControlMaster - ;; options. - login-args - (append - (flatten-tree (tramp-get-method-parameter v 'tramp-async-args)) - (flatten-tree - (mapcar - (lambda (x) (split-string x " ")) - (tramp-expand-args - v 'tramp-login-args nil - ?h (or host "") ?u (or user "") ?p (or port "") - ?c (format-spec (or options "") (format-spec-make ?t tmpfile)) - ?d (or device "") ?a (or pta "") ?l "")))) - ;; Suppress `internal-default-process-sentinel', which is - ;; set when :sentinel is nil. (Bug#71049) - p (make-process - :name name :buffer buffer - :command (append `(,login-program) login-args command) - :coding coding :noquery noquery :connection-type connection-type - :sentinel (or sentinel #'ignore) :stderr stderr)) - ;; Set filter. Prior Emacs 29.1, it doesn't work reliably - ;; to provide it as `make-process' argument when filter is - ;; t. See Bug#51177. - (when filter - (set-process-filter p filter)) - (tramp-post-process-creation p v) - ;; Query flag is overwritten in `tramp-post-process-creation', - ;; so we reset it. - (set-process-query-on-exit-flag p (null noquery)) - ;; This is needed for ssh or PuTTY based processes, and - ;; only if the respective options are set. Perhaps, the - ;; setting could be more fine-grained. - ;; (process-put p 'tramp-shared-socket t) - (process-put p 'remote-command orig-command) - (tramp-set-connection-property p "remote-command" orig-command) - (when (bufferp stderr) - (tramp-taint-remote-process-buffer stderr)) - - p))))) + (tramp-skeleton-make-process args nil nil + ;; Check for `tramp-sh-file-name-handler' and + ;; `adb-file-name-handler-p', because something is different + ;; between tramp-sh.el, and tramp-adb.el or tramp-sshfs.el. + (let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v)) + (adb-file-name-handler-p (tramp-adb-file-name-p v)) + (env (mapcar + (lambda (elt) + (when (tramp-compat-string-search "=" elt) elt)) + tramp-remote-process-environment)) + ;; We use as environment the difference to toplevel + ;; `process-environment'. + (env (dolist (elt process-environment env) + (when (and + (tramp-compat-string-search "=" elt) + (not + (member + elt (default-toplevel-value 'process-environment)))) + (setq env (cons elt env))))) + ;; Add remote path if exists. + (env (if-let ((sh-file-name-handler-p) + (remote-path + (string-join (tramp-get-remote-path v) ":"))) + (setenv-internal env "PATH" remote-path 'keep) + env)) + ;; Add HISTFILE if indicated. + (env (if-let ((sh-file-name-handler-p)) + (cond + ((stringp tramp-histfile-override) + (setenv-internal + env "HISTFILE" tramp-histfile-override 'keep)) + (tramp-histfile-override + (setq env (setenv-internal env "HISTFILE" "''" 'keep)) + (setq env (setenv-internal env "HISTSIZE" "0" 'keep)) + (setenv-internal env "HISTFILESIZE" "0" 'keep)) + (t env)) + env)) + ;; Add INSIDE_EMACS. + (env (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) + (env (mapcar #'tramp-shell-quote-argument (delq nil env))) + ;; Quote command. + (command (mapconcat #'tramp-shell-quote-argument command " ")) + ;; Set cwd and environment variables. + (command + (append + `("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env") + env `(,command ")"))) + ;; Add remote shell if needed. + (command + (if (consp (tramp-get-method-parameter v 'tramp-direct-async)) + (append + (tramp-get-method-parameter v 'tramp-direct-async) + `(,(string-join command " "))) + command)) + (login-program + (tramp-get-method-parameter v 'tramp-login-program)) + ;; We don't create the temporary file. In fact, it is just + ;; a prefix for the ControlPath option of ssh; the real + ;; temporary file has another name, and it is created and + ;; protected by ssh. It is also removed by ssh when the + ;; connection is closed. The temporary file name is cached + ;; in the main connection process, therefore we cannot use + ;; `tramp-get-connection-process'. + (tmpfile + (when sh-file-name-handler-p + (with-tramp-connection-property + (tramp-get-process v) "temp-file" + (tramp-compat-make-temp-name)))) + (options + (when sh-file-name-handler-p + (tramp-compat-funcall + 'tramp-ssh-controlmaster-options v))) + (device + (when adb-file-name-handler-p + (tramp-compat-funcall + 'tramp-adb-get-device v))) + (pta (unless (eq connection-type 'pipe) "-t")) + login-args p) + + ;; Command could be too long, for example due to a longish PATH. + (when (and sh-file-name-handler-p + (tramp-compat-length> + (string-join command) (tramp-get-remote-pipe-buf v))) + (signal 'error (cons "Command too long:" command))) + + (setq + ;; Replace `login-args' place holders. Split ControlMaster + ;; options. + login-args + (append + (flatten-tree (tramp-get-method-parameter v 'tramp-async-args)) + (flatten-tree + (mapcar + (lambda (x) (split-string x " ")) + (tramp-expand-args + v 'tramp-login-args nil + ?h (or host "") ?u (or user "") ?p (or port "") + ?c (format-spec (or options "") (format-spec-make ?t tmpfile)) + ?d (or device "") ?a (or pta "") ?l "")))) + ;; Suppress `internal-default-process-sentinel', which is set + ;; when :sentinel is nil. (Bug#71049) + p (make-process + :name name :buffer buffer + :command (append `(,login-program) login-args command) + :coding coding :noquery noquery :connection-type connection-type + :sentinel (or sentinel #'ignore) :stderr stderr)) + ;; Set filter. Prior Emacs 29.1, it doesn't work reliably to + ;; provide it as `make-process' argument when filter is t. See + ;; Bug#51177. + (when filter + (set-process-filter p filter)) + (tramp-post-process-creation p v) + ;; Query flag is overwritten in `tramp-post-process-creation', + ;; so we reset it. + (set-process-query-on-exit-flag p (null noquery)) + ;; This is needed for ssh or PuTTY based processes, and only if + ;; the respective options are set. Perhaps, the setting could + ;; be more fine-grained. + ;; (process-put p 'tramp-shared-socket t) + (process-put p 'remote-command orig-command) + (tramp-set-connection-property p "remote-command" orig-command) + (when (bufferp stderr) + (tramp-taint-remote-process-buffer stderr)) + + p))) (defun tramp-handle-make-symbolic-link (_target linkname &optional _ok-if-already-exists) commit 087b842eedbaff3990cb6f80786934f4c5220d63 Author: Mattias Engdegård Date: Mon Jun 10 14:03:48 2024 +0200 cperl-mode: fix doc string escaping * lisp/progmodes/cperl-mode.el (cperl--extra-paired-delimiters): Fix broken escaping. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 18af10cb807..1544dcd8a19 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3683,7 +3683,7 @@ fontified. Do nothing if BEGIN and END are equal. If ( ?\N{U+1F8AB} . ?\N{U+1F8AA} )) "Full list of paired delimiters for quote-like constructs. As an experimental feature, Perl uses these under \"feature -\='extra_paired_delimiters\='\" or in feature bundles of Perl 5.40 or +\\='extra_paired_delimiters\\='\" or in feature bundles of Perl 5.40 or newer. To activate the extra delimiters, switch on the minor mode `cperl-extra-paired-delimiters-mode'. This is also available from the \"Perl\" menu in section \"Toggle...\". commit 331573e40731d6635acd366694493c26b480c230 Author: Mattias Engdegård Date: Mon Jun 10 13:59:31 2024 +0200 Org: fix mistakes in regexp, skip set and doc string All found by Relint. * lisp/org/org-element.el (org-element-copy-buffer): Repair incorrect escaping. * lisp/org/org-macs.el (org--line-empty-p): Fix broken skip-set. * lisp/org/org.el (org-setup-yank-dnd-handlers): Fix broken regexp. diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index 34520d16e1d..b15f0b69d98 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -648,7 +648,7 @@ IMPORTANT: The buffer copy may also have variable `buffer-file-name' copied. To prevent Emacs overwriting the original buffer file, -`write-contents-functions' is set to \='(always). Do not alter this +`write-contents-functions' is set to \\='(always). Do not alter this variable and do not do anything that might alter it (like calling a major mode) to prevent data corruption. Also, do note that Emacs may jump into the created buffer if the original file buffer is closed and diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 555ff44a330..694e747b04e 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -815,7 +815,7 @@ Match at beginning of line when WITH-BOL is non-nil." (and (not (bobp)) (save-excursion (forward-line n) - (skip-chars-forward "[ \t]") + (skip-chars-forward " \t") (eolp)))) (defun org-previous-line-empty-p () diff --git a/lisp/org/org.el b/lisp/org/org.el index ab676e623af..ff5b63212e0 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -20749,7 +20749,7 @@ it has a `diary' type." (yank-media-handler "image/.*" #'org--image-yank-media-handler) ;; Looks like different DEs go for different handler names, ;; https://larsee.com/blog/2019/05/clipboard-files/. - (yank-media-handler "x/special-\\(?:gnome\|KDE\|mate\\)-files" + (yank-media-handler "x/special-\\(?:gnome\\|KDE\\|mate\\)-files" #'org--copied-files-yank-media-handler)) (when (boundp 'x-dnd-direct-save-function) (setq-local x-dnd-direct-save-function #'org--dnd-xds-function))) commit bb7b406adb0f95002f22116786da2470fef129b2 Author: Eli Zaretskii Date: Mon Jun 10 14:21:48 2024 +0300 ; Avoid byte-compilation warning in cperl-mode.el * lisp/progmodes/cperl-mode.el (cperl--extra-paired-delimiters): Avoid byte-compiler warning about curved quotes. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 5dba24ae76a..18af10cb807 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3688,7 +3688,7 @@ newer. To activate the extra delimiters, switch on the minor mode `cperl-extra-paired-delimiters-mode'. This is also available from the \"Perl\" menu in section \"Toggle...\". The character pairs available are: -(), <>, [], {}, «», »«, ༺༻, ༼༽, ᚛᚜, ‘’, ’‘, “”, ”“, ‵′, ‶″, ‷‴, ‹›, ›‹, ⁅⁆, +(), <>, [], {}, «», »«, ༺༻, ༼༽, ᚛᚜, \\=‘\\=’, \\=’\\=‘, \\=“\\=”, \\=”\\=“, \\=‵\\=′, \\=‶\\=″, \\=‷\\=‴, ‹›, ›‹, ⁅⁆, ⁍⁌, ⁽⁾, ₍₎, →←, ↛↚, ↝↜, ↠↞, ↣↢, ↦↤, ↪↩, ↬↫, ↱↰, ↳↲, ⇀↼, ⇁↽, ⇉⇇, ⇏⇍, ⇒⇐, ⇛⇚, ⇝⇜, ⇢⇠, ⇥⇤, ⇨⇦, ⇴⬰, ⇶⬱, ⇸⇷, ⇻⇺, ⇾⇽, ∈∋, ∉∌, ∊∍, ≤≥, ≦≧, ≨≩, ≪≫, ≮≯, ≰≱, ≲≳, ≴≵, ≺≻, ≼≽, ≾≿, ⊀⊁, ⊂⊃, ⊄⊅, ⊆⊇, ⊈⊉, ⊊⊋, ⊣⊢, ⊦⫞, ⊨⫤, ⊩⫣, ⊰⊱, ⋐⋑, ⋖⋗, ⋘⋙, ⋜⋝, commit 24448b7bbb8b8ee87e2ff3c974c3af7a1c5e42c1 Author: Michael Albinus Date: Mon Jun 10 12:55:59 2024 +0200 Extend auto-revert-test07-auto-revert-several-buffers * test/lisp/autorevert-tests.el (auto-revert-test05-global-notify): Make cleanup robust. (auto-revert-test07-auto-revert-several-buffers): Extend test. (Bug#71424) diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index c202970e0b2..4763994c5d4 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -528,8 +528,9 @@ This expects `auto-revert--messages' to be bound by (unless was-in-global-auto-revert-mode (global-auto-revert-mode 0)) ; Turn it off. (dolist (buf (list buf-1 buf-2 buf-3)) - (with-current-buffer buf (setq-local kill-buffer-hook nil)) - (ignore-errors (kill-buffer buf))) + (ignore-errors + (with-current-buffer buf (setq-local kill-buffer-hook nil)) + (kill-buffer buf))) (ignore-errors (delete-file file-2b))))))))) (auto-revert--deftest-remote auto-revert-test05-global-notify @@ -568,7 +569,7 @@ This expects `auto-revert--messages' to be bound by (auto-revert--deftest-remote auto-revert-test06-write-file "Test `write-file' in `auto-revert-mode' for remote buffers.") -;; This is inspired by Bug#44638. +;; This is inspired by Bug#44638, Bug#71424. (ert-deftest auto-revert-test07-auto-revert-several-buffers () "Check autorevert for several buffers visiting the same file." ;; (with-auto-revert-test @@ -591,24 +592,50 @@ This expects `auto-revert--messages' to be bound by (auto-revert-mode 1) (should auto-revert-mode)) - (dotimes (i num-buffers) - (push (make-indirect-buffer - (car buffers) - (format "%s-%d" (buffer-file-name (car buffers)) i) - 'clone) - buffers)) + (dolist (clone '(clone nil)) + (dotimes (i num-buffers) + (push (make-indirect-buffer + (car (last buffers)) + (format "%s-%d-%s" + (buffer-file-name (car (last buffers))) i clone) + clone) + buffers))) (setq buffers (nreverse buffers)) (dolist (buf buffers) (with-current-buffer buf (should (string-equal (buffer-string) "any text")) - (should auto-revert-mode))) + (if (string-suffix-p "-nil" (buffer-name buf)) + (should-not auto-revert-mode) + (should auto-revert-mode)))) (auto-revert-tests--write-file "another text" tmpfile (pop times)) ;; Check, that the buffer has been reverted. (auto-revert--wait-for-revert (car buffers)) (dolist (buf buffers) (with-current-buffer buf - (should (string-equal (buffer-string) "another text"))))) + (should (string-equal (buffer-string) "another text")))) + + ;; Disabling autorevert in an indirect buffer does not + ;; disable autorevert in the corresponding base buffer. + (dolist (buf (cdr buffers)) + (with-current-buffer buf + (auto-revert-mode 0) + (should-not auto-revert-mode)) + (with-current-buffer (car buffers) + (should + (buffer-local-value + 'auto-revert-notify-watch-descriptor (current-buffer))) + (should auto-revert-mode))) + + ;; Killing an indirect buffer does not disable autorevert in + ;; the corresponding base buffer. + (dolist (buf (cdr buffers)) + (kill-buffer buf)) + (with-current-buffer (car buffers) + (should + (buffer-local-value + 'auto-revert-notify-watch-descriptor (current-buffer))) + (should auto-revert-mode))) ;; Exit. (ignore-errors commit 060c48435f49eb03019cc9eb7f1657f756f56ceb Author: Harald Jörg Date: Mon Jun 10 12:19:04 2024 +0200 cperl-mode.el: Update for the current Perl version 5.040 * etc/NEWS: Announce new features of cperl-mode. * lisp/progmodes/cperl-mode.el (cperl-menu): Add toggle for extra paired delimiters. (defconst): new rx expressions `cperl--sub-name-generated-rx' and `cperl--field-declaration-rx' (cperl--imenu-entries-rx): Use the new expressions (cperl--extra-paired-delimiters): New variable holding the paired delimiters for Perl 5.36 and newer (cperl-imenu-sub-keywords): Add autogenerated methods to imenu (cperl-init-faces): Add the __CLASS__ token, builtin constants, and attributes for field declarations. (cperl-short-docs): Add __CLASS__ to one-line docs. (cperl-extra-paired-delimiters-mode): new minor mode to handle non-ASCII paired delimiters. * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-fontify-builtin-constants): new test. (cperl-test-fontify-class): New test clauses for attributes. (cperl-test-field-declaration-rx): new test. (cperl-test-autogenerated-reader-rx): new unit test for the rx expression. (cperl-test-extra-delimiters): new test. (cperl-test-imenu-index): new clauses for imenu capture of autogenerated methods. * test/lisp/progmodes/cperl-mode-resources/grammar.pl: Add examples for Perl 5.40 syntax. * test/lisp/progmodes/cperl-mode-resources/extra-delimiters.pl: New resource for non-ASCII paired delimiters. diff --git a/etc/NEWS b/etc/NEWS index 75c26c031c2..94557fdd255 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1657,9 +1657,9 @@ fit on fewer lines without negatively impacting readability. CPerl mode fontifies subroutine signatures like variable declarations which makes them visually distinct from subroutine prototypes. -*** Syntax of Perl up to version 5.38 is supported. +*** Syntax of Perl up to version 5.40 is supported. CPerl mode supports the new keywords for exception handling and the -object oriented syntax which were added in Perl 5.36 and 5.38. +object oriented syntax which were added in Perl 5.36, 5.38 and 5.40. *** New user option 'cperl-fontify-trailer'. This user option takes the values 'perl-code' or 'comment' and treats @@ -1673,6 +1673,11 @@ This command sets the indentation style for the current buffer. To change the default style, either use the user option with the same name or use the command 'cperl-set-style'. +*** New minor mode cperl-extra-paired-delimiters-mode +Perl 5.36 and newer allows using more than 200 non-ASCII paired +delimiters for quote-like constructs, eg. "q«text»". Use this minor +mode in buffers where this feature is activated. + *** Commands using the Perl info page are obsolete. The Perl documentation in info format is no longer distributed with Perl or on CPAN since more than 10 years. Perl documentation can be diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index cbc23507fca..5dba24ae76a 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1130,6 +1130,7 @@ Unless KEEP, removes the old indentation." ["Auto newline" cperl-toggle-auto-newline t] ["Electric parens" cperl-toggle-electric t] ["Electric keywords" cperl-toggle-abbrev t] + ["Extra paired delimiters" cperl-extra-paired-delimiters-mode t] ["Fix whitespace on indent" cperl-toggle-construct-fix t] ["Auto-help on Perl constructs" cperl-toggle-autohelp t] ["Auto fill" auto-fill-mode t]) @@ -1436,6 +1437,33 @@ Contains three groups: One to distinguish lexical from \"normal\" subroutines, for the keyword \"sub\" or \"method\", and one for the subroutine name.") + (defconst cperl--sub-name-generated-rx + `(sequence symbol-start + (optional (group-n 3 unmatchable)) + ;; autogenerated methods are not lexicals, so enforce the + ;; first capture group to be nil + "field" + ,cperl--ws+-rx + (or + (sequence (in "$%@") + (group-n 2 ,cperl--basic-identifier-rx) + (1+ (not (in ";={"))) + ":" + (group-n 1 "reader") + (not "(")) + (sequence ,cperl--basic-variable-rx + (1+ (not (in ";={"))) + ":" + (group-n 1 "reader") + "(" + (group-n 2 ,cperl--basic-identifier-rx) + ")"))) + "A regular expression to capture autogenerated reader methods. +The name of the method is either the field name without its sigil, or +given in parentheses after the \":reader\" keyword.") + ;; I don't dare to think about :writer where the generated name does + ;; not even occur in the text. + (defconst cperl--block-declaration-rx `(sequence (or "class" "method" "package" "sub") @@ -1445,16 +1473,16 @@ the subroutine name.") Used for indentation. These declarations introduce a block which does not need a semicolon to terminate the statement.") -;;; Initializer blocks are not (yet) part of the Perl core. -;; (defconst cperl--field-declaration-rx -;; `(sequence -;; "field" -;; (1+ ,cperl--ws-or-comment-rx) -;; ,cperl--basic-variable-rx) -;; "A regular expression to find a declaration for a field. -;; Used for indentation. These declarations allow an initializer -;; block which does not need a semicolon to terminate the -;; statement.") +(defconst cperl--field-declaration-rx + `(sequence + "field" + (1+ ,cperl--ws-or-comment-rx) + ,cperl--basic-variable-rx + (optional (sequence ,cperl--ws+-rx ,cperl--attribute-list-rx)) + ) + "A regular expression to find a declaration for a field. +Fields can have attributes for fontification, and even for imenu because +for example \":reader\" implicitly declares a method.") (defconst cperl--pod-heading-rx `(sequence line-start @@ -1470,6 +1498,7 @@ heading text.") `(or ,cperl--package-for-imenu-rx ,cperl--class-for-imenu-rx ,cperl--sub-name-for-imenu-rx + ,cperl--sub-name-generated-rx ,cperl--pod-heading-rx) "A regular expression to collect stuff that goes into the `imenu' index. Covers packages and classes, subroutines and methods, and POD headings.") @@ -3351,10 +3380,333 @@ fontified. Do nothing if BEGIN and END are equal. If (put-text-property begin end 'face (if string 'font-lock-string-face 'font-lock-comment-face))))) -(defvar cperl-starters '(( ?\( . ?\) ) - ( ?\[ . ?\] ) - ( ?\{ . ?\} ) - ( ?\< . ?\> ))) +(defvar cperl--basic-paired-delimiters '(( ?\( . ?\) ) + ( ?\[ . ?\] ) + ( ?\{ . ?\} ) + ( ?\< . ?\> ))) +;; -------- The following definition is generated code from "perlop" +;; https://metacpan.org/release/HAARG/perl-5.40.0/view/pod/perlop.pod +(defvar cperl--extra-paired-delimiters '(( ?\N{U+0028} . ?\N{U+0029} ) + ( ?\N{U+003C} . ?\N{U+003E} ) + ( ?\N{U+005B} . ?\N{U+005D} ) + ( ?\N{U+007B} . ?\N{U+007D} ) + ( ?\N{U+00AB} . ?\N{U+00BB} ) + ( ?\N{U+00BB} . ?\N{U+00AB} ) + ( ?\N{U+0F3A} . ?\N{U+0F3B} ) + ( ?\N{U+0F3C} . ?\N{U+0F3D} ) + ( ?\N{U+169B} . ?\N{U+169C} ) + ( ?\N{U+2018} . ?\N{U+2019} ) + ( ?\N{U+2019} . ?\N{U+2018} ) + ( ?\N{U+201C} . ?\N{U+201D} ) + ( ?\N{U+201D} . ?\N{U+201C} ) + ( ?\N{U+2035} . ?\N{U+2032} ) + ( ?\N{U+2036} . ?\N{U+2033} ) + ( ?\N{U+2037} . ?\N{U+2034} ) + ( ?\N{U+2039} . ?\N{U+203A} ) + ( ?\N{U+203A} . ?\N{U+2039} ) + ( ?\N{U+2045} . ?\N{U+2046} ) + ( ?\N{U+204D} . ?\N{U+204C} ) + ( ?\N{U+207D} . ?\N{U+207E} ) + ( ?\N{U+208D} . ?\N{U+208E} ) + ( ?\N{U+2192} . ?\N{U+2190} ) + ( ?\N{U+219B} . ?\N{U+219A} ) + ( ?\N{U+219D} . ?\N{U+219C} ) + ( ?\N{U+21A0} . ?\N{U+219E} ) + ( ?\N{U+21A3} . ?\N{U+21A2} ) + ( ?\N{U+21A6} . ?\N{U+21A4} ) + ( ?\N{U+21AA} . ?\N{U+21A9} ) + ( ?\N{U+21AC} . ?\N{U+21AB} ) + ( ?\N{U+21B1} . ?\N{U+21B0} ) + ( ?\N{U+21B3} . ?\N{U+21B2} ) + ( ?\N{U+21C0} . ?\N{U+21BC} ) + ( ?\N{U+21C1} . ?\N{U+21BD} ) + ( ?\N{U+21C9} . ?\N{U+21C7} ) + ( ?\N{U+21CF} . ?\N{U+21CD} ) + ( ?\N{U+21D2} . ?\N{U+21D0} ) + ( ?\N{U+21DB} . ?\N{U+21DA} ) + ( ?\N{U+21DD} . ?\N{U+21DC} ) + ( ?\N{U+21E2} . ?\N{U+21E0} ) + ( ?\N{U+21E5} . ?\N{U+21E4} ) + ( ?\N{U+21E8} . ?\N{U+21E6} ) + ( ?\N{U+21F4} . ?\N{U+2B30} ) + ( ?\N{U+21F6} . ?\N{U+2B31} ) + ( ?\N{U+21F8} . ?\N{U+21F7} ) + ( ?\N{U+21FB} . ?\N{U+21FA} ) + ( ?\N{U+21FE} . ?\N{U+21FD} ) + ( ?\N{U+2208} . ?\N{U+220B} ) + ( ?\N{U+2209} . ?\N{U+220C} ) + ( ?\N{U+220A} . ?\N{U+220D} ) + ( ?\N{U+2264} . ?\N{U+2265} ) + ( ?\N{U+2266} . ?\N{U+2267} ) + ( ?\N{U+2268} . ?\N{U+2269} ) + ( ?\N{U+226A} . ?\N{U+226B} ) + ( ?\N{U+226E} . ?\N{U+226F} ) + ( ?\N{U+2270} . ?\N{U+2271} ) + ( ?\N{U+2272} . ?\N{U+2273} ) + ( ?\N{U+2274} . ?\N{U+2275} ) + ( ?\N{U+227A} . ?\N{U+227B} ) + ( ?\N{U+227C} . ?\N{U+227D} ) + ( ?\N{U+227E} . ?\N{U+227F} ) + ( ?\N{U+2280} . ?\N{U+2281} ) + ( ?\N{U+2282} . ?\N{U+2283} ) + ( ?\N{U+2284} . ?\N{U+2285} ) + ( ?\N{U+2286} . ?\N{U+2287} ) + ( ?\N{U+2288} . ?\N{U+2289} ) + ( ?\N{U+228A} . ?\N{U+228B} ) + ( ?\N{U+22A3} . ?\N{U+22A2} ) + ( ?\N{U+22A6} . ?\N{U+2ADE} ) + ( ?\N{U+22A8} . ?\N{U+2AE4} ) + ( ?\N{U+22A9} . ?\N{U+2AE3} ) + ( ?\N{U+22B0} . ?\N{U+22B1} ) + ( ?\N{U+22D0} . ?\N{U+22D1} ) + ( ?\N{U+22D6} . ?\N{U+22D7} ) + ( ?\N{U+22D8} . ?\N{U+22D9} ) + ( ?\N{U+22DC} . ?\N{U+22DD} ) + ( ?\N{U+22DE} . ?\N{U+22DF} ) + ( ?\N{U+22E0} . ?\N{U+22E1} ) + ( ?\N{U+22E6} . ?\N{U+22E7} ) + ( ?\N{U+22E8} . ?\N{U+22E9} ) + ( ?\N{U+22F2} . ?\N{U+22FA} ) + ( ?\N{U+22F3} . ?\N{U+22FB} ) + ( ?\N{U+22F4} . ?\N{U+22FC} ) + ( ?\N{U+22F6} . ?\N{U+22FD} ) + ( ?\N{U+22F7} . ?\N{U+22FE} ) + ( ?\N{U+2308} . ?\N{U+2309} ) + ( ?\N{U+230A} . ?\N{U+230B} ) + ( ?\N{U+2326} . ?\N{U+232B} ) + ( ?\N{U+2348} . ?\N{U+2347} ) + ( ?\N{U+23ED} . ?\N{U+23EE} ) + ( ?\N{U+261B} . ?\N{U+261A} ) + ( ?\N{U+261E} . ?\N{U+261C} ) + ( ?\N{U+269E} . ?\N{U+269F} ) + ( ?\N{U+2768} . ?\N{U+2769} ) + ( ?\N{U+276A} . ?\N{U+276B} ) + ( ?\N{U+276C} . ?\N{U+276D} ) + ( ?\N{U+276E} . ?\N{U+276F} ) + ( ?\N{U+2770} . ?\N{U+2771} ) + ( ?\N{U+2772} . ?\N{U+2773} ) + ( ?\N{U+2774} . ?\N{U+2775} ) + ( ?\N{U+27C3} . ?\N{U+27C4} ) + ( ?\N{U+27C5} . ?\N{U+27C6} ) + ( ?\N{U+27C8} . ?\N{U+27C9} ) + ( ?\N{U+27DE} . ?\N{U+27DD} ) + ( ?\N{U+27E6} . ?\N{U+27E7} ) + ( ?\N{U+27E8} . ?\N{U+27E9} ) + ( ?\N{U+27EA} . ?\N{U+27EB} ) + ( ?\N{U+27EC} . ?\N{U+27ED} ) + ( ?\N{U+27EE} . ?\N{U+27EF} ) + ( ?\N{U+27F4} . ?\N{U+2B32} ) + ( ?\N{U+27F6} . ?\N{U+27F5} ) + ( ?\N{U+27F9} . ?\N{U+27F8} ) + ( ?\N{U+27FC} . ?\N{U+27FB} ) + ( ?\N{U+27FE} . ?\N{U+27FD} ) + ( ?\N{U+27FF} . ?\N{U+2B33} ) + ( ?\N{U+2900} . ?\N{U+2B34} ) + ( ?\N{U+2901} . ?\N{U+2B35} ) + ( ?\N{U+2903} . ?\N{U+2902} ) + ( ?\N{U+2905} . ?\N{U+2B36} ) + ( ?\N{U+2907} . ?\N{U+2906} ) + ( ?\N{U+290D} . ?\N{U+290C} ) + ( ?\N{U+290F} . ?\N{U+290E} ) + ( ?\N{U+2910} . ?\N{U+2B37} ) + ( ?\N{U+2911} . ?\N{U+2B38} ) + ( ?\N{U+2914} . ?\N{U+2B39} ) + ( ?\N{U+2915} . ?\N{U+2B3A} ) + ( ?\N{U+2916} . ?\N{U+2B3B} ) + ( ?\N{U+2917} . ?\N{U+2B3C} ) + ( ?\N{U+2918} . ?\N{U+2B3D} ) + ( ?\N{U+291A} . ?\N{U+2919} ) + ( ?\N{U+291C} . ?\N{U+291B} ) + ( ?\N{U+291E} . ?\N{U+291D} ) + ( ?\N{U+2920} . ?\N{U+291F} ) + ( ?\N{U+2933} . ?\N{U+2B3F} ) + ( ?\N{U+2937} . ?\N{U+2936} ) + ( ?\N{U+2945} . ?\N{U+2946} ) + ( ?\N{U+2947} . ?\N{U+2B3E} ) + ( ?\N{U+2953} . ?\N{U+2952} ) + ( ?\N{U+2957} . ?\N{U+2956} ) + ( ?\N{U+295B} . ?\N{U+295A} ) + ( ?\N{U+295F} . ?\N{U+295E} ) + ( ?\N{U+2964} . ?\N{U+2962} ) + ( ?\N{U+296C} . ?\N{U+296A} ) + ( ?\N{U+296D} . ?\N{U+296B} ) + ( ?\N{U+2971} . ?\N{U+2B40} ) + ( ?\N{U+2972} . ?\N{U+2B41} ) + ( ?\N{U+2974} . ?\N{U+2B4B} ) + ( ?\N{U+2975} . ?\N{U+2B42} ) + ( ?\N{U+2979} . ?\N{U+297B} ) + ( ?\N{U+2983} . ?\N{U+2984} ) + ( ?\N{U+2985} . ?\N{U+2986} ) + ( ?\N{U+2987} . ?\N{U+2988} ) + ( ?\N{U+2989} . ?\N{U+298A} ) + ( ?\N{U+298B} . ?\N{U+298C} ) + ( ?\N{U+298D} . ?\N{U+2990} ) + ( ?\N{U+298F} . ?\N{U+298E} ) + ( ?\N{U+2991} . ?\N{U+2992} ) + ( ?\N{U+2993} . ?\N{U+2994} ) + ( ?\N{U+2995} . ?\N{U+2996} ) + ( ?\N{U+2997} . ?\N{U+2998} ) + ( ?\N{U+29A8} . ?\N{U+29A9} ) + ( ?\N{U+29AA} . ?\N{U+29AB} ) + ( ?\N{U+29B3} . ?\N{U+29B4} ) + ( ?\N{U+29C0} . ?\N{U+29C1} ) + ( ?\N{U+29D8} . ?\N{U+29D9} ) + ( ?\N{U+29DA} . ?\N{U+29DB} ) + ( ?\N{U+29FC} . ?\N{U+29FD} ) + ( ?\N{U+2A79} . ?\N{U+2A7A} ) + ( ?\N{U+2A7B} . ?\N{U+2A7C} ) + ( ?\N{U+2A7D} . ?\N{U+2A7E} ) + ( ?\N{U+2A7F} . ?\N{U+2A80} ) + ( ?\N{U+2A81} . ?\N{U+2A82} ) + ( ?\N{U+2A83} . ?\N{U+2A84} ) + ( ?\N{U+2A85} . ?\N{U+2A86} ) + ( ?\N{U+2A87} . ?\N{U+2A88} ) + ( ?\N{U+2A89} . ?\N{U+2A8A} ) + ( ?\N{U+2A8D} . ?\N{U+2A8E} ) + ( ?\N{U+2A95} . ?\N{U+2A96} ) + ( ?\N{U+2A97} . ?\N{U+2A98} ) + ( ?\N{U+2A99} . ?\N{U+2A9A} ) + ( ?\N{U+2A9B} . ?\N{U+2A9C} ) + ( ?\N{U+2A9D} . ?\N{U+2A9E} ) + ( ?\N{U+2A9F} . ?\N{U+2AA0} ) + ( ?\N{U+2AA1} . ?\N{U+2AA2} ) + ( ?\N{U+2AA6} . ?\N{U+2AA7} ) + ( ?\N{U+2AA8} . ?\N{U+2AA9} ) + ( ?\N{U+2AAA} . ?\N{U+2AAB} ) + ( ?\N{U+2AAC} . ?\N{U+2AAD} ) + ( ?\N{U+2AAF} . ?\N{U+2AB0} ) + ( ?\N{U+2AB1} . ?\N{U+2AB2} ) + ( ?\N{U+2AB3} . ?\N{U+2AB4} ) + ( ?\N{U+2AB5} . ?\N{U+2AB6} ) + ( ?\N{U+2AB7} . ?\N{U+2AB8} ) + ( ?\N{U+2AB9} . ?\N{U+2ABA} ) + ( ?\N{U+2ABB} . ?\N{U+2ABC} ) + ( ?\N{U+2ABD} . ?\N{U+2ABE} ) + ( ?\N{U+2ABF} . ?\N{U+2AC0} ) + ( ?\N{U+2AC1} . ?\N{U+2AC2} ) + ( ?\N{U+2AC3} . ?\N{U+2AC4} ) + ( ?\N{U+2AC5} . ?\N{U+2AC6} ) + ( ?\N{U+2AC7} . ?\N{U+2AC8} ) + ( ?\N{U+2AC9} . ?\N{U+2ACA} ) + ( ?\N{U+2ACB} . ?\N{U+2ACC} ) + ( ?\N{U+2ACF} . ?\N{U+2AD0} ) + ( ?\N{U+2AD1} . ?\N{U+2AD2} ) + ( ?\N{U+2AD5} . ?\N{U+2AD6} ) + ( ?\N{U+2AE5} . ?\N{U+22AB} ) + ( ?\N{U+2AF7} . ?\N{U+2AF8} ) + ( ?\N{U+2AF9} . ?\N{U+2AFA} ) + ( ?\N{U+2B46} . ?\N{U+2B45} ) + ( ?\N{U+2B47} . ?\N{U+2B49} ) + ( ?\N{U+2B48} . ?\N{U+2B4A} ) + ( ?\N{U+2B4C} . ?\N{U+2973} ) + ( ?\N{U+2B62} . ?\N{U+2B60} ) + ( ?\N{U+2B6C} . ?\N{U+2B6A} ) + ( ?\N{U+2B72} . ?\N{U+2B70} ) + ( ?\N{U+2B7C} . ?\N{U+2B7A} ) + ( ?\N{U+2B86} . ?\N{U+2B84} ) + ( ?\N{U+2B8A} . ?\N{U+2B88} ) + ( ?\N{U+2B95} . ?\N{U+2B05} ) + ( ?\N{U+2B9A} . ?\N{U+2B98} ) + ( ?\N{U+2B9E} . ?\N{U+2B9C} ) + ( ?\N{U+2BA1} . ?\N{U+2BA0} ) + ( ?\N{U+2BA3} . ?\N{U+2BA2} ) + ( ?\N{U+2BA9} . ?\N{U+2BA8} ) + ( ?\N{U+2BAB} . ?\N{U+2BAA} ) + ( ?\N{U+2BB1} . ?\N{U+2BB0} ) + ( ?\N{U+2BB3} . ?\N{U+2BB2} ) + ( ?\N{U+2BEE} . ?\N{U+2BEC} ) + ( ?\N{U+2E02} . ?\N{U+2E03} ) + ( ?\N{U+2E03} . ?\N{U+2E02} ) + ( ?\N{U+2E04} . ?\N{U+2E05} ) + ( ?\N{U+2E05} . ?\N{U+2E04} ) + ( ?\N{U+2E09} . ?\N{U+2E0A} ) + ( ?\N{U+2E0A} . ?\N{U+2E09} ) + ( ?\N{U+2E0C} . ?\N{U+2E0D} ) + ( ?\N{U+2E0D} . ?\N{U+2E0C} ) + ( ?\N{U+2E11} . ?\N{U+2E10} ) + ( ?\N{U+2E1C} . ?\N{U+2E1D} ) + ( ?\N{U+2E1D} . ?\N{U+2E1C} ) + ( ?\N{U+2E20} . ?\N{U+2E21} ) + ( ?\N{U+2E21} . ?\N{U+2E20} ) + ( ?\N{U+2E22} . ?\N{U+2E23} ) + ( ?\N{U+2E24} . ?\N{U+2E25} ) + ( ?\N{U+2E26} . ?\N{U+2E27} ) + ( ?\N{U+2E28} . ?\N{U+2E29} ) + ( ?\N{U+2E36} . ?\N{U+2E37} ) + ( ?\N{U+2E42} . ?\N{U+201E} ) + ( ?\N{U+2E55} . ?\N{U+2E56} ) + ( ?\N{U+2E57} . ?\N{U+2E58} ) + ( ?\N{U+2E59} . ?\N{U+2E5A} ) + ( ?\N{U+2E5B} . ?\N{U+2E5C} ) + ( ?\N{U+A9C1} . ?\N{U+A9C2} ) + ( ?\N{U+FD3E} . ?\N{U+FD3F} ) + ( ?\N{U+FF62} . ?\N{U+FF63} ) + ( ?\N{U+FFEB} . ?\N{U+FFE9} ) + ( ?\N{U+1D103} . ?\N{U+1D102} ) + ( ?\N{U+1D106} . ?\N{U+1D107} ) + ( ?\N{U+1F57B} . ?\N{U+1F57D} ) + ( ?\N{U+1F599} . ?\N{U+1F598} ) + ( ?\N{U+1F59B} . ?\N{U+1F59A} ) + ( ?\N{U+1F59D} . ?\N{U+1F59C} ) + ( ?\N{U+1F5E6} . ?\N{U+1F5E7} ) + ( ?\N{U+1F802} . ?\N{U+1F800} ) + ( ?\N{U+1F806} . ?\N{U+1F804} ) + ( ?\N{U+1F80A} . ?\N{U+1F808} ) + ( ?\N{U+1F812} . ?\N{U+1F810} ) + ( ?\N{U+1F816} . ?\N{U+1F814} ) + ( ?\N{U+1F81A} . ?\N{U+1F818} ) + ( ?\N{U+1F81E} . ?\N{U+1F81C} ) + ( ?\N{U+1F822} . ?\N{U+1F820} ) + ( ?\N{U+1F826} . ?\N{U+1F824} ) + ( ?\N{U+1F82A} . ?\N{U+1F828} ) + ( ?\N{U+1F82E} . ?\N{U+1F82C} ) + ( ?\N{U+1F832} . ?\N{U+1F830} ) + ( ?\N{U+1F836} . ?\N{U+1F834} ) + ( ?\N{U+1F83A} . ?\N{U+1F838} ) + ( ?\N{U+1F83E} . ?\N{U+1F83C} ) + ( ?\N{U+1F842} . ?\N{U+1F840} ) + ( ?\N{U+1F846} . ?\N{U+1F844} ) + ( ?\N{U+1F852} . ?\N{U+1F850} ) + ( ?\N{U+1F862} . ?\N{U+1F860} ) + ( ?\N{U+1F86A} . ?\N{U+1F868} ) + ( ?\N{U+1F872} . ?\N{U+1F870} ) + ( ?\N{U+1F87A} . ?\N{U+1F878} ) + ( ?\N{U+1F882} . ?\N{U+1F880} ) + ( ?\N{U+1F892} . ?\N{U+1F890} ) + ( ?\N{U+1F896} . ?\N{U+1F894} ) + ( ?\N{U+1F89A} . ?\N{U+1F898} ) + ( ?\N{U+1F8A1} . ?\N{U+1F8A0} ) + ( ?\N{U+1F8A3} . ?\N{U+1F8A2} ) + ( ?\N{U+1F8A5} . ?\N{U+1F8A6} ) + ( ?\N{U+1F8A7} . ?\N{U+1F8A4} ) + ( ?\N{U+1F8A9} . ?\N{U+1F8A8} ) + ( ?\N{U+1F8AB} . ?\N{U+1F8AA} )) + "Full list of paired delimiters for quote-like constructs. +As an experimental feature, Perl uses these under \"feature +\='extra_paired_delimiters\='\" or in feature bundles of Perl 5.40 or +newer. To activate the extra delimiters, switch on the minor mode +`cperl-extra-paired-delimiters-mode'. This is also available from the +\"Perl\" menu in section \"Toggle...\". +The character pairs available are: +(), <>, [], {}, «», »«, ༺༻, ༼༽, ᚛᚜, ‘’, ’‘, “”, ”“, ‵′, ‶″, ‷‴, ‹›, ›‹, ⁅⁆, +⁍⁌, ⁽⁾, ₍₎, →←, ↛↚, ↝↜, ↠↞, ↣↢, ↦↤, ↪↩, ↬↫, ↱↰, ↳↲, ⇀↼, ⇁↽, ⇉⇇, ⇏⇍, ⇒⇐, ⇛⇚, +⇝⇜, ⇢⇠, ⇥⇤, ⇨⇦, ⇴⬰, ⇶⬱, ⇸⇷, ⇻⇺, ⇾⇽, ∈∋, ∉∌, ∊∍, ≤≥, ≦≧, ≨≩, ≪≫, ≮≯, ≰≱, ≲≳, +≴≵, ≺≻, ≼≽, ≾≿, ⊀⊁, ⊂⊃, ⊄⊅, ⊆⊇, ⊈⊉, ⊊⊋, ⊣⊢, ⊦⫞, ⊨⫤, ⊩⫣, ⊰⊱, ⋐⋑, ⋖⋗, ⋘⋙, ⋜⋝, +⋞⋟, ⋠⋡, ⋦⋧, ⋨⋩, ⋲⋺, ⋳⋻, ⋴⋼, ⋶⋽, ⋷⋾, ⌈⌉, ⌊⌋, ⌦⌫, ⍈⍇, ⏭⏮, ☛☚, ☞☜, ⚞⚟, ❨❩, ❪❫, +❬❭, ❮❯, ❰❱, ❲❳, ❴❵, ⟃⟄, ⟅⟆, ⟈⟉, ⟞⟝, ⟦⟧, ⟨⟩, ⟪⟫, ⟬⟭, ⟮⟯, ⟴⬲, ⟶⟵, ⟹⟸, ⟼⟻, ⟾⟽, +⟿⬳, ⤀⬴, ⤁⬵, ⤃⤂, ⤅⬶, ⤇⤆, ⤍⤌, ⤏⤎, ⤐⬷, ⤑⬸, ⤔⬹, ⤕⬺, ⤖⬻, ⤗⬼, ⤘⬽, ⤚⤙, ⤜⤛, ⤞⤝, ⤠⤟, +⤳⬿, ⤷⤶, ⥅⥆, ⥇⬾, ⥓⥒, ⥗⥖, ⥛⥚, ⥟⥞, ⥤⥢, ⥬⥪, ⥭⥫, ⥱⭀, ⥲⭁, ⥴⭋, ⥵⭂, ⥹⥻, ⦃⦄, ⦅⦆, ⦇⦈, +⦉⦊, ⦋⦌, ⦍⦐, ⦏⦎, ⦑⦒, ⦓⦔, ⦕⦖, ⦗⦘, ⦨⦩, ⦪⦫, ⦳⦴, ⧀⧁, ⧘⧙, ⧚⧛, ⧼⧽, ⩹⩺, ⩻⩼, ⩽⩾, ⩿⪀, +⪁⪂, ⪃⪄, ⪅⪆, ⪇⪈, ⪉⪊, ⪍⪎, ⪕⪖, ⪗⪘, ⪙⪚, ⪛⪜, ⪝⪞, ⪟⪠, ⪡⪢, ⪦⪧, ⪨⪩, ⪪⪫, ⪬⪭, ⪯⪰, ⪱⪲, +⪳⪴, ⪵⪶, ⪷⪸, ⪹⪺, ⪻⪼, ⪽⪾, ⪿⫀, ⫁⫂, ⫃⫄, ⫅⫆, ⫇⫈, ⫉⫊, ⫋⫌, ⫏⫐, ⫑⫒, ⫕⫖, ⫥⊫, ⫷⫸, ⫹⫺, +⭆⭅, ⭇⭉, ⭈⭊, ⭌⥳, ⭢⭠, ⭬⭪, ⭲⭰, ⭼⭺, ⮆⮄, ⮊⮈, ⮕⬅, ⮚⮘, ⮞⮜, ⮡⮠, ⮣⮢, ⮩⮨, ⮫⮪, ⮱⮰, ⮳⮲, +⯮⯬, ⸂⸃, ⸃⸂, ⸄⸅, ⸅⸄, ⸉⸊, ⸊⸉, ⸌⸍, ⸍⸌, ⸑⸐, ⸜⸝, ⸝⸜, ⸠⸡, ⸡⸠, ⸢⸣, ⸤⸥, ⸦⸧, ⸨⸩, ⸶⸷, +⹂„, ⹕⹖, ⹗⹘, ⹙⹚, ⹛⹜, ꧁꧂, ﴾﴿, ｢｣, ￫￩, 𝄃𝄂, 𝄆𝄇, 🕻🕽, 🖙🖘, 🖛🖚, 🖝🖜, 🗦🗧, 🠂🠀, 🠆🠄, 🠊🠈, +🠒🠐, 🠖🠔, 🠚🠘, 🠞🠜, 🠢🠠, 🠦🠤, 🠪🠨, 🠮🠬, 🠲🠰, 🠶🠴, 🠺🠸, 🠾🠼, 🡂🡀, 🡆🡄, 🡒🡐, 🡢🡠, 🡪🡨, 🡲🡰, 🡺🡸, +🢂🢀, 🢒🢐, 🢖🢔, 🢚🢘, 🢡🢠, 🢣🢢, 🢥🢦, 🢧🢤, 🢩🢨, 🢫🢪") + +;; --------End of generated code +(defvar cperl-starters cperl--basic-paired-delimiters) (defun cperl-cached-syntax-table (st) "Get a syntax table cached in ST, or create and cache into ST a syntax table. @@ -5672,7 +6024,8 @@ indentation and initial hashes. Behaves usually outside of comment." ;; The following lists are used for categorizing the entries found by ;; `cperl-imenu--create-perl-index'. (defvar cperl-imenu-package-keywords '("package" "class" "role")) -(defvar cperl-imenu-sub-keywords '("sub" "method" "function" "fun")) +(defvar cperl-imenu-sub-keywords '("sub" "method" "function" "fun" + "reader")) ;; for autogenerated (defvar cperl-imenu-pod-keywords '("=head")) (defun cperl-imenu--create-perl-index () @@ -5973,7 +6326,7 @@ functions (which they are not). Inherits from `default'.") (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" (regexp-opt - '("CORE" "__FILE__" "__LINE__" "__SUB__" "__PACKAGE__" + '("CORE" "__FILE__" "__LINE__" "__SUB__" "__PACKAGE__" "__CLASS__" "abs" "accept" "alarm" "and" "atan2" "bind" "binmode" "bless" "caller" "chdir" "chmod" "chown" "chr" "chroot" "close" @@ -6087,7 +6440,7 @@ functions (which they are not). Inherits from `default'.") ;; 1=my_etc, 2=white? 3=(+white? 4=white? 5=var ;; -------- variable declarations ;; (matcher (subexp facespec) ... - `(,(rx (sequence (or "state" "my" "local" "our" "field")) + `(,(rx (sequence (or "state" "my" "local" "our")) (eval cperl--ws*-rx) (opt (group (sequence "(" (eval cperl--ws*-rx)))) (group @@ -6137,6 +6490,44 @@ functions (which they are not). Inherits from `default'.") (forward-char -2)) ; disable continued expr nil (1 font-lock-variable-name-face))) + ;; -------- builtin constants with and without package prefix + ;; (matcher subexp facespec) + `(,(rx (or space (in "=<>-")) + (group (optional "&") + (optional "builtin::") + (or "inf" "nan") + symbol-end)) + 1 'font-lock-constant-face) + ;; -------- field declarations + `(,(rx "field" + (eval cperl--ws+-rx) + (group (eval cperl--basic-variable-rx)) + (optional (sequence + (eval cperl--ws+-rx) + (group (eval cperl--attribute-list-rx))))) + (1 font-lock-variable-name-face) + ;; -------- optional attributes + ;; (anchored-matcher pre-form post-form subex-highlighters) + (,(rx + (group (optional ":" (eval cperl--ws*-rx)) + (eval cperl--basic-identifier-rx)) + (optional "(" + (group (eval cperl--basic-identifier-rx)) + ")")) + ;; pre-form: Define range for anchored matcher + (if (match-beginning 2) + (progn + (goto-char (match-beginning 2)) + (match-end 2)) + ;; If there's no attribute list in match 2, set a short + ;; limit to the search for the anchored matcher, + ;; otherwise it might interpret stuff from the + ;; initializer expression as attribute. + (1+ (point))) + nil + (1 font-lock-constant-face) + (2 font-lock-string-face nil t) ; lax match, value is optional + )) ;; ----- foreach my $foo ( ;; (matcher subexp facespec) `(,(rx symbol-start "for" (opt "each") @@ -7773,6 +8164,7 @@ x= ... Repetition assignment. \\u Upcase the next character. See also \\U and \\l, ucfirst. \\x Hex character, e.g. \\x1b. ... ^ ... Bitwise exclusive or. +__CLASS__ The class of an object in construction __DATA__ Ends program source. __END__ Ends program source. ADJUST {...} Callback for object creation @@ -8984,6 +9376,24 @@ do extra unwind via `cperl-unwind-to-safe'." "Text property which inhibits refontification.") (make-obsolete-variable 'cperl-do-not-fontify nil "28.1") +;;; Minor mode for optional Perl features +(define-minor-mode cperl-extra-paired-delimiters-mode + "Toggle treatment of extra paired delimiters in Perl. +Many non-ASCII paired delimiters can be used for quote-like constructs +by activating the feature \"extra_paired_delimiters\" either explicitly +or as part of the Perl 5.40 feature bundle. This command allows +`cperl-mode' to recognize the same set of paired delimiters, see the +variable `cperl--extra-paired-delimiters'." + :group 'cperl + :lighter "«»" + :interactive (cperl-mode) + (if cperl-extra-paired-delimiters-mode + (progn + (setq-local cperl-starters cperl--extra-paired-delimiters) + (cperl-find-pods-heres (point-min) (point-max))) + (setq-local cperl-starters cperl--basic-paired-delimiters) + (cperl-find-pods-heres (point-min) (point-max)))) + (provide 'cperl-mode) ;;; cperl-mode.el ends here diff --git a/test/lisp/progmodes/cperl-mode-resources/extra-delimiters.pl b/test/lisp/progmodes/cperl-mode-resources/extra-delimiters.pl new file mode 100644 index 00000000000..8d2f6397e9d --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/extra-delimiters.pl @@ -0,0 +1,23 @@ +use utf8; + +my $string_with_strange_delimiters = q«a»; +my $printed = 0; + +label: +print $string_with_strange_delimiters; +$printed = 1; + +# With cperl-extra-delimiters-mode=on the previous lines are a label +# and a a print statement. This line here is a comment. Without +# cperl-extra-delimiters-mode, all this is part of the variable +# declaration. + +# Perl will print hist an "a" if called like this: +# perl -M5.040 extra.pl +# ...and, if called without that -M switch, +# perl extra.pl +# will print everything until here: «; + +$printed or print $string_with_strange_delimiters; + +my $sanity = "eventually recovered."; diff --git a/test/lisp/progmodes/cperl-mode-resources/grammar.pl b/test/lisp/progmodes/cperl-mode-resources/grammar.pl index 9420c0d1fa8..14da28b0fd8 100644 --- a/test/lisp/progmodes/cperl-mode-resources/grammar.pl +++ b/test/lisp/progmodes/cperl-mode-resources/grammar.pl @@ -194,4 +194,16 @@ package Class::Class; } } +=head1 Perl 5.40 brings new stuff + +The __CLASS__ token (only for fontification) and the :reader +method-generator for classes are available with Perl 5.40. + +=cut + +class With::Readers { + field $simple; + field $auto_reader :reader; + field $named_reader :reader(named); +} 1; diff --git a/test/lisp/progmodes/cperl-mode-resources/perl-class.pl b/test/lisp/progmodes/cperl-mode-resources/perl-class.pl index 032690d20a5..ebcb52c8ffd 100644 --- a/test/lisp/progmodes/cperl-mode-resources/perl-class.pl +++ b/test/lisp/progmodes/cperl-mode-resources/perl-class.pl @@ -16,4 +16,8 @@ } } +class D { + field $decorated :param :reader(get_decoration); + field $no_attributes = not_an(attribute) +} say "done!"; diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 9d9718f719c..7c8cc3931bc 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -216,6 +216,39 @@ attributes, prototypes and signatures." 'font-lock-variable-name-face))) (goto-char end-of-sub)))))) +(ert-deftest cperl-test-fontify-builtin-constants () + "Test fontificiation of the floating point constants \"nan\" and \"inf\"." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((constants '("my $min=-builtin::inf;" + "my $unknown = builtin::nan;" + "if ($big == inf) {" + "my $with_ampersand = &inf"))) + (dolist (code constants) + (with-temp-buffer + (insert code) + (goto-char (point-min)) + (funcall cperl-test-mode) + (font-lock-ensure) + (search-forward-regexp "&?\\(builtin::\\)?\\(inf\\|nan\\)") + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-constant-face))))) + ;; Also, test some things that are not these constants + (let ((lookalikes '(("sub inf { ... }" . font-lock-function-name-face) + ("my $inf = 1E6;" . font-lock-variable-name-face) + ("$object->inf;" . cperl-method-call)))) + (dolist (doppelganger lookalikes) + (let ((code (car doppelganger)) + (face (cdr doppelganger))) + (with-temp-buffer + (insert code) + (goto-char (point-min)) + (funcall cperl-test-mode) + (font-lock-ensure) + (search-forward-regexp "&?\\(builtin::\\)?\\(inf\\|nan\\)") + (should (equal (get-text-property (match-beginning 0) 'face) + face))))))) + + (ert-deftest cperl-test-fontify-class () "Test fontification of the various elements in a Perl class." (skip-unless (eq cperl-test-mode #'cperl-mode)) @@ -241,6 +274,24 @@ attributes, prototypes and signatures." 'font-lock-variable-name-face)) (should (equal (get-text-property (match-beginning 1) 'face) 'font-lock-variable-name-face)) + ;; Fields + (goto-char (point-min)) + (search-forward-regexp "\\(field\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-keyword-face)) + (search-forward-regexp "\\(decorated\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-variable-name-face)) + (search-forward-regexp "\\(:param\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-constant-face)) + (search-forward-regexp "\\(get_decoration\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-string-face)) + ;; Initializers are no attributes + (search-forward-regexp "\\(not_an\\)") + (should-not (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-constant-face)) ))) (ert-deftest cperl-test-fontify-special-variables () @@ -516,7 +567,7 @@ Also includes valid cases with whitespace in strange places." valid invalid))) (ert-deftest cperl-test-attribute-list-rx () - "Test attributes and attribute lists" + "Test attributes and attribute lists." (skip-unless (eq cperl-test-mode #'cperl-mode)) (let ((valid '(":" ":foo" ": bar()" ":baz(quux):" @@ -533,7 +584,26 @@ Also includes valid cases with whitespace in strange places." (cperl-test--validate-regexp (rx (eval cperl--attribute-list-rx)) valid invalid))) -(ert-deftest cperl-test-prototype-rx () +(ert-deftest cperl-test-field-declaration-rx () + "Test field declarations with and without attributes." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((valid + '("field $fold" + "field @many" + "field %ofStrawberries" + "field $required :param" + "field $renamed :param(alias)" + "field $readable : param reader(get_readable)")) + (invalid + '("field name" ; missing sigil + "field $else::where" ; invalid qualification + "field &code"))) ; invalid sigil + (cperl-test--validate-regexp (rx (eval cperl--field-declaration-rx)) + valid invalid))) + + + + (ert-deftest cperl-test-prototype-rx () "Test subroutine prototypes" (skip-unless (eq cperl-test-mode #'cperl-mode)) (let ((valid @@ -562,6 +632,21 @@ Also includes valid cases with whitespace in strange places." (cperl-test--validate-regexp (rx (eval cperl--signature-rx)) valid invalid))) +(ert-deftest cperl-test-autogenerated-reader-rx () + (let ((code-examples '("field $name :reader;" + "field $field :reader(name);" + "field $name :param :reader;" + "field $field :param :reader(name);" + "field $field :reader(name) :param;" + "field $field :reader(name) = 'value';"))) + (dolist (code code-examples) + (with-temp-buffer + (insert code) + (goto-char (point-min)) + (search-forward-regexp (rx (eval cperl--sub-name-generated-rx))) + (should (string= (match-string 1) "reader")) + (should (string= (match-string 2) "name")))))) + ;;; Test unicode identifier in various places (defun cperl--test-unicode-setup (code string) @@ -604,7 +689,7 @@ point after the first occurrence of STRING (no regexp!)." (goto-char (point-min)) (search-forward "-34") (beginning-of-defun) - (should (looking-at "sub"))))) + (should (looking-at "sub"))))) (ert-deftest cperl-test-unicode-varname () (with-temp-buffer @@ -827,6 +912,41 @@ perl-mode generally does not stringify bareword hash keys." (insert word) (should (string= word (cperl-word-at-point-hard))))))) +(ert-deftest cperl-test-extra-delimiters () + "Test whether cperl-mode can process unicode delimiters. +The minor mode `cperl-extra-paired-delimiters-mode' controls whether we +have extra paired delimiters." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (with-temp-buffer + (insert-file-contents (ert-resource-file "extra-delimiters.pl")) + (funcall cperl-test-mode) + (cperl-extra-paired-delimiters-mode t) + (font-lock-ensure) + (goto-char (point-min)) + (search-forward-regexp "\\(label:\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + font-lock-constant-face)) + (search-forward-regexp "\\(comment\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + font-lock-comment-face)) + (search-forward-regexp "\\(sanity\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + font-lock-variable-name-face)) + ;; Now switch off the minor mode and redo + (cperl-extra-paired-delimiters-mode -1) + (font-lock-ensure) + (goto-char (point-min)) + (search-forward-regexp "\\(label:\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + font-lock-string-face)) + (search-forward-regexp "\\(comment\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + font-lock-string-face)) + (search-forward-regexp "\\(sanity\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + font-lock-variable-name-face)))) + + ;;; Function test: Building an index for imenu (ert-deftest cperl-test-imenu-index () @@ -853,7 +973,9 @@ created by CPerl mode, so skip it for Perl mode." "Package::in_package_again" "Erdős::Number::erdős_number" "Class::Class::init" - "Class::Inner::init_again"))) + "Class::Inner::init_again" + "With::Readers::auto_reader" + "With::Readers::named"))) (dolist (sub expected) (should (assoc-string sub index))))))) commit 5416889873219988ce9e023eaf448fdbe691d304 Author: Basil L. Contovounesios Date: Mon Jun 10 09:42:10 2024 +0200 ; Fix recent change to outline.el. The library now makes use of hash-table-empty-p. diff --git a/lisp/outline.el b/lisp/outline.el index 00bfb231302..421fbfd6d1f 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -34,7 +34,9 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) +(eval-when-compile + (require 'cl-lib) + (require 'subr-x)) (require 'icons) (defgroup outlines nil commit b7b43931ee4263e81bdaf41da571b94e01d10eff Author: Po Lu Date: Mon Jun 10 15:37:58 2024 +0800 Minor revisions to Android key bindings * etc/PROBLEMS (Runtime problems specific to Android): Document inappropriate generation of F3 on certain systems. * lisp/bindings.el ([iconify-frame], [make-frame-visible]): Update references to long-obsolete ignore-event command. * lisp/term/android-win.el ([KEYCODE_NOTIFICATION], [\83]): Ignore these two nuisance keys by default. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 085ed4d0532..6c143d22de4 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -3666,7 +3666,7 @@ result that the next redisplay recenters the window around this outdated position. There is no solution but installing a more cooperative--and preferably free--input method. -** The default input method sometimes performs edits out of place in large buffers. +** The default input method performs edits elsewhere than point in large buffers. When first reactivated in a window after having been dismissed, certain heuristics applied by the "Android Keyboard (AOSP)" input method to @@ -3680,6 +3680,14 @@ in the input method that can be easily reproduced by inserting lengthy documents into any text editor, with no real solution except avoiding edit suggestions from recently-reactivated input methods. +** The F3 key appears to be spontaneously activated. + +It is possible that this is a product of your inadvertently contacting +the back-facing fingerprint sensor, which generates F3 key events on +devices manufactured by OnePlus and possibly others. Sadly, to the best +of our knowledge such events cannot be distinguished from legitimate +keypresses. + * Build-time problems ** Configuration diff --git a/lisp/bindings.el b/lisp/bindings.el index 5a8c7cfafd7..6b34c5750c1 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -978,9 +978,8 @@ language you are using." ;; It seems that they can't because they're handled via ;; special-event-map which is used at very low-level. -stef (global-set-key [delete-frame] 'handle-delete-frame) -(global-set-key [iconify-frame] 'ignore-event) -(global-set-key [make-frame-visible] 'ignore-event) - +(global-set-key [iconify-frame] 'ignore) +(global-set-key [make-frame-visible] 'ignore) ;These commands are defined in editfns.c ;but they are not assigned to keys there. diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index bab6b6b9ff0..3e0f71abf91 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -617,6 +617,16 @@ accessible to other programs." :ccl-decoder 'android-decode-jni :ccl-encoder 'android-encode-jni) + +;; Default key definitions. + +;; Suppress KEYCODE_NOTIFICATION, which has been observed to be +;; spontaneously generated on certain tablets, so that the user may not +;; be disturbed by intrusive messages when it is registered. +(global-set-key [KEYCODE_NOTIFICATION] #'ignore) +(global-set-key [\83] #'ignore) ; KEYCODE_NOTIFICATION on pre-Honeycomb + ; releases. + (provide 'android-win) ;; android-win.el ends here. commit d6ecabe23b752116e48e8fbb28ee6f47eef5ec18 Author: Basil L. Contovounesios Date: Mon Jun 10 07:29:38 2024 +0200 ; Tweak recent NEWS and window.el docs. diff --git a/etc/NEWS b/etc/NEWS index f4cb7c1a3c8..75c26c031c2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -129,7 +129,7 @@ to your init: ** The default process filter was rewritten in native code. The round-trip through the Lisp function 'internal-default-process-filter' is skipped when the process filter is -the default one. It's reimplemented in native code, reducing GC churn. +the default one. It's reimplemented in native code, reducing GC churn. To undo the change, set 'read-process-output-fast' to nil. diff --git a/lisp/window.el b/lisp/window.el index 16aee6a306a..604b9868921 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -7852,14 +7852,14 @@ Action alist entries are: `some-window' -- This entry defines which window `display-buffer-use-some-window' should choose. The possible choices are `lru' or nil (the default) to select the least recently used window, - and `mru' to select the most recently used window. It can also be - a function that takes two arguments: a buffer and an alist, and should - return the window where to display the buffer. If the value is `lru', - it avoids selecting windows that are not full-width and windows on - another frame. If the value is `mru', it does not consider the - selected window and windows on any frame but the selected one. - It's useful to customize `display-buffer-base-action' to - `(nil . ((some-window . mru))) when you want to display buffers in the + and `mru' to select the most recently used window. It can also be a + function that takes two arguments: a buffer and an alist, and should + return the window in which to display the buffer. If the value is + `lru', it avoids selecting windows that are not full-width and windows + on another frame. If the value is `mru', it does not consider the + selected window and windows on any frame but the selected one. It's + useful to customize `display-buffer-base-action' to + `(nil . ((some-window . mru)))' when you want to display buffers in the same non-selected window in a configuration with more than two windows. `body-function' -- A function called with one argument - the displayed window. It is called after the buffer is