Merge from origin/emacs-31

7eab6ef3ce Fix 'sgml-parse-tag-backward' to handle tags in comments
09dc864b0b Fix eww-submit for forms with no action (bug#80918)
0e7a24d931 * lisp/progmodes/hideshow.el (hs--set-variable): Use 'set...
f12b01582d Fix Completions buffer disappearing with tmm-menubar (bug...
519fd83211 Fix secrets.el when Emacs is a flatpak
9e4ea934f2 Fix 'prepare-user-lisp' to follow symlinks
e613e38021 Update "timeout" to 2.1.6
196fd80689 [GTK3, HiDPI] Fix width/height round-trip through Configu...
acc07f1a03 [GTK3] On Expose, repaint the border before the content
5323eebcff Test read-passwd behavior (bug#80838)
01c5990dd0 Fix nested read-passwd calls (bug#80838)
027043df25 ; * lisp/gnus/message.el (message-server-alist): Doc fix ...
3b608b233e Fix terminal emulation of "ESC [ K" sequence
6a605c65a8 Fix vertical-motion across overlay strings with embedded ...
e4d529c67b ; Fix last change
d54faa0f1b Mark gnus-dbus.el as obsolete
9bf2a19bb2 Move gnus-dbus.el to obsolete/gnus-dbus.el
984024daf3 Gnus: Use new sleep library
d7c130972e ; * lisp/term/pgtk-win.el (icon-map-list): Fix :type.
5579893ed7 ; Don't block/unblock input in text_extents methods
547b1ee7b6 Fix Rmail behavior wrt globalized minor modes
6ba05106f4 Fix display images in the display margins
56f27dd9f0 Eglot: fix eglot--sig-info with non-UTF-32 positionEncoding
543d8a7a9d [NS] Fix deprecated variable (bug#80985)

# Conflicts:
#	etc/NEWS
This commit is contained in:
Eli Zaretskii 2026-05-16 07:17:51 -04:00
commit 87e4687749
26 changed files with 424 additions and 145 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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 <karthikchikmagalur@gmail.com>
;; 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)

View file

@ -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)

View file

@ -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."

View file

@ -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)

View file

@ -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."

View file

@ -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.

View file

@ -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.

View file

@ -3,6 +3,7 @@
;; Copyright (C) 2020-2026 Free Software Foundation, Inc.
;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
;; 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)

View file

@ -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)

View file

@ -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

View file

@ -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

View file

@ -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))))

View file

@ -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))

View file

@ -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)

View file

@ -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;

View file

@ -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;

View file

@ -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)
{

View file

@ -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 */

View file

@ -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))
{

View file

@ -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;

View file

@ -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

View file

@ -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