comparison lisp/server.el @ 88016:921eddfa6d43

(server-buffer): New const. (server-log): New var. (server-log): Use them. (server-process-filter): (Try to) run the continuation in the same cwd as the client's.

88015:7b54e553ca0b

      (server-log "Deleted" proc))))

(defvar server-log-time-function 'current-time-string
  "Function to generate timestamps for the *server* buffer.")

(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."
  (when (get-buffer "*server*")
    (with-current-buffer "*server*"
      (goto-char (point-max))
      (insert (funcall server-log-time-function)
	      (cond
		((null client) " ")
		((listp client) (format " %s: " (car client)))

		       :filter 'server-process-filter
		       ;; We must receive file names without being decoded.
		       ;; Those are decoded by server-process-filter according
		       ;; to file-name-coding-system.
		       :coding 'raw-text
		       ;; The rest of the args depends on the kind of socket used.
		       (if server-use-tcp
			   (list :family nil
				 :service t
				 :host (or server-host 'local)
				 :plist '(:authenticated nil))

                    ((nil) (if display (server-select-display display)))
                    ((window-system)
                     (server-create-window-system-frame display nowait proc))
                    (t (server-create-tty-frame tty-name tty-type proc))))

            (process-put proc 'continuation
                         (lexical-let ((proc proc)
                                       (files files)
                                       (nowait nowait)
                                       (commands commands)
                                       (dontkill dontkill)
                                       (frame frame)
                                       (tty-name tty-name))
                           (lambda ()
                             (server-execute proc files nowait commands
                                             dontkill frame tty-name))))

            (when (or frame files)
              (server-goto-toplevel proc))

            (server-execute-continuation proc))))

88016:921eddfa6d43

      (server-log "Deleted" proc))))

(defvar server-log-time-function 'current-time-string
  "Function to generate timestamps for the *server* buffer.")

(defconst server-buffer " *server*"
  "Buffer used internally by Emacs's server.
One use is to log the I/O for debugging purposes (see `server-log'),
the other is to provide a current buffer in which the process filter can
safely let-bind buffer-local variables like default-directory.")

(defvar server-log nil
  "If non-nil, log the server's inputs and outputs in the `server-buffer'.")

(defun server-log (string &optional client)
  "If `server-log' is non-nil, log STRING to `server-buffer'.
If CLIENT is non-nil, add a description of it to the logged message."
  (when server-log
    (with-current-buffer (get-buffer-create server-buffer)
      (goto-char (point-max))
      (insert (funcall server-log-time-function)
	      (cond
		((null client) " ")
		((listp client) (format " %s: " (car client)))

		       :filter 'server-process-filter
		       ;; We must receive file names without being decoded.
		       ;; Those are decoded by server-process-filter according
		       ;; to file-name-coding-system.
		       :coding 'raw-text
		       ;; The other args depend on the kind of socket used.
		       (if server-use-tcp
			   (list :family nil
				 :service t
				 :host (or server-host 'local)
				 :plist '(:authenticated nil))

                    ((nil) (if display (server-select-display display)))
                    ((window-system)
                     (server-create-window-system-frame display nowait proc))
                    (t (server-create-tty-frame tty-name tty-type proc))))

            (process-put
             proc 'continuation
             (lexical-let ((proc proc)
                           (files files)
                           (nowait nowait)
                           (commands commands)
                           (dontkill dontkill)
                           (frame frame)
                           (dir dir)
                           (tty-name tty-name))
               (lambda ()
                 (with-current-buffer (get-buffer-create server-buffer)
                   ;; Use the same cwd as the emacsclient, if possible, so
                   ;; relative file names work correctly, even in `eval'.
                   (let ((default-directory
                           (if (file-directory-p dir) dir default-directory)))
                     (server-execute proc files nowait commands
                                     dontkill frame tty-name))))))

            (when (or frame files)
              (server-goto-toplevel proc))

            (server-execute-continuation proc))))