|
0
|
1 ; Lisp Interface code between GNU Emacs and gnuserv.
|
|
|
2 ;
|
|
|
3 ; This file is part of GNU Emacs.
|
|
|
4 ;
|
|
|
5 ; Copying is permitted under those conditions described by the GNU
|
|
|
6 ; General Public License.
|
|
|
7 ;
|
|
36
|
8 ; Copyright (C) 1989-1996 Free Software Foundation, Inc.
|
|
0
|
9 ;
|
|
|
10 ; Author: Andy Norman (ange@hplb.hpl.hp.com) based on
|
|
|
11 ; 'lisp/server.el' from the 18.52 GNU Emacs distribution.
|
|
|
12 ;
|
|
|
13 ; Please mail bugs and suggestions to the author at the above address.
|
|
|
14 ;
|
|
|
15 ;;; Synched up with: Not in FSF.
|
|
|
16
|
|
|
17 ; Updated for XEmacs, GNU Emacs 19 and Epoch V4 to use multiple frames
|
|
|
18 ; by Bob Weiner, <weiner@mot.com>, 1/20/94. (Still works with Emacs V18, too.)
|
|
|
19 ; Modified 'server-process-filter' to use \^D as end of request terminator
|
|
|
20 ; as gnuclient and gnudoit have been modified to send. This permits
|
|
|
21 ; multi-line requests.
|
|
|
22 ; Modified 'server-make-window-visible' to work with multiple frames.
|
|
|
23 ; Modified 'server-find-file' to display in a separate frame when possible.
|
|
|
24 ; Modified 'server-edit' to delete newly created frame when used to
|
|
|
25 ; terminate an edit and to signal an error if called within a
|
|
|
26 ; non-server-edit buffer.
|
|
|
27 ; Bob Weiner, <weiner@mot.com>, 5/9/94.
|
|
|
28 ; Added 'server-done-function' variable. Made default value 'kill-buffer'
|
|
|
29 ; instead of 'bury-buffer' as in original gnuserv.el.
|
|
|
30 ;
|
|
|
31 ; Darrell Kindred <dkindred+@cmu.edu> May/1994
|
|
|
32 ; Updated to allow multi-line return values:
|
|
|
33 ; - output to gnuserv is "m/n:xxx" where m is the client number,
|
|
|
34 ; n is the length of the data, and xxx is the data itself, followed
|
|
|
35 ; by newline
|
|
|
36 ;
|
|
|
37 ; Arup Mukherjee <arup+@cmu.edu> May/1994
|
|
|
38 ; Updated for XEmacs 19.10, and others:
|
|
|
39 ; - use find-file-other-screen if present
|
|
2
|
40 ; - new variable gnuserv-frame can be set to a frame or screen which
|
|
0
|
41 ; is used for all edited files.
|
|
|
42 ; - check to see if server.el is already loaded and complain if it is, since
|
|
|
43 ; gnuserv.el can't coexist with server.el
|
|
|
44 ; - rename server-start to gnuserv-start, although server-start remains as
|
|
|
45 ; an alias. This allows gnuserv-start to be autoloaded from gnuserv.el
|
|
|
46 ; - changed server-get-buffer to take into account that in newer emacsen,
|
|
|
47 ; get buffer returns nil on deleted buffers.
|
|
|
48 ; - only try to create/delete frames or screens if window-system is non-nil
|
|
|
49 ; (otherwise things don't work w/ emacs19 on a dumb terminal)
|
|
|
50 ;
|
|
|
51 ; Ben Wing <wing@666.com> sometime in 1995
|
|
|
52 ; Updated to allow `gnuattach'-type connections to the existing TTY
|
|
|
53 ;
|
|
|
54 ; Ben Wing <wing@666.com> May/1996
|
|
|
55 ; patch to get TTY terminal type correct.
|
|
36
|
56 ;
|
|
|
57 ; Jan Vroonhof <vroonhof@math.ethz.ch> July/1996
|
|
|
58 ; ported the server-temp-file-regexp feature from server.el
|
|
|
59 ; ported server hooks from server.el
|
|
|
60 ; ported kill-*-query functions from server.el (and made it optional)
|
|
|
61 ; synced other behaviour with server.el
|
|
0
|
62
|
|
|
63
|
|
|
64
|
|
|
65 (defconst gnuserv-rcs-header-id "!Header: gnuserv.el,v 2.1 95/02/16 12:00:16 arup alpha !")
|
|
|
66
|
|
|
67
|
|
|
68 ;; server.el and gnuserv.el can't coexist because of conflicting defvar's and
|
|
|
69 ;; function names.
|
|
|
70
|
|
|
71 (if (and (boundp 'server-buffer-clients)
|
|
|
72 (not (featurep 'gnuserv)))
|
|
|
73 (error "Can't run gnuserv because server.el appears to be loaded already"))
|
|
|
74
|
|
12
|
75 ;;;###autoload
|
|
0
|
76 (defvar gnuserv-frame nil
|
|
|
77 "*If non-nil, the frame to be used to display all edited files.
|
|
|
78 If nil, then a new frame is created for each file edited.
|
|
|
79 This variable has no effect in XEmacs versions older than 19.9.")
|
|
|
80
|
|
|
81 (defvar server-done-function 'kill-buffer
|
|
|
82 "*A function of one argument, a buffer, which removes the buffer after editing.
|
|
36
|
83 Functions such as 'kill-buffer' and 'bury-buffer' are good values. See also
|
|
|
84 `server-done-temp-file-function'")
|
|
|
85
|
|
|
86 (defvar server-done-temp-file-function 'kill-buffer
|
|
|
87 "*A function of one argument, a buffer, which removes the buffer after editing a
|
|
|
88 temporary file. Functions such as 'kill-buffer' and 'bury-buffer' are
|
|
|
89 good values. See also `server-done-function'")
|
|
0
|
90
|
|
|
91 (defvar server-program "gnuserv"
|
|
|
92 "*The program to use as the edit server")
|
|
|
93
|
|
36
|
94
|
|
|
95 (defvar server-visit-hook nil
|
|
|
96 "*List of hooks to call when visiting a file for the Emacs server.")
|
|
|
97
|
|
|
98 ;; defined by server.el but obsolete?
|
|
|
99 ;; (defvar server-switch-hook nil
|
|
|
100 ;; "*List of hooks to call when switching to a buffer for the Emacs server.")
|
|
|
101
|
|
|
102 (defvar server-done-hook nil
|
|
|
103 "*List of hooks to call when done editing a buffer for the Emacs server.")
|
|
|
104
|
|
|
105
|
|
0
|
106 (defvar server-process nil
|
|
|
107 "The current server process")
|
|
|
108
|
|
|
109 (defvar server-string ""
|
|
|
110 "The last input string from the server")
|
|
|
111
|
|
12
|
112 (defvar server-kill-last-frame nil
|
|
|
113 "set to t to kill last frame")
|
|
|
114
|
|
0
|
115 (defvar current-client nil
|
|
|
116 "The client we are currently talking to")
|
|
|
117
|
|
|
118 (defvar server-clients nil
|
|
|
119 "List of current server clients.
|
|
|
120 Each element is (CLIENTID BUFFER...) where CLIENTID is an integer
|
|
|
121 that can be given to the server process to identify a client.
|
|
|
122 When a buffer is killed, it is removed from this list.")
|
|
|
123
|
|
36
|
124 (defvar server-kill-quietly nil
|
|
|
125 "If this variable is set then don't confirm kills of buffers with
|
|
|
126 clients attached")
|
|
|
127
|
|
|
128
|
|
0
|
129 (defvar server-buffer-clients nil
|
|
|
130 "List of client ids for clients requesting editing of the current buffer.")
|
|
|
131
|
|
36
|
132 (defvar server-temp-file-regexp "^/tmp/Re\\|/draft$"
|
|
|
133 "*Regexp which should match filenames of temporary files
|
|
|
134 which are deleted and reused after each edit
|
|
|
135 by the programs that invoke the emacs server.")
|
|
|
136
|
|
|
137 (defvar server-make-temp-file-backup nil
|
|
|
138 "Non-nil makes the server backup temporary files also")
|
|
|
139
|
|
0
|
140 (make-variable-buffer-local 'server-buffer-clients)
|
|
|
141 (setq-default server-buffer-clients nil)
|
|
|
142 (or (assq 'server-buffer-clients minor-mode-alist)
|
|
|
143 (setq minor-mode-alist (cons '(server-buffer-clients " Server")
|
|
|
144 minor-mode-alist)))
|
|
|
145
|
|
36
|
146 (defun server-temp-file-p (buffer)
|
|
|
147 "Return non-nil if BUFFER contains a file considered temporary.
|
|
|
148 These are files whose names suggest they are repeatedly
|
|
|
149 reused to pass information to another program.
|
|
|
150
|
|
|
151 The variable `server-temp-file-regexp' controls which filenames
|
|
|
152 are considered temporary."
|
|
|
153 (and (buffer-file-name buffer)
|
|
|
154 (string-match server-temp-file-regexp (buffer-file-name buffer))))
|
|
|
155
|
|
|
156
|
|
0
|
157 (defun server-log (string)
|
|
|
158 "If a *server* buffer exists, write STRING to it for logging purposes."
|
|
|
159 (if (get-buffer "*server*")
|
|
|
160 (save-excursion
|
|
|
161 (set-buffer "*server*")
|
|
|
162 (goto-char (point-max))
|
|
|
163 (insert string)
|
|
|
164 (or (bolp) (newline)))))
|
|
|
165
|
|
|
166
|
|
|
167 (defun server-sentinel (proc msg)
|
|
|
168 (cond ((eq (process-status proc) 'exit)
|
|
|
169 (server-log (message "Server subprocess exited")))
|
|
|
170 ((eq (process-status proc) 'signal)
|
|
|
171 (server-log (message "Server subprocess killed")))))
|
|
|
172
|
|
|
173
|
|
|
174 (defun server-process-display-error (string)
|
|
|
175 "Whenever a gnuserv error is reported, display it in a pop-up window."
|
|
|
176 (let ((cur (selected-window))
|
|
|
177 (pop-up-windows t))
|
|
|
178 (pop-to-buffer (get-buffer-create "*server*"))
|
|
|
179 (set-window-start (selected-window) (point))
|
|
|
180 (server-log string)
|
|
|
181 (select-window cur)))
|
|
|
182
|
|
|
183
|
|
|
184 (defun server-process-filter (proc string)
|
|
|
185 "Process client gnuserv requests to execute Emacs commands."
|
|
|
186 (setq server-string (concat server-string string))
|
|
|
187 (if (string-match "\^D$" server-string) ; requests end with ctrl-D
|
|
|
188 (if (string-match "^[0-9]+" server-string) ; client request id
|
|
|
189 (progn
|
|
|
190 (server-log server-string)
|
|
|
191 (let ((header (read-from-string server-string)))
|
|
|
192 (setq current-client (car header))
|
|
|
193 (condition-case oops
|
|
|
194 (eval (car (read-from-string server-string
|
|
|
195 (cdr header))))
|
|
|
196 (error (setq server-string "")
|
|
|
197 (server-write-to-client current-client oops)
|
|
|
198 (setq current-client nil)
|
|
|
199 (signal (car oops) (cdr oops)))
|
|
|
200 (quit (setq server-string "")
|
|
|
201 (server-write-to-client current-client oops)
|
|
|
202 (setq current-client nil)
|
|
|
203 (signal 'quit nil)))
|
|
|
204 (setq server-string "")))
|
|
|
205 (progn ;error string from server
|
|
|
206 (server-process-display-error server-string)
|
|
|
207 (setq server-string "")))))
|
|
|
208
|
|
|
209
|
|
|
210 (defun server-release-outstanding-buffers ()
|
|
|
211 "Release all buffers that have clients waiting for them to be finished."
|
|
|
212 (interactive)
|
|
|
213 (while server-clients
|
|
|
214 (let ((buffer (nth 1 (car server-clients)))) ; for all buffers...
|
|
|
215 (server-buffer-done buffer)))) ; destructively modifies server-clients
|
|
|
216
|
|
|
217 ;;;###autoload
|
|
|
218 (defun gnuserv-start (&optional leave-dead)
|
|
|
219 "Allow this Emacs process to be a server for client processes.
|
|
|
220 This starts a server communications subprocess through which
|
|
|
221 client \"editors\" (gnuclient and gnudoit) can send editing commands to
|
|
|
222 this Emacs job. See the gnuserv(1) manual page for more details.
|
|
|
223
|
|
|
224 Prefix arg means just kill any existing server communications subprocess."
|
|
|
225 (interactive "P")
|
|
|
226 ;; kill it dead!
|
|
|
227 (if server-process
|
|
|
228 (progn
|
|
|
229 (server-release-outstanding-buffers)
|
|
|
230 (set-process-sentinel server-process nil)
|
|
|
231 (condition-case ()
|
|
|
232 (delete-process server-process)
|
|
|
233 (error nil))))
|
|
|
234 ;; If we already had a server, clear out associated status.
|
|
|
235 (if leave-dead
|
|
|
236 nil
|
|
|
237 (if server-process
|
|
|
238 (server-log (message "Restarting server")))
|
|
|
239 (setq server-string "")
|
|
|
240 (setq current-client nil)
|
|
|
241 (let ((process-connection-type t))
|
|
|
242 (setq server-process
|
|
|
243 (start-process "server" nil server-program)))
|
|
|
244 (set-process-sentinel server-process 'server-sentinel)
|
|
|
245 (set-process-filter server-process 'server-process-filter)
|
|
|
246 (process-kill-without-query server-process)))
|
|
|
247
|
|
|
248 ;; make gnuserv-start an alias to server-start, for backward compatibility
|
|
|
249 (fset 'server-start (function gnuserv-start))
|
|
|
250
|
|
36
|
251 ; Can gnuserv handle commands in close succesion? (See server.el line 283) JV
|
|
0
|
252 (defun server-write-to-client (client form)
|
|
|
253 "Write the given form to the given client via the server process."
|
|
|
254 (if (and client
|
|
|
255 (eq (process-status server-process) 'run))
|
|
|
256 (let* ((result (format "%s" form))
|
|
|
257 (s (format "%s/%d:%s\n" client (length result) result)))
|
|
|
258 (process-send-string server-process s)
|
|
|
259 (server-log s))))
|
|
|
260
|
|
|
261 (defun server-eval (form)
|
|
|
262 "Evaluate form and return result to client."
|
|
|
263 (server-write-to-client current-client (eval form))
|
|
|
264 (setq current-client nil))
|
|
|
265
|
|
|
266
|
|
|
267 (defun server-eval-quickly (form)
|
|
|
268 "Let client know that we've received the request, but eval the form
|
|
|
269 afterwards in order to not keep the client waiting."
|
|
|
270 (server-write-to-client current-client nil)
|
|
|
271 (setq current-client nil)
|
|
|
272 (eval form))
|
|
|
273
|
|
|
274
|
|
|
275 (defun server-make-window-visible ()
|
|
|
276 "Try to make this window even more visible."
|
|
2
|
277 (and (or (and (boundp 'window-system)
|
|
|
278 (boundp 'window-system-version)
|
|
|
279 (eq window-system 'x)
|
|
|
280 (eq window-system-version 11))
|
|
|
281 (and (fboundp 'console-type)
|
|
|
282 (eq 'x (console-type))))
|
|
0
|
283 (cond ((fboundp 'raise-frame)
|
|
|
284 (raise-frame (selected-frame)))
|
|
|
285 ((fboundp 'deiconify-screen)
|
|
|
286 (deiconify-screen (selected-screen))
|
|
|
287 (raise-screen (selected-screen)))
|
|
|
288 ((fboundp 'mapraised-screen)
|
|
|
289 (mapraised-screen))
|
|
|
290 ((fboundp 'x-remap-window)
|
|
|
291 (x-remap-window)
|
|
|
292 ;; give window chance to re-display text
|
|
|
293 (accept-process-output)))))
|
|
|
294
|
|
30
|
295 (defun server-tty-find-file (tty termtype pid file)
|
|
|
296 (let ((device (make-tty-device tty termtype pid )))
|
|
0
|
297 (select-frame (make-frame nil device))
|
|
|
298 (if (not file)
|
|
|
299 (switch-to-buffer (get-buffer-create "*scratch*"))
|
|
36
|
300 (find-file file)))
|
|
|
301 (run-hooks 'server-visit-hook))
|
|
0
|
302
|
|
|
303 (defun server-find-file (file)
|
|
|
304 "Edit file FILENAME.
|
|
|
305 Switch to a buffer visiting file FILENAME,
|
|
|
306 creating one if none already exists."
|
|
|
307 (let ((obuf (get-file-buffer file))
|
|
|
308 ;; XEmacs addition.
|
|
|
309 (force-dialog-box-use t))
|
|
|
310 (if (and obuf (set-buffer obuf))
|
|
|
311 (if (file-exists-p file)
|
|
|
312 (if (or (not (verify-visited-file-modtime obuf))
|
|
|
313 (buffer-modified-p obuf))
|
|
|
314 (revert-buffer t nil))
|
|
|
315 (if (y-or-n-p
|
|
|
316 (concat "File no longer exists: "
|
|
|
317 file
|
|
|
318 ", write buffer to file? "))
|
|
|
319 (write-file file))))
|
|
|
320 (cond ((and window-system
|
|
|
321 gnuserv-frame (fboundp 'frame-live-p) ;; v19 & XEmacs 19.12+
|
|
|
322 (frame-live-p gnuserv-frame))
|
|
|
323 (select-frame gnuserv-frame)
|
|
|
324 (find-file file))
|
|
|
325
|
|
|
326 ((and window-system
|
|
|
327 gnuserv-frame (fboundp 'live-screen-p) ;; XEmacs 19.9+
|
|
|
328 (live-screen-p gnuserv-frame))
|
|
|
329 (select-screen gnuserv-frame)
|
|
|
330 (find-file file))
|
|
|
331
|
|
|
332 ((and window-system
|
|
|
333 (fboundp 'select-frame)) ;; v19 & XEmacs 19.12+
|
|
|
334 (select-frame (make-frame))
|
|
|
335 (find-file file))
|
|
|
336
|
|
|
337 ((and window-system
|
|
|
338 (fboundp 'select-screen) ;; XEmacs 19.10+
|
|
|
339 (fboundp 'make-screen))
|
|
|
340 (select-screen (make-screen))
|
|
|
341 (find-file file))
|
|
|
342
|
|
|
343 ((and (eq window-system 'x) ;; XEmacs 19.9-
|
|
|
344 (fboundp 'select-screen)
|
|
|
345 (fboundp 'x-create-screen))
|
|
|
346 (select-screen (x-create-screen nil))
|
|
|
347 (find-file file))
|
|
|
348
|
|
|
349 ((and window-system
|
|
|
350 (fboundp 'create-screen)) ;; epoch
|
|
|
351 (if (screenp gnuserv-frame)
|
|
|
352 (progn (select-screen gnuserv-frame)
|
|
|
353 (find-file file))
|
|
|
354 (select-screen (create-screen (find-file-noselect file)))))
|
|
|
355
|
|
36
|
356 (t (find-file file)))) ;; emacs18+
|
|
|
357 (run-hooks 'server-visit-hook))
|
|
0
|
358
|
|
|
359
|
|
|
360 (defun server-edit-files-quickly (list)
|
|
|
361 "For each (line-number . file) pair in LIST, edit the file at line-number.
|
|
|
362 Unlike (server-edit-files), no information is saved about clients waiting on
|
|
|
363 edits to this buffer."
|
|
|
364 (server-write-to-client current-client nil)
|
|
|
365 (setq current-client nil)
|
|
|
366 (while list
|
|
|
367 (let ((line (car (car list)))
|
|
|
368 (path (cdr (car list))))
|
|
|
369 (server-find-file path)
|
|
|
370 (server-make-window-visible)
|
|
|
371 (goto-line line))
|
|
|
372 (setq list (cdr list))))
|
|
|
373
|
|
|
374
|
|
|
375 (defun server-edit-files (list)
|
|
|
376 "For each (line-number . file) pair in LIST, edit the file at line-number.
|
|
|
377 Save enough information for (server-kill-buffer) to inform the client when
|
|
|
378 the edit is finished."
|
|
|
379 (while list
|
|
|
380 (let ((line (car (car list)))
|
|
|
381 (path (cdr (car list))))
|
|
|
382 (server-find-file path)
|
|
|
383 (server-make-window-visible)
|
|
|
384 (let ((old-clients (assq current-client server-clients))
|
|
|
385 (buffer (current-buffer)))
|
|
|
386 (goto-line line)
|
|
|
387 (setq server-buffer-clients
|
|
|
388 (cons current-client server-buffer-clients))
|
|
|
389 (if old-clients ;client already waiting for buffers?
|
|
|
390 (nconc old-clients (list buffer)) ;yes -- append this one as well
|
|
|
391 (setq server-clients ;nope -- make a new record
|
|
|
392 (cons (list current-client buffer)
|
|
|
393 server-clients)))))
|
|
|
394 (setq list (cdr list)))
|
|
|
395 (message (substitute-command-keys
|
|
|
396 (if (and (boundp 'infodock-version) window-system)
|
|
|
397 "Type {\\[server-edit]} or select Frame/Delete to finish edit."
|
|
|
398 "When done with a buffer, type \\[server-edit]."))))
|
|
|
399
|
|
30
|
400 (defun server-tty-edit-files (tty termtype pid list)
|
|
0
|
401 "For each (line-number . file) pair in LIST, edit the file at line-number.
|
|
|
402 Save enough information for (server-kill-buffer) to inform the client when
|
|
|
403 the edit is finished."
|
|
|
404 (or list (setq list '((1 . nil))))
|
|
|
405 (while list
|
|
|
406 (let ((line (car (car list)))
|
|
|
407 (path (cdr (car list))))
|
|
30
|
408 (server-tty-find-file tty termtype pid path)
|
|
0
|
409 (server-make-window-visible)
|
|
|
410 (let ((old-clients (assq current-client server-clients))
|
|
|
411 (buffer (current-buffer)))
|
|
|
412 (goto-line line)
|
|
|
413 (setq server-buffer-clients
|
|
|
414 (cons current-client server-buffer-clients))
|
|
|
415 (if old-clients ;client already waiting for buffers?
|
|
|
416 (nconc old-clients (list buffer)) ;yes -- append this one as well
|
|
|
417 (setq server-clients ;nope -- make a new record
|
|
|
418 (cons (list current-client buffer)
|
|
|
419 server-clients)))))
|
|
|
420 (setq list (cdr list)))
|
|
|
421 (message (substitute-command-keys
|
|
|
422 (if (and (boundp 'infodock-version) window-system)
|
|
|
423 "Type {\\[server-edit]} or select Frame/Delete to finish edit."
|
|
|
424 "When done with a buffer, type \\[server-edit]."))))
|
|
|
425
|
|
|
426 (defun server-get-buffer (buffer)
|
|
|
427 "One arg, a BUFFER or a buffer name. Return the buffer object even if killed.
|
|
|
428 Signal an error if there is no record of BUFFER."
|
|
|
429 (if (null buffer)
|
|
|
430 (current-buffer)
|
|
|
431 (let ((buf (get-buffer buffer)))
|
|
|
432 (if (null buf)
|
|
|
433 (if (bufferp buffer)
|
|
|
434 buffer
|
|
|
435 (if (stringp buffer)
|
|
|
436 (error "No buffer named %s" buffer)
|
|
|
437 (error "Invalid buffer argument")))
|
|
|
438 buf))))
|
|
|
439
|
|
|
440 (defun server-kill-buffer (buffer)
|
|
|
441 "Kill the BUFFER. The argument may be a buffer object or buffer name.
|
|
|
442 NOTE: This function has been enhanced to allow for remote editing
|
|
|
443 in the following way:
|
|
|
444
|
|
|
445 If the buffer is waited upon by one or more clients, and a client is
|
|
|
446 not waiting for other buffers to be killed, then the client is told
|
|
|
447 that the buffer has been killed."
|
|
|
448 (interactive "bKill buffer ")
|
|
|
449 (setq buffer (server-get-buffer buffer))
|
|
|
450 (if (buffer-name buffer)
|
|
|
451 (save-excursion
|
|
|
452 (set-buffer buffer)
|
|
|
453 (let ((old-clients server-clients))
|
|
|
454 (server-real-kill-buffer buffer) ;try to kill it
|
|
|
455 (if (buffer-name buffer) ;succeeded in killing?
|
|
|
456 nil ;nope
|
|
|
457 (while old-clients
|
|
|
458 (let ((client (car old-clients)))
|
|
|
459 (delq buffer client)
|
|
|
460 (if (cdr client) ;pending buffers?
|
|
|
461 nil ;yep
|
|
|
462 (server-write-to-client (car client) nil) ;nope, tell client
|
|
|
463 (setq server-clients (delq client server-clients))))
|
|
48
|
464 (setq old-clients (cdr old-clients)))
|
|
|
465 t)))))
|
|
0
|
466
|
|
|
467
|
|
36
|
468 ;; Ask before killing a server buffer.
|
|
|
469 ;; It was suggested to release its client instead,
|
|
|
470 ;; but I think that is dangerous--the client would proceed
|
|
|
471 ;; using whatever is on disk in that file. -- rms.
|
|
|
472 (defun server-kill-buffer-query-function ()
|
|
|
473 (or server-kill-quietly
|
|
|
474 (not server-buffer-clients)
|
|
|
475 (yes-or-no-p (format "Buffer `%s' still has clients; kill it? "
|
|
|
476 (buffer-name (current-buffer))))))
|
|
|
477
|
|
|
478 (add-hook 'kill-buffer-query-functions
|
|
|
479 'server-kill-buffer-query-function)
|
|
|
480
|
|
|
481 (defun server-kill-emacs-query-function ()
|
|
|
482 (let (live-client
|
|
|
483 (tail server-clients))
|
|
|
484 ;; See if any clients have any buffers that are still alive.
|
|
|
485 (while tail
|
|
|
486 (if (memq t (mapcar 'stringp (mapcar 'buffer-name (cdr (car tail)))))
|
|
|
487 (setq live-client t))
|
|
|
488 (setq tail (cdr tail)))
|
|
|
489 (or server-kill-quietly
|
|
|
490 (not live-client)
|
|
|
491 (yes-or-no-p "Server buffers still have clients; exit anyway? "))))
|
|
|
492
|
|
|
493 (add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function)
|
|
|
494
|
|
|
495
|
|
0
|
496 (defun server-kill-all-local-variables ()
|
|
|
497 "Eliminate all the buffer-local variable values of the current buffer.
|
|
|
498 This buffer will then see the default values of all variables.
|
|
|
499 NOTE: This function has been modified to ignore the variable
|
|
|
500 server-buffer-clients."
|
|
|
501 (let ((clients server-buffer-clients))
|
|
|
502 (server-real-kill-all-local-variables)
|
|
|
503 (if clients
|
|
|
504 (setq server-buffer-clients clients))))
|
|
|
505
|
|
|
506
|
|
|
507 (or (fboundp 'server-real-kill-buffer)
|
|
|
508 (fset 'server-real-kill-buffer (symbol-function 'kill-buffer)))
|
|
|
509
|
|
|
510 (fset 'kill-buffer 'server-kill-buffer)
|
|
|
511
|
|
|
512 (or (fboundp 'server-real-kill-all-local-variables)
|
|
|
513 (fset 'server-real-kill-all-local-variables
|
|
|
514 (symbol-function 'kill-all-local-variables)))
|
|
|
515
|
|
|
516 (fset 'kill-all-local-variables 'server-kill-all-local-variables)
|
|
|
517
|
|
|
518
|
|
|
519 (defun server-buffer-done (buffer)
|
|
|
520 "Mark BUFFER as \"done\" for its client(s).
|
|
|
521 Buries the buffer, and returns another server buffer as a suggestion for the
|
|
|
522 new current buffer."
|
|
36
|
523 ; Note we do NOT return a list with a killed flag, doesn't seem usefull to me. JV
|
|
0
|
524 (let ((next-buffer nil)
|
|
|
525 (old-clients server-clients))
|
|
|
526 (while old-clients
|
|
|
527 (let ((client (car old-clients)))
|
|
|
528 (or next-buffer
|
|
|
529 (setq next-buffer (nth 1 (memq buffer client))))
|
|
|
530 (delq buffer client)
|
|
36
|
531 ;; Delete all dead buffers from CLIENT. (Why? JV , copyed from server.el)
|
|
|
532 (let ((tail client))
|
|
|
533 (while tail
|
|
|
534 (and (bufferp (car tail))
|
|
|
535 (null (buffer-name (car tail)))
|
|
|
536 (delq (car tail) client))
|
|
|
537 (setq tail (cdr tail))))
|
|
0
|
538 ;; If client now has no pending buffers,
|
|
|
539 ;; tell it that it is done, and forget it entirely.
|
|
|
540 (if (cdr client)
|
|
|
541 nil
|
|
30
|
542 (if (buffer-name buffer)
|
|
|
543 (save-excursion
|
|
|
544 (set-buffer buffer)
|
|
36
|
545 (setq server-buffer-clients nil)
|
|
|
546 (run-hooks 'server-done-hook)))
|
|
30
|
547 ; Order is important here --
|
|
|
548 ; server-kill-buffer tries to notify clients that
|
|
|
549 ; they are done, too, but if we try and notify twice,
|
|
|
550 ; we are h0zed -- Hunter Kelly 3/3/97
|
|
|
551 (setq server-clients (delq client server-clients))
|
|
36
|
552 (if (server-temp-file-p buffer)
|
|
|
553 (funcall server-done-temp-file-function buffer)
|
|
|
554 (funcall server-done-function buffer))
|
|
30
|
555 (server-write-to-client (car client) nil)))
|
|
0
|
556 (setq old-clients (cdr old-clients)))
|
|
|
557 next-buffer))
|
|
|
558
|
|
|
559
|
|
|
560 (defun mh-draft-p (buffer)
|
|
|
561 "Return non-nil if this BUFFER is an mh <draft> file. Since MH deletes
|
|
|
562 draft *BEFORE* it is edited, the server treats them specially."
|
|
|
563 ;; This may not be appropriately robust for all cases.
|
|
|
564 (string= (buffer-name buffer) "draft"))
|
|
|
565
|
|
|
566
|
|
|
567 (defun server-done ()
|
|
|
568 "Offer to save current buffer and mark it as \"done\" for clients.
|
|
|
569 Also bury it, and return a suggested new current buffer."
|
|
|
570 (let ((buffer (current-buffer)))
|
|
|
571 (if server-buffer-clients
|
|
|
572 (progn
|
|
36
|
573 (if (mh-draft-p buffer);; Does this comflict with temp-file ? JV
|
|
0
|
574 (progn (save-buffer)
|
|
|
575 (write-region (point-min) (point-max)
|
|
|
576 (concat buffer-file-name "~"))
|
|
|
577 (kill-buffer buffer))
|
|
36
|
578 (if (server-temp-file-p buffer)
|
|
|
579 ;; For a temp file, save, and do NOT make a non-numeric backup
|
|
|
580 ;; Why does server.el explicitly back up temporary files?
|
|
|
581 (let ((version-control nil)
|
|
|
582 (buffer-backed-up (not server-make-temp-file-backup)))
|
|
|
583 (save-buffer))
|
|
|
584 (if (and (buffer-modified-p)
|
|
|
585 (y-or-n-p (concat "Save file " buffer-file-name "? ")))
|
|
|
586 (save-buffer buffer))))
|
|
0
|
587 (server-buffer-done buffer)))))
|
|
|
588
|
|
|
589
|
|
|
590 (defun server-edit (&optional arg)
|
|
36
|
591 "Switch to next server editing
|
|
|
592 buffer and mark current one as \"done\". If a server buffer is
|
|
|
593 current, it is marked \"done\" and optionally saved. MH <draft> files
|
|
|
594 are always saved and backed up, no questions asked. Files that match
|
|
|
595 server-temp-file-regexp are considered temporary and are saved
|
|
|
596 unconditionally and
|
|
|
597 backed up if server-make-temp-file-backup is non-nil. When all of a
|
|
|
598 client's buffers are marked as \"done\", the client is notified.
|
|
0
|
599
|
|
|
600 If invoked with a prefix argument, or if there is no server process running,
|
|
12
|
601 starts server process and that is all. Invoked by \\[server-edit].
|
|
|
602
|
|
|
603 If `server-kill-last-frame' is t, then the final frame will be killed."
|
|
0
|
604 (interactive "P")
|
|
|
605 (if (or arg
|
|
|
606 (not server-process)
|
|
|
607 (memq (process-status server-process) '(signal exit)))
|
|
|
608 (server-start nil)
|
|
|
609 (if server-buffer-clients
|
|
36
|
610 (progn (server-done-and-switch)
|
|
2
|
611 (cond ((fboundp 'console-type) ;; XEmacs 19.14+
|
|
|
612 (or (and (equal (console-type) 'x)
|
|
|
613 gnuserv-frame
|
|
|
614 (frame-live-p gnuserv-frame))
|
|
|
615 (condition-case ()
|
|
12
|
616 (delete-frame (selected-frame)
|
|
|
617 server-kill-last-frame)
|
|
2
|
618 (error
|
|
|
619 (message "Not deleting last visible frame...")))))
|
|
|
620 ((or (not window-system)
|
|
0
|
621 (and gnuserv-frame
|
|
|
622 (or (and (fboundp 'frame-live-p)
|
|
|
623 (frame-live-p gnuserv-frame))
|
|
|
624 (and (fboundp 'live-screen-p)
|
|
|
625 (live-screen-p gnuserv-frame))
|
|
|
626 (and (fboundp 'create-screen)
|
|
|
627 (screenp gnuserv-frame)))))
|
|
|
628 ()) ;; do nothing
|
|
|
629 ((fboundp 'delete-frame)
|
|
|
630 (delete-frame (selected-frame) t))
|
|
|
631 ((fboundp 'delete-screen)
|
|
|
632 (delete-screen))))
|
|
|
633 (error
|
|
|
634 "(server-edit): Use only on buffers created by external programs.")
|
|
|
635 )))
|
|
|
636
|
|
36
|
637 (defun server-switch-buffer-internal (next-buffer always)
|
|
0
|
638 "Switch to NEXT-BUFFER if a live buffer, otherwise switch to another buffer
|
|
36
|
639 with gnuserv clients. If no such buffer is available, we switch to
|
|
|
640 another normal buffer if `always' is non-nil!"
|
|
|
641 ;; switching
|
|
0
|
642 (if next-buffer
|
|
|
643 (if (and (bufferp next-buffer)
|
|
|
644 (buffer-name next-buffer))
|
|
|
645 (switch-to-buffer next-buffer)
|
|
|
646 ;; If NEXT-BUFFER is a dead buffer,
|
|
|
647 ;; remove the server records for it
|
|
|
648 ;; and try the next surviving server buffer.
|
|
36
|
649 (server-switch-buffer-internal
|
|
|
650 (server-buffer-done next-buffer) always))
|
|
|
651 (if server-clients
|
|
|
652 (server-switch-buffer-internal (nth 1 (car server-clients)) always)
|
|
|
653 (if always
|
|
|
654 (switch-to-buffer (other-buffer))))))
|
|
|
655
|
|
|
656 ;; For compatability
|
|
|
657 (defun server-switch-buffer (next-buffer)
|
|
|
658 (server-switch-buffer-internal next-buffer t))
|
|
|
659
|
|
|
660 ;; The below function calles server-done and switches to the next
|
|
|
661 ;; sensible buffer. This implementation works regardless of the values
|
|
|
662 ;; of server-*-function and doens't need the tail recursion
|
|
|
663 ;; variable passing of server.el. It is more transparant too. JV
|
|
|
664 (defun server-done-and-switch ()
|
|
|
665 "Be done with the current buffer and switch to another server buffer
|
|
|
666 if there is one, otherwise just switch buffer"
|
|
|
667 (let ((old-current (current-buffer)))
|
|
|
668 (server-switch-buffer-internal (server-done) nil)
|
|
|
669 (if (eq old-current (current-buffer))
|
|
|
670 (switch-to-buffer (other-buffer)))))
|
|
0
|
671
|
|
|
672 (global-set-key "\C-x#" 'server-edit)
|
|
|
673
|
|
|
674 (provide 'gnuserv)
|
|
|
675
|
|
12
|
676 ;;; gnuserv.el ends here
|
