File emacs-27.1-Xauthority4server.patch of Package emacs.20241204185638
From werner@suse.de
Date: Mon, 08 Mar 2021 13:35:41 +0000
Subject: Allow GNU Emacs server to open X Display
even if the Xauthority file is not the default expected by XCloseDisplay()
---
etc/emacs.service | 2 ++
lisp/server.el | 45 +++++++++++++++++++++++++++++++++++++++++++--
2 files changed, 45 insertions(+), 2 deletions(-)
--- etc/emacs.service
+++ etc/emacs.service 2024-04-11 06:46:29.320172754 +0000
@@ -5,9 +5,11 @@
[Unit]
Description=Emacs text editor
Documentation=info:emacs man:emacs(1) https://gnu.org/software/emacs/
+After=graphical-session.target
[Service]
Type=notify
+Environment=XAUTHORITY=%t/emacs/xauth
ExecStart=emacs --fg-daemon
# Emacs will exit with status 15 after having received SIGTERM, which
--- lisp/server.el
+++ lisp/server.el 2024-04-11 06:17:17.692578500 +0000
@@ -289,6 +289,11 @@ If nil, no instructions are displayed."
"The directory in which to place the server socket.
If local sockets are not supported, this is nil.")
+;; Hold the Xauthority if an X Display is used
+(defvar server-xauth-file nil
+ "The Xauthority file to hold the Xauthority cookies.
+If no Xauthority is used, this is nil.")
+
(define-error 'server-running-external "External server running")
(defun server-clients-with (property value)
@@ -619,6 +624,11 @@ If the key is not valid, signal an error
(let ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)))
(expand-file-name server-name server-dir)))
+(defsubst server--xauth ()
+ "Return the xauth file name to hold the X Authority."
+ (let ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)))
+ (expand-file-name "xauth" server-dir)))
+
(defun server-stop (&optional noframe)
"If this Emacs process has a server communication subprocess, stop it.
If this actually stopped the server, return non-nil. If the
@@ -720,7 +730,8 @@ the `server-process' variable."
(setq leave-dead t)))
;; Now any previous server is properly stopped.
(unless leave-dead
- (let ((server-file (server--file-name)))
+ (let ((server-file (server--file-name))
+ (xauth-file (server--xauth)))
;; Make sure there is a safe directory in which to place the socket.
(server-ensure-safe-dir (file-name-directory server-file))
(with-file-modes ?\700
@@ -762,6 +773,14 @@ the `server-process' variable."
(unless server-process (error "Could not start server process"))
(server-log "Started server")
(process-put server-process :server-file server-file)
+ ;; File to hold X Authority cookies
+ (unless (file-exists-p xauth-file)
+ (make-empty-file xauth-file))
+ (when (file-exists-p xauth-file)
+ (let ((var (concat "XAUTHORITY=" xauth-file)))
+ (dolist (proc (process-list))
+ (process-put proc 'env (cons var (process-get proc 'env)))))
+ (setq server-xauth-file xauth-file))
(setq server-mode t)
(push 'server-mode global-minor-modes)
(when server-use-tcp
@@ -898,7 +917,7 @@ This handles splitting the command if it
(let ((frame
(server-with-environment
(process-get proc 'env)
- '("LANG" "LC_CTYPE" "LC_ALL"
+ '("LANG" "LC_CTYPE" "LC_ALL" "LC_PAPER" "LC_MEASUREMENT"
;; For tgetent(3); list according to ncurses(3).
"BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES"
"NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING"
@@ -1171,6 +1190,8 @@ The following commands are accepted by t
nowait ; t if emacsclient does not want to wait for us.
frame ; Frame opened for the client (if any).
display ; Open frame on this display.
+ (xauth-file (expand-file-name "~/.Xauthority"))
+ xauth-cmd
parent-id ; Window ID for XEmbed
dontkill ; t if client should not be killed.
commands
@@ -1314,6 +1335,16 @@ The following commands are accepted by t
;; -env NAME=VALUE: An environment variable.
("-env"
(let ((var (pop args-left)))
+ (if (and (stringp var)
+ (string-match "^\\([^=]+\\)=\\(.*\\)" var))
+ (if (cond ((string-equal (match-string 1 var) "LANG") t)
+ ((string-equal (match-string 1 var) "LC_CTYPE") t)
+ ((string-equal (match-string 1 var) "LC_ALL") t)
+ ((string-equal (match-string 1 var) "LC_PAPER") t)
+ ((string-equal (match-string 1 var) "LC_MEASUREMENT") t)
+ ((string-equal (match-string 1 var) "DISPLAY") t)
+ ((string-equal (match-string 1 var) "XAUTHORITY") (setq xauth-file (match-string 2 var))))
+ (setenv (match-string 1 var) (match-string 2 var) t)))
;; XXX Variables should be encoded as in getenv/setenv.
(process-put proc 'env
(cons var (process-get proc 'env)))))
@@ -1329,6 +1360,16 @@ The following commands are accepted by t
;; Unknown command.
(arg (error "Unknown command: %s" arg))))
+ (if (and display server-xauth-file)
+ (progn
+ (if (not xauth-file)
+ (setq xauth-file (expand-file-name "~/.Xauthority")))
+ (if (and (file-exists-p xauth-file) (not (file-equal-p xauth-file server-xauth-file)))
+ (progn
+ (setq xauth-cmd (concat "xauth -i -f " xauth-file " extract - " display
+ "| xauth -f " server-xauth-file " merge -"))
+ (shell-command xauth-cmd)))))
+
;; If both -no-wait and -tty are given with file or sexp
;; arguments, use an existing frame.
(and nowait
