;;; server.el --- Lisp code for GNU Emacs running as server process -*- lexical-binding: t -*-
-;; Copyright (C) 1986-1987, 1992, 1994-2013 Free Software Foundation,
+;; Copyright (C) 1986-1987, 1992, 1994-2015 Free Software Foundation,
;; Inc.
;; Author: William Sommerfeld <wesommer@athena.mit.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: processes
;; Changes by peck@sun.com and by rms.
"The name or IP address to use as host address of the server process.
If set, the server accepts remote connections; otherwise it is local.
-DO NOT give this a non-nil value unless you know what you are
-doing! On unsecured networks, accepting remote connections is
-very dangerous, because server-client communication (including
-session authentication) is not encrypted."
+DO NOT give this a non-nil value unless you know what you are doing!
+On unsecured networks, accepting remote connections is very dangerous,
+because server-client communication (including session authentication)
+is not encrypted."
:group 'server
:type '(choice
(string :tag "Name or IP address")
(cl-letf (((default-file-modes) ?\700))
(add-hook 'suspend-tty-functions 'server-handle-suspend-tty)
(add-hook 'delete-frame-functions 'server-handle-delete-frame)
- (add-hook 'kill-buffer-query-functions
- 'server-kill-buffer-query-function)
(add-hook 'kill-emacs-query-functions
'server-kill-emacs-query-function)
(add-hook 'kill-emacs-hook 'server-force-stop) ;Cleanup upon exit.
(error "Invalid terminal type"))
(add-to-list 'frame-inherited-parameters 'client)
(let ((frame
- (server-with-environment (process-get proc 'env)
- '("LANG" "LC_CTYPE" "LC_ALL"
- ;; For tgetent(3); list according to ncurses(3).
- "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES"
- "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING"
- "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO"
- "TERMINFO_DIRS" "TERMPATH"
- ;; rxvt wants these
- "COLORFGBG" "COLORTERM")
- (make-frame `((window-system . nil)
- (tty . ,tty)
- (tty-type . ,type)
- ;; Ignore nowait here; we always need to
- ;; clean up opened ttys when the client dies.
- (client . ,proc)
- ;; This is a leftover from an earlier
- ;; attempt at making it possible for process
- ;; run in the server process to use the
- ;; environment of the client process.
- ;; It has no effect now and to make it work
- ;; we'd need to decide how to make
- ;; process-environment interact with client
- ;; envvars, and then to change the
- ;; C functions `child_setup' and
- ;; `getenv_internal' accordingly.
- (environment . ,(process-get proc 'env)))))))
+ (server-with-environment
+ (process-get proc 'env)
+ '("LANG" "LC_CTYPE" "LC_ALL"
+ ;; For tgetent(3); list according to ncurses(3).
+ "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES"
+ "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING"
+ "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO"
+ "TERMINFO_DIRS" "TERMPATH"
+ ;; rxvt wants these
+ "COLORFGBG" "COLORTERM")
+ (make-frame `((window-system . nil)
+ (tty . ,tty)
+ (tty-type . ,type)
+ ;; Ignore nowait here; we always need to
+ ;; clean up opened ttys when the client dies.
+ (client . ,proc)
+ ;; This is a leftover from an earlier
+ ;; attempt at making it possible for process
+ ;; run in the server process to use the
+ ;; environment of the client process.
+ ;; It has no effect now and to make it work
+ ;; we'd need to decide how to make
+ ;; process-environment interact with client
+ ;; envvars, and then to change the
+ ;; C functions `child_setup' and
+ ;; `getenv_internal' accordingly.
+ (environment . ,(process-get proc 'env)))))))
;; ttys don't use the `display' parameter, but callproc.c does to set
;; the DISPLAY environment on subprocesses.
(save-buffer)))
(server-buffer-done (current-buffer))))
-;; Ask before killing a server buffer.
-;; It was suggested to release its client instead,
-;; but I think that is dangerous--the client would proceed
-;; using whatever is on disk in that file. -- rms.
-(defun server-kill-buffer-query-function ()
- "Ask before killing a server buffer."
- (or (not server-buffer-clients)
- (let ((res t))
- (dolist (proc server-buffer-clients)
- (when (and (memq proc server-clients)
- (eq (process-status proc) 'open))
- (setq res nil)))
- res)
- (yes-or-no-p (format "Buffer `%s' still has clients; kill it? "
- (buffer-name (current-buffer))))))
-
(defun server-kill-emacs-query-function ()
"Ask before exiting Emacs if it has live clients."
(or (not server-clients)
(define-key ctl-x-map "#" 'server-edit)
(defun server-unload-function ()
- "Unload the server library."
+ "Unload the Server library."
(server-mode -1)
(substitute-key-definition 'server-edit nil ctl-x-map)
(save-current-buffer
"Contact the Emacs server named SERVER and evaluate FORM there.
Returns the result of the evaluation, or signals an error if it
cannot contact the specified server. For example:
- \(server-eval-at \"server\" '(emacs-pid))
+ (server-eval-at \"server\" '(emacs-pid))
returns the process ID of the Emacs instance running \"server\"."
(let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir))
(server-file (expand-file-name server server-dir))