diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index 1f9d571a3b0..8764fcade90 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -66,6 +66,7 @@ another. An overview of D-Bus can be found at * Errors and Events:: Errors and events. * Monitoring Messages:: Monitoring messages. * File Descriptors:: Handle file descriptors. +* Flatpak integration:: Integration with flatpak * Index:: Index including concepts, functions, variables. * GNU Free Documentation License:: The license for this documentation. @@ -2302,6 +2303,38 @@ instance have acquired a file descriptor as well. Example: @end defun +@node Flatpak integration +@chapter Integration with flatpak + +@c https://docs.flatpak.org/en/latest/sandbox-permissions.html +@c TODO: This needs more input. + +If you run the Emacs flatpak program, there are restrictions. By +default, there is limited access to the session D-Bus, and no access to +the system D-Bus. You must enable access to services living outside the +sandbox like + +@example +# flatpak override --talk-name=org.freedesktop.secrets org.gnu.emacs +@end example + +@samp{org.gnu.emacs} is the Emacs flatpak application, and +@samp{org.freedesktop.secrets} is a service you want to talk to, for +example. + +Access to the entire bus with @samp{--socket=system-bus} or +@samp{--socket=session-bus} stops the filtering and using them is a +security risk. So they must be avoided. + +@c Bug#80977. +Service names might be mapped when arriving Emacs. For example, you +will see the @samp{org.freedesktop.DBus.NameOwnerChanged} signal for +service @samp{org.freedesktop.portal.Flatpak}, even if you have +registered the signal for another namespace. + +@c TODO: What about portals? + + @node Index @unnumbered Index diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index a440aac1a90..fa436e0b87d 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -849,7 +849,7 @@ Various * Spam Package:: A package for filtering and processing spam. * The Gnus Registry:: A package for tracking messages by Message-ID. * The Gnus Cloud:: A package for synchronizing Gnus marks. -* D-Bus Integration:: Closing Gnus servers on system sleep. +* System Sleep Integration:: Closing Gnus servers on system sleep. * Other modes:: Interaction with other modes. * Various Various:: Things that are really various. @@ -22712,7 +22712,7 @@ For instance, @code{nnir-notmuch-program} is now * Spam Package:: A package for filtering and processing spam. * The Gnus Registry:: A package for tracking messages by Message-ID. * The Gnus Cloud:: A package for synchronizing Gnus marks. -* D-Bus Integration:: Closing Gnus servers on system sleep. +* System Sleep Integration:: Closing Gnus servers on system sleep. * Other modes:: Interaction with other modes. * Various Various:: Things that are really various. @end menu @@ -26680,11 +26680,11 @@ CloudSynchronizationDataPack(TM)s. It's easiest to set this from the Server buffer (@pxref{Gnus Cloud Setup}). @end defvar -@node D-Bus Integration -@section D-Bus Integration -@cindex dbus -@cindex D-Bus -@cindex gnus-dbus +@c Section name changed from this in Emacs 31. @c +@c This anchor allows old links to continue working. @c +@anchor{D-Bus Integration} +@node System Sleep Integration +@section System Sleep Integration @cindex system sleep @cindex closing servers automatically @cindex hung connections @@ -26692,13 +26692,10 @@ Server buffer (@pxref{Gnus Cloud Setup}). When using laptops or other systems that have a sleep or hibernate functionality, it's possible for long-running server connections to become ``hung'', requiring the user to manually close and re-open the -connections after the system resumes. On systems compiled with D-Bus -support (check the value of @code{(featurep 'dbusbind)}), Gnus can -register a D-Bus signal to automatically close all server connections -before the system goes to sleep. To enable this, set -@code{gnus-dbus-close-on-sleep} to a non-@code{nil} value. - -For more information about D-Bus and Emacs, @pxref{Top,,, dbus, D-Bus integration in Emacs}. +connections after the system resumes. Using the system sleep library, +Gnus can automatically close all server connections before the system +goes to sleep. To enable this, set @code{gnus-close-on-sleep} to a +non-@code{nil} value. @node Other modes @section Interaction with other modes diff --git a/etc/NEWS.31 b/etc/NEWS.31 index 0c221d049e0..c0e05deed2e 100644 --- a/etc/NEWS.31 +++ b/etc/NEWS.31 @@ -795,7 +795,7 @@ docstring for the new option. See the file "etc/ORG-NEWS" for user-visible changes in Org. +++ -** New user option 'compilation-search-extra-path' +** New user option 'compilation-search-extra-path'. compile.el will now use paths specified in both 'compilation-search-extra-path' and 'compilation-search-path', when doing search. 'compilation-search-extra-path' is consulted first. @@ -1967,6 +1967,17 @@ Gnus, see "(gnus) Symbolic Prefixes" in the Gnus manual. --- *** Sorting selected groups is now possible with 'gnus-topic-mode'. +--- +*** gnus-dbus.el is now obsolete. + ++++ +*** System sleep integration is now independent of D-Bus. +The system sleep integration previously provided by customizing the +variable 'gnus-dbus-close-on-sleep' is now deprecated. A new system +using the builtin 'system-sleep' library is now available by customizing +'gnus-close-on-sleep'. This will work on all systems that the +'system-sleep' library supports. + ** Sieve +++ @@ -2811,7 +2822,7 @@ another branch. --- *** VC Annotate for Mercurial repositories shows changeset hashes. To restore showing revision numbers instead of changeset hashes, -customize the new option vc-hg-annotate-show-revision-numbers to +customize the new user option 'vc-hg-annotate-show-revision-numbers' to non-nil. +++ @@ -4605,7 +4616,7 @@ singleton list. By default it kills Emacs, as before, but 'kill-emacs-on-sigint' can be set to nil to change that. The response to SIGINT in interactive sessions is unaffected, -e.g. in a normal GUI session it still kills Emacs whereas in a terminal +e.g., in a normal GUI session it still kills Emacs whereas in a terminal it causes 'quit' since it is used for 'C-g'. +++ @@ -4614,6 +4625,7 @@ While it is marginally more efficient than ':after' or ':before', the main purpose is to make the intention more obvious when the advice modifies only the interactive form and not the actual behavior of the function. + * Changes in Emacs 31.1 on Non-Free Operating Systems diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 6cdea11c1ee..bc660b2f4ab 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -2602,14 +2602,14 @@ point is moved into the passwords (see `authinfo-hide-elements'). (defvar read-passwd--mode-line-icon nil "Propertized mode line icon for showing/hiding passwords.") -(defvar read-passwd--hide-password t - "Toggle whether password should be hidden in minibuffer.") +(defvar read-passwd--password-hidden nil + "Flag indicating whether password in minibuffer is hidden.") (defun read-passwd--hide-password () "Make password in minibuffer hidden or visible." (let ((beg (minibuffer-prompt-end))) (dotimes (i (1+ (- (buffer-size) beg))) - (if read-passwd--hide-password + (if read-passwd--password-hidden (put-text-property (+ i beg) (+ 1 i beg) 'display (string (or read-hide-char ?*))) (remove-list-of-text-properties (+ i beg) (+ 1 i beg) '(display))) @@ -2617,9 +2617,10 @@ point is moved into the passwords (see `authinfo-hide-elements'). (+ i beg) (+ 1 i beg) 'help-echo "C-u: Clear password\nTAB: Toggle password visibility")))) -(defun read-passwd-toggle-visibility () +(defun read-passwd-toggle-visibility (&optional force) "Toggle minibuffer contents visibility. -Adapt also mode line." +Adapt also mode line. If optional FORCE is non-nil, hide the minibuffer +contents." (interactive) (let ((win (active-minibuffer-window))) (unless win (error "No active minibuffer")) @@ -2627,12 +2628,13 @@ Adapt also mode line." ;; mini-buffer. (with-current-buffer (window-buffer win) (when (memq 'read-passwd-mode local-minor-modes) - (setq read-passwd--hide-password (not read-passwd--hide-password)) + (setq read-passwd--password-hidden + (or force (not read-passwd--password-hidden))) (setq read-passwd--mode-line-icon `(:propertize ,(if icon-preference (icon-string - (if read-passwd--hide-password + (if read-passwd--password-hidden 'read-passwd--show-password-icon 'read-passwd--hide-password-icon)) "") @@ -2652,6 +2654,9 @@ Adapt also mode line." "C-u" #'delete-minibuffer-contents ;bug#12570 "TAB" #'read-passwd-toggle-visibility) +(defvar read-passwd--mini-buffers nil + "List of minibuffers where `read-passwd' is active.") + (define-minor-mode read-passwd-mode "Toggle visibility of password in minibuffer." :group 'mode-line @@ -2659,21 +2664,25 @@ Adapt also mode line." :keymap read-passwd-map :version "30.1" - (setq read-passwd--hide-password nil) - (or global-mode-string (setq global-mode-string '(""))) - - (let ((mode-string '(:eval read-passwd--mode-line-icon))) - (if read-passwd-mode - ;; Add `read-passwd--mode-line-icon'. - (or (member mode-string global-mode-string) - (setq global-mode-string - (append global-mode-string (list mode-string)))) - ;; Remove `read-passwd--mode-line-icon'. - (setq global-mode-string - (delete mode-string global-mode-string)))) - + (unless read-passwd-mode + (setq read-passwd--mini-buffers + (delq (current-buffer) read-passwd--mini-buffers))) + (unless read-passwd--mini-buffers + (let ((mode-string '(:eval read-passwd--mode-line-icon))) + (if read-passwd-mode + ;; Add `read-passwd--mode-line-icon'. + (or (member mode-string global-mode-string) + (setq global-mode-string + (append global-mode-string (list mode-string)))) + ;; Remove `read-passwd--mode-line-icon'. + (setq global-mode-string + (delete mode-string global-mode-string))))) (when read-passwd-mode - (read-passwd-toggle-visibility))) + (push (current-buffer) read-passwd--mini-buffers)) + ;; Always hide the current password. + (when read-passwd--mini-buffers + (with-current-buffer (car read-passwd--mini-buffers) + (read-passwd-toggle-visibility t)))) (defvar overriding-text-conversion-style) diff --git a/lisp/emacs-lisp/timeout.el b/lisp/emacs-lisp/timeout.el index b5ea819a6e2..5accb5b7e24 100644 --- a/lisp/emacs-lisp/timeout.el +++ b/lisp/emacs-lisp/timeout.el @@ -1,10 +1,10 @@ ;;; timeout.el --- Throttle or debounce Elisp functions -*- lexical-binding: t; -*- -;; Copyright (C) 2023-2026 Free Software Foundation, Inc. +;; Copyright (C) 2023-2026 Free Software Foundation, Inc. ;; Author: Karthik Chikmagalur ;; Keywords: convenience, extensions -;; Version: 2.1 +;; Version: 2.1.6 ;; Package-Requires: ((emacs "24.4")) ;; URL: https://github.com/karthink/timeout @@ -58,6 +58,9 @@ ;;; Code: (require 'nadvice) +(define-obsolete-function-alias 'timeout-throttle! 'timeout-throttle "v2.0") +(define-obsolete-function-alias 'timeout-debounce! 'timeout-debounce "v2.0") + (defsubst timeout--eval-value (value) "Eval a VALUE. If value is a function (either lambda or a callable symbol), eval the @@ -109,9 +112,13 @@ This is intended for use as function advice." "Debounce calls to this function." (prog1 default (if (timerp debounce-timer) - (timer-set-idle-time debounce-timer (timeout--eval-value delay-value)) + (progn + (cancel-timer debounce-timer) + (timer-set-time + debounce-timer (time-add nil (timeout--eval-value delay-value))) + (timer-activate debounce-timer)) (setq debounce-timer - (run-with-idle-timer + (run-with-timer (timeout--eval-value delay-value) nil (lambda (buf) (cancel-timer debounce-timer) @@ -206,7 +213,7 @@ previous successful call is returned." (unless (and throttle-timer (timerp throttle-timer)) (setq result (apply func args)) (setq throttle-timer - (run-with-timer + (run-with-timer (timeout--eval-value throttle-value) nil (lambda () (cancel-timer throttle-timer) @@ -238,9 +245,13 @@ returned." (cadr (interactive-form func)))) (prog1 default (if (timerp debounce-timer) - (timer-set-idle-time debounce-timer (timeout--eval-value delay-value)) + (progn + (cancel-timer debounce-timer) + (timer-set-time + debounce-timer (time-add nil (timeout--eval-value delay-value))) + (timer-activate debounce-timer)) (setq debounce-timer - (run-with-idle-timer + (run-with-timer (timeout--eval-value delay-value) nil (lambda (buf) (cancel-timer debounce-timer) @@ -259,9 +270,13 @@ returned." "\n\nDebounce calls to this function")) (prog1 default (if (timerp debounce-timer) - (timer-set-idle-time debounce-timer (timeout--eval-value delay-value)) + (progn + (cancel-timer debounce-timer) + (timer-set-time + debounce-timer (time-add nil (timeout--eval-value delay-value))) + (timer-activate debounce-timer)) (setq debounce-timer - (run-with-idle-timer + (run-with-timer (timeout--eval-value delay-value) nil (lambda (buf) (cancel-timer debounce-timer) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index f63fc41ea5e..62faa26468d 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -31,7 +31,6 @@ (require 'gnus-range) (require 'gnus-util) (require 'gnus-cloud) -(require 'gnus-dbus) (autoload 'message-make-date "message") (autoload 'gnus-agent-read-servers-validate "gnus-agent") (autoload 'gnus-agent-save-local "gnus-agent") @@ -733,6 +732,21 @@ the first newsgroup." ;; Remove Gnus frames. (gnus-kill-gnus-frames)) +(defcustom gnus-close-on-sleep nil + "When non-nil, close Gnus servers on system sleep." + :version "31.1" + :type 'boolean + :group 'gnus-start) + +(defun gnus-sleep-handler (sleep-event) + "Close connection to servers before system sleep. +See `gnus-close-on-sleep' to enable this functionality. + +SLEEP-EVENT is checked to ensure this is only run before sleep." + (when (and (eq 'pre-sleep (sleep-event-state sleep-event)) + (gnus-alive-p)) + (ignore-errors (gnus-close-all-servers)))) + (defun gnus-no-server-1 (&optional arg child) "Read network news. If ARG is a positive number, Gnus will use that as the startup @@ -800,8 +814,9 @@ prompt the user for the name of an NNTP server to use." (gnus-run-hooks 'gnus-setup-news-hook) (when gnus-agent (gnus-request-create-group "queue" '(nndraft ""))) - (when gnus-dbus-close-on-sleep - (gnus-dbus-register-sleep-signal)) + (when gnus-close-on-sleep + (add-hook 'system-sleep-event-functions + #'gnus-sleep-handler)) (gnus-start-draft-setup) ;; Generate the group buffer. (gnus-group-list-groups level) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 0879f3be1b4..671c3fdc1bc 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -4401,6 +4401,9 @@ a non-nil value when called in the message buffer without any arguments. If METHOD is nil in this case, the return value of the function will be inserted instead. +For an explanation of the \"X-Message-SMTP-Method\" header, see +Info node `(message) Mail Variables'. + Note: if the buffer already has a \"X-Message-SMTP-Method\" header, these rules are ignored, and the header is left unchanged." diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 5f1cabaccdc..d51a90d1e63 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -1328,13 +1328,14 @@ Instead, these commands are available: (when rmail-display-summary (rmail-summary)) (rmail-construct-io-menu)) - (run-mode-hooks 'rmail-mode-hook))) + (run-hooks 'rmail-mode-hook))) (defun rmail-mode-2 () (kill-all-local-variables) (rmail-mode-1) (rmail-perm-variables) - (rmail-variables)) + (rmail-variables) + (run-mode-hooks)) (defun rmail-mode-1 () (setq major-mode 'rmail-mode) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 744e20cf444..b1c5e6e5180 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2796,6 +2796,9 @@ Whether we update the buffer is based on `completion-eager-display' and `eager-display' and `eager-update'. If FORCE-EAGER-UPDATE is non-nil, we only check eager-display." + (when (and force-eager-update completions--background-update-timer) + (cancel-timer completions--background-update-timer) + (setq completions--background-update-timer nil)) (unless completions--background-update-timer (setq completions--background-update-timer (run-with-idle-timer @@ -2816,7 +2819,10 @@ has been requested by the completion table." (when completion-auto-deselect (with-selected-window window (completions--deselect)))) - (completions--start-background-update))) + (when (or completion-in-region-mode + (completions--should-show-p + (completion--field-metadata (minibuffer-prompt-end)))) + (completions--start-background-update)))) (defun minibuffer-completion-help (&optional start end) "Display a list of possible completions of the current minibuffer contents." diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 70d70185688..9acbaa52fa9 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -2246,11 +2246,12 @@ Interactively, EVENT is the value of `last-nonmenu-event'." (plist-get eww-data :url))))))) (eww-browse-url (concat - (if (cdr (assq :action form)) - (shr-expand-url (cdr (assq :action form)) (plist-get eww-data :url)) - (plist-get eww-data :url)) - "?" - (mm-url-encode-www-form-urlencoded values)))))) + (shr-expand-url + (or (cdr (assq :action form)) + (car (url-path-and-query (url-generic-parse-url (plist-get eww-data :url))))) + (plist-get eww-data :url)) + "?" + (mm-url-encode-www-form-urlencoded values)))))) (defun eww-browse-with-external-browser (&optional url) "Browse the current URL with an external browser. diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el index 0d585ffa261..973fd6bebab 100644 --- a/lisp/net/secrets.el +++ b/lisp/net/secrets.el @@ -913,11 +913,14 @@ to their attributes." :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus "NameOwnerChanged" (lambda (&rest args) - (when secrets-debug (message "Secret Service has changed: %S" args)) - (setq secrets-session-path secrets-empty-path - secrets-prompt-signal nil - secrets-collection-paths nil)) - secrets-service) + ;; The flatpak version of Emacs shows also signals from + ;; "org.freedesktop.portal.Flatpak". (Bug#80977) + (when (and (stringp (car args)) (string-equal secrets-service (car args))) + (when secrets-debug (message "Secret Service has changed: %S" args)) + (setq secrets-session-path secrets-empty-path + secrets-prompt-signal nil + secrets-collection-paths nil))) + :arg-namespace secrets-service) ;; We want to refresh our cache, when there is a change in ;; collections. diff --git a/lisp/gnus/gnus-dbus.el b/lisp/obsolete/gnus-dbus.el similarity index 67% rename from lisp/gnus/gnus-dbus.el rename to lisp/obsolete/gnus-dbus.el index a985e44c5b8..a62cf8a0f97 100644 --- a/lisp/gnus/gnus-dbus.el +++ b/lisp/obsolete/gnus-dbus.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2020-2026 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen +;; Obsolete-since: 31.1 ;; This file is part of GNU Emacs. @@ -21,6 +22,10 @@ ;;; Commentary: +;; This library is obsolete. +;; +;; Use `gnus-close-on-sleep' instead. + ;; This library contains some Gnus integration for systems using DBUS. ;; At present it registers a signal to close all Gnus servers before ;; system sleep or hibernation. @@ -31,17 +36,29 @@ (require 'dbus) (declare-function gnus-close-all-servers "gnus-start") -(defcustom gnus-dbus-close-on-sleep nil - "When non-nil, close Gnus servers on system sleep." - :group 'gnus-dbus - :type 'boolean) +;; (defcustom gnus-dbus-close-on-sleep nil +;; "When non-nil, close Gnus servers on system sleep." +;; :group 'gnus-dbus +;; :type 'boolean) + +;; It is suggested in the elisp documention that we create variable +;; alias's before executing the `defcustom'. To reliably accomplish +;; that in this case we would have to edit gnus-start.el which I don't +;; want to do. So I've done this instead. +(require 'gnus-start) ;; Run defcustom for `gnus-close-on-sleep' +(when (bound-and-true-p gnus-dbus-close-on-sleep) + (setq gnus-close-on-sleep gnus-dbus-close-on-sleep)) +(with-suppressed-warnings ((suspicious nil)) ;; Doesn't like aliasing bound variables + (define-obsolete-variable-alias 'gnus-dbus-close-on-sleep 'gnus-close-on-sleep "31.1")) (defvar gnus-dbus-sleep-registration-object nil "Object returned from `dbus-register-signal'. Used to unregister the signal.") +(make-obsolete-variable 'gnus-dbus-sleep-registration-object nil "31.1") (defun gnus-dbus-register-sleep-signal () "Use `dbus-register-signal' to close servers on sleep." + (declare (obsolete nil "31.1")) (when (featurep 'dbusbind) (setq gnus-dbus-sleep-registration-object (dbus-register-signal :system @@ -54,6 +71,7 @@ Used to unregister the signal.") (defun gnus-dbus-sleep-handler (sleep-start) ;; Sleep-start is t before sleeping. + (declare (obsolete nil "31.1")) (when (and sleep-start (gnus-alive-p)) (condition-case nil @@ -61,6 +79,7 @@ Used to unregister the signal.") (error nil)))) (defun gnus-dbus-unregister-sleep-signal () + (declare (obsolete gnus-sleep-handler "31.1")) (condition-case nil (dbus-unregister-object gnus-dbus-sleep-registration-object) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index b41fd3d2212..e97b1749b79 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2152,19 +2152,18 @@ LBP defaults to `eglot--bol'." (funcall eglot-current-linepos-function))))) (defvar eglot-move-to-linepos-function #'eglot-move-to-utf-16-linepos - "Function to move to a position within a line reported by the LSP server. + "Move point to LSP-reported position within a line. -Per the LSP spec, character offsets in LSP Position objects count -UTF-16 code units, not actual code points. So when LSP says -position 3 of a line containing just \"aXbc\", where X is a funny -looking character in the UTF-16 \"supplementary plane\", it -actually means `b', not `c'. The default value -`eglot-move-to-utf-16-linepos' accounts for this. +Per the LSP spec, character offsets in LSP Position objects count UTF-16 +code units, not actual code points. So when LSP says position 3 of a +line containing just \"aXbc\", where X is a funny looking character in +the UTF-16 \"supplementary plane\", it actually means `b', not `c'. The +default value `eglot-move-to-utf-16-linepos' accounts for this. This variable can also be set to `eglot-move-to-utf-8-linepos' or -`eglot-move-to-utf-32-linepos' for servers not closely following -the spec. Also, since LSP 3.17 server and client may agree on an -encoding and Eglot will set this variable automatically.") +`eglot-move-to-utf-32-linepos' for servers not closely following the +spec. Also, since LSP 3.17 server and client may agree on an encoding +and Eglot will set this variable automatically.") (defun eglot-move-to-utf-8-linepos (n) "Move to line's Nth byte as computed by LSP's UTF-8 criterion." @@ -2175,7 +2174,8 @@ encoding and Eglot will set this variable automatically.") (while (and (< (position-bytes (point)) goal-byte) (< (point) eol)) ;; raw bytes take 2 bytes in the buffer (when (>= (char-after) #x3fff80) (setq goal-byte (1+ goal-byte))) - (forward-char 1)))) + (forward-char 1)) + (point))) (defun eglot-move-to-utf-16-linepos (n) "Move to line's Nth code unit as computed by LSP's UTF-16 criterion." @@ -2186,7 +2186,8 @@ encoding and Eglot will set this variable automatically.") (while (and (< (point) goal-char) (< (point) eol)) ;; code points in the "supplementary place" use two code units (when (<= #x010000 (char-after) #x10ffff) (setq goal-char (1- goal-char))) - (forward-char 1)))) + (forward-char 1)) + (point))) (defun eglot-move-to-utf-32-linepos (n) "Move to line's Nth codepoint as computed by LSP's UTF-32 criterion." @@ -4108,66 +4109,67 @@ for which LSP on-type-formatting should be requested." (mapconcat #'eglot--format-markup (if (vectorp contents) contents (list contents)) "\n")) -(defun eglot--sig-info (sig &optional sig-active briefp) +(cl-defun eglot--sig-info (sig &optional sig-active briefp + &aux (move-fn eglot-move-to-linepos-function) + first-parlabel + fpardoc) (eglot--dbind ((SignatureInformation) ((:label siglabel)) ((:documentation sigdoc)) parameters activeParameter) sig (with-temp-buffer - (insert siglabel) - ;; Add documentation, indented so we can distinguish multiple signatures - (when-let* ((doc (and (not briefp) sigdoc (eglot--format-markup sigdoc)))) - (goto-char (point-max)) - (insert "\n" (replace-regexp-in-string "^" " " doc))) - ;; Try to highlight function name only - (let (first-parlabel) - (cond ((and (cl-plusp (length parameters)) - (vectorp (setq first-parlabel - (plist-get (aref parameters 0) :label)))) - (save-excursion - (goto-char (elt first-parlabel 0)) - (skip-syntax-backward "^w") - (add-face-text-property (point-min) (point) - 'font-lock-function-name-face))) - ((save-excursion - (goto-char (point-min)) - (looking-at "\\([^(]*\\)([^)]*)")) - (add-face-text-property (match-beginning 1) (match-end 1) - 'font-lock-function-name-face)))) + (save-excursion + ;; Insert main siglabel line + (insert siglabel) + ;; Add function documentation to end on a new line, indented so + ;; we can distinguish multiple signatures + (when-let* ((doc (and (not briefp) sigdoc (eglot--format-markup sigdoc)))) + (goto-char (point-max)) + (insert "\n" (replace-regexp-in-string "^" " " doc)))) + ;; Back to point-min: try to highlight function name only + (cond ((and (cl-plusp (length parameters)) + (vectorp (setq first-parlabel + (plist-get (aref parameters 0) :label)))) + (funcall move-fn (elt first-parlabel 0)) + (skip-syntax-backward "^w") + (add-face-text-property (point-min) (point) + 'font-lock-function-name-face)) + ((looking-at "\\([^(]*\\)([^)]*)") + (add-face-text-property (match-beginning 1) (match-end 1) + 'font-lock-function-name-face))) ;; Now to the parameters (cl-loop with active-param = (or activeParameter sig-active) + with case-fold-search = nil for i from 0 for parameter across parameters do (eglot--dbind ((ParameterInformation) ((:label parlabel)) ((:documentation pardoc))) parameter - ;; ...perhaps highlight it in the formals list - (when (eq i active-param) - (save-excursion - (goto-char (point-min)) - (pcase-let - ((`(,beg ,end) - (if (stringp parlabel) - (let ((case-fold-search nil)) - (and (search-forward parlabel (line-end-position) t) - (list (match-beginning 0) (match-end 0)))) - (list (1+ (aref parlabel 0)) (1+ (aref parlabel 1)))))) - (if (and beg end) - (add-face-text-property - beg end - 'eldoc-highlight-function-argument))))) - ;; ...and/or maybe add its doc on a line by its own. - (let (fpardoc) + (cl-flet ((parlabel-bounds () + (cond ((stringp parlabel) + (and (search-forward parlabel (line-end-position) t) + (match-data))) + (t (mapcar move-fn parlabel))))) + ;; ...perhaps highlight it in the formals list + (when-let* ((b (and (eq i active-param) + (parlabel-bounds)))) + (add-face-text-property + (car b) (cadr b) + 'eldoc-highlight-function-argument)) + ;; ...and/or maybe add its doc on a line by its own. (when (and pardoc (not briefp) (not (string-empty-p (setq fpardoc (eglot--format-markup pardoc))))) - (insert "\n " - (propertize - (if (stringp parlabel) parlabel - (substring siglabel (aref parlabel 0) (aref parlabel 1))) - 'face (and (eq i active-param) 'eldoc-highlight-function-argument)) - ": " fpardoc))))) + (unless (stringp parlabel) + (setq parlabel (apply #'buffer-substring (parlabel-bounds)))) + (save-excursion + (goto-char (point-max)) + (insert "\n " + (propertize + parlabel + 'face (and (eq i active-param) 'eldoc-highlight-function-argument)) + ": " fpardoc)))))) (buffer-string)))) (defun eglot-signature-eldoc-function (cb &rest _ignored) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 34a3fe97da3..f781a82b105 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -1228,9 +1228,9 @@ DEFAULT is a value to use as fallback." (val (if (integerp nth) (nth nth old-lookup) (funcall nth old-lookup)))) - (set (make-local-variable var) val) + (set-local var val) (when default - (set (make-local-variable var) default))))) + (set-local var default))))) ;; TODO: When `hs-special-modes-alist' is removed, `hs-grok-mode-type' ;; and `hs--set-variable' will no longer be necessary, but diff --git a/lisp/startup.el b/lisp/startup.el index e4c20d4b592..e6f2087604f 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1265,7 +1265,7 @@ unconditionally." (backup-inhibited t) (dirs (list dir))) (add-to-list 'load-path (directory-file-name dir)) - (dolist (file (directory-files-recursively dir "" t pred)) + (dolist (file (directory-files-recursively dir "" t pred t)) (cond ((and (file-regular-p file) (string-suffix-p ".el" file)) (unless just-activate diff --git a/lisp/term.el b/lisp/term.el index 15ba310a73a..79697170338 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -4128,10 +4128,11 @@ all pending output has been dealt with.")) ;; contain a space, to force the previous line to continue to wrap. ;; We could do this always, but it seems preferable to not add the ;; extra space when wrapped is false. - (when wrapped - (insert-before-markers ? )) - (insert-before-markers ?\n) - (delete-region saved-point (point))) + (let ((deletion-point (point))) + (when wrapped + (insert-before-markers ? )) + (insert-before-markers ?\n) + (delete-region saved-point deletion-point))) (put-text-property saved-point (point) 'font-lock-face 'default) (goto-char saved-point)))) diff --git a/lisp/term/pgtk-win.el b/lisp/term/pgtk-win.el index abf3ab0951e..ffa20d21e63 100644 --- a/lisp/term/pgtk-win.el +++ b/lisp/term/pgtk-win.el @@ -302,7 +302,10 @@ If you don't want stock icons, set the variable to nil." :type '(choice (const :tag "Don't use stock icons" nil) (repeat (choice symbol (cons (string :tag "Emacs icon") - (string :tag "Stock/named"))))) + (choice + (group (string "Named") + (string "Stock")) + (string :tag "Stock/named")))))) :group 'pgtk) (defconst x-gtk-stock-cache (make-hash-table :weakness t :test 'equal)) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index be14462d1a0..c9f38d1ee47 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -1397,7 +1397,13 @@ Returns t if found, nil otherwise." (while (re-search-backward "[<>]" limit 'move) ;; If this character has "open" or "close" syntax, then we've ;; found the one we want. - (when (memq (syntax-class (syntax-after (point))) '(4 5)) + (when (and (memq (syntax-class (syntax-after (point))) '(4 5)) + ;; We want to ignore tags in comments. We could also + ;; check `syntax-ppss', but that can become expensive + ;; in a busy loop, so we re-use the face instead. + (not (memq (get-text-property (point) 'face) + '(font-lock-comment-delimiter-face + font-lock-comment-face)))) (throw 'found t))))) (defun sgml-parse-tag-backward (&optional limit) diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 3a609187a53..ac5f52eccc2 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -415,7 +415,6 @@ ftcrfont_text_extents (struct font *font, { int width, i; - block_input (); width = ftcrfont_glyph_extents (font, code[0], metrics); for (i = 1; i < nglyphs; i++) { @@ -435,7 +434,6 @@ ftcrfont_text_extents (struct font *font, } width += w; } - unblock_input (); if (metrics) metrics->width = width; diff --git a/src/gtkutil.c b/src/gtkutil.c index ce91d2a189b..daa3fd1b993 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1181,6 +1181,7 @@ xg_frame_set_char_size (struct frame *f, int width, int height) int outer_height = height + FRAME_TOOLBAR_HEIGHT (f) + FRAME_MENUBAR_HEIGHT (f); int outer_width = width + FRAME_TOOLBAR_WIDTH (f); + int scale = xg_get_scale (f); #ifndef HAVE_PGTK gtk_window_get_size (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), @@ -1200,8 +1201,10 @@ xg_frame_set_char_size (struct frame *f, int width, int height) } #endif - outer_height /= xg_get_scale (f); - outer_width /= xg_get_scale (f); + outer_height /= scale; + outer_width /= scale; + height = outer_height * scale; + width = outer_width * scale; xg_wm_set_size_hint (f, 0, 0); @@ -1328,6 +1331,9 @@ xg_frame_set_size_and_position (struct frame *f, int width, int height) outer_height /= scale; outer_width /= scale; + height = outer_height * scale; + width = outer_width * scale; + x /= scale; y /= scale; diff --git a/src/indent.c b/src/indent.c index 9721c95dcf7..e8513fbf6f2 100644 --- a/src/indent.c +++ b/src/indent.c @@ -2295,6 +2295,7 @@ buffer, whether or not it is currently displayed in some window. */) double start_col UNINIT; int start_x UNINIT; int to_x = -1; + ptrdiff_t ovl_start = -1; bool start_x_given = !NILP (cur_col); if (start_x_given) @@ -2327,13 +2328,29 @@ buffer, whether or not it is currently displayed in some window. */) { const char *s = SSDATA (it.string); const char *e = s + SBYTES (it.string); + Lisp_Object prop; + ptrdiff_t ovl_idx = + it.current.overlay_string_index >= 0 + ? it.current.overlay_string_index % OVERLAY_STRING_CHUNK_SIZE + : -1; + + /* If this is a string from an overlay, compute where that + overlay starts. */ + if (!it.string_from_display_prop_p && ovl_idx >= 0) + ovl_start = OVERLAY_START (it.string_overlays[ovl_idx]); disp_string_at_start_p = /* If it.area is anything but TEXT_AREA, we need not bother about the display string, as it doesn't affect cursor positioning. */ it.area == TEXT_AREA - && it.string_from_display_prop_p + && (it.string_from_display_prop_p + /* Overlay string on invisible text has the same effect + on display and cursor movement as a display string. */ + || (ovl_start >= BEGV + && (prop = Fget_char_property (make_fixnum (ovl_start), + Qinvisible, window), + TEXT_PROP_MEANS_INVISIBLE (prop)))) /* A display string on anything but buffer text (e.g., on an overlay string) doesn't affect cursor positioning. */ && (it.sp > 0 && it.stack[it.sp - 1].method == GET_FROM_BUFFER); @@ -2456,6 +2473,13 @@ buffer, whether or not it is currently displayed in some window. */) if ((nlines < 0 && IT_CHARPOS (it) > BEGV) || (nlines == 0 && !(start_x_given && start_x <= to_x))) move_it_by_lines (&it, max (PTRDIFF_MIN, nlines)); + /* If we haven't moved due to an overlay string on invisible + text, back up past that overlay string. */ + if (IT_CHARPOS (it) == it_start + && disp_string_at_start_p + && ovl_start >= BEGV + && it_overshoot_count > 0) + move_it_by_lines (&it, -it_overshoot_count); } else if (overshoot_handled) { diff --git a/src/nsterm.h b/src/nsterm.h index 610ca4c4acc..b21dd519e4b 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -1384,6 +1384,11 @@ enum NSWindowTabbingMode #define NSButtonTypeMomentaryPushIn NSMomentaryPushInButton #endif +#if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_15) +/* Deprecated in macOS 10.15. */ +#define NSLevelIndicatorStyleContinuousCapacity NSContinuousCapacityLevelIndicatorStyle +#endif + extern void mark_nsterm (void); #endif /* HAVE_NS */ diff --git a/src/xdisp.c b/src/xdisp.c index 773aba2789f..b485d9ccf40 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -6534,10 +6534,19 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, if (NILP (location)) it->area = TEXT_AREA; - else if (EQ (location, Qleft_margin)) - it->area = LEFT_MARGIN_AREA; else - it->area = RIGHT_MARGIN_AREA; + { + if (EQ (location, Qleft_margin)) + it->area = LEFT_MARGIN_AREA; + else + it->area = RIGHT_MARGIN_AREA; + /* Use the 'margin' face for displaying text and images + in the margins. */ + it->face_id = + NILP (Vface_remapping_alist) + ? MARGIN_FACE_ID + : lookup_basic_face (it->w, it->f, MARGIN_FACE_ID); + } if (STRINGP (value)) { diff --git a/src/xftfont.c b/src/xftfont.c index f15dbae1e7a..113c51eebe0 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -466,10 +466,8 @@ xftfont_text_extents (struct font *font, const unsigned int *code, struct font_info *xftfont_info = (struct font_info *) font; XGlyphInfo extents; - block_input (); XftGlyphExtents (xftfont_info->display, xftfont_info->xftfont, code, nglyphs, &extents); - unblock_input (); metrics->lbearing = - extents.x; metrics->rbearing = - extents.x + extents.width; diff --git a/src/xterm.c b/src/xterm.c index c021d06dd5d..1401693541c 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -19931,14 +19931,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_clear_area (f, event->xexpose.x, event->xexpose.y, event->xexpose.width, event->xexpose.height); + /* Paint the border before content (few operations, less + chance for a compositor sync in between). */ + x_clear_under_internal_border (f); #endif expose_frame (f, event->xexpose.x, event->xexpose.y, event->xexpose.width, event->xexpose.height); #ifndef USE_TOOLKIT_SCROLL_BARS x_scroll_bar_handle_exposure (f, (XEvent *) event); -#endif -#ifdef USE_GTK - x_clear_under_internal_border (f); #endif } #ifndef USE_TOOLKIT_SCROLL_BARS diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index 7da3fed70be..9a58d15484d 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -571,5 +571,118 @@ machine c1 port c2 user c3 password c4\n" :user '("a" "b") :host '("example.org") :port '("irc" "ftp" "https" 123))))) +(defun auth-source-test--displayed-string (string) + "Apply `display' properties of STRING and return the displayed string." + (let ((i 0) + res) + (while i + (let ((display (get-text-property i 'display string)) + (i0 i)) + (setq i (next-single-property-change i 'display string)) + (if display + (push display res) + (push (substring string i0 i) res)))) + (apply #'concat (nreverse res)))) + +(ert-deftest auth-source-test-read-passwd () + "Check that a password read with `read-passwd' isn't visible by default." + (let* ((cursor-in-echo-area t) + (screenshot (intern "ert--screenshot")) + (keys `[,@"secret" + ;; fake input event to capture the current minibuf string + ,screenshot + ;; leave outer prompt + ,@(kbd "RET")]) + (minibuffer-string nil) + (command-screenshot + (lambda () + (interactive) + (setq minibuffer-string (buffer-string))))) + (unwind-protect + (progn + (define-key global-map `[,screenshot] command-screenshot) + (ert-simulate-keys keys + (should (equal (read-passwd "Test: ") "secret")))) + (define-key global-map `[,screenshot] command-screenshot t)) + ;; check that the secret's there + (should (equal "Test: secret" minibuffer-string)) + ;; now simulate what redisplay does to hide the password + (setq minibuffer-string + (auth-source-test--displayed-string minibuffer-string)) + ;; check that the secret is not visible + (should (equal "Test: ******" minibuffer-string)))) + +(ert-deftest auth-source-test-read-passwd-revealed () + "Check that a password read with `read-passwd' can be made visible." + (let* ((cursor-in-echo-area t) + (screenshot (intern "ert--screenshot")) + (keys `[,@"secret" + ;; TAB: reveals the password + ,@(kbd "TAB") + ;; fake input event to capture the current minibuf string + ,screenshot + ;; leave outer prompt + ,@(kbd "RET")]) + (minibuffer-string nil) + (command-screenshot + (lambda () + (interactive) + (setq minibuffer-string (buffer-string))))) + (unwind-protect + (progn + (define-key global-map `[,screenshot] command-screenshot) + (ert-simulate-keys keys + (should (equal (read-passwd "Test: ") "secret")))) + (define-key global-map `[,screenshot] command-screenshot t)) + ;; check that the secret's there + (should (equal "Test: secret" minibuffer-string)) + ;; now simulate what redisplay does to hide the password + (setq minibuffer-string + (auth-source-test--displayed-string minibuffer-string)) + ;; check that the secret is visible once more + (should (equal "Test: secret" minibuffer-string)))) + +(ert-deftest auth-source-test-read-passwd-nested () + "Check that nested `read-passwd' calls do not reveal the password." + (let* ((cursor-in-echo-area t) + (trigger-nested (intern "ert--trigger-nested")) + (screenshot (intern "ert--screenshot")) + (keys `[,@"secret" + ;; fake input event to trigger a nested prompt + ,trigger-nested + ,@"SECRET" + ;; leave nested prompt + ,@(kbd "RET") + ;; fake input event to capture the current minibuf string + ,screenshot + ;; leave outer prompt + ,@(kbd "RET")]) + (inner-password nil) + (command-trigger-nested + (lambda () + (interactive) + (setq inner-password (read-passwd "inner prompt: ")))) + (minibuffer-string nil) + (command-screenshot + (lambda () + (interactive) + (setq minibuffer-string (buffer-string))))) + (unwind-protect + (progn + (define-key global-map `[,screenshot] command-screenshot) + (define-key global-map `[,trigger-nested] command-trigger-nested) + (ert-simulate-keys keys + (should (equal (read-passwd "Test: ") "secret")))) + (define-key global-map `[,screenshot] command-screenshot t) + (define-key global-map `[,trigger-nested] command-trigger-nested t)) + (should (equal inner-password "SECRET")) + ;; check that the secret's there + (should (equal "Test: secret" minibuffer-string)) + ;; now simulate what redisplay does to hide the password + (setq minibuffer-string + (auth-source-test--displayed-string minibuffer-string)) + ;; check that the secret has been hidden + (should (equal "Test: ******" minibuffer-string)))) + (provide 'auth-source-tests) ;;; auth-source-tests.el ends here