(put 'server-host 'risky-local-variable t)
(defcustom server-port nil
- "The port number that the server process should listen on."
+ "The port number that the server process should listen on.
+This variable only takes effect when the Emacs server is using
+TCP instead of local sockets. A nil value means to use a random
+port number."
:group 'server
:type '(choice
(string :tag "Port number")
(defun server-clients-with (property value)
"Return a list of clients with PROPERTY set to VALUE."
(let (result)
- (dolist (proc server-clients result)
+ (dolist (proc server-clients)
(when (equal value (process-get proc property))
- (push proc result)))))
+ (push proc result)))
+ result))
(defun server-add-client (proc)
"Create a client for process PROC, if it doesn't already have one.
(defun server-eval-and-print (expr proc)
"Eval EXPR and send the result back to client PROC."
(let ((v (eval (car (read-from-string expr)))))
- (when (and v proc)
+ (when proc
(with-temp-buffer
(let ((standard-output (current-buffer)))
(pp v)
frame))
-(defun server-create-window-system-frame (display nowait proc parent-id)
+(defun server-create-window-system-frame (display nowait proc parent-id
+ &optional parameters)
(add-to-list 'frame-inherited-parameters 'client)
(if (not (fboundp 'make-frame-on-display))
(progn
;; killing emacs on that frame.
(let* ((params `((client . ,(if nowait 'nowait proc))
;; This is a leftover, see above.
- (environment . ,(process-get proc 'env))))
+ (environment . ,(process-get proc 'env))
+ ,@parameters))
(display (or display
(frame-parameter nil 'display)
(getenv "DISPLAY")
`-current-frame'
Forbid the creation of new frames.
+`-frame-parameters ALIST'
+ Set the parameters of the created frame.
+
`-nowait'
Request that the next frame created should not be
associated with this client.
commands
dir
use-current-frame
+ frame-parameters ;parameters for newly created frame
tty-name ; nil, `window-system', or the tty name.
tty-type ; string.
files
;; -current-frame: Don't create frames.
(`"-current-frame" (setq use-current-frame t))
+ ;; -frame-parameters: Set frame parameters
+ (`"-frame-parameters"
+ (let ((alist (pop args-left)))
+ (if coding-system
+ (setq alist (decode-coding-string alist coding-system)))
+ (setq frame-parameters (car (read-from-string alist)))))
+
;; -display DISPLAY:
;; Open X frames on the given display instead of the default.
(`"-display"
(if display (server-select-display display)))
((eq tty-name 'window-system)
(server-create-window-system-frame display nowait proc
- parent-id))
+ parent-id
+ frame-parameters))
;; When resuming on a tty, tty-name is nil.
(tty-name
(server-create-tty-frame tty-name tty-type proc))))
"When done with a buffer, type \\[server-edit]")))))
(when (and frame (null tty-name))
(server-unselect-display frame)))
- (error (server-return-error proc err)))))
+ ((quit error)
+ (when (eq (car err) 'quit)
+ (message "Quit emacsclient request"))
+ (server-return-error proc err)))))
(defun server-return-error (proc err)
(ignore-errors
(add-to-history 'file-name-history filen)
(if (null obuf)
(progn
- (run-hooks 'pre-command-hook)
+ (run-hooks 'pre-command-hook)
(set-buffer (find-file-noselect filen)))
(set-buffer obuf)
;; separately for each file, in sync with post-command hooks,
;; with the new buffer current:
- (run-hooks 'pre-command-hook)
+ (run-hooks 'pre-command-hook)
(cond ((file-exists-p filen)
(when (not (verify-visited-file-modtime obuf))
(revert-buffer t nil)))
(server-goto-line-column (cdr file))
(run-hooks 'server-visit-hook)
;; hooks may be specific to current buffer:
- (run-hooks 'post-command-hook))
+ (run-hooks 'post-command-hook))
(unless nowait
;; When the buffer is killed, inform the clients.
(add-hook 'kill-buffer-hook 'server-kill-buffer nil t)
"Ask before killing a server buffer."
(or (not server-buffer-clients)
(let ((res t))
- (dolist (proc server-buffer-clients res)
+ (dolist (proc server-buffer-clients)
(when (and (memq proc server-clients)
(eq (process-status proc) 'open))
- (setq res nil))))
+ (setq res nil)))
+ res)
(yes-or-no-p (format "Buffer `%s' still has clients; kill it? "
(buffer-name (current-buffer))))))
"Ask before exiting Emacs if it has live clients."
(or (not server-clients)
(let (live-client)
- (dolist (proc server-clients live-client)
+ (dolist (proc server-clients)
(when (memq t (mapcar 'buffer-live-p (process-get
proc 'buffers)))
- (setq live-client t))))
+ (setq live-client t)))
+ live-client)
(yes-or-no-p "This Emacs session has clients; exit anyway? ")))
(defun server-kill-buffer ()
;; continue standard unloading
nil)
+(defun server-eval-at (server form)
+ "Eval FORM on Emacs Server SERVER."
+ (let ((auth-file (expand-file-name server server-auth-dir))
+ (coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
+ address port secret process)
+ (unless (file-exists-p auth-file)
+ (error "No such server definition: %s" auth-file))
+ (with-temp-buffer
+ (insert-file-contents auth-file)
+ (unless (looking-at "\\([0-9.]+\\):\\([0-9]+\\)")
+ (error "Invalid auth file"))
+ (setq address (match-string 1)
+ port (string-to-number (match-string 2)))
+ (forward-line 1)
+ (setq secret (buffer-substring (point) (line-end-position)))
+ (erase-buffer)
+ (unless (setq process (open-network-stream "eval-at" (current-buffer)
+ address port))
+ (error "Unable to contact the server"))
+ (set-process-query-on-exit-flag process nil)
+ (process-send-string
+ process
+ (concat "-auth " secret " -eval "
+ (replace-regexp-in-string
+ " " "&_" (format "%S" form))
+ "\n"))
+ (while (memq (process-status process) '(open run))
+ (accept-process-output process 0 10))
+ (goto-char (point-min))
+ ;; If the result is nil, there's nothing in the buffer. If the
+ ;; result is non-nil, it's after "-print ".
+ (when (search-forward "\n-print" nil t)
+ (let ((start (point)))
+ (while (search-forward "&_" nil t)
+ (replace-match " " t t))
+ (goto-char start)
+ (read (current-buffer)))))))
+
\f
(provide 'server)