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