commit 338337ec32a210c611231313b3da70a815b2af0f (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Wed Jul 10 10:39:33 2024 +0800 * configure.ac: Fix typo in commentary of strlen substitute. diff --git a/configure.ac b/configure.ac index ee2ef1c60fb..54c46151bd5 100644 --- a/configure.ac +++ b/configure.ac @@ -1612,7 +1612,7 @@ AC_DEFUN([gl_TYPE_OFF64_T], AC_SUBST([HAVE_OFF64_T])]) # `strnlen' cannot accept nlen greater than the size of the object S -# on Android 2.2 and earlier. +# on Android 5.0 and earlier. m4_define([ORIGINAL_AC_FUNC_STRNLEN], m4_defn([AC_FUNC_STRNLEN])) AC_DEFUN([AC_FUNC_STRNLEN], [ AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])dnl commit 8e46f44ea0eb761e24beda8c5cdbc8fcca87307a Author: Jim Porter Date: Sat Jul 6 14:09:08 2024 -0700 Improve Eshell's behavior when waiting for processes This has a few benefits. First, it fixes a race condition when killing old processes in 'eshell-command'. Second, the "wait" built-in command is now more useful. Finally, killing processes when exiting Eshell (via 'eshell-round-robin-kill') should be much faster. * lisp/eshell/esh-proc.el (esh-opt): Require. (eshell-wait-for-process): Make obsolete in favor of... (eshell-wait-for-processes): ... this. Accept a timeout and support PIDs. Update callers. (eshell/wait): New implementation accepting -t/--timeout. (eshell-round-robin-kill): Use 'eshell-wait-for-processes'. * lisp/eshell/eshell.el (eshell-command): Use 'eshell-round-robin-kill'. * doc/misc/eshell.texi (List of Built-ins): Document the new "wait" behavior. * etc/NEWS: Announce this change. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 69f94fab469..8547131194e 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -1201,8 +1201,11 @@ or a string, referring to an environment variable. @cmindex wait @cindex processes, waiting for -@item wait [@var{process}]@dots{} -Wait until each specified @var{process} has exited. +@item wait [-t @var{timeout}] [@var{process}]@dots{} +Wait until each specified @var{process} has exited. Processes can +either be process objects (@pxref{Processes, , , elisp, GNU Emacs Lisp +Reference Manual}) or integer PIDs. If you pass @code{-t} or +@code{--timeout}, wait at most that many seconds before exiting. @cmindex which @item which @var{command}@dots{} diff --git a/etc/NEWS b/etc/NEWS index 8c49d4b24f6..f10f9ae4d65 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -54,6 +54,12 @@ this will prompt for confirmation before creating a new buffer when necessary. To restore the previous behavior, set this option to 'confirm-kill-process'. ++++ +*** Eshell's built-in "wait" command now accepts a timeout. +By passing "-t" or "--timeout", you can specify a maximum time to wait +for the processes to exit. Additionally, you can now wait for external +processes by passing their PIDs. + ** SHR +++ diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 0b3137127d2..b936f68a57a 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -1299,7 +1299,7 @@ have been replaced by constants." (if-let (((memq (car form) eshell-deferrable-commands)) (procs (eshell-make-process-list result))) (if synchronous-p - (apply #'eshell/wait procs) + (funcall #'eshell-wait-for-processes procs) (eshell-manipulate form "inserting ignore form" (setcar form 'ignore) (setcdr form nil)) diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index f982e2101f5..0dcdf3bb76c 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -25,6 +25,7 @@ (require 'esh-arg) (require 'esh-io) +(require 'esh-opt) (require 'esh-util) (require 'pcomplete) @@ -184,16 +185,46 @@ This is like `process-live-p', but additionally checks whether ;; cleared out the handles (see `eshell-sentinel'). (process-get process :eshell-handles))) -(defun eshell-wait-for-process (&rest procs) - "Wait until PROCS have successfully completed." - (dolist (proc procs) - (when (eshell-processp proc) - (while (eshell-process-active-p proc) - (when (input-pending-p) - (discard-input)) - (sit-for eshell-process-wait-time))))) +(defun eshell-wait-for-processes (&optional procs timeout) + "Wait until PROCS have completed execution. +If TIMEOUT is non-nil, wait at most that many seconds. Return non-nil +if all the processes finished executing before the timeout expired." + (let ((expiration (when timeout (time-add (current-time) timeout)))) + (catch 'timeout + (dolist (proc procs) + (while (if (processp proc) + (eshell-process-active-p proc) + (process-attributes proc)) + (when (input-pending-p) + (discard-input)) + (when (and expiration + (not (time-less-p (current-time) expiration))) + (throw 'timeout nil)) + (sit-for eshell-process-wait-time))) + t))) -(defalias 'eshell/wait #'eshell-wait-for-process) +(defun eshell-wait-for-process (&rest procs) + "Wait until PROCS have completed execution." + (declare (obsolete 'eshell-wait-for-processes "31.1")) + (eshell-wait-for-processes procs)) + +(defun eshell/wait (&rest args) + "Wait until processes have completed execution." + (eshell-eval-using-options + "wait" args + '((?h "help" nil nil "show this usage screen") + (?t "timeout" t timeout "timeout in seconds") + :preserve-args + :show-usage + :usage "[OPTION] PROCESS... +Wait until PROCESS(es) have completed execution.") + (when (stringp timeout) + (setq timeout (string-to-number timeout))) + (dolist (arg args) + (unless (or (processp arg) (natnump arg)) + (error "wait: invalid argument type: %s" (type-of arg)))) + (unless (eshell-wait-for-processes args timeout) + (error "wait: timed out after %s seconds" timeout)))) (defun eshell/jobs () "List processes, if there are any." @@ -626,16 +657,14 @@ long to delay between signals." (defun eshell-round-robin-kill (&optional query) "Kill current process by trying various signals in sequence. See the variable `eshell-kill-processes-on-exit'." - (let ((sigs eshell-kill-process-signals)) - (while sigs + (catch 'done + (dolist (sig eshell-kill-process-signals) (eshell-process-interact - (lambda (proc) - (signal-process (process-id proc) (car sigs))) t query) - (setq query nil) - (if (not eshell-process-list) - (setq sigs nil) - (sleep-for eshell-kill-process-wait-time) - (setq sigs (cdr sigs)))))) + (lambda (proc) (signal-process proc sig)) t query) + (when (eshell-wait-for-processes (mapcar #'car eshell-process-list) + eshell-kill-process-wait-time) + (throw 'done nil)) + (setq query nil)))) (defun eshell-query-kill-processes () "Kill processes belonging to the current Eshell buffer, possibly with query." diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index 568f6745067..b7be3dd1643 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -176,7 +176,7 @@ (require 'cl-lib)) (require 'esh-util) (require 'esh-module) ;For eshell-using-module -(require 'esh-proc) ;For eshell-wait-for-process +(require 'esh-proc) ;For eshell-wait-for-processes (require 'esh-io) ;For eshell-last-command-status (require 'esh-cmd) @@ -357,8 +357,7 @@ buffer is already taken by another running shell command." (with-current-buffer bufname ;; Stop all the processes in the old buffer (there may ;; be several). - (eshell-process-interact #'interrupt-process t)) - (accept-process-output) + (eshell-round-robin-kill)) (kill-buffer bufname)) ((eq eshell-command-async-buffer 'confirm-new-buffer) (shell-command--same-buffer-confirm "Use a new buffer") @@ -377,7 +376,7 @@ buffer is already taken by another running shell command." ;; make the output as attractive as possible, with no ;; extraneous newlines (unless async - (apply #'eshell-wait-for-process (cadr eshell-foreground-command)) + (funcall #'eshell-wait-for-processes (cadr eshell-foreground-command)) (cl-assert (not eshell-foreground-command)) (goto-char (point-max)) (while (and (bolp) (not (bobp))) commit 342998511add79c594a170dc04ecda2f2db0fd36 Author: Jim Porter Date: Tue Jul 9 17:19:26 2024 -0700 Don't use the Lisp implementation of "kill" in remote Eshell directories * lisp/eshell/esh-proc.el (eshell/kill): When in a remote directory, fall back to the external "kill" program (bug#72013). diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index a5e9de79907..f982e2101f5 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -206,6 +206,11 @@ This is like `process-live-p', but additionally checks whether Usage: kill [-] | ... Accepts PIDs and process objects. Optionally accept signals and signal names." + ;; The implementation below only supports local PIDs. For remote + ;; connections, fall back to the external "kill" command. + (when (file-remote-p default-directory) + (declare-function eshell-external-command "esh-ext" (command args)) + (throw 'eshell-external (eshell-external-command "kill" args))) ;; If the first argument starts with a dash, treat it as the signal ;; specifier. (let ((signum 'SIGINT)) commit 57defada883c7b93117246c52a383d417f77c765 Author: Andrea Corallo Date: Tue Jul 9 22:31:34 2024 +0200 * test/src/comp-tests.el (compile-forms): Simplify test. diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 60bc1903801..33b127d5d26 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -495,8 +495,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (comp-deftest compile-forms () "Verify lambda form native compilation." (should-error (native-compile '(+ 1 foo))) - (let ((lexical-binding t) - (f (native-compile '(lambda (x) (1+ x))))) + (let ((f (native-compile '(lambda (x) (1+ x))))) (should (native-comp-function-p f)) (should (= (funcall f 2) 3))) (let* ((lexical-binding nil) commit b9b9322a8e62299a223ff6673ed33de90d513bc4 Author: Andrea Corallo Date: Tue Jul 9 21:11:43 2024 +0200 Support interpreted functions as input for 'native-compile' (bug#71934) * lisp/emacs-lisp/comp.el (comp--spill-lap-single-function): New function. (comp--spill-lap-function): Make use of and do not accept '(closure ...' as input. (comp--spill-lap-function): Specialize on interpreted functions as well. (native-compile): Update doc. * test/src/comp-tests.el (compile-interpreted-functions): New test. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 947fb06e602..0a2c520c5d5 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -792,21 +792,29 @@ clashes." :byte-func byte-code))) (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h))) -(cl-defmethod comp--spill-lap-function ((form list)) - "Byte-compile FORM, spilling data from the byte compiler." - (unless (memq (car-safe form) '(lambda closure)) - (signal 'native-compiler-error - '("Cannot native-compile, form is not a lambda or closure"))) +(defun comp--spill-lap-single-function (function) + "Byte-compile FUNCTION, spilling data from the byte compiler." (unless (comp-ctxt-output comp-ctxt) (setf (comp-ctxt-output comp-ctxt) (make-temp-file "comp-lambda-" nil ".eln"))) - (let* ((byte-code (byte-compile form)) + (let* ((byte-code (byte-compile function)) (c-name (comp-c-func-name "anonymous-lambda" "F"))) - (setf (comp-ctxt-top-level-forms comp-ctxt) - (list (make-byte-to-native-func-def :name '--anonymous-lambda - :c-name c-name - :byte-func byte-code))) - (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h))) + (setf (comp-ctxt-top-level-forms comp-ctxt) + (list (make-byte-to-native-func-def :name '--anonymous-lambda + :c-name c-name + :byte-func byte-code))) + (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h))) + +(cl-defmethod comp--spill-lap-function ((form list)) + "Byte-compile FORM, spilling data from the byte compiler." + (unless (eq (car-safe form) 'lambda) + (signal 'native-compiler-error + '("Cannot native-compile, form is not a lambda"))) + (comp--spill-lap-single-function form)) + +(cl-defmethod comp--spill-lap-function ((fun interpreted-function)) + "Spill data from the byte compiler for the interpreted-function FUN." + (comp--spill-lap-single-function fun)) (defun comp--intern-func-in-ctxt (_ obj) "Given OBJ of type `byte-to-native-lambda', create a function in `comp-ctxt'." @@ -3577,14 +3585,13 @@ Search happens in `native-comp-eln-load-path'." ;;;###autoload (defun native-compile (function-or-file &optional output) "Compile FUNCTION-OR-FILE into native code. -This is the synchronous entry-point for the Emacs Lisp native -compiler. FUNCTION-OR-FILE is a function symbol, a form, or the -filename of an Emacs Lisp source file. If OUTPUT is non-nil, use -it as the filename for the compiled object. If FUNCTION-OR-FILE -is a filename, if the compilation was successful return the -filename of the compiled object. If FUNCTION-OR-FILE is a -function symbol or a form, if the compilation was successful -return the compiled function." +This is the synchronous entry-point for the Emacs Lisp native compiler. +FUNCTION-OR-FILE is a function symbol, a form, an interpreted-function, +or the filename of an Emacs Lisp source file. If OUTPUT is non-nil, use +it as the filename for the compiled object. If FUNCTION-OR-FILE is a +filename, if the compilation was successful return the filename of the +compiled object. If FUNCTION-OR-FILE is a function symbol or a form, if +the compilation was successful return the compiled function." (declare (ftype (function ((or string symbol) &optional string) (or native-comp-function string)))) (comp--native-compile function-or-file nil output)) diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 6744f14435b..60bc1903801 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -504,6 +504,12 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (should (native-comp-function-p f)) (should (= (funcall f 2) 3)))) +(comp-deftest compile-interpreted-functions () + "Verify native compilation of interpreted functions." + (let ((f (native-compile (eval '(lambda (x) (1+ x)))))) + (should (native-comp-function-p f)) + (should (= (funcall f 2) 3)))) + (comp-deftest comp-test-defsubst () ;; Bug#42664, Bug#43280, Bug#44209. (should-not (native-comp-function-p (symbol-function 'comp-test-defsubst-f)))) commit ac797f60160848fb625db4855befc68352d6cbd2 Author: Mattias Engdegård Date: Tue Jul 9 18:30:48 2024 +0200 ; * lisp/net/shr.el (shr-image-zoom-levels): Fix wrong type. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 4ccd8a5a85a..39271cc5296 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -233,10 +233,10 @@ can be one of the following symbols: * `fill-height': Display the image zoomed to fill the height of the current window." :version "31.1" - :type '(set (choice (const :tag "Fit to window size" fit) - (const :tag "Original size" original) - (const :tag "Full image size" image) - (const :tag "Fill window height" fill-height)))) + :type '(set (const :tag "Fit to window size" fit) + (const :tag "Original size" original) + (const :tag "Full image size" image) + (const :tag "Fill window height" fill-height))) (defvar shr-content-function nil "If bound, this should be a function that will return the content. commit 7e358aa706f9dbfce24304e8a05904538615537f Author: Mattias Engdegård Date: Tue Jul 9 10:01:03 2024 +0200 Use cheaper string constructors * src/coding.c (make_string_from_utf8): * src/fileio.c (file_name_directory): * src/lread.c (Fintern): * src/gnutls.c (Fgnutls_format_certificate): Use `make_multibyte_string` and `make_unibyte_string` instead of more expensive `make_specified_string` and `make_string_from_bytes`. diff --git a/src/coding.c b/src/coding.c index b48164efc69..e42b6b6e720 100644 --- a/src/coding.c +++ b/src/coding.c @@ -6365,7 +6365,7 @@ make_string_from_utf8 (const char *text, ptrdiff_t nbytes) /* If TEXT is a valid UTF-8 string, we can convert it to a Lisp string directly. Otherwise, we need to decode it. */ if (chars == nbytes || bytes == nbytes) - return make_specified_string (text, chars, nbytes, true); + return make_multibyte_string (text, chars, nbytes); else { struct coding_system coding; diff --git a/src/fileio.c b/src/fileio.c index 7afe3e75737..fa280f2db00 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -523,7 +523,7 @@ file_name_directory (Lisp_Object filename) else { dostounix_filename (beg); - tem_fn = make_specified_string (beg, -1, p - beg, 0); + tem_fn = make_unibyte_string (beg, p - beg); } SAFE_FREE (); return tem_fn; diff --git a/src/gnutls.c b/src/gnutls.c index 3ff7f21d5a5..334d1d47eb6 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1646,8 +1646,7 @@ string representation. */) emacs_gnutls_strerror (err)); } - Lisp_Object result = make_string_from_bytes ((char *) out.data, out.size, - out.size); + Lisp_Object result = make_unibyte_string ((char *) out.data, out.size); gnutls_free (out.data); gnutls_x509_crt_deinit (crt); diff --git a/src/lread.c b/src/lread.c index c3b0e8a3ef5..c1f309866c8 100644 --- a/src/lread.c +++ b/src/lread.c @@ -5025,8 +5025,8 @@ it defaults to the value of `obarray'. */) { if (longhand) { - tem = intern_driver (make_specified_string (longhand, longhand_chars, - longhand_bytes, true), + tem = intern_driver (make_multibyte_string (longhand, longhand_chars, + longhand_bytes), obarray, tem); xfree (longhand); } commit acfc3884bf58f7b407c42c8751affbcb365eb105 Author: Michael Albinus Date: Tue Jul 9 17:37:50 2024 +0200 Warn if D-Bus error "InteractiveAuthorizationRequired" occurs * lisp/net/dbus.el (dbus-error-interactive-authorization-required): New defconst. (dbus-warn-interactive-authorization-required): New defun. (dbus-event-error-functions): Add it. diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index a50f3a93938..8426d04fefd 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -192,6 +192,10 @@ See /usr/include/dbus-1.0/dbus/dbus-protocol.h.") (defconst dbus-error-failed (concat dbus-error-dbus ".Failed") "A generic error; \"something went wrong\" - see the error message for more.") +(defconst dbus-error-interactive-authorization-required + (concat dbus-error-dbus ".InteractiveAuthorizationRequired") + "Interactive authentication required.") + (defconst dbus-error-invalid-args (concat dbus-error-dbus ".InvalidArgs") "Invalid arguments passed to a method call.") @@ -243,7 +247,9 @@ Otherwise, return result of last form in BODY, or all other errors." (progn ,@body) (dbus-error (when dbus-debug (signal (car err) (cdr err)))))) -(defvar dbus-event-error-functions '(dbus-notice-synchronous-call-errors) +(defvar dbus-event-error-functions + '(dbus-notice-synchronous-call-errors + dbus-warn-interactive-authorization-required) "Functions to be called when a D-Bus error happens in the event handler. Every function must accept two arguments, the event and the error variable caught in `condition-case' by `dbus-error'.") @@ -282,6 +288,18 @@ The result will be made available in `dbus-return-values-table'." (setcar result :error) (setcdr result er)))) +(defun dbus-warn-interactive-authorization-required (ev er) + "Detect `dbus-error-interactive-authorization-required'." + (when (string-equal (cadr er) dbus-error-interactive-authorization-required) + (lwarn 'dbus :warning "%S" (cdr er)) + (let* ((key (list :serial + (dbus-event-bus-name ev) + (dbus-event-serial-number ev))) + (result (gethash key dbus-return-values-table))) + (when (consp result) + (setcar result :complete) + (setcdr result nil))))) + (defun dbus-call-method (bus service path interface method &rest args) "Call METHOD on the D-Bus BUS. commit df265195004836621c1e6c7042534e17b99e26ec Merge: 4ca35cbb6eb 8350ebd22e9 Author: Po Lu Date: Tue Jul 9 22:04:03 2024 +0800 Merge from savannah/emacs-30 8350ebd22e9 Fix bug#71929 8f96e0064fa ; Change `imap-shell-host` docstring to mention SSH commit 8350ebd22e983df5eb9ad33d427bd3d6a09ffe7f Author: Po Lu Date: Tue Jul 9 22:00:39 2024 +0800 Fix bug#71929 * src/image.c (free_image_cache): Unconditionally release image cache, as this function is only called with its existence already established. * src/xfaces.c (free_frame_faces): Clear FRAME_IMAGE_CACHE (f). (bug#71929) diff --git a/src/dispextern.h b/src/dispextern.h index 51dc354d37c..cc248a4472e 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3653,7 +3653,7 @@ extern void x_kill_gs_process (Pixmap, struct frame *); extern Lisp_Object image_find_image_file (Lisp_Object); struct image_cache *make_image_cache (void); -void free_image_cache (struct frame *); +extern void free_image_cache (struct frame *); void clear_image_caches (Lisp_Object); void mark_image_cache (struct image_cache *); void image_prune_animation_caches (bool); diff --git a/src/image.c b/src/image.c index 2945447b962..2ee2f3245be 100644 --- a/src/image.c +++ b/src/image.c @@ -2304,23 +2304,18 @@ void free_image_cache (struct frame *f) { struct image_cache *c = FRAME_IMAGE_CACHE (f); - if (c) - { - ptrdiff_t i; + ptrdiff_t i; - /* Cache should not be referenced by any frame when freed. */ - eassert (c->refcount == 0); + /* Cache should not be referenced by any frame when freed. */ + eassert (c->refcount == 0); - for (i = 0; i < c->used; ++i) - free_image (f, c->images[i]); - xfree (c->images); - xfree (c->buckets); - xfree (c); - FRAME_IMAGE_CACHE (f) = NULL; - } + for (i = 0; i < c->used; ++i) + free_image (f, c->images[i]); + xfree (c->images); + xfree (c->buckets); + xfree (c); } - /* Clear image cache of frame F. FILTER=t means free all images. FILTER=nil means clear only images that haven't been displayed for some time. diff --git a/src/xfaces.c b/src/xfaces.c index 188dd4778bc..684b6ccfac7 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -712,6 +712,11 @@ free_frame_faces (struct frame *f) --image_cache->refcount; if (image_cache->refcount == 0) free_image_cache (f); + + /* The `image_cache' field must be emptied, in case references + to this dead frame should remain and be scanned by GC. + (bug#71929) */ + FRAME_IMAGE_CACHE (f) = NULL; } } #endif /* HAVE_WINDOW_SYSTEM */ commit 4ca35cbb6ebe9b2bd0690d73b9ff722be7e07b2c Author: Po Lu Date: Tue Jul 9 21:16:47 2024 +0800 ; * src/dbusbind.c (Fdbus_message_internal): Fix coding style. diff --git a/src/dbusbind.c b/src/dbusbind.c index 27b9c190793..1a8bcfdf5d4 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1523,7 +1523,7 @@ usage: (dbus-message-internal &rest REST) */) CHECK_FIXNAT (args[count+1]); timeout = min (XFIXNAT (args[count+1]), INT_MAX); - count = count+2; + count = count + 2; } /* Check for authorizable parameter. */ else if (EQ (args[count], QCauthorizable)) @@ -1540,7 +1540,7 @@ usage: (dbus-message-internal &rest REST) */) XD_DEBUG_MESSAGE (":authorizable not supported"); #endif - count = count+2; + count = count + 2; } else break; commit 8f96e0064fa701655413bdeb4612b5b2a63102c4 Author: Stefan Kangas Date: Tue Jul 9 14:09:20 2024 +0200 ; Change `imap-shell-host` docstring to mention SSH * lisp/net/imap.el (imap-shell-host): Doc fix; mention SSH instead of rlogin. diff --git a/lisp/net/imap.el b/lisp/net/imap.el index a06740528e9..614fc56b513 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -228,7 +228,7 @@ See also `imap-log'." :type 'boolean) (defcustom imap-shell-host "gateway" - "Hostname of rlogin proxy." + "Hostname of SSH proxy." :type 'string) (defcustom imap-default-user (user-login-name) commit 813ca8c214a7105190d359edcbedcf30aafb0bfa Author: Michael Albinus Date: Tue Jul 9 14:01:07 2024 +0200 Adapt dbus-tests.el * test/lisp/net/dbus-tests.el (dbus-test04-call-method-authorizable): New test. (dbus--test-signal-handler): Remove debug message. diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index 78ae79b8711..7901522a403 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -732,6 +732,38 @@ is in progress." ;; Cleanup. (dbus-unregister-service :session dbus--test-service))) +(ert-deftest dbus-test04-call-method-authorizable () + "Verify `dbus-call-method' request authorizable." + :tags '(:expensive-test) + (skip-unless dbus--test-enabled-session-bus) + (skip-unless + (dbus-ignore-errors + (dbus-call-method + :session dbus-service-dbus dbus-path-dbus + dbus-interface-dbus "ListNames"))) + + (should + (dbus-call-method + :session dbus-service-dbus dbus-path-dbus + dbus-interface-dbus "ListNames" :authorizable t)) + + (should + (dbus-call-method + :session dbus-service-dbus dbus-path-dbus + dbus-interface-dbus "ListNames" :authorizable nil)) + + (should + (dbus-call-method + :session dbus-service-dbus dbus-path-dbus + dbus-interface-dbus "ListNames" :authorizable 'something)) + + ;; Only method calls are allowed for :authorizable. + (should-error + (dbus-send-signal + :session dbus--test-service dbus--test-path + dbus--test-interface "Foo" :authorizable t "foo") + :type 'dbus-error)) + (defvar dbus--test-event-expected nil "The expected event in `dbus--test-signal-handler'.") @@ -741,7 +773,7 @@ is in progress." (defun dbus--test-signal-handler (&rest args) "Signal handler for `dbus-test*-signal' and `dbus-test08-register-monitor'." (ignore-error dbus-error - (message "%S" last-input-event) + ;; (message "%S" last-input-event) (let ((last-input-event last-input-event)) (when (or (null dbus--test-event-expected) (and (equal (dbus-event-bus-name last-input-event) commit 551a71c313be26d067e59fa11c79e4ef5c550e92 Author: Steven Allen Date: Tue Jul 9 13:16:43 2024 +0200 Support interactive D-Bus authorization When invoking D-Bus methods, let the user enable interactive authorization by passing an :authorizable t parameter. This makes it possible to D-Bus methods that require polkit authorization. * configure.ac (HAVE_DBUS_MESSAGE_SET_ALLOW_INTERACTIVE_AUTHORIZATION): Set a new variable if `dbus_message_set_allow_interactive_authorization' is available. * src/dbusbind.c (dbus-message-internal): Allow interactive authorization by passing :authorizable t. * doc/misc/dbus.texi (Synchronous Methods, Asynchronous Methods): * etc/NEWS: * lisp/net/dbus.el (dbus-call-method-asynchronously): Document the new parameter. diff --git a/configure.ac b/configure.ac index 909f5786c9a..ee2ef1c60fb 100644 --- a/configure.ac +++ b/configure.ac @@ -3943,6 +3943,8 @@ if test "${with_dbus}" = "yes"; then dnl dbus_watch_get_unix_fd has been introduced in D-Bus 1.1.1. dnl dbus_type_is_valid and dbus_validate_* have been introduced in dnl D-Bus 1.5.12. + dnl dbus_message_set_allow_interactive_authorization was introduced + dnl in D-Bus 1.8.10. OLD_LIBS=$LIBS LIBS="$LIBS $DBUS_LIBS" AC_CHECK_FUNCS([dbus_watch_get_unix_fd \ @@ -3950,7 +3952,8 @@ if test "${with_dbus}" = "yes"; then dbus_validate_bus_name \ dbus_validate_path \ dbus_validate_interface \ - dbus_validate_member]) + dbus_validate_member \ + dbus_message_set_allow_interactive_authorization]) LIBS=$OLD_LIBS DBUS_OBJ=dbusbind.o fi diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index e5d867acd40..20d26c80d38 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -1208,7 +1208,7 @@ which carries the input parameters to the object owning the method to be called, and a reply message returning the resulting output parameters from the object. -@defun dbus-call-method bus service path interface method &optional :timeout timeout &rest args +@defun dbus-call-method bus service path interface method &optional :timeout timeout :authorizable auth &rest args @anchor{dbus-call-method} This function calls @var{method} on the D-Bus @var{bus}. @var{bus} is either the keyword @code{:system} or the keyword @code{:session}. @@ -1223,6 +1223,10 @@ method call must return. The default value is 25,000. If the method call doesn't return in time, a D-Bus error is raised (@pxref{Errors and Events}). +If the parameter @code{:authorizable} is given and the following +@var{auth} is non-@code{nil}, the invoked method may interactively +prompt the user for authorization. The default is @code{nil}. + The remaining arguments @var{args} are passed to @var{method} as arguments. They are converted into D-Bus types as described in @ref{Type Conversion}. @@ -1302,7 +1306,7 @@ emulate the @code{lshal} command on GNU/Linux systems: @cindex method calls, asynchronous @cindex asynchronous method calls -@defun dbus-call-method-asynchronously bus service path interface method handler &optional :timeout timeout &rest args +@defun dbus-call-method-asynchronously bus service path interface method handler &optional :timeout timeout :authorizable auth &rest args This function calls @var{method} on the D-Bus @var{bus} asynchronously. @var{bus} is either the keyword @code{:system} or the keyword @code{:session}. @@ -1321,6 +1325,10 @@ reply message must arrive. The default value is 25,000. If there is no reply message in time, a D-Bus error is raised (@pxref{Errors and Events}). +If the parameter @code{:authorizable} is given and the following +@var{auth} is non-@code{nil}, the invoked method may interactively +prompt the user for authorization. The default is @code{nil}. + The remaining arguments @var{args} are passed to @var{method} as arguments. They are converted into D-Bus types as described in @ref{Type Conversion}. diff --git a/etc/NEWS b/etc/NEWS index 2718765fe16..8c49d4b24f6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -109,6 +109,12 @@ positives. * Lisp Changes in Emacs 31.1 ++++ +*** Support interactive D-Bus authorization. +A new ':authorizable t' parameter has been added to 'dbus-call-method' +and 'dbus-call-method-asynchronously' to allow the user to interactively +authorize the invoked D-Bus method (e.g., via polkit). + * Changes in Emacs 31.1 on Non-Free Operating Systems diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index dd5f0e88859..a50f3a93938 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -297,6 +297,10 @@ TIMEOUT specifies the maximum number of milliseconds before the method call must return. The default value is 25,000. If the method call doesn't return in time, a D-Bus error is raised. +If the parameter `:authorizable' is given and the following AUTH +is non-nil, the invoked method may interactively prompt the user +for authorization. The default is nil. + All other arguments ARGS are passed to METHOD as arguments. They are converted into D-Bus types via the following rules: @@ -427,6 +431,10 @@ TIMEOUT specifies the maximum number of milliseconds before the method call must return. The default value is 25,000. If the method call doesn't return in time, a D-Bus error is raised. +If the parameter `:authorizable' is given and the following AUTH +is non-nil, the invoked method may interactively prompt the user +for authorization. The default is nil. + All other arguments ARGS are passed to METHOD as arguments. They are converted into D-Bus types via the following rules: diff --git a/src/dbusbind.c b/src/dbusbind.c index 35ce03c7911..27b9c190793 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1314,7 +1314,7 @@ The following usages are expected: `dbus-call-method', `dbus-call-method-asynchronously': (dbus-message-internal dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER - &optional :timeout TIMEOUT &rest ARGS) + &optional :timeout TIMEOUT :authorizable AUTH &rest ARGS) `dbus-send-signal': (dbus-message-internal @@ -1512,12 +1512,38 @@ usage: (dbus-message-internal &rest REST) */) XD_SIGNAL1 (build_string ("Unable to create an error message")); } - /* Check for timeout parameter. */ - if ((count + 2 <= nargs) && EQ (args[count], QCtimeout)) + while ((count + 2 <= nargs)) { - CHECK_FIXNAT (args[count+1]); - timeout = min (XFIXNAT (args[count+1]), INT_MAX); - count = count+2; + /* Check for timeout parameter. */ + if (EQ (args[count], QCtimeout)) + { + if (mtype != DBUS_MESSAGE_TYPE_METHOD_CALL) + XD_SIGNAL1 + (build_string (":timeout is only supported on method calls")); + + CHECK_FIXNAT (args[count+1]); + timeout = min (XFIXNAT (args[count+1]), INT_MAX); + count = count+2; + } + /* Check for authorizable parameter. */ + else if (EQ (args[count], QCauthorizable)) + { + if (mtype != DBUS_MESSAGE_TYPE_METHOD_CALL) + XD_SIGNAL1 + (build_string (":authorizable is only supported on method calls")); + + /* Ignore this keyword if unsupported. */ +#ifdef HAVE_DBUS_MESSAGE_SET_ALLOW_INTERACTIVE_AUTHORIZATION + dbus_message_set_allow_interactive_authorization + (dmessage, NILP (args[count+1]) ? FALSE : TRUE); +#else + XD_DEBUG_MESSAGE (":authorizable not supported"); +#endif + + count = count+2; + } + else break; + } /* Initialize parameter list of message. */ @@ -1895,6 +1921,9 @@ syms_of_dbusbind (void) /* Lisp symbol for method call timeout. */ DEFSYM (QCtimeout, ":timeout"); + /* Lisp symbol for method interactive authorization. */ + DEFSYM (QCauthorizable, ":authorizable"); + /* Lisp symbols of D-Bus types. */ DEFSYM (QCbyte, ":byte"); DEFSYM (QCboolean, ":boolean"); commit 24cad0e2e773a6f9cbd4a9721694a44246a7c974 Author: Michael Albinus Date: Tue Jul 9 12:11:13 2024 +0200 Make D-Bus tests stable * test/lisp/net/dbus-tests.el (dbus-debug): Declare, not define. (dbus--test-event-expected): New defvar. (dbus--test-signal-handler): Check for `dbus--test-event-expected'. (dbus-test05-register-signal-with-nils) (dbus-test08-register-monitor): Adapt tests. diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index a217c92b1f7..78ae79b8711 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -25,7 +25,7 @@ (require 'ert-x) (require 'dbus) -(defvar dbus-debug nil) +(defvar dbus-debug) (declare-function dbus-get-unique-name "dbusbind.c" (bus)) (defconst dbus--test-enabled-session-bus @@ -732,12 +732,29 @@ is in progress." ;; Cleanup. (dbus-unregister-service :session dbus--test-service))) +(defvar dbus--test-event-expected nil + "The expected event in `dbus--test-signal-handler'.") + (defvar dbus--test-signal-received nil "Received signal value in `dbus--test-signal-handler'.") (defun dbus--test-signal-handler (&rest args) "Signal handler for `dbus-test*-signal' and `dbus-test08-register-monitor'." - (setq dbus--test-signal-received args)) + (ignore-error dbus-error + (message "%S" last-input-event) + (let ((last-input-event last-input-event)) + (when (or (null dbus--test-event-expected) + (and (equal (dbus-event-bus-name last-input-event) + (dbus-event-bus-name dbus--test-event-expected)) + (equal (dbus-event-message-type last-input-event) + (dbus-event-message-type dbus--test-event-expected)) + (equal (dbus-event-service-name last-input-event) + (dbus-event-service-name dbus--test-event-expected)) + (equal (dbus-event-path-name last-input-event) + (dbus-event-path-name dbus--test-event-expected)) + (equal (dbus-event-member-name last-input-event) + (dbus-event-member-name dbus--test-event-expected)))) + (setq dbus--test-signal-received args))))) (defun dbus--test-timeout-handler (&rest _ignore) "Timeout handler, reporting a failed test." @@ -796,7 +813,6 @@ is in progress." "Check signal registration for an own service. SERVICE, PATH, INTERFACE and SIGNAL are ‘nil’. This is interpreted as a wildcard for the respective argument." - :tags '(:unstable) (skip-unless dbus--test-enabled-session-bus) (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) @@ -805,6 +821,14 @@ wildcard for the respective argument." (handler #'dbus--test-signal-handler) registered) + ;; Filter received signals in signal handler. + (setq dbus--test-event-expected + `(dbus-event :session ,dbus-message-type-signal + 0 ;; Serial number doesn't matter. + ,(dbus-get-unique-name :session) + nil ;; Destination doesn't matter. + ,dbus--test-path ,dbus--test-interface ,member ,handler)) + ;; Register signal handler. (should (equal @@ -843,6 +867,7 @@ wildcard for the respective argument." (should-not (dbus-unregister-object registered))) ;; Cleanup. + (setq dbus--test-event-expected nil) (dbus-unregister-service :session dbus--test-service))) (ert-deftest dbus-test06-register-property () @@ -1934,19 +1959,32 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method." (skip-unless dbus--test-enabled-session-bus) (unwind-protect - (let (registered) + (let ((member "Member") + (handler #'dbus--test-signal-handler) + registered) + + ;; Filter received signals in signal handler. + (setq dbus--test-event-expected + `(dbus-event :session-private ,dbus-message-type-signal + 0 ;; Serial number doesn't matter. + ,(dbus-get-unique-name :session) + nil ;; Destination doesn't matter. + ,dbus--test-path ,dbus--test-interface ,member ,handler)) + + ;; Register monitor. (should (equal - (setq registered - (dbus-register-monitor :session #'dbus--test-signal-handler)) - '((:monitor :session-private) - (nil nil dbus--test-signal-handler)))) + (setq + registered + (dbus-register-monitor :session handler)) + `((:monitor :session-private) + (nil nil ,handler)))) ;; Send a signal, shall be traced. (setq dbus--test-signal-received nil) (dbus-send-signal :session dbus--test-service dbus--test-path - dbus--test-interface "Foo" "foo") + dbus--test-interface member "foo") (with-timeout (1 (dbus--test-timeout-handler)) (while (null dbus--test-signal-received) (read-event nil nil 0.1))) @@ -1959,13 +1997,18 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method." (setq dbus--test-signal-received nil) (dbus-send-signal :session dbus--test-service dbus--test-path - dbus--test-interface "Foo" "foo") + dbus--test-interface member "foo") (with-timeout (1 (ignore)) (while (null dbus--test-signal-received) (read-event nil nil 0.1))) - (should-not dbus--test-signal-received)) + (should-not dbus--test-signal-received) + + ;; Unregister monitor. + ;; TODO: This seems to be a noop. And it returns nil. + (dbus-unregister-object registered)) ;; Cleanup. + (setq dbus--test-event-expected nil) (dbus-unregister-service :session dbus--test-service))) (ert-deftest dbus-test09-get-managed-objects () commit 3f0f0712da30f97a029e38b9506b66f177be562c Merge: d883f9a1f35 671ad83026e Author: Andrea Corallo Date: Tue Jul 9 11:23:18 2024 +0200 Merge from savannah/emacs-30 671ad83026e Fix bug#70697 with respect to fringe bitmaps 15c591bad62 Fix byte-compiler warning in calc.el # Conflicts: # lisp/calc/calc.el commit d883f9a1f35c5daed877e4a96ecd7e31c259dc40 Author: Andrea Corallo Date: Tue Jul 9 11:04:30 2024 +0200 Silence a warning in 'calc-embedded-open-close-new-formula-alist' * lisp/calc/calc.el (calc-embedded-open-close-new-formula-alist): Silence warning. diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 1bbc297e58c..8b2277e5973 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -341,7 +341,8 @@ See calc-embedded-open-plain." (defcustom calc-embedded-open-close-new-formula-alist nil - "Alist of major modes with pairs of new formula delimiters used by `calc-embedded'." + "Alist of major modes with pairs of new formula delimiters used by +`calc-embedded'." :type '(alist :key-type (symbol :tag "Major mode") :value-type (list (string :tag "Opening new formula delimiter") (string :tag "Closing new formula delimiter")))) commit e53f0f4869600f698e9d8c9527aaf5fba9ec1243 Author: Andrea Corallo Date: Tue Jul 9 11:03:04 2024 +0200 * etc/TODO (Native compiler improvements): Add entry. diff --git a/etc/TODO b/etc/TODO index 53b456c733a..590cd350e0e 100644 --- a/etc/TODO +++ b/etc/TODO @@ -926,6 +926,12 @@ restore the redirection through funcall. *** Features to be improved or missing +**** Make use of function type declaration + +The native compiler should make use of function type declarations (when +available) to propagate parameter types inside the function for better +value/type predictions. + **** Fix portable dumping so that you can redump without using -batch ***** Redumps and native compiler "preloaded" sub-folder. commit 671ad83026e0f9727a809311d43fd7a57403b33b Author: Po Lu Date: Tue Jul 9 14:10:07 2024 +0800 Fix bug#70697 with respect to fringe bitmaps * src/pgtkterm.c (pgtk_draw_fringe_bitmap): Always call `fill_background_by_face' for clearing backgrounds of fringe bitmaps. (bug#70697) diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 49b7ea406f8..839bfdce988 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -3594,20 +3594,7 @@ pgtk_draw_fringe_bitmap (struct window *w, struct glyph_row *row, pgtk_clip_to_row (w, row, ANY_AREA, cr); if (p->bx >= 0 && !p->overlay_p) - { - /* In case the same realized face is used for fringes and for - something displayed in the text (e.g. face `region' on - mono-displays, the fill style may have been changed to - FillSolid in pgtk_draw_glyph_string_background. */ - if (face->stipple) - fill_background_by_face (f, face, p->bx, p->by, p->nx, p->ny); - else - { - pgtk_set_cr_source_with_color (f, face->background, true); - cairo_rectangle (cr, p->bx, p->by, p->nx, p->ny); - cairo_fill (cr); - } - } + fill_background_by_face (f, face, p->bx, p->by, p->nx, p->ny); if (p->which && p->which < max_fringe_bmp commit 15c591bad6282824adf33fa195733da416d3fef2 Author: Po Lu Date: Tue Jul 9 09:35:16 2024 +0800 Fix byte-compiler warning in calc.el * lisp/calc/calc.el (calc-embedded-open-close-new-formula-alist): Remove previously introduced quotation marks, as they bring the width of the doc string past 80. diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 1bbc297e58c..f92e4958e33 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -341,7 +341,7 @@ See calc-embedded-open-plain." (defcustom calc-embedded-open-close-new-formula-alist nil - "Alist of major modes with pairs of new formula delimiters used by `calc-embedded'." + "Alist of major modes with pairs of new formula delimiters used by calc-embedded." :type '(alist :key-type (symbol :tag "Major mode") :value-type (list (string :tag "Opening new formula delimiter") (string :tag "Closing new formula delimiter"))))