aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2007-09-16 05:16:42 +0000
committerStefan Monnier2007-09-16 05:16:42 +0000
commit448f754fa83af6490f9e72be19f9fbae9b06f5e7 (patch)
treec2de0645b4424aa1e413430310ab6da6aba05c17
parent13ba37405b52b714132f00715122f9a7326330f9 (diff)
downloademacs-448f754fa83af6490f9e72be19f9fbae9b06f5e7.tar.gz
emacs-448f754fa83af6490f9e72be19f9fbae9b06f5e7.zip
(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.
-rw-r--r--lisp/ChangeLog11
-rw-r--r--lisp/server.el133
2 files changed, 57 insertions, 87 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c3dffec43db..773eb8973d5 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,16 @@
12007-09-16 Stefan Monnier <monnier@iro.umontreal.ca> 12007-09-16 Stefan Monnier <monnier@iro.umontreal.ca>
2 2
3 * server.el (server-clients): Only keep procs, no properties any more.
4 (server-client): Remove.
5 (server-client-get, server-client-set): Remove, replace all callers by
6 process-get and process-put resp.
7 (server-clients-with, server-add-client, server-delete-client)
8 (server-create-tty-frame, server-create-window-system-frame)
9 (server-process-filter, server-execute, server-visit-files)
10 (server-buffer-done, server-kill-buffer-query-function)
11 (server-kill-emacs-query-function, server-switch-buffer)
12 (server-save-buffers-kill-terminal): Update accordingly.
13
3 * server.el (server-with-environment): Simplify. 14 * server.el (server-with-environment): Simplify.
4 (server-select-display, server-unselect-display): Re-add functions that 15 (server-select-display, server-unselect-display): Re-add functions that
5 seem to have been lost in the multi-tty merge. 16 seem to have been lost in the multi-tty merge.
diff --git a/lisp/server.el b/lisp/server.el
index 434d7d7ecef..5c44986bb2c 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -139,8 +139,7 @@ If set, the server accepts remote connections; otherwise it is local."
139 139
140(defvar server-clients nil 140(defvar server-clients nil
141 "List of current server clients. 141 "List of current server clients.
142Each element is (PROC PROPERTIES...) where PROC is a process object, 142Each element is a process.")
143and PROPERTIES is an association list of client properties.")
144 143
145(defvar server-buffer-clients nil 144(defvar server-buffer-clients nil
146 "List of client processes requesting editing of current buffer.") 145 "List of client processes requesting editing of current buffer.")
@@ -202,49 +201,17 @@ are done with it in the server.")
202 "The directory in which to place the server socket. 201 "The directory in which to place the server socket.
203Initialized by `server-start'.") 202Initialized by `server-start'.")
204 203
205(defun server-client (proc)
206 "Return the Emacs client corresponding to PROC.
207PROC must be a process object.
208The car of the result is PROC; the cdr is an association list.
209See `server-client-get' and `server-client-set'."
210 (assq proc server-clients))
211
212(defun server-client-get (client property)
213 "Get the value of PROPERTY in CLIENT.
214CLIENT may be a process object, or a client returned by `server-client'.
215Return nil if CLIENT has no such property."
216 (or (listp client) (setq client (server-client client)))
217 (cdr (assq property (cdr client))))
218
219(defun server-client-set (client property value)
220 "Set the PROPERTY to VALUE in CLIENT, and return VALUE.
221CLIENT may be a process object, or a client returned by `server-client'."
222 (let (p proc)
223 (if (listp client)
224 (setq proc (car client))
225 (setq proc client
226 client (server-client client)))
227 (setq p (assq property client))
228 (cond
229 (p (setcdr p value))
230 (client (setcdr client (cons (cons property value) (cdr client))))
231 (t (setq server-clients
232 `((,proc (,property . ,value)) . ,server-clients))))
233 value))
234
235(defun server-clients-with (property value) 204(defun server-clients-with (property value)
236 "Return a list of clients with PROPERTY set to VALUE." 205 "Return a list of clients with PROPERTY set to VALUE."
237 (let (result) 206 (let (result)
238 (dolist (client server-clients result) 207 (dolist (proc server-clients result)
239 (when (equal value (server-client-get client property)) 208 (when (equal value (process-get proc property))
240 (setq result (cons (car client) result)))))) 209 (push proc result)))))
241 210
242(defun server-add-client (proc) 211(defun server-add-client (proc)
243 "Create a client for process PROC, if it doesn't already have one. 212 "Create a client for process PROC, if it doesn't already have one.
244New clients have no properties." 213New clients have no properties."
245 (unless (server-client proc) 214 (add-to-list 'server-clients proc))
246 (setq server-clients (cons (cons proc nil)
247 server-clients))))
248 215
249(defun server-getenv-from (env variable) 216(defun server-getenv-from (env variable)
250 "Get the value of VARIABLE in ENV. 217 "Get the value of VARIABLE in ENV.
@@ -280,18 +247,15 @@ ENV should be in the same format as `process-environment'."
280 process-environment))) 247 process-environment)))
281 (progn ,@body)))) 248 (progn ,@body))))
282 249
283(defun server-delete-client (client &optional noframe) 250(defun server-delete-client (proc &optional noframe)
284 "Delete CLIENT, including its buffers, terminals and frames. 251 "Delete CLIENT, including its buffers, terminals and frames.
285If NOFRAME is non-nil, let the frames live. (To be used from 252If NOFRAME is non-nil, let the frames live. (To be used from
286`delete-frame-functions'.)" 253`delete-frame-functions'.)"
287 (server-log (concat "server-delete-client" (if noframe " noframe")) 254 (server-log (concat "server-delete-client" (if noframe " noframe"))
288 client) 255 proc)
289 ;; Force a new lookup of client (prevents infinite recursion). 256 ;; Force a new lookup of client (prevents infinite recursion).
290 (setq client (server-client 257 (when (memq proc server-clients)
291 (if (listp client) (car client) client))) 258 (let ((buffers (process-get proc 'buffers)))
292 (let ((proc (car client))
293 (buffers (server-client-get client 'buffers)))
294 (when client
295 259
296 ;; Kill the client's buffers. 260 ;; Kill the client's buffers.
297 (dolist (buf buffers) 261 (dolist (buf buffers)
@@ -323,16 +287,16 @@ If NOFRAME is non-nil, let the frames live. (To be used from
323 (set-frame-parameter frame 'client nil) 287 (set-frame-parameter frame 'client nil)
324 (delete-frame frame)))) 288 (delete-frame frame))))
325 289
326 (setq server-clients (delq client server-clients)) 290 (setq server-clients (delq proc server-clients))
327 291
328 ;; Delete the client's tty. 292 ;; Delete the client's tty.
329 (let ((terminal (server-client-get client 'terminal))) 293 (let ((terminal (process-get proc 'terminal)))
330 (when (eq (terminal-live-p terminal) t) 294 (when (eq (terminal-live-p terminal) t)
331 (delete-terminal terminal))) 295 (delete-terminal terminal)))
332 296
333 ;; Delete the client's process. 297 ;; Delete the client's process.
334 (if (eq (process-status (car client)) 'open) 298 (if (eq (process-status proc) 'open)
335 (delete-process (car client))) 299 (delete-process proc))
336 300
337 (server-log "Deleted" proc)))) 301 (server-log "Deleted" proc))))
338 302
@@ -427,7 +391,7 @@ message."
427 (server-log (format "server-handle-suspend-tty, terminal %s" terminal) proc) 391 (server-log (format "server-handle-suspend-tty, terminal %s" terminal) proc)
428 (condition-case err 392 (condition-case err
429 (server-send-string proc "-suspend \n") 393 (server-send-string proc "-suspend \n")
430 (file-error (condition-case nil (server-delete-client proc) (error nil)))))) 394 (file-error (ignore-errors (server-delete-client proc))))))
431 395
432(defun server-unquote-arg (arg) 396(defun server-unquote-arg (arg)
433 "Remove &-quotation from ARG. 397 "Remove &-quotation from ARG.
@@ -603,15 +567,14 @@ Server mode runs a process that accepts commands from the
603 ;; Ignore nowait here; we always need to 567 ;; Ignore nowait here; we always need to
604 ;; clean up opened ttys when the client dies. 568 ;; clean up opened ttys when the client dies.
605 `((client . ,proc) 569 `((client . ,proc)
606 (environment . ,(process-get proc 'env)))))) 570 (environment . ,(process-get proc 'env)))))))
607 (client (server-client proc)))
608 571
609 (set-frame-parameter frame 'display-environment-variable 572 (set-frame-parameter frame 'display-environment-variable
610 (server-getenv-from (process-get proc 'env) "DISPLAY")) 573 (server-getenv-from (process-get proc 'env) "DISPLAY"))
611 (select-frame frame) 574 (select-frame frame)
612 (server-client-set client 'frame frame) 575 (process-put proc 'frame frame)
613 (server-client-set client 'tty (terminal-name frame)) 576 (process-put proc 'tty (terminal-name frame))
614 (server-client-set client 'terminal (frame-terminal frame)) 577 (process-put proc 'terminal (frame-terminal frame))
615 578
616 ;; Display *scratch* by default. 579 ;; Display *scratch* by default.
617 (switch-to-buffer (get-buffer-create "*scratch*") 'norecord) 580 (switch-to-buffer (get-buffer-create "*scratch*") 'norecord)
@@ -640,8 +603,7 @@ Server mode runs a process that accepts commands from the
640 (frame-parameter nil 'display) 603 (frame-parameter nil 'display)
641 (getenv "DISPLAY") 604 (getenv "DISPLAY")
642 (error "Please specify display")) 605 (error "Please specify display"))
643 params)) 606 params)))
644 (client (server-client proc)))
645 (server-log (format "%s created" frame) proc) 607 (server-log (format "%s created" frame) proc)
646 ;; XXX We need to ensure the parameters are 608 ;; XXX We need to ensure the parameters are
647 ;; really set because Emacs forgets unhandled 609 ;; really set because Emacs forgets unhandled
@@ -651,8 +613,8 @@ Server mode runs a process that accepts commands from the
651 (set-frame-parameter frame 'display-environment-variable 613 (set-frame-parameter frame 'display-environment-variable
652 (server-getenv-from (process-get proc 'env) "DISPLAY")) 614 (server-getenv-from (process-get proc 'env) "DISPLAY"))
653 (select-frame frame) 615 (select-frame frame)
654 (server-client-set client 'frame frame) 616 (process-put proc 'frame frame)
655 (server-client-set client 'terminal (frame-terminal frame)) 617 (process-put proc 'terminal (frame-terminal frame))
656 618
657 ;; Display *scratch* by default. 619 ;; Display *scratch* by default.
658 (switch-to-buffer (get-buffer-create "*scratch*") 'norecord) 620 (switch-to-buffer (get-buffer-create "*scratch*") 'norecord)
@@ -818,7 +780,6 @@ The following commands are accepted by the client:
818 (coding-system (and default-enable-multibyte-characters 780 (coding-system (and default-enable-multibyte-characters
819 (or file-name-coding-system 781 (or file-name-coding-system
820 default-file-name-coding-system))) 782 default-file-name-coding-system)))
821 (client (server-client proc))
822 nowait ; t if emacsclient does not want to wait for us. 783 nowait ; t if emacsclient does not want to wait for us.
823 frame ; The frame that was opened for the client (if any). 784 frame ; The frame that was opened for the client (if any).
824 display ; Open the frame on this display. 785 display ; Open the frame on this display.
@@ -861,7 +822,7 @@ The following commands are accepted by the client:
861 822
862 ;; -resume: Resume a suspended tty frame. 823 ;; -resume: Resume a suspended tty frame.
863 ((equal "-resume" arg) 824 ((equal "-resume" arg)
864 (lexical-let ((terminal (server-client-get client 'terminal))) 825 (lexical-let ((terminal (process-get proc 'terminal)))
865 (setq dontkill t) 826 (setq dontkill t)
866 (push (lambda () 827 (push (lambda ()
867 (when (eq (terminal-live-p terminal) t) 828 (when (eq (terminal-live-p terminal) t)
@@ -872,7 +833,7 @@ The following commands are accepted by the client:
872 ;; get out of sync, and a C-z sends a SIGTSTP to 833 ;; get out of sync, and a C-z sends a SIGTSTP to
873 ;; emacsclient.) 834 ;; emacsclient.)
874 ((equal "-suspend" arg) 835 ((equal "-suspend" arg)
875 (lexical-let ((terminal (server-client-get client 'terminal))) 836 (lexical-let ((terminal (process-get proc 'terminal)))
876 (setq dontkill t) 837 (setq dontkill t)
877 (push (lambda () 838 (push (lambda ()
878 (when (eq (terminal-live-p terminal) t) 839 (when (eq (terminal-live-p terminal) t)
@@ -977,11 +938,10 @@ The following commands are accepted by the client:
977 938
978(defun server-execute (proc files nowait commands dontkill frame tty-name) 939(defun server-execute (proc files nowait commands dontkill frame tty-name)
979 (condition-case err 940 (condition-case err
980 (let* ((client (server-client proc)) 941 (let* ((buffers
981 (buffers
982 (when files 942 (when files
983 (run-hooks 'pre-command-hook) 943 (run-hooks 'pre-command-hook)
984 (prog1 (server-visit-files files client nowait) 944 (prog1 (server-visit-files files proc nowait)
985 (run-hooks 'post-command-hook))))) 945 (run-hooks 'post-command-hook)))))
986 946
987 (mapc 'funcall (nreverse commands)) 947 (mapc 'funcall (nreverse commands))
@@ -1029,10 +989,10 @@ FILE-LINE-COL should be a three-element list as described in
1029 (if (> column-number 0) 989 (if (> column-number 0)
1030 (move-to-column (1- column-number))))) 990 (move-to-column (1- column-number)))))
1031 991
1032(defun server-visit-files (files client &optional nowait) 992(defun server-visit-files (files proc &optional nowait)
1033 "Find FILES and return a list of buffers created. 993 "Find FILES and return a list of buffers created.
1034FILES is an alist whose elements are (FILENAME LINENUMBER COLUMNNUMBER). 994FILES is an alist whose elements are (FILENAME LINENUMBER COLUMNNUMBER).
1035CLIENT is the client that requested this operation. 995PROC is the client that requested this operation.
1036NOWAIT non-nil means this client is not waiting for the results, 996NOWAIT non-nil means this client is not waiting for the results,
1037so don't mark these buffers specially, just visit them normally." 997so don't mark these buffers specially, just visit them normally."
1038 ;; Bind last-nonmenu-event to force use of keyboard, not mouse, for queries. 998 ;; Bind last-nonmenu-event to force use of keyboard, not mouse, for queries.
@@ -1069,12 +1029,11 @@ so don't mark these buffers specially, just visit them normally."
1069 (unless nowait 1029 (unless nowait
1070 ;; When the buffer is killed, inform the clients. 1030 ;; When the buffer is killed, inform the clients.
1071 (add-hook 'kill-buffer-hook 'server-kill-buffer nil t) 1031 (add-hook 'kill-buffer-hook 'server-kill-buffer nil t)
1072 (push (car client) server-buffer-clients)) 1032 (push proc server-buffer-clients))
1073 (push (current-buffer) client-record))) 1033 (push (current-buffer) client-record)))
1074 (unless nowait 1034 (unless nowait
1075 (server-client-set 1035 (process-put proc 'buffers
1076 client 'buffers 1036 (nconc (process-get proc 'buffers) client-record)))
1077 (nconc (server-client-get client 'buffers) client-record)))
1078 client-record)) 1037 client-record))
1079 1038
1080(defun server-buffer-done (buffer &optional for-killing) 1039(defun server-buffer-done (buffer &optional for-killing)
@@ -1086,23 +1045,23 @@ a temp file).
1086FOR-KILLING if non-nil indicates that we are called from `kill-buffer'." 1045FOR-KILLING if non-nil indicates that we are called from `kill-buffer'."
1087 (let ((next-buffer nil) 1046 (let ((next-buffer nil)
1088 (killed nil)) 1047 (killed nil))
1089 (dolist (client server-clients) 1048 (dolist (proc server-clients)
1090 (let ((buffers (server-client-get client 'buffers))) 1049 (let ((buffers (process-get proc 'buffers)))
1091 (or next-buffer 1050 (or next-buffer
1092 (setq next-buffer (nth 1 (memq buffer buffers)))) 1051 (setq next-buffer (nth 1 (memq buffer buffers))))
1093 (when buffers ; Ignore bufferless clients. 1052 (when buffers ; Ignore bufferless clients.
1094 (setq buffers (delq buffer buffers)) 1053 (setq buffers (delq buffer buffers))
1095 ;; Delete all dead buffers from CLIENT. 1054 ;; Delete all dead buffers from PROC.
1096 (dolist (b buffers) 1055 (dolist (b buffers)
1097 (and (bufferp b) 1056 (and (bufferp b)
1098 (not (buffer-live-p b)) 1057 (not (buffer-live-p b))
1099 (setq buffers (delq b buffers)))) 1058 (setq buffers (delq b buffers))))
1100 (server-client-set client 'buffers buffers) 1059 (process-put proc 'buffers buffers)
1101 ;; If client now has no pending buffers, 1060 ;; If client now has no pending buffers,
1102 ;; tell it that it is done, and forget it entirely. 1061 ;; tell it that it is done, and forget it entirely.
1103 (unless buffers 1062 (unless buffers
1104 (server-log "Close" client) 1063 (server-log "Close" proc)
1105 (server-delete-client client))))) 1064 (server-delete-client proc)))))
1106 (when (and (bufferp buffer) (buffer-name buffer)) 1065 (when (and (bufferp buffer) (buffer-name buffer))
1107 ;; We may or may not kill this buffer; 1066 ;; We may or may not kill this buffer;
1108 ;; if we do, do not call server-buffer-done recursively 1067 ;; if we do, do not call server-buffer-done recursively
@@ -1171,9 +1130,9 @@ specifically for the clients and did not exist before their request for it."
1171 (or (not server-buffer-clients) 1130 (or (not server-buffer-clients)
1172 (let ((res t)) 1131 (let ((res t))
1173 (dolist (proc server-buffer-clients res) 1132 (dolist (proc server-buffer-clients res)
1174 (let ((client (server-client proc))) 1133 (when (and (memq proc server-clients)
1175 (when (and client (eq (process-status proc) 'open)) 1134 (eq (process-status proc) 'open))
1176 (setq res nil))))) 1135 (setq res nil))))
1177 (yes-or-no-p (format "Buffer `%s' still has clients; kill it? " 1136 (yes-or-no-p (format "Buffer `%s' still has clients; kill it? "
1178 (buffer-name (current-buffer)))))) 1137 (buffer-name (current-buffer))))))
1179 1138
@@ -1181,9 +1140,9 @@ specifically for the clients and did not exist before their request for it."
1181 "Ask before exiting Emacs it has live clients." 1140 "Ask before exiting Emacs it has live clients."
1182 (or (not server-clients) 1141 (or (not server-clients)
1183 (let (live-client) 1142 (let (live-client)
1184 (dolist (client server-clients live-client) 1143 (dolist (proc server-clients live-client)
1185 (when (memq t (mapcar 'buffer-live-p (server-client-get 1144 (when (memq t (mapcar 'buffer-live-p (process-get
1186 client 'buffers))) 1145 proc 'buffers)))
1187 (setq live-client t)))) 1146 (setq live-client t))))
1188 (yes-or-no-p "This Emacs session has clients; exit anyway? "))) 1147 (yes-or-no-p "This Emacs session has clients; exit anyway? ")))
1189 1148
@@ -1236,10 +1195,10 @@ done that."
1236 (progn 1195 (progn
1237 (let ((rest server-clients)) 1196 (let ((rest server-clients))
1238 (while (and rest (not next-buffer)) 1197 (while (and rest (not next-buffer))
1239 (let ((client (car rest))) 1198 (let ((proc (car rest)))
1240 ;; Only look at frameless clients. 1199 ;; Only look at frameless clients.
1241 (when (not (server-client-get client 'frame)) 1200 (when (not (process-get proc 'frame))
1242 (setq next-buffer (car (server-client-get client 'buffers)))) 1201 (setq next-buffer (car (process-get proc 'buffers))))
1243 (setq rest (cdr rest))))) 1202 (setq rest (cdr rest)))))
1244 (and next-buffer (server-switch-buffer next-buffer killed-one)) 1203 (and next-buffer (server-switch-buffer next-buffer killed-one))
1245 (unless (or next-buffer killed-one (window-dedicated-p (selected-window))) 1204 (unless (or next-buffer killed-one (window-dedicated-p (selected-window)))
@@ -1292,7 +1251,7 @@ With prefix arg, silently save all file-visiting buffers, then kill.
1292 1251
1293If emacsclient was started with a list of filenames to edit, then 1252If emacsclient was started with a list of filenames to edit, then
1294only these files will be asked to be saved." 1253only these files will be asked to be saved."
1295 (let ((buffers (server-client-get proc 'buffers))) 1254 (let ((buffers (process-get proc 'buffers)))
1296 ;; If client is bufferless, emulate a normal Emacs session 1255 ;; If client is bufferless, emulate a normal Emacs session
1297 ;; exit and offer to save all buffers. Otherwise, offer to 1256 ;; exit and offer to save all buffers. Otherwise, offer to
1298 ;; save only the buffers belonging to the client. 1257 ;; save only the buffers belonging to the client.