Commit b663c837 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/server.el: Cosmetic changes

Remove redundant :group args.
(server-temp-file-regexp): Fix ^$ to  \`\'.
parent d5497ec3
Pipeline #1541 failed with stage
in 54 minutes and 21 seconds
...@@ -96,7 +96,6 @@ ...@@ -96,7 +96,6 @@
(unless load-in-progress (unless load-in-progress
(message "Local sockets unsupported, using TCP sockets"))) (message "Local sockets unsupported, using TCP sockets")))
(set-default sym val)) (set-default sym val))
:group 'server
:type 'boolean :type 'boolean
:version "22.1") :version "22.1")
...@@ -108,7 +107,6 @@ DO NOT give this a non-nil value unless you know what you are doing! ...@@ -108,7 +107,6 @@ DO NOT give this a non-nil value unless you know what you are doing!
On unsecured networks, accepting remote connections is very dangerous, On unsecured networks, accepting remote connections is very dangerous,
because server-client communication (including session authentication) because server-client communication (including session authentication)
is not encrypted." is not encrypted."
:group 'server
:type '(choice :type '(choice
(string :tag "Name or IP address") (string :tag "Name or IP address")
(const :tag "Local" nil)) (const :tag "Local" nil))
...@@ -121,7 +119,6 @@ is not encrypted." ...@@ -121,7 +119,6 @@ is not encrypted."
This variable only takes effect when the Emacs server is using This variable only takes effect when the Emacs server is using
TCP instead of local sockets. A nil value means to use a random TCP instead of local sockets. A nil value means to use a random
port number." port number."
:group 'server
:type '(choice :type '(choice
(string :tag "Port number") (string :tag "Port number")
(const :tag "Random" nil)) (const :tag "Random" nil))
...@@ -138,7 +135,6 @@ NOTE: On FAT32 filesystems, directories are not secure; ...@@ -138,7 +135,6 @@ NOTE: On FAT32 filesystems, directories are not secure;
files can be read and modified by any user or process. files can be read and modified by any user or process.
It is strongly suggested to set `server-auth-dir' to a It is strongly suggested to set `server-auth-dir' to a
directory residing in a NTFS partition instead." directory residing in a NTFS partition instead."
:group 'server
:type 'directory :type 'directory
:version "22.1") :version "22.1")
;;;###autoload ;;;###autoload
...@@ -166,7 +162,6 @@ communications are unencrypted, still apply. ...@@ -166,7 +162,6 @@ communications are unencrypted, still apply.
The key must consist of 64 ASCII printable characters except for The key must consist of 64 ASCII printable characters except for
space (this means characters from ! to ~; or from code 33 to space (this means characters from ! to ~; or from code 33 to
126). You can use \\[server-generate-key] to get a random key." 126). You can use \\[server-generate-key] to get a random key."
:group 'server
:type '(choice :type '(choice
(const :tag "Random" nil) (const :tag "Random" nil)
(string :tag "Password")) (string :tag "Password"))
...@@ -174,30 +169,25 @@ space (this means characters from ! to ~; or from code 33 to ...@@ -174,30 +169,25 @@ space (this means characters from ! to ~; or from code 33 to
(defcustom server-raise-frame t (defcustom server-raise-frame t
"If non-nil, raise frame when switching to a buffer." "If non-nil, raise frame when switching to a buffer."
:group 'server
:type 'boolean :type 'boolean
:version "22.1") :version "22.1")
(defcustom server-visit-hook nil (defcustom server-visit-hook nil
"Hook run when visiting a file for the Emacs server." "Hook run when visiting a file for the Emacs server."
:group 'server
:type 'hook) :type 'hook)
(defcustom server-switch-hook nil (defcustom server-switch-hook nil
"Hook run when switching to a buffer for the Emacs server." "Hook run when switching to a buffer for the Emacs server."
:group 'server
:type 'hook) :type 'hook)
(defcustom server-after-make-frame-hook nil (defcustom server-after-make-frame-hook nil
"Hook run when the Emacs server creates a client frame. "Hook run when the Emacs server creates a client frame.
The created frame is selected when the hook is called." The created frame is selected when the hook is called."
:group 'server
:type 'hook :type 'hook
:version "27.1") :version "27.1")
(defcustom server-done-hook nil (defcustom server-done-hook nil
"Hook run when done editing a buffer for the Emacs server." "Hook run when done editing a buffer for the Emacs server."
:group 'server
:type 'hook) :type 'hook)
(defvar server-process nil (defvar server-process nil
...@@ -223,7 +213,6 @@ If it is a frame, use the frame's selected window. ...@@ -223,7 +213,6 @@ If it is a frame, use the frame's selected window.
It is not meaningful to set this to a specific frame or window with Custom. It is not meaningful to set this to a specific frame or window with Custom.
Only programs can do so." Only programs can do so."
:group 'server
:version "22.1" :version "22.1"
:type '(choice (const :tag "Use selected window" :type '(choice (const :tag "Use selected window"
:match (lambda (widget value) :match (lambda (widget value)
...@@ -233,11 +222,10 @@ Only programs can do so." ...@@ -233,11 +222,10 @@ Only programs can do so."
(function-item :tag "Use pop-to-buffer" pop-to-buffer) (function-item :tag "Use pop-to-buffer" pop-to-buffer)
(function :tag "Other function"))) (function :tag "Other function")))
(defcustom server-temp-file-regexp "^/tmp/Re\\|/draft$" (defcustom server-temp-file-regexp "\\`/tmp/Re\\|/draft\\'"
"Regexp matching names of temporary files. "Regexp matching names of temporary files.
These are deleted and reused after each edit by the programs that These are deleted and reused after each edit by the programs that
invoke the Emacs server." invoke the Emacs server."
:group 'server
:type 'regexp) :type 'regexp)
(defcustom server-kill-new-buffers t (defcustom server-kill-new-buffers t
...@@ -248,7 +236,6 @@ it with the Emacs server. If nil, kill only buffers as specified by ...@@ -248,7 +236,6 @@ it with the Emacs server. If nil, kill only buffers as specified by
Please note that only buffers that still have a client are killed, Please note that only buffers that still have a client are killed,
i.e. buffers visited with \"emacsclient --no-wait\" are never killed i.e. buffers visited with \"emacsclient --no-wait\" are never killed
in this way." in this way."
:group 'server
:type 'boolean :type 'boolean
:version "21.1") :version "21.1")
...@@ -278,7 +265,6 @@ If this is an absolute file name, it specifies where the socket ...@@ -278,7 +265,6 @@ If this is an absolute file name, it specifies where the socket
file will be created. To have emacsclient connect to the same file will be created. To have emacsclient connect to the same
socket, use the \"-s\" switch for local non-TCP sockets, and socket, use the \"-s\" switch for local non-TCP sockets, and
the \"-f\" switch otherwise." the \"-f\" switch otherwise."
:group 'server
:type 'string :type 'string
:version "23.1") :version "23.1")
...@@ -381,7 +367,7 @@ Updates `server-clients'." ...@@ -381,7 +367,7 @@ Updates `server-clients'."
(server-log "Deleted" proc)))) (server-log "Deleted" proc))))
(defvar server-log-time-function 'current-time-string (defvar server-log-time-function #'current-time-string
"Function to generate timestamps for `server-buffer'.") "Function to generate timestamps for `server-buffer'.")
(defconst server-buffer " *server*" (defconst server-buffer " *server*"
...@@ -549,6 +535,16 @@ Creates the directory if necessary and makes sure: ...@@ -549,6 +535,16 @@ Creates the directory if necessary and makes sure:
(cl-letf (((default-file-modes) ?\700)) (make-directory dir t)) (cl-letf (((default-file-modes) ?\700)) (make-directory dir t))
(setq attrs (file-attributes dir 'integer))) (setq attrs (file-attributes dir 'integer)))
(let ((olddir (or (getenv "TMPDIR") "/tmp")))
(when (and (equal dir (format "%s/emacs" (getenv "XDG_RUNTIME_DIR")))
(file-writable-p olddir))
(let ((link (format "%s/emacs%d" olddir (user-uid))))
(unless (file-directory-p link)
;; We're using the new location, so try and setup a symlink from
;; the old location, in case we want to use an old emacsclient.
;; FIXME: Check that it's safe to use!
(make-symbolic-link dir link t)))))
;; Check that it's safe for use. ;; Check that it's safe for use.
(let* ((uid (file-attribute-user-id attrs)) (let* ((uid (file-attribute-user-id attrs))
(w32 (eq system-type 'windows-nt)) (w32 (eq system-type 'windows-nt))
...@@ -684,16 +680,16 @@ server or call `\\[server-force-delete]' to forcibly disconnect it.")) ...@@ -684,16 +680,16 @@ server or call `\\[server-force-delete]' to forcibly disconnect it."))
(when server-process (when server-process
(server-log (message "Restarting server"))) (server-log (message "Restarting server")))
(cl-letf (((default-file-modes) ?\700)) (cl-letf (((default-file-modes) ?\700))
(add-hook 'suspend-tty-functions 'server-handle-suspend-tty) (add-hook 'suspend-tty-functions #'server-handle-suspend-tty)
(add-hook 'delete-frame-functions 'server-handle-delete-frame) (add-hook 'delete-frame-functions #'server-handle-delete-frame)
(add-hook 'kill-emacs-query-functions (add-hook 'kill-emacs-query-functions
'server-kill-emacs-query-function) #'server-kill-emacs-query-function)
;; We put server's kill-emacs-hook after the others, so that ;; We put server's kill-emacs-hook after the others, so that
;; frames are not deleted too early, because doing that ;; frames are not deleted too early, because doing that
;; would severely degrade our abilities to communicate with ;; would severely degrade our abilities to communicate with
;; the user, while some hooks may wish to ask the user ;; the user, while some hooks may wish to ask the user
;; questions (e.g., desktop-kill). ;; questions (e.g., desktop-kill).
(add-hook 'kill-emacs-hook 'server-force-stop t) ;Cleanup upon exit. (add-hook 'kill-emacs-hook #'server-force-stop t) ;Cleanup upon exit.
(setq server-process (setq server-process
(apply #'make-network-process (apply #'make-network-process
:name server-name :name server-name
...@@ -792,7 +788,6 @@ Server mode runs a process that accepts commands from the ...@@ -792,7 +788,6 @@ Server mode runs a process that accepts commands from the
`emacsclient' program. See Info node `Emacs server' and `emacsclient' program. See Info node `Emacs server' and
`server-start' for details." `server-start' for details."
:global t :global t
:group 'server
:version "22.1" :version "22.1"
;; Fixme: Should this check for an existing server socket and do ;; Fixme: Should this check for an existing server socket and do
;; nothing if there is one (for multiple Emacs sessions)? ;; nothing if there is one (for multiple Emacs sessions)?
...@@ -1118,7 +1113,7 @@ The following commands are accepted by the client: ...@@ -1118,7 +1113,7 @@ The following commands are accepted by the client:
;; Remove this line from STRING. ;; Remove this line from STRING.
(setq string (substring string (match-end 0))) (setq string (substring string (match-end 0)))
(setq args-left (setq args-left
(mapcar 'server-unquote-arg (split-string request " " t))) (mapcar #'server-unquote-arg (split-string request " " t)))
(while args-left (while args-left
(pcase (pop args-left) (pcase (pop args-left)
;; -version CLIENT-VERSION: obsolete at birth. ;; -version CLIENT-VERSION: obsolete at birth.
...@@ -1341,7 +1336,7 @@ The following commands are accepted by the client: ...@@ -1341,7 +1336,7 @@ The following commands are accepted by the client:
(when initial-buffer (when initial-buffer
(switch-to-buffer initial-buffer 'norecord)))))) (switch-to-buffer initial-buffer 'norecord))))))
(mapc 'funcall (nreverse commands)) (mapc #'funcall (nreverse commands))
;; Delete the client if necessary. ;; Delete the client if necessary.
(cond (cond
...@@ -1441,7 +1436,7 @@ so don't mark these buffers specially, just visit them normally." ...@@ -1441,7 +1436,7 @@ so don't mark these buffers specially, just visit them normally."
(run-hooks 'post-command-hook)) (run-hooks 'post-command-hook))
(unless nowait (unless nowait
;; When the buffer is killed, inform the clients. ;; When the buffer is killed, inform the clients.
(add-hook 'kill-buffer-hook 'server-kill-buffer nil t) (add-hook 'kill-buffer-hook #'server-kill-buffer nil t)
(push proc server-buffer-clients)) (push proc server-buffer-clients))
(push (current-buffer) client-record))) (push (current-buffer) client-record)))
(unless nowait (unless nowait
...@@ -1552,8 +1547,8 @@ specifically for the clients and did not exist before their request for it." ...@@ -1552,8 +1547,8 @@ specifically for the clients and did not exist before their request for it."
"Ask before exiting Emacs if it has live clients." "Ask before exiting Emacs if it has live clients."
(or (not (let (live-client) (or (not (let (live-client)
(dolist (proc server-clients) (dolist (proc server-clients)
(when (memq t (mapcar 'buffer-live-p (process-get (when (memq t (mapcar #'buffer-live-p
proc 'buffers))) (process-get proc 'buffers)))
(setq live-client t))) (setq live-client t)))
live-client)) live-client))
(yes-or-no-p "This Emacs session has clients; exit anyway? "))) (yes-or-no-p "This Emacs session has clients; exit anyway? ")))
...@@ -1589,7 +1584,7 @@ starts server process and that is all. Invoked by \\[server-edit]." ...@@ -1589,7 +1584,7 @@ starts server process and that is all. Invoked by \\[server-edit]."
(not server-process) (not server-process)
(memq (process-status server-process) '(signal exit))) (memq (process-status server-process) '(signal exit)))
(server-mode 1)) (server-mode 1))
(server-clients (apply 'server-switch-buffer (server-done))) (server-clients (apply #'server-switch-buffer (server-done)))
(t (message "No server editing buffers exist")))) (t (message "No server editing buffers exist"))))
(defun server-switch-buffer (&optional next-buffer killed-one filepos) (defun server-switch-buffer (&optional next-buffer killed-one filepos)
...@@ -1622,7 +1617,7 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)." ...@@ -1622,7 +1617,7 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)."
(if (not (buffer-live-p next-buffer)) (if (not (buffer-live-p next-buffer))
;; If NEXT-BUFFER is a dead buffer, remove the server records for it ;; If NEXT-BUFFER is a dead buffer, remove the server records for it
;; and try the next surviving server buffer. ;; and try the next surviving server buffer.
(apply 'server-switch-buffer (server-buffer-done next-buffer)) (apply #'server-switch-buffer (server-buffer-done next-buffer))
;; OK, we know next-buffer is live, let's display and select it. ;; OK, we know next-buffer is live, let's display and select it.
(if (functionp server-window) (if (functionp server-window)
(funcall server-window next-buffer) (funcall server-window next-buffer)
...@@ -1701,7 +1696,7 @@ only these files will be asked to be saved." ...@@ -1701,7 +1696,7 @@ only these files will be asked to be saved."
(save-current-buffer (save-current-buffer
(dolist (buffer (buffer-list)) (dolist (buffer (buffer-list))
(set-buffer buffer) (set-buffer buffer)
(remove-hook 'kill-buffer-hook 'server-kill-buffer t))) (remove-hook 'kill-buffer-hook #'server-kill-buffer t)))
;; continue standard unloading ;; continue standard unloading
nil) nil)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment