;; The global variable "server-clients" lists all the waiting clients,
;; and which files are yet to be edited for each.
+;; Todo:
+
+;; - handle command-line-args-left.
+;; - move most of the args processing and decision making from emacsclient.c
+;; to here.
+;; - fix up handling of the client's environment (place it in the terminal?).
+
;;; Code:
(eval-when-compile (require 'cl))
(defcustom server-kill-new-buffers t
"Whether to kill buffers when done with them.
If non-nil, kill a buffer unless it already existed before editing
-it with Emacs server. If nil, kill only buffers as specified by
+it with the Emacs server. If nil, kill only buffers as specified by
`server-temp-file-regexp'.
-Please note that only buffers are killed that still have a client,
-i.e. buffers visited which \"emacsclient --no-wait\" are never killed in
+Please note that only buffers that still have a client are killed,
+i.e. buffers visited with \"emacsclient --no-wait\" are never killed in
this way."
:group 'server
:type 'boolean
(progn ,@body))))
(defun server-delete-client (proc &optional noframe)
- "Delete CLIENT, including its buffers, terminals and frames.
+ "Delete PROC, including its buffers, terminals and frames.
If NOFRAME is non-nil, let the frames live. (To be used from
`delete-frame-functions'.)"
(server-log (concat "server-delete-client" (if noframe " noframe"))
;; Delete the client's tty.
(let ((terminal (process-get proc 'terminal)))
- (when (eq (terminal-live-p terminal) t)
+ ;; Only delete the terminal if it is non-nil.
+ (when (and terminal (eq (terminal-live-p terminal) t))
(delete-terminal terminal)))
;; Delete the client's process.
(defun server-log (string &optional client)
"If a *server* buffer exists, write STRING to it for logging purposes.
-If CLIENT is non-nil, add a description of it to the logged
-message."
+If CLIENT is non-nil, add a description of it to the logged message."
(when (get-buffer "*server*")
(with-current-buffer "*server*"
(goto-char (point-max))
(defun server-select-display (display)
;; If the current frame is on `display' we're all set.
- (unless (equal (frame-parameter (selected-frame) 'display) display)
+ ;; Similarly if we are unable to open a frames on other displays, there's
+ ;; nothing more we can do.
+ (unless (or (not (fboundp 'make-frame-on-display))
+ (equal (frame-parameter (selected-frame) 'display) display))
;; Otherwise, look for an existing frame there and select it.
(dolist (frame (frame-list))
(when (equal (frame-parameter frame 'display) display)
(when server-use-tcp
(let ((auth-key
(loop
- ;; The auth key is a 64-byte string of random chars in the
- ;; range `!'..`~'.
- for i below 64
- collect (+ 33 (random 94)) into auth
- finally return (concat auth))))
+ ;; The auth key is a 64-byte string of random chars in the
+ ;; range `!'..`~'.
+ for i below 64
+ collect (+ 33 (random 94)) into auth
+ finally return (concat auth))))
(process-put server-process :auth-key auth-key)
(with-temp-file server-file
(set-buffer-multibyte nil)
(server-quote-arg text)))))))))
(defun server-create-tty-frame (tty type proc)
+ (add-to-list 'frame-inherited-parameters 'client)
(let ((frame
(server-with-environment (process-get proc 'env)
'("LANG" "LC_CTYPE" "LC_ALL"
"BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES"
"NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING"
"NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO"
- "TERMINFO_DIRS" "TERMPATH"
+ "TERMINFO_DIRS" "TERMPATH"
;; rxvt wants these
"COLORFGBG" "COLORTERM")
(make-frame-on-tty tty 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.
(set-frame-parameter frame 'display
frame))
(defun server-create-window-system-frame (display nowait proc)
+ (add-to-list 'frame-inherited-parameters 'client)
(if (not (fboundp 'make-frame-on-display))
(progn
;; This emacs does not support X.
;; `server-save-buffers-kill-terminal' from unexpectedly
;; killing emacs on that frame.
(let* ((params `((client . ,(if nowait 'nowait proc))
+ ;; This is a leftover, see above.
(environment . ,(process-get proc 'env))))
(frame (make-frame-on-display
(or 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
+ ;; 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)
on this tty until it gets a -resume command.
`-resume'
- Resume this tty frame. The client sends this string when it
+ Resume this tty frame. The client sends this string when it
gets the SIGCONT signal and it is the foreground process on its
controlling tty.
used to forward window change signals to it.
`-window-system-unsupported'
- Signals that the server does not
- support creating X frames; the client must try again with a tty
- frame.
+ Signals that the server does not support creating X frames;
+ the client must try again with a tty frame.
`-print STRING'
Print STRING on stdout. Used to send values
Signal an error (but continue processing).
`-suspend'
- Suspend this terminal, i.e., stop the client process. Sent
- when the user presses C-z."
+ Suspend this terminal, i.e., stop the client process.
+ Sent when the user presses C-z."
(server-log (concat "Received " string) proc)
;; First things first: let's check the authentication
(unless (process-get proc :authenticated)
;; Save for later any partial line that remains.
(when (> (length string) 0)
(process-put proc 'previous-string string))
-
+
;; In earlier versions of server.el (where we used an `emacsserver'
;; process), there could be multiple lines. Nowadays this is not
;; supported any more.
;; 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))))
+ (setq display (match-string 1 request))
+ (setq request (substring request (match-end 0))))
;; -window-system: Open a new X frame.
((equal "-window-system" arg)
;; Unknown command.
(t (error "Unknown command: %s" arg)))))
-
+
(setq frame
(case tty-name
((nil) (if display (server-select-display display)))
(run-hooks 'post-command-hook)))))
(mapc 'funcall (nreverse commands))
-
+
;; Delete the client if necessary.
(cond
(nowait
`server-visit-files'."
(goto-line (nth 1 file-line-col))
(let ((column-number (nth 2 file-line-col)))
- (if (> column-number 0)
- (move-to-column (1- column-number)))))
+ (when (> column-number 0)
+ (move-to-column (1- column-number)))))
(defun server-visit-files (files proc &optional nowait)
"Find FILES and return a list of buffers created.
(buffer-name (current-buffer))))))
(defun server-kill-emacs-query-function ()
- "Ask before exiting Emacs it has live clients."
+ "Ask before exiting Emacs if it has live clients."
(or (not server-clients)
(let (live-client)
(dolist (proc server-clients live-client)
HCoop / bpt / emacs.git / blobdiff