mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-06-14 12:31:25 +00:00
Merge from origin/emacs-31
7eab6ef3ceFix 'sgml-parse-tag-backward' to handle tags in comments09dc864b0bFix eww-submit for forms with no action (bug#80918)0e7a24d931* lisp/progmodes/hideshow.el (hs--set-variable): Use 'set...f12b01582dFix Completions buffer disappearing with tmm-menubar (bug...519fd83211Fix secrets.el when Emacs is a flatpak9e4ea934f2Fix 'prepare-user-lisp' to follow symlinkse613e38021Update "timeout" to 2.1.6196fd80689[GTK3, HiDPI] Fix width/height round-trip through Configu...acc07f1a03[GTK3] On Expose, repaint the border before the content5323eebcffTest read-passwd behavior (bug#80838)01c5990dd0Fix nested read-passwd calls (bug#80838)027043df25; * lisp/gnus/message.el (message-server-alist): Doc fix ...3b608b233eFix terminal emulation of "ESC [ K" sequence6a605c65a8Fix vertical-motion across overlay strings with embedded ...e4d529c67b; Fix last changed54faa0f1bMark gnus-dbus.el as obsolete9bf2a19bb2Move gnus-dbus.el to obsolete/gnus-dbus.el984024daf3Gnus: Use new sleep libraryd7c130972e; * lisp/term/pgtk-win.el (icon-map-list): Fix :type.5579893ed7; Don't block/unblock input in text_extents methods547b1ee7b6Fix Rmail behavior wrt globalized minor modes6ba05106f4Fix display images in the display margins56f27dd9f0Eglot: fix eglot--sig-info with non-UTF-32 positionEncoding543d8a7a9d[NS] Fix deprecated variable (bug#80985) # Conflicts: # etc/NEWS
This commit is contained in:
commit
87e4687749
26 changed files with 424 additions and 145 deletions
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
18
etc/NEWS.31
18
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
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
26
src/indent.c
26
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)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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 */
|
||||
|
|
|
|||
15
src/xdisp.c
15
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))
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue