1 |
;;; server.el --- Lisp code for GNU Emacs running as server process |
;;; server.el --- Lisp code for GNU Emacs running as server process |
2 |
|
|
3 |
;; Copyright (C) 1986, 87, 92, 94, 95, 96, 97, 98, 99, 2000, 2001 |
;; Copyright (C) 1986, 87, 92, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002 |
4 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: William Sommerfeld <wesommer@athena.mit.edu> |
;; Author: William Sommerfeld <wesommer@athena.mit.edu> |
32 |
;; a server for other processes. |
;; a server for other processes. |
33 |
|
|
34 |
;; Load this library and do M-x server-edit to enable Emacs as a server. |
;; Load this library and do M-x server-edit to enable Emacs as a server. |
35 |
;; Emacs runs the program ../arch-lib/emacsserver as a subprocess |
;; Emacs opens up a socket for communication with clients. If there are no |
36 |
;; for communication with clients. If there are no client buffers to edit, |
;; client buffers to edit, server-edit acts like (switch-to-buffer |
37 |
;; server-edit acts like (switch-to-buffer (other-buffer)) |
;; (other-buffer)) |
38 |
|
|
39 |
;; When some other program runs "the editor" to edit a file, |
;; When some other program runs "the editor" to edit a file, |
40 |
;; "the editor" can be the Emacs client program ../lib-src/emacsclient. |
;; "the editor" can be the Emacs client program ../lib-src/emacsclient. |
44 |
;; Note that any number of clients may dispatch files to emacs to be edited. |
;; Note that any number of clients may dispatch files to emacs to be edited. |
45 |
|
|
46 |
;; When you finish editing a Server buffer, again call server-edit |
;; When you finish editing a Server buffer, again call server-edit |
47 |
;; to mark that buffer as done for the client and switch to the next |
;; to mark that buffer as done for the client and switch to the next |
48 |
;; Server buffer. When all the buffers for a client have been edited |
;; Server buffer. When all the buffers for a client have been edited |
49 |
;; and exited with server-edit, the client "editor" will return |
;; and exited with server-edit, the client "editor" will return |
50 |
;; to the program that invoked it. |
;; to the program that invoked it. |
51 |
|
|
52 |
;; Your editing commands and Emacs's display output go to and from |
;; Your editing commands and Emacs's display output go to and from |
53 |
;; the terminal in the usual way. Thus, server operation is possible |
;; the terminal in the usual way. Thus, server operation is possible |
69 |
;; brought into the foreground for editing. When done editing, Emacs is |
;; brought into the foreground for editing. When done editing, Emacs is |
70 |
;; suspended again, and the client program is brought into the foreground. |
;; suspended again, and the client program is brought into the foreground. |
71 |
|
|
72 |
;; The buffer local variable "server-buffer-clients" lists |
;; The buffer local variable "server-buffer-clients" lists |
73 |
;; the clients who are waiting for this buffer to be edited. |
;; the clients who are waiting for this buffer to be edited. |
74 |
;; The global variable "server-clients" lists all the waiting clients, |
;; The global variable "server-clients" lists all the waiting clients, |
75 |
;; and which files are yet to be edited for each. |
;; and which files are yet to be edited for each. |
76 |
|
|
77 |
;;; Code: |
;;; Code: |
78 |
|
|
79 |
|
(eval-when-compile (require 'cl)) |
80 |
|
|
81 |
(defgroup server nil |
(defgroup server nil |
82 |
"Emacs running as a server process." |
"Emacs running as a server process." |
83 |
:group 'external) |
:group 'external) |
84 |
|
|
|
(defcustom server-program (expand-file-name "emacsserver" exec-directory) |
|
|
"*The program to use as the edit server." |
|
|
:group 'server |
|
|
:type 'string) |
|
|
|
|
85 |
(defcustom server-visit-hook nil |
(defcustom server-visit-hook nil |
86 |
"*List of hooks to call when visiting a file for the Emacs server." |
"*Hook run when visiting a file for the Emacs server." |
87 |
:group 'server |
:group 'server |
88 |
:type '(repeat function)) |
:type 'hook) |
89 |
|
|
90 |
(defcustom server-switch-hook nil |
(defcustom server-switch-hook nil |
91 |
"*List of hooks to call when switching to a buffer for the Emacs server." |
"*Hook run when switching to a buffer for the Emacs server." |
92 |
:group 'server |
:group 'server |
93 |
:type '(repeat function)) |
:type 'hook) |
94 |
|
|
95 |
(defcustom server-done-hook nil |
(defcustom server-done-hook nil |
96 |
"*List of hooks to call when done editing a buffer for the Emacs server." |
"*Hook run when done editing a buffer for the Emacs server." |
97 |
:group 'server |
:group 'server |
98 |
:type '(repeat function)) |
:type 'hook) |
|
|
|
|
(defvar server-process nil |
|
|
"The current server process") |
|
99 |
|
|
100 |
(defvar server-previous-string "") |
(defvar server-process nil |
101 |
|
"The current server process.") |
102 |
|
|
103 |
(defvar server-clients nil |
(defvar server-clients nil |
104 |
"List of current server clients. |
"List of current server clients. |
112 |
;; Changing major modes should not erase this local. |
;; Changing major modes should not erase this local. |
113 |
(put 'server-buffer-clients 'permanent-local t) |
(put 'server-buffer-clients 'permanent-local t) |
114 |
|
|
115 |
(defvar server-window nil |
(defcustom server-window nil |
116 |
"*The window to use for selecting Emacs server buffers. |
"*Specification of the window to use for selecting Emacs server buffers. |
117 |
If nil, use the selected window. |
If nil, use the selected window. |
118 |
If it is a frame, use the frame's selected window.") |
If it is a function, it should take one argument (a buffer) and |
119 |
|
display and select it. A common value is `pop-to-buffer'. |
120 |
|
If it is a window, use that. |
121 |
|
If it is a frame, use the frame's selected window. |
122 |
|
|
123 |
|
It is not meaningful to set this to a specific frame or window with Custom. |
124 |
|
Only programs can do so." |
125 |
|
:group 'server |
126 |
|
:version "21.4" |
127 |
|
:type '(choice (const :tag "Use selected window" |
128 |
|
:match (lambda (widget value) |
129 |
|
(not (functionp value))) |
130 |
|
nil) |
131 |
|
(function-item :tag "Use pop-to-buffer" pop-to-buffer) |
132 |
|
(function :tag "Other function"))) |
133 |
|
|
134 |
(defcustom server-temp-file-regexp "^/tmp/Re\\|/draft$" |
(defcustom server-temp-file-regexp "^/tmp/Re\\|/draft$" |
135 |
"*Regexp which should match filenames of temporary files |
"*Regexp matching names of temporary files. |
136 |
which are deleted and reused after each edit |
These are deleted and reused after each edit by the programs that |
137 |
by the programs that invoke the Emacs server." |
invoke the Emacs server." |
138 |
:group 'server |
:group 'server |
139 |
:type 'regexp) |
:type 'regexp) |
140 |
|
|
141 |
(defcustom server-kill-new-buffers t |
(defcustom server-kill-new-buffers t |
142 |
"*Whether to kill buffers when done with them. |
"*Whether to kill buffers when done with them. |
143 |
If non-nil, kill a buffer unless it already existed before editing |
If non-nil, kill a buffer unless it already existed before editing |
144 |
it with Emacs server. If nil, kill only buffers as specified by |
it with Emacs server. If nil, kill only buffers as specified by |
145 |
`server-temp-file-regexp'. |
`server-temp-file-regexp'. |
146 |
Please note that only buffers are killed that still have a client, |
Please note that only buffers are killed that still have a client, |
147 |
i.e. buffers visited which \"emacsclient --no-wait\" are never killed in |
i.e. buffers visited which \"emacsclient --no-wait\" are never killed in |
154 |
(setq minor-mode-alist (cons '(server-buffer-clients " Server") minor-mode-alist))) |
(setq minor-mode-alist (cons '(server-buffer-clients " Server") minor-mode-alist))) |
155 |
|
|
156 |
(defvar server-existing-buffer nil |
(defvar server-existing-buffer nil |
157 |
"Non-nil means a buffer existed before the Emacs server was asked visit it. |
"Non-nil means the buffer existed before the server was asked to visit it. |
158 |
This means that the server should not kill the buffer when you say you |
This means that the server should not kill the buffer when you say you |
159 |
are done with it in the server. This variable is local in each buffer |
are done with it in the server.") |
|
where it is set.") |
|
160 |
(make-variable-buffer-local 'server-existing-buffer) |
(make-variable-buffer-local 'server-existing-buffer) |
161 |
|
|
162 |
;; If a *server* buffer exists, |
;; Fixme: This doesn't look secure. If it really is, it deserves a |
163 |
;; write STRING to it for logging purposes. |
;; comment, but I'd expect it to be created in a protected subdir as |
164 |
(defun server-log (string) |
;; normal. -- fx |
165 |
|
(defvar server-socket-name |
166 |
|
(format "/tmp/esrv%d-%s" (user-uid) |
167 |
|
(substring (system-name) 0 (string-match "\\." (system-name))))) |
168 |
|
|
169 |
|
(defun server-log (string &optional client) |
170 |
|
"If a *server* buffer exists, write STRING to it for logging purposes." |
171 |
(if (get-buffer "*server*") |
(if (get-buffer "*server*") |
172 |
(save-excursion |
(with-current-buffer "*server*" |
|
(set-buffer "*server*") |
|
173 |
(goto-char (point-max)) |
(goto-char (point-max)) |
174 |
(insert (current-time-string) " " string) |
(insert (current-time-string) |
175 |
|
(if client (format " %s:" client) " ") |
176 |
|
string) |
177 |
(or (bolp) (newline))))) |
(or (bolp) (newline))))) |
178 |
|
|
179 |
(defun server-sentinel (proc msg) |
(defun server-sentinel (proc msg) |
180 |
(cond ((eq (process-status proc) 'exit) |
(let ((client (assq proc server-clients))) |
181 |
(server-log (message "Server subprocess exited"))) |
;; Remove PROC from the list of clients. |
182 |
((eq (process-status proc) 'signal) |
(when client |
183 |
(server-log (message "Server subprocess killed"))))) |
(setq server-clients (delq client server-clients)) |
184 |
|
(dolist (buf (cdr client)) |
185 |
|
(with-current-buffer buf |
186 |
|
;; Remove PROC from the clients of each buffer. |
187 |
|
(setq server-buffer-clients (delq proc server-buffer-clients)) |
188 |
|
;; Kill the buffer if necessary. |
189 |
|
(when (and (null server-buffer-clients) |
190 |
|
(or (and server-kill-new-buffers |
191 |
|
(not server-existing-buffer)) |
192 |
|
(server-temp-file-p))) |
193 |
|
(kill-buffer (current-buffer))))))) |
194 |
|
(server-log (format "Status changed to %s" (process-status proc)) proc)) |
195 |
|
|
196 |
|
(defun server-select-display (display) |
197 |
|
;; If the current frame is on `display' we're all set. |
198 |
|
(unless (equal (frame-parameter (selected-frame) 'display) display) |
199 |
|
;; Otherwise, look for an existing frame there and select it. |
200 |
|
(dolist (frame (frame-list)) |
201 |
|
(when (equal (frame-parameter frame 'display) display) |
202 |
|
(select-frame frame))) |
203 |
|
;; If there's no frame on that display yet, create a dummy one |
204 |
|
;; and select it. |
205 |
|
(unless (equal (frame-parameter (selected-frame) 'display) display) |
206 |
|
(select-frame |
207 |
|
(make-frame-on-display |
208 |
|
display |
209 |
|
;; This frame is only there in place of an actual "current display" |
210 |
|
;; setting, so we want it to be as unobtrusive as possible. That's |
211 |
|
;; what the invisibility is for. The minibuffer setting is so that |
212 |
|
;; we don't end up displaying a buffer in it (which noone would |
213 |
|
;; notice). |
214 |
|
'((visibility . nil) (minibuffer . only))))))) |
215 |
|
|
216 |
|
(defun server-unquote-arg (arg) |
217 |
|
(replace-regexp-in-string |
218 |
|
"&." (lambda (s) |
219 |
|
(case (aref s 1) |
220 |
|
(?& "&") |
221 |
|
(?- "-") |
222 |
|
(?n "\n") |
223 |
|
(t " "))) |
224 |
|
arg t t)) |
225 |
|
|
226 |
;;;###autoload |
;;;###autoload |
227 |
(defun server-start (&optional leave-dead) |
(defun server-start (&optional leave-dead) |
234 |
Prefix arg means just kill any existing server communications subprocess." |
Prefix arg means just kill any existing server communications subprocess." |
235 |
(interactive "P") |
(interactive "P") |
236 |
;; kill it dead! |
;; kill it dead! |
237 |
(if server-process |
(condition-case () (delete-process server-process) (error nil)) |
|
(progn |
|
|
(set-process-sentinel server-process nil) |
|
|
(condition-case () (delete-process server-process) (error nil)))) |
|
238 |
;; Delete the socket files made by previous server invocations. |
;; Delete the socket files made by previous server invocations. |
239 |
(let* ((sysname (system-name)) |
(condition-case () (delete-file server-socket-name) (error nil)) |
|
(dot-index (string-match "\\." sysname))) |
|
|
(condition-case () |
|
|
(delete-file (format "~/.emacs-server-%s" sysname)) |
|
|
(error nil)) |
|
|
(condition-case () |
|
|
(delete-file (format "/tmp/esrv%d-%s" (user-uid) sysname)) |
|
|
(error nil)) |
|
|
;; In case the server file name was made with a domainless hostname, |
|
|
;; try deleting that name too. |
|
|
(if dot-index |
|
|
(let ((shortname (substring sysname 0 dot-index))) |
|
|
(condition-case () |
|
|
(delete-file (format "~/.emacs-server-%s" shortname)) |
|
|
(error nil)) |
|
|
(condition-case () |
|
|
(delete-file (format "/tmp/esrv%d-%s" (user-uid) shortname)) |
|
|
(error nil))))) |
|
240 |
;; If this Emacs already had a server, clear out associated status. |
;; If this Emacs already had a server, clear out associated status. |
241 |
(while server-clients |
(while server-clients |
242 |
(let ((buffer (nth 1 (car server-clients)))) |
(let ((buffer (nth 1 (car server-clients)))) |
243 |
(server-buffer-done buffer))) |
(server-buffer-done buffer))) |
244 |
(if leave-dead |
(unless leave-dead |
|
nil |
|
245 |
(if server-process |
(if server-process |
246 |
(server-log (message "Restarting server"))) |
(server-log (message "Restarting server"))) |
247 |
;; Using a pty is wasteful, and the separate session causes |
(let ((umask (default-file-modes))) |
248 |
;; annoyance sometimes (some systems kill idle sessions). |
(unwind-protect |
249 |
(let ((process-connection-type nil)) |
(progn |
250 |
(setq server-process (start-process "server" nil server-program))) |
(set-default-file-modes ?\700) |
251 |
(set-process-sentinel server-process 'server-sentinel) |
(setq server-process |
252 |
(set-process-filter server-process 'server-process-filter) |
(make-network-process |
253 |
;; We must receive file names without being decoded. Those are |
:name "server" :family 'local :server t :noquery t |
254 |
;; decoded by server-process-filter accoding to |
:service server-socket-name |
255 |
;; file-name-coding-system. |
:sentinel 'server-sentinel :filter 'server-process-filter |
256 |
(set-process-coding-system server-process 'raw-text 'raw-text) |
;; We must receive file names without being decoded. |
257 |
(process-kill-without-query server-process))) |
;; Those are decoded by server-process-filter according |
258 |
|
;; to file-name-coding-system. |
259 |
|
:coding 'raw-text))) |
260 |
|
(set-default-file-modes umask))))) |
261 |
|
|
262 |
|
;;;###autoload |
263 |
|
(define-minor-mode server-mode |
264 |
|
"Toggle Server mode. |
265 |
|
With ARG, turn Server mode on if ARG is positive, off otherwise. |
266 |
|
Server mode runs a process that accepts commands from the |
267 |
|
`emacsclient' program. See `server-start' and Info node `Emacs server'." |
268 |
|
:global t |
269 |
|
:group 'server |
270 |
|
:version "21.4" |
271 |
|
;; Fixme: Should this check for an existing server socket and do |
272 |
|
;; nothing if there is one (for multiple Emacs sessions)? |
273 |
|
(server-start (not server-mode))) |
274 |
|
(custom-add-version 'server-mode "21.4") |
275 |
|
|
|
;Process a request from the server to edit some files. |
|
|
;Format of STRING is "Client: CLIENTID PATH PATH PATH... \n" |
|
276 |
(defun server-process-filter (proc string) |
(defun server-process-filter (proc string) |
277 |
(server-log string) |
"Process a request from the server to edit some files. |
278 |
(setq string (concat server-previous-string string)) |
PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." |
279 |
|
(server-log string proc) |
280 |
|
(let ((prev (process-get proc 'previous-string))) |
281 |
|
(when prev |
282 |
|
(setq string (concat prev string)) |
283 |
|
(process-put proc 'previous-string nil))) |
284 |
;; If the input is multiple lines, |
;; If the input is multiple lines, |
285 |
;; process each line individually. |
;; process each line individually. |
286 |
(while (string-match "\n" string) |
(while (string-match "\n" string) |
288 |
(coding-system (and default-enable-multibyte-characters |
(coding-system (and default-enable-multibyte-characters |
289 |
(or file-name-coding-system |
(or file-name-coding-system |
290 |
default-file-name-coding-system))) |
default-file-name-coding-system))) |
291 |
client nowait |
client nowait eval |
292 |
(files nil) |
(files nil) |
293 |
(lineno 1) |
(lineno 1) |
294 |
(columnno 0)) |
(columnno 0)) |
295 |
;; Remove this line from STRING. |
;; Remove this line from STRING. |
296 |
(setq string (substring string (match-end 0))) |
(setq string (substring string (match-end 0))) |
297 |
(if (string-match "^Error: " request) |
(setq client (cons proc nil)) |
298 |
(message "Server error: %s" (substring request (match-end 0))) |
(while (string-match "[^ ]* " request) |
299 |
(if (string-match "^Client: " request) |
(let ((arg (substring request (match-beginning 0) (1- (match-end 0)))) |
300 |
(progn |
(pos 0)) |
301 |
|
(setq request (substring request (match-end 0))) |
302 |
|
(cond |
303 |
|
((equal "-nowait" arg) (setq nowait t)) |
304 |
|
;;; This is not safe unless we make sure other users can't send commands. |
305 |
|
;;; ((equal "-eval" arg) (setq eval t)) |
306 |
|
((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) |
307 |
|
(let ((display (server-unquote-arg (match-string 1 request)))) |
308 |
(setq request (substring request (match-end 0))) |
(setq request (substring request (match-end 0))) |
309 |
(setq client (list (substring request 0 (string-match " " request)))) |
(condition-case err |
310 |
(setq request (substring request (match-end 0))) |
(server-select-display display) |
311 |
(while (string-match "[^ ]+ " request) |
(error (process-send-string proc (nth 1 err)) |
312 |
(let ((arg |
(setq request ""))))) |
313 |
(substring request (match-beginning 0) (1- (match-end 0)))) |
;; ARG is a line number option. |
314 |
(pos 0)) |
((string-match "\\`\\+[0-9]+\\'" arg) |
315 |
(setq request (substring request (match-end 0))) |
(setq lineno (string-to-int (substring arg 1)))) |
316 |
(if (string-match "\\`-nowait" arg) |
;; ARG is line number:column option. |
317 |
(setq nowait t) |
((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg) |
318 |
(cond |
(setq lineno (string-to-int (match-string 1 arg)) |
319 |
;; ARG is a line number option. |
columnno (string-to-int (match-string 2 arg)))) |
320 |
((string-match "\\`\\+[0-9]+\\'" arg) |
(t |
321 |
(setq lineno (string-to-int (substring arg 1)))) |
;; Undo the quoting that emacsclient does |
322 |
;; ARG is line number:column option. |
;; for certain special characters. |
323 |
((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg) |
(setq arg (server-unquote-arg arg)) |
324 |
(setq lineno (string-to-int (match-string 1 arg)) |
;; Now decode the file name if necessary. |
325 |
columnno (string-to-int (match-string 2 arg)))) |
(if coding-system |
326 |
(t |
(setq arg (decode-coding-string arg coding-system))) |
327 |
;; ARG is a file name. |
(if eval |
328 |
;; Collapse multiple slashes to single slashes. |
(let ((v (eval (car (read-from-string arg))))) |
329 |
(setq arg (command-line-normalize-file-name arg)) |
(when v |
330 |
;; Undo the quoting that emacsclient does |
(with-temp-buffer |
331 |
;; for certain special characters. |
(let ((standard-output (current-buffer))) |
332 |
(while (string-match "&." arg pos) |
(pp v) |
333 |
(setq pos (1+ (match-beginning 0))) |
(process-send-region proc (point-min) (point-max)))))) |
334 |
(let ((nextchar (aref arg pos))) |
;; ARG is a file name. |
335 |
(cond ((= nextchar ?&) |
;; Collapse multiple slashes to single slashes. |
336 |
(setq arg (replace-match "&" t t arg))) |
(setq arg (command-line-normalize-file-name arg)) |
337 |
((= nextchar ?-) |
(push (list arg lineno columnno) files)) |
338 |
(setq arg (replace-match "-" t t arg))) |
(setq lineno 1) |
339 |
(t |
(setq columnno 0))))) |
340 |
(setq arg (replace-match " " t t arg)))))) |
(when files |
341 |
;; Now decode the file name if necessary. |
(run-hooks 'pre-command-hook) |
342 |
(if coding-system |
(server-visit-files files client nowait) |
343 |
(setq arg (decode-coding-string arg coding-system))) |
(run-hooks 'post-command-hook)) |
344 |
(setq files |
;; CLIENT is now a list (CLIENTNUM BUFFERS...) |
345 |
(cons (list arg lineno columnno) |
(if (null (cdr client)) |
346 |
files)) |
;; This client is empty; get rid of it immediately. |
347 |
(setq lineno 1) |
(progn |
348 |
(setq columnno 0)))))) |
(delete-process proc) |
349 |
(run-hooks 'pre-command-hook) |
(server-log "Close empty client" proc)) |
350 |
(server-visit-files files client nowait) |
;; We visited some buffer for this client. |
351 |
(run-hooks 'post-command-hook) |
(or nowait (push client server-clients)) |
352 |
;; CLIENT is now a list (CLIENTNUM BUFFERS...) |
(unless (or isearch-mode (minibufferp)) |
353 |
(if (null (cdr client)) |
(server-switch-buffer (nth 1 client)) |
354 |
;; This client is empty; get rid of it immediately. |
(run-hooks 'server-switch-hook) |
355 |
(progn |
(unless nowait |
356 |
(send-string server-process |
(message (substitute-command-keys |
357 |
(format "Close: %s Done\n" (car client))) |
"When done with a buffer, type \\[server-edit]"))))))) |
|
(server-log (format "Close empty client: %s Done\n" (car client)))) |
|
|
;; We visited some buffer for this client. |
|
|
(or nowait |
|
|
(setq server-clients (cons client server-clients))) |
|
|
(server-switch-buffer (nth 1 client)) |
|
|
(run-hooks 'server-switch-hook) |
|
|
(message (substitute-command-keys |
|
|
"When done with a buffer, type \\[server-edit]")))))))) |
|
358 |
;; Save for later any partial line that remains. |
;; Save for later any partial line that remains. |
359 |
(setq server-previous-string string)) |
(when (> (length string) 0) |
360 |
|
(process-put proc 'previous-string string))) |
361 |
|
|
362 |
|
(defun server-goto-line-column (file-line-col) |
363 |
|
(goto-line (nth 1 file-line-col)) |
364 |
|
(let ((column-number (nth 2 file-line-col))) |
365 |
|
(if (> column-number 0) |
366 |
|
(move-to-column (1- column-number))))) |
367 |
|
|
368 |
(defun server-visit-files (files client &optional nowait) |
(defun server-visit-files (files client &optional nowait) |
369 |
"Finds FILES and returns the list CLIENT with the buffers nconc'd. |
"Find FILES and return the list CLIENT with the buffers nconc'd. |
370 |
FILES is an alist whose elements are (FILENAME LINENUMBER COLUMNNUMBER). |
FILES is an alist whose elements are (FILENAME LINENUMBER COLUMNNUMBER). |
371 |
NOWAIT non-nil means this client is not waiting for the results, |
NOWAIT non-nil means this client is not waiting for the results, |
372 |
so don't mark these buffers specially, just visit them normally." |
so don't mark these buffers specially, just visit them normally." |
373 |
;; Bind last-nonmenu-event to force use of keyboard, not mouse, for queries. |
;; Bind last-nonmenu-event to force use of keyboard, not mouse, for queries. |
374 |
(let (client-record (last-nonmenu-event t) (obuf (current-buffer))) |
(let ((last-nonmenu-event t) client-record) |
375 |
;; Restore the current buffer afterward, but not using save-excursion, |
;; Restore the current buffer afterward, but not using save-excursion, |
376 |
;; because we don't want to save point in this buffer |
;; because we don't want to save point in this buffer |
377 |
;; if it happens to be one of those specified by the server. |
;; if it happens to be one of those specified by the server. |
378 |
(unwind-protect |
(save-current-buffer |
379 |
(while files |
(dolist (file files) |
380 |
;; If there is an existing buffer modified or the file is |
;; If there is an existing buffer modified or the file is |
381 |
;; modified, revert it. If there is an existing buffer with |
;; modified, revert it. If there is an existing buffer with |
382 |
;; deleted file, offer to write it. |
;; deleted file, offer to write it. |
383 |
(let* ((filen (car (car files))) |
(let* ((filen (car file)) |
384 |
(obuf (get-file-buffer filen))) |
(obuf (get-file-buffer filen))) |
385 |
(push filen file-name-history) |
(push filen file-name-history) |
386 |
(if (and obuf (set-buffer obuf)) |
(if (and obuf (set-buffer obuf)) |
387 |
(progn |
(progn |
388 |
(cond ((file-exists-p filen) |
(cond ((file-exists-p filen) |
389 |
(if (or (not (verify-visited-file-modtime obuf)) |
(if (not (verify-visited-file-modtime obuf)) |
390 |
(buffer-modified-p obuf)) |
(revert-buffer t nil))) |
391 |
(revert-buffer t nil))) |
(t |
392 |
(t |
(if (y-or-n-p |
393 |
(if (y-or-n-p |
(concat "File no longer exists: " |
394 |
(concat "File no longer exists: " |
filen |
395 |
filen |
", write buffer to file? ")) |
396 |
", write buffer to file? ")) |
(write-file filen)))) |
397 |
(write-file filen)))) |
(setq server-existing-buffer t) |
398 |
(setq server-existing-buffer t) |
(server-goto-line-column file)) |
399 |
(goto-line (nth 1 (car files)))) |
(set-buffer (find-file-noselect filen)) |
400 |
(set-buffer (find-file-noselect filen)) |
(server-goto-line-column file) |
401 |
(goto-line (nth 1 (car files))) |
(run-hooks 'server-visit-hook))) |
402 |
(let ((column-number (nth 2 (car files)))) |
(unless nowait |
403 |
(when (> column-number 0) |
;; When the buffer is killed, inform the clients. |
404 |
(move-to-column (1- column-number)))) |
(add-hook 'kill-buffer-hook 'server-kill-buffer nil t) |
405 |
(run-hooks 'server-visit-hook))) |
(push (car client) server-buffer-clients)) |
406 |
(if (not nowait) |
(push (current-buffer) client-record))) |
|
(setq server-buffer-clients |
|
|
(cons (car client) server-buffer-clients))) |
|
|
(setq client-record (cons (current-buffer) client-record)) |
|
|
(setq files (cdr files))) |
|
|
(set-buffer obuf)) |
|
407 |
(nconc client client-record))) |
(nconc client client-record))) |
408 |
|
|
409 |
(defun server-buffer-done (buffer &optional for-killing) |
(defun server-buffer-done (buffer &optional for-killing) |
410 |
"Mark BUFFER as \"done\" for its client(s). |
"Mark BUFFER as \"done\" for its client(s). |
411 |
This buries the buffer, then returns a list of the form (NEXT-BUFFER KILLED). |
This buries the buffer, then returns a list of the form (NEXT-BUFFER KILLED). |
412 |
NEXT-BUFFER is another server buffer, as a suggestion for what to select next, |
NEXT-BUFFER is another server buffer, as a suggestion for what to select next, |
413 |
or nil. KILLED is t if we killed BUFFER |
or nil. KILLED is t if we killed BUFFER (typically, because it was visiting |
414 |
\(typically, because it was visiting a temp file)." |
a temp file). |
415 |
(let ((running (eq (process-status server-process) 'run)) |
FOR-KILLING if non-nil indicates that we are called from `kill-buffer'." |
416 |
(next-buffer nil) |
(let ((next-buffer nil) |
417 |
(killed nil) |
(killed nil) |
|
(first t) |
|
418 |
(old-clients server-clients)) |
(old-clients server-clients)) |
419 |
(while old-clients |
(while old-clients |
420 |
(let ((client (car old-clients))) |
(let ((client (car old-clients))) |
421 |
(or next-buffer |
(or next-buffer |
422 |
(setq next-buffer (nth 1 (memq buffer client)))) |
(setq next-buffer (nth 1 (memq buffer client)))) |
423 |
(delq buffer client) |
(delq buffer client) |
424 |
;; Delete all dead buffers from CLIENT. |
;; Delete all dead buffers from CLIENT. |
430 |
(setq tail (cdr tail)))) |
(setq tail (cdr tail)))) |
431 |
;; If client now has no pending buffers, |
;; If client now has no pending buffers, |
432 |
;; tell it that it is done, and forget it entirely. |
;; tell it that it is done, and forget it entirely. |
433 |
(if (cdr client) nil |
(unless (cdr client) |
434 |
(if running |
(delete-process (car client)) |
435 |
(progn |
(server-log "Close" (car client)) |
|
;; Don't send emacsserver two commands in close succession. |
|
|
;; It cannot handle that. |
|
|
(or first (sit-for 1)) |
|
|
(setq first nil) |
|
|
(send-string server-process |
|
|
(format "Close: %s Done\n" (car client))) |
|
|
(server-log (format "Close: %s Done\n" (car client))))) |
|
436 |
(setq server-clients (delq client server-clients)))) |
(setq server-clients (delq client server-clients)))) |
437 |
(setq old-clients (cdr old-clients))) |
(setq old-clients (cdr old-clients))) |
438 |
(if (and (bufferp buffer) (buffer-name buffer)) |
(if (and (bufferp buffer) (buffer-name buffer)) |
440 |
;; if we do, do not call server-buffer-done recursively |
;; if we do, do not call server-buffer-done recursively |
441 |
;; from kill-buffer-hook. |
;; from kill-buffer-hook. |
442 |
(let ((server-kill-buffer-running t)) |
(let ((server-kill-buffer-running t)) |
443 |
(save-excursion |
(with-current-buffer buffer |
|
(set-buffer buffer) |
|
444 |
(setq server-buffer-clients nil) |
(setq server-buffer-clients nil) |
445 |
(run-hooks 'server-done-hook)) |
(run-hooks 'server-done-hook)) |
446 |
;; Notice whether server-done-hook killed the buffer. |
;; Notice whether server-done-hook killed the buffer. |
464 |
(bury-buffer buffer))))))) |
(bury-buffer buffer))))))) |
465 |
(list next-buffer killed))) |
(list next-buffer killed))) |
466 |
|
|
467 |
(defun server-temp-file-p (buffer) |
(defun server-temp-file-p (&optional buffer) |
468 |
"Return non-nil if BUFFER contains a file considered temporary. |
"Return non-nil if BUFFER contains a file considered temporary. |
469 |
These are files whose names suggest they are repeatedly |
These are files whose names suggest they are repeatedly |
470 |
reused to pass information to another program. |
reused to pass information to another program. |
481 |
as a suggestion for what to select next, or nil. |
as a suggestion for what to select next, or nil. |
482 |
KILLED is t if we killed BUFFER, which happens if it was created |
KILLED is t if we killed BUFFER, which happens if it was created |
483 |
specifically for the clients and did not exist before their request for it." |
specifically for the clients and did not exist before their request for it." |
484 |
(let ((buffer (current-buffer))) |
(when server-buffer-clients |
485 |
(if server-buffer-clients |
(if (server-temp-file-p) |
486 |
(progn |
;; For a temp file, save, and do make a non-numeric backup |
487 |
(if (server-temp-file-p buffer) |
;; (unless make-backup-files is nil). |
488 |
;; For a temp file, save, and do make a non-numeric backup |
(let ((version-control nil) |
489 |
;; (unless make-backup-files is nil). |
(buffer-backed-up nil)) |
490 |
(let ((version-control nil) |
(save-buffer)) |
491 |
(buffer-backed-up nil)) |
(if (and (buffer-modified-p) |
492 |
(save-buffer)) |
buffer-file-name |
493 |
(if (and (buffer-modified-p) |
(y-or-n-p (concat "Save file " buffer-file-name "? "))) |
494 |
buffer-file-name |
(save-buffer))) |
495 |
(y-or-n-p (concat "Save file " buffer-file-name "? "))) |
(server-buffer-done (current-buffer)))) |
|
(save-buffer buffer))) |
|
|
(server-buffer-done buffer))))) |
|
496 |
|
|
497 |
;; Ask before killing a server buffer. |
;; Ask before killing a server buffer. |
498 |
;; It was suggested to release its client instead, |
;; It was suggested to release its client instead, |
522 |
(defvar server-kill-buffer-running nil |
(defvar server-kill-buffer-running nil |
523 |
"Non-nil while `server-kill-buffer' or `server-buffer-done' is running.") |
"Non-nil while `server-kill-buffer' or `server-buffer-done' is running.") |
524 |
|
|
|
;; When a buffer is killed, inform the clients. |
|
|
(add-hook 'kill-buffer-hook 'server-kill-buffer) |
|
525 |
(defun server-kill-buffer () |
(defun server-kill-buffer () |
526 |
;; Prevent infinite recursion if user has made server-done-hook |
;; Prevent infinite recursion if user has made server-done-hook |
527 |
;; call kill-buffer. |
;; call kill-buffer. |
543 |
prevent a backup for it.) The variable `server-temp-file-regexp' controls |
prevent a backup for it.) The variable `server-temp-file-regexp' controls |
544 |
which filenames are considered temporary. |
which filenames are considered temporary. |
545 |
|
|
546 |
If invoked with a prefix argument, or if there is no server process running, |
If invoked with a prefix argument, or if there is no server process running, |
547 |
starts server process and that is all. Invoked by \\[server-edit]." |
starts server process and that is all. Invoked by \\[server-edit]." |
548 |
(interactive "P") |
(interactive "P") |
549 |
(if (or arg |
(if (or arg |
559 |
;; if we have already killed one temp-file server buffer. |
;; if we have already killed one temp-file server buffer. |
560 |
;; This means we should avoid the final "switch to some other buffer" |
;; This means we should avoid the final "switch to some other buffer" |
561 |
;; since we've already effectively done that. |
;; since we've already effectively done that. |
562 |
(cond ((and (windowp server-window) |
(if (null next-buffer) |
563 |
(window-live-p server-window)) |
(if server-clients |
564 |
(select-window server-window)) |
(server-switch-buffer (nth 1 (car server-clients)) killed-one) |
565 |
((framep server-window) |
(unless (or killed-one (window-dedicated-p (selected-window))) |
566 |
(if (not (frame-live-p server-window)) |
(switch-to-buffer (other-buffer)) |
567 |
(setq server-window (make-frame))) |
(message "No server buffers remain to edit"))) |
568 |
(select-window (frame-selected-window server-window)))) |
(if (not (buffer-name next-buffer)) |
569 |
(if (window-minibuffer-p (selected-window)) |
;; If NEXT-BUFFER is a dead buffer, remove the server records for it |
|
(select-window (next-window nil 'nomini 0))) |
|
|
;; Move to a non-dedicated window, if we have one. |
|
|
(when (window-dedicated-p (selected-window)) |
|
|
(select-window (get-window-with-predicate |
|
|
(lambda (w) (not (window-dedicated-p w))) |
|
|
'nomini 'visible (selected-window)))) |
|
|
(set-window-dedicated-p (selected-window) nil) |
|
|
(if next-buffer |
|
|
(if (and (bufferp next-buffer) |
|
|
(buffer-name next-buffer)) |
|
|
(switch-to-buffer next-buffer) |
|
|
;; If NEXT-BUFFER is a dead buffer, |
|
|
;; remove the server records for it |
|
570 |
;; and try the next surviving server buffer. |
;; and try the next surviving server buffer. |
571 |
(apply 'server-switch-buffer |
(apply 'server-switch-buffer (server-buffer-done next-buffer)) |
572 |
(server-buffer-done next-buffer))) |
;; OK, we know next-buffer is live, let's display and select it. |
573 |
(if server-clients |
(if (functionp server-window) |
574 |
(server-switch-buffer (nth 1 (car server-clients)) killed-one) |
(funcall server-window next-buffer) |
575 |
(if (not killed-one) |
(let ((win (get-buffer-window next-buffer 0))) |
576 |
(switch-to-buffer (other-buffer)))))) |
(if (and win (not server-window)) |
577 |
|
;; The buffer is already displayed: just reuse the window. |
578 |
|
(let ((frame (window-frame win))) |
579 |
|
(if (eq (frame-visible-p frame) 'icon) |
580 |
|
(raise-frame frame)) |
581 |
|
(select-window win) |
582 |
|
(set-buffer next-buffer)) |
583 |
|
;; Otherwise, let's find an appropriate window. |
584 |
|
(cond ((and (windowp server-window) |
585 |
|
(window-live-p server-window)) |
586 |
|
(select-window server-window)) |
587 |
|
((framep server-window) |
588 |
|
(if (not (frame-live-p server-window)) |
589 |
|
(setq server-window (make-frame))) |
590 |
|
(select-window (frame-selected-window server-window)))) |
591 |
|
(if (window-minibuffer-p (selected-window)) |
592 |
|
(select-window (next-window nil 'nomini 0))) |
593 |
|
;; Move to a non-dedicated window, if we have one. |
594 |
|
(when (window-dedicated-p (selected-window)) |
595 |
|
(select-window |
596 |
|
(get-window-with-predicate |
597 |
|
(lambda (w) |
598 |
|
(and (not (window-dedicated-p w)) |
599 |
|
(equal (frame-parameter (window-frame w) 'display) |
600 |
|
(frame-parameter (selected-frame) 'display)))) |
601 |
|
'nomini 'visible (selected-window)))) |
602 |
|
(condition-case nil |
603 |
|
(switch-to-buffer next-buffer) |
604 |
|
;; After all the above, we might still have ended up with |
605 |
|
;; a minibuffer/dedicated-window (if there's no other). |
606 |
|
(error (pop-to-buffer next-buffer))))))))) |
607 |
|
|
608 |
(global-set-key "\C-x#" 'server-edit) |
(global-set-key "\C-x#" 'server-edit) |
609 |
|
|
610 |
(defun server-unload-hook () |
(defun server-unload-hook () |
611 |
|
(server-start t) |
612 |
(remove-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function) |
(remove-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function) |
613 |
(remove-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) |
(remove-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) |
614 |
(remove-hook 'kill-buffer-hook 'server-kill-buffer)) |
(remove-hook 'kill-buffer-hook 'server-kill-buffer)) |