;;; server.el --- Lisp code for GNU Emacs running as server process
-;; Copyright (C) 1986,87,92,94,95,96,97,98,99,2000,01,02,03,2004
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1987, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+;; 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
;; Author: William Sommerfeld <wesommer@athena.mit.edu>
;; Maintainer: FSF
(setq server-clients (cons (cons proc nil)
server-clients))))
-;;;###autoload
-(defun server-getenv (variable &optional frame)
- "Get the value of VARIABLE in the client environment of frame FRAME.
-VARIABLE should be a string. Value is nil if VARIABLE is undefined in
-the environment. Otherwise, value is a string.
-
-If FRAME is an emacsclient frame, then the variable is looked up
-in the environment of the emacsclient process; otherwise the
-function consults the environment of the Emacs process.
-
-If FRAME is nil or missing, then the selected frame is used."
- (when (not frame) (setq frame (selected-frame)))
- (let ((client (frame-parameter frame 'client)) env)
- (if (null client)
- (getenv variable)
- (setq env (server-client-get client 'environment))
- (if (null env)
- (getenv variable)
- (cdr (assoc variable env))))))
-
-(defmacro server-with-client-environment (client vars &rest body)
- "Evaluate BODY with environment variables VARS set to those of CLIENT.
+(defun server-getenv-from (env variable)
+ "Get the value of VARIABLE in ENV.
+VARIABLE should be a string. Value is nil if VARIABLE is
+undefined in ENV. Otherwise, value is a string.
+
+ENV should be in the same format as `process-environment'."
+ (let (entry result)
+ (while (and env (null result))
+ (setq entry (car env)
+ env (cdr env))
+ (if (and (> (length entry) (length variable))
+ (eq ?= (aref entry (length variable)))
+ (equal variable (substring entry 0 (length variable))))
+ (setq result (substring entry (+ (length variable) 1)))))
+ result))
+
+(defmacro server-with-environment (env vars &rest body)
+ "Evaluate BODY with environment variables VARS set to those in ENV.
The environment variables are then restored to their previous values.
-VARS should be a list of strings."
+VARS should be a list of strings.
+ENV should be in the same format as `process-environment'."
(declare (indent 2))
(let ((oldvalues (make-symbol "oldvalues"))
(var (make-symbol "var"))
(value (make-symbol "value"))
(pair (make-symbol "pair")))
`(let (,oldvalues)
- (dolist (,var (quote ,vars))
- (let ((,value (cdr (assoc ,var (server-client-get ,client 'environment)))))
+ (dolist (,var ,vars)
+ (let ((,value (server-getenv-from ,env ,var)))
(setq ,oldvalues (cons (cons ,var (getenv ,var)) ,oldvalues))
(setenv ,var ,value)))
(unwind-protect
(setenv (car ,pair) (cdr ,pair)))))))
(defun server-delete-client (client &optional noframe)
- "Delete CLIENT, including its buffers, devices and frames.
+ "Delete CLIENT, including its buffers, terminals and frames.
If NOFRAME is non-nil, let the frames live. (To be used from
`delete-frame-functions'."
;; Force a new lookup of client (prevents infinite recursion).
(kill-buffer (current-buffer))))))
;; Delete the client's tty.
- (let ((device (server-client-get client 'device)))
- (when (eq (display-live-p device) t)
- (delete-display device)))
+ (let ((terminal (server-client-get client 'terminal)))
+ (when (eq (terminal-live-p terminal) t)
+ (delete-terminal terminal)))
;; Delete the client's frames.
(unless noframe
(defun server-sentinel (proc msg)
"The process sentinel for Emacs server connections."
+ ;; If this is a new client process, set the query-on-exit flag to nil
+ ;; for this process (it isn't inherited from the server process).
+ (when (and (eq (process-status proc) 'open)
+ (process-query-on-exit-flag proc))
+ (set-process-query-on-exit-flag proc nil))
(server-log (format "Status changed to %s: %s" (process-status proc) msg) proc)
(server-delete-client proc))
;; there are other frames on it.
(< 0 (let ((frame-num 0))
(mapc (lambda (f)
- (when (eq (frame-display f)
- (frame-display frame))
+ (when (eq (frame-terminal f)
+ (frame-terminal frame))
(setq frame-num (1+ frame-num))))
(frame-list))
frame-num))))
(server-log (format "server-handle-delete-frame, frame %s" frame) proc)
(server-delete-client proc 'noframe)))) ; Let delete-frame delete the frame later.
-(defun server-handle-suspend-tty (device)
+(defun server-handle-suspend-tty (terminal)
"Notify the emacsclient process to suspend itself when its tty device is suspended."
- (dolist (proc (server-clients-with 'device device))
- (server-log (format "server-handle-suspend-tty, device %s" device) proc)
+ (dolist (proc (server-clients-with 'terminal terminal))
+ (server-log (format "server-handle-suspend-tty, terminal %s" terminal) proc)
(condition-case err
(server-send-string proc "-suspend \n")
(file-error (condition-case nil (server-delete-client proc) (error nil))))))
error if there is a mismatch. The server replies with
`-good-version' to confirm the match.
-`-env NAME VALUE'
+`-env NAME=VALUE'
An environment variable on the client side.
+`-current-frame'
+ Forbid the creation of new frames.
+
`-nowait'
Request that the next frame created should not be
associated with this client.
(or file-name-coding-system
default-file-name-coding-system)))
(client (server-client proc))
+ current-frame
nowait ; t if emacsclient does not want to wait for us.
frame ; The frame that was opened for the client (if any).
- display ; Open the frame on this display.
+ display ; Open the frame on this display.
dontkill ; t if the client should not be killed.
+ env
(files nil)
(lineno 1)
(columnno 0))
;; -nowait: Emacsclient won't wait for a result.
((equal "-nowait" arg) (setq nowait t))
+ ;; -current-frame: Don't create frames.
+ ((equal "-current-frame" arg) (setq current-frame t))
+
;; -display DISPLAY:
- ;; Open X frames on the given instead of the default.
+ ;; Open X frames on the given display instead of the default.
((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
(setq display (match-string 1 request)
request (substring request (match-end 0))))
((equal "-window-system" arg)
(unless (server-client-get client 'version)
(error "Protocol error; make sure to use the correct version of emacsclient"))
- (if (fboundp 'x-create-frame)
- (progn
- (setq frame (make-frame-on-display
- (or display
- (frame-parameter nil 'device)
- (getenv "DISPLAY")
- (error "Please specify display"))
- (list (cons 'client proc))))
- ;; XXX We need to ensure the client parameter is
- ;; really set because Emacs forgets initialization
- ;; parameters for X frames at the moment.
- (modify-frame-parameters frame (list (cons 'client proc)))
- (select-frame frame)
- (server-client-set client 'frame frame)
- (server-client-set client 'device (frame-display frame))
- (setq dontkill t))
- ;; This emacs does not support X.
- (server-log "Window system unsupported" proc)
- (server-send-string proc "-window-system-unsupported \n")
- (setq dontkill t)))
+ (unless current-frame
+ (if (fboundp 'x-create-frame)
+ (let ((params (if nowait
+ ;; Flag frame as client-created, but use a dummy client.
+ ;; This will prevent the frame from being deleted when
+ ;; emacsclient quits while also preventing
+ ;; `server-save-buffers-kill-terminal' from unexpectedly
+ ;; killing emacs on that frame.
+ (list (cons 'client 'nowait) (cons 'environment env))
+ (list (cons 'client proc) (cons 'environment env)))))
+ (setq frame (make-frame-on-display
+ (or display
+ (frame-parameter nil 'display)
+ (getenv "DISPLAY")
+ (error "Please specify display"))
+ params))
+ (server-log (format "%s created" frame) proc)
+ ;; XXX We need to ensure the parameters are
+ ;; really set because Emacs forgets unhandled
+ ;; initialization parameters for X frames at
+ ;; the moment.
+ (modify-frame-parameters frame params)
+ (select-frame frame)
+ (server-client-set client 'frame frame)
+ (server-client-set client 'terminal (frame-terminal frame))
+ (setq dontkill t))
+ ;; This emacs does not support X.
+ (server-log "Window system unsupported" proc)
+ (server-send-string proc "-window-system-unsupported \n")
+ (setq dontkill t))))
;; -resume: Resume a suspended tty frame.
((equal "-resume" arg)
- (let ((device (server-client-get client 'device)))
+ (let ((terminal (server-client-get client 'terminal)))
(setq dontkill t)
- (when (eq (display-live-p device) t)
- (resume-tty device))))
+ (when (eq (terminal-live-p terminal) t)
+ (resume-tty terminal))))
;; -suspend: Suspend the client's frame. (In case we
;; get out of sync, and a C-z sends a SIGTSTP to
;; emacsclient.)
((equal "-suspend" arg)
- (let ((device (server-client-get client 'device)))
+ (let ((terminal (server-client-get client 'terminal)))
(setq dontkill t)
- (when (eq (display-live-p device) t)
- (suspend-tty device))))
+ (when (eq (terminal-live-p terminal) t)
+ (suspend-tty terminal))))
;; -ignore COMMENT: Noop; useful for debugging emacsclient.
;; (The given comment appears in the server log.)
(setq request (substring request (match-end 0)))
(unless (server-client-get client 'version)
(error "Protocol error; make sure you use the correct version of emacsclient"))
- (server-with-client-environment proc
- ("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")
- (setq frame (make-frame-on-tty tty type
- `((client . ,proc)))))
- (select-frame frame)
- (server-client-set client 'frame frame)
- (server-client-set client 'tty (display-name frame))
- (server-client-set client 'device (frame-display frame))
-
- ;; Reply with our pid.
- (server-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
- (setq dontkill t)))
+ (unless current-frame
+ (server-with-environment 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")
+ (setq frame (make-frame-on-tty tty type
+ ;; Ignore nowait here; we always need to clean
+ ;; up opened ttys when the client dies.
+ `((client . ,proc)
+ (environment . ,env)))))
+ (select-frame frame)
+ (server-client-set client 'frame frame)
+ (server-client-set client 'tty (terminal-name frame))
+ (server-client-set client 'terminal (frame-terminal frame))
+
+ ;; Reply with our pid.
+ (server-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
+ (setq dontkill t))))
;; -position LINE: Go to the given line in the next file.
((and (equal "-position" arg) (string-match "\\(\\+[0-9]+\\) " request))
- (setq request (substring request (match-end 0))
- lineno (string-to-number (substring (match-string 1 request) 1))))
+ (setq lineno (string-to-number (substring (match-string 1 request) 1))
+ request (substring request (match-end 0))))
;; -position LINE:COLUMN: Set point to the given position in the next file.
((and (equal "-position" arg) (string-match "\\+\\([0-9]+\\):\\([0-9]+\\) " request))
(if coding-system
(setq file (decode-coding-string file coding-system)))
(setq file (command-line-normalize-file-name file))
- (push (list file lineno columnno) files))
+ (push (list file lineno columnno) files)
+ (server-log (format "New file: %s (%d:%d)" file lineno columnno) proc))
(setq lineno 1
columnno 0))
(setq lineno 1
columnno 0)))
- ;; -env NAME VALUE: An environment variable.
- ((and (equal "-env" arg) (string-match "\\([^ ]+\\) \\([^ ]+\\) " request))
- (let ((name (server-unquote-arg (match-string 1 request)))
- (value (server-unquote-arg (match-string 2 request))))
- (when coding-system
- (setq name (decode-coding-string name coding-system))
- (setq value (decode-coding-string value coding-system)))
+ ;; -env NAME=VALUE: An environment variable.
+ ((and (equal "-env" arg) (string-match "\\([^ ]+\\) " request))
+ (let ((var (server-unquote-arg (match-string 1 request))))
+ ;; XXX Variables should be encoded as in getenv/setenv.
(setq request (substring request (match-end 0)))
- (server-client-set
- client 'environment
- (cons (cons name value)
- (server-client-get client 'environment)))))
+ (setq env (cons var env))))
;; Unknown command.
(t (error "Unknown command: %s" arg)))))
((or isearch-mode (minibufferp))
nil)
((and frame (null buffers))
- (message (substitute-command-keys
- "When done with this frame, type \\[delete-frame]")))
+ (message "%s" (substitute-command-keys
+ "When done with this frame, type \\[delete-frame]")))
((not (null buffers))
(server-switch-buffer (car buffers))
(run-hooks 'server-switch-hook)
(unless nowait
- (message (substitute-command-keys
- "When done with a buffer, type \\[server-edit]"))))))))
+ (message "%s" (substitute-command-keys
+ "When done with a buffer, type \\[server-edit]"))))))))
;; Save for later any partial line that remains.
(when (> (length string) 0)
(get-window-with-predicate
(lambda (w)
(and (not (window-dedicated-p w))
- (equal (frame-parameter (window-frame w) 'device)
- (frame-parameter (selected-frame) 'device))))
+ (equal (frame-terminal (window-frame w))
+ (frame-terminal (selected-frame)))))
'nomini 'visible (selected-window))))
(condition-case nil
(switch-to-buffer next-buffer)
;; a minibuffer/dedicated-window (if there's no other).
(error (pop-to-buffer next-buffer)))))))))
-(defun server-save-buffers-kill-display (&optional arg)
- "Offer to save each buffer, then kill the current connection.
-If the current frame has no client, kill Emacs itself.
+;;;###autoload
+(defun server-save-buffers-kill-terminal (proc &optional arg)
+ "Offer to save each buffer, then kill PROC.
With prefix arg, silently save all file-visiting buffers, then kill.
If emacsclient was started with a list of filenames to edit, then
only these files will be asked to be saved."
- (interactive "P")
- (let ((proc (frame-parameter (selected-frame) 'client)))
- (if proc
- (let ((buffers (server-client-get proc 'buffers)))
- ;; If client is bufferless, emulate a normal Emacs session
- ;; exit and offer to save all buffers. Otherwise, offer to
- ;; save only the buffers belonging to the client.
- (save-some-buffers arg
- (if buffers
- (lambda () (memq (current-buffer) buffers))
- t))
- (server-delete-client proc))
- (save-buffers-kill-emacs))))
-
-(global-set-key "\C-x#" 'server-edit)
+ (let ((buffers (server-client-get proc 'buffers)))
+ ;; If client is bufferless, emulate a normal Emacs session
+ ;; exit and offer to save all buffers. Otherwise, offer to
+ ;; save only the buffers belonging to the client.
+ (save-some-buffers arg
+ (if buffers
+ (lambda () (memq (current-buffer) buffers))
+ t))
+ (server-delete-client proc)))
+
+(define-key ctl-x-map "#" 'server-edit)
(defun server-unload-hook ()
"Unload the server library."
HCoop / bpt / emacs.git / blobdiff