# HG changeset patch # User Stefan Monnier # Date 1189919802 0 # Node ID c38a9291ef0ad3c1a586ec0c2c00489b54106035 # Parent 6cce7d77ef38d33b6359162431d2c36dc907eeaa (server-clients): Only keep procs, no properties any more. (server-client): Remove. (server-client-get, server-client-set): Remove, replace all callers by process-get and process-put resp. (server-clients-with, server-add-client, server-delete-client) (server-create-tty-frame, server-create-window-system-frame) (server-process-filter, server-execute, server-visit-files) (server-buffer-done, server-kill-buffer-query-function) (server-kill-emacs-query-function, server-switch-buffer) (server-save-buffers-kill-terminal): Update accordingly. diff -r 6cce7d77ef38 -r c38a9291ef0a lisp/ChangeLog --- a/lisp/ChangeLog Sun Sep 16 04:53:39 2007 +0000 +++ b/lisp/ChangeLog Sun Sep 16 05:16:42 2007 +0000 @@ -1,5 +1,16 @@ 2007-09-16 Stefan Monnier + * server.el (server-clients): Only keep procs, no properties any more. + (server-client): Remove. + (server-client-get, server-client-set): Remove, replace all callers by + process-get and process-put resp. + (server-clients-with, server-add-client, server-delete-client) + (server-create-tty-frame, server-create-window-system-frame) + (server-process-filter, server-execute, server-visit-files) + (server-buffer-done, server-kill-buffer-query-function) + (server-kill-emacs-query-function, server-switch-buffer) + (server-save-buffers-kill-terminal): Update accordingly. + * server.el (server-with-environment): Simplify. (server-select-display, server-unselect-display): Re-add functions that seem to have been lost in the multi-tty merge. diff -r 6cce7d77ef38 -r c38a9291ef0a lisp/server.el --- a/lisp/server.el Sun Sep 16 04:53:39 2007 +0000 +++ b/lisp/server.el Sun Sep 16 05:16:42 2007 +0000 @@ -139,8 +139,7 @@ (defvar server-clients nil "List of current server clients. -Each element is (PROC PROPERTIES...) where PROC is a process object, -and PROPERTIES is an association list of client properties.") +Each element is a process.") (defvar server-buffer-clients nil "List of client processes requesting editing of current buffer.") @@ -202,49 +201,17 @@ "The directory in which to place the server socket. Initialized by `server-start'.") -(defun server-client (proc) - "Return the Emacs client corresponding to PROC. -PROC must be a process object. -The car of the result is PROC; the cdr is an association list. -See `server-client-get' and `server-client-set'." - (assq proc server-clients)) - -(defun server-client-get (client property) - "Get the value of PROPERTY in CLIENT. -CLIENT may be a process object, or a client returned by `server-client'. -Return nil if CLIENT has no such property." - (or (listp client) (setq client (server-client client))) - (cdr (assq property (cdr client)))) - -(defun server-client-set (client property value) - "Set the PROPERTY to VALUE in CLIENT, and return VALUE. -CLIENT may be a process object, or a client returned by `server-client'." - (let (p proc) - (if (listp client) - (setq proc (car client)) - (setq proc client - client (server-client client))) - (setq p (assq property client)) - (cond - (p (setcdr p value)) - (client (setcdr client (cons (cons property value) (cdr client)))) - (t (setq server-clients - `((,proc (,property . ,value)) . ,server-clients)))) - value)) - (defun server-clients-with (property value) "Return a list of clients with PROPERTY set to VALUE." (let (result) - (dolist (client server-clients result) - (when (equal value (server-client-get client property)) - (setq result (cons (car client) result)))))) + (dolist (proc server-clients result) + (when (equal value (process-get proc property)) + (push proc result))))) (defun server-add-client (proc) "Create a client for process PROC, if it doesn't already have one. New clients have no properties." - (unless (server-client proc) - (setq server-clients (cons (cons proc nil) - server-clients)))) + (add-to-list 'server-clients proc)) (defun server-getenv-from (env variable) "Get the value of VARIABLE in ENV. @@ -280,18 +247,15 @@ process-environment))) (progn ,@body)))) -(defun server-delete-client (client &optional noframe) +(defun server-delete-client (proc &optional noframe) "Delete CLIENT, 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")) - client) + proc) ;; Force a new lookup of client (prevents infinite recursion). - (setq client (server-client - (if (listp client) (car client) client))) - (let ((proc (car client)) - (buffers (server-client-get client 'buffers))) - (when client + (when (memq proc server-clients) + (let ((buffers (process-get proc 'buffers))) ;; Kill the client's buffers. (dolist (buf buffers) @@ -323,16 +287,16 @@ (set-frame-parameter frame 'client nil) (delete-frame frame)))) - (setq server-clients (delq client server-clients)) + (setq server-clients (delq proc server-clients)) ;; Delete the client's tty. - (let ((terminal (server-client-get client 'terminal))) + (let ((terminal (process-get proc 'terminal))) (when (eq (terminal-live-p terminal) t) (delete-terminal terminal))) ;; Delete the client's process. - (if (eq (process-status (car client)) 'open) - (delete-process (car client))) + (if (eq (process-status proc) 'open) + (delete-process proc)) (server-log "Deleted" proc)))) @@ -427,7 +391,7 @@ (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)))))) + (file-error (ignore-errors (server-delete-client proc)))))) (defun server-unquote-arg (arg) "Remove &-quotation from ARG. @@ -603,15 +567,14 @@ ;; Ignore nowait here; we always need to ;; clean up opened ttys when the client dies. `((client . ,proc) - (environment . ,(process-get proc 'env)))))) - (client (server-client proc))) + (environment . ,(process-get proc 'env))))))) (set-frame-parameter frame 'display-environment-variable (server-getenv-from (process-get proc 'env) "DISPLAY")) (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)) + (process-put proc 'frame frame) + (process-put proc 'tty (terminal-name frame)) + (process-put proc 'terminal (frame-terminal frame)) ;; Display *scratch* by default. (switch-to-buffer (get-buffer-create "*scratch*") 'norecord) @@ -640,8 +603,7 @@ (frame-parameter nil 'display) (getenv "DISPLAY") (error "Please specify display")) - params)) - (client (server-client proc))) + params))) (server-log (format "%s created" frame) proc) ;; XXX We need to ensure the parameters are ;; really set because Emacs forgets unhandled @@ -651,8 +613,8 @@ (set-frame-parameter frame 'display-environment-variable (server-getenv-from (process-get proc 'env) "DISPLAY")) (select-frame frame) - (server-client-set client 'frame frame) - (server-client-set client 'terminal (frame-terminal frame)) + (process-put proc 'frame frame) + (process-put proc 'terminal (frame-terminal frame)) ;; Display *scratch* by default. (switch-to-buffer (get-buffer-create "*scratch*") 'norecord) @@ -818,7 +780,6 @@ (coding-system (and default-enable-multibyte-characters (or file-name-coding-system default-file-name-coding-system))) - (client (server-client proc)) 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. @@ -861,7 +822,7 @@ ;; -resume: Resume a suspended tty frame. ((equal "-resume" arg) - (lexical-let ((terminal (server-client-get client 'terminal))) + (lexical-let ((terminal (process-get proc 'terminal))) (setq dontkill t) (push (lambda () (when (eq (terminal-live-p terminal) t) @@ -872,7 +833,7 @@ ;; get out of sync, and a C-z sends a SIGTSTP to ;; emacsclient.) ((equal "-suspend" arg) - (lexical-let ((terminal (server-client-get client 'terminal))) + (lexical-let ((terminal (process-get proc 'terminal))) (setq dontkill t) (push (lambda () (when (eq (terminal-live-p terminal) t) @@ -977,11 +938,10 @@ (defun server-execute (proc files nowait commands dontkill frame tty-name) (condition-case err - (let* ((client (server-client proc)) - (buffers + (let* ((buffers (when files (run-hooks 'pre-command-hook) - (prog1 (server-visit-files files client nowait) + (prog1 (server-visit-files files proc nowait) (run-hooks 'post-command-hook))))) (mapc 'funcall (nreverse commands)) @@ -1029,10 +989,10 @@ (if (> column-number 0) (move-to-column (1- column-number))))) -(defun server-visit-files (files client &optional nowait) +(defun server-visit-files (files proc &optional nowait) "Find FILES and return a list of buffers created. FILES is an alist whose elements are (FILENAME LINENUMBER COLUMNNUMBER). -CLIENT is the client that requested this operation. +PROC is the client that requested this operation. NOWAIT non-nil means this client is not waiting for the results, so don't mark these buffers specially, just visit them normally." ;; Bind last-nonmenu-event to force use of keyboard, not mouse, for queries. @@ -1069,12 +1029,11 @@ (unless nowait ;; When the buffer is killed, inform the clients. (add-hook 'kill-buffer-hook 'server-kill-buffer nil t) - (push (car client) server-buffer-clients)) + (push proc server-buffer-clients)) (push (current-buffer) client-record))) (unless nowait - (server-client-set - client 'buffers - (nconc (server-client-get client 'buffers) client-record))) + (process-put proc 'buffers + (nconc (process-get proc 'buffers) client-record))) client-record)) (defun server-buffer-done (buffer &optional for-killing) @@ -1086,23 +1045,23 @@ FOR-KILLING if non-nil indicates that we are called from `kill-buffer'." (let ((next-buffer nil) (killed nil)) - (dolist (client server-clients) - (let ((buffers (server-client-get client 'buffers))) + (dolist (proc server-clients) + (let ((buffers (process-get proc 'buffers))) (or next-buffer (setq next-buffer (nth 1 (memq buffer buffers)))) (when buffers ; Ignore bufferless clients. (setq buffers (delq buffer buffers)) - ;; Delete all dead buffers from CLIENT. + ;; Delete all dead buffers from PROC. (dolist (b buffers) (and (bufferp b) (not (buffer-live-p b)) (setq buffers (delq b buffers)))) - (server-client-set client 'buffers buffers) + (process-put proc 'buffers buffers) ;; If client now has no pending buffers, ;; tell it that it is done, and forget it entirely. (unless buffers - (server-log "Close" client) - (server-delete-client client))))) + (server-log "Close" proc) + (server-delete-client proc))))) (when (and (bufferp buffer) (buffer-name buffer)) ;; We may or may not kill this buffer; ;; if we do, do not call server-buffer-done recursively @@ -1171,9 +1130,9 @@ (or (not server-buffer-clients) (let ((res t)) (dolist (proc server-buffer-clients res) - (let ((client (server-client proc))) - (when (and client (eq (process-status proc) 'open)) - (setq res nil))))) + (when (and (memq proc server-clients) + (eq (process-status proc) 'open)) + (setq res nil)))) (yes-or-no-p (format "Buffer `%s' still has clients; kill it? " (buffer-name (current-buffer)))))) @@ -1181,9 +1140,9 @@ "Ask before exiting Emacs it has live clients." (or (not server-clients) (let (live-client) - (dolist (client server-clients live-client) - (when (memq t (mapcar 'buffer-live-p (server-client-get - client 'buffers))) + (dolist (proc server-clients live-client) + (when (memq t (mapcar 'buffer-live-p (process-get + proc 'buffers))) (setq live-client t)))) (yes-or-no-p "This Emacs session has clients; exit anyway? "))) @@ -1236,10 +1195,10 @@ (progn (let ((rest server-clients)) (while (and rest (not next-buffer)) - (let ((client (car rest))) + (let ((proc (car rest))) ;; Only look at frameless clients. - (when (not (server-client-get client 'frame)) - (setq next-buffer (car (server-client-get client 'buffers)))) + (when (not (process-get proc 'frame)) + (setq next-buffer (car (process-get proc 'buffers)))) (setq rest (cdr rest))))) (and next-buffer (server-switch-buffer next-buffer killed-one)) (unless (or next-buffer killed-one (window-dedicated-p (selected-window))) @@ -1292,7 +1251,7 @@ If emacsclient was started with a list of filenames to edit, then only these files will be asked to be saved." - (let ((buffers (server-client-get proc 'buffers))) + (let ((buffers (process-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.