|
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 ;
|
|
|
8 ; Copyright (C) 1989-1994 Free Software Foundation, Inc.
|
|
|
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.
|
|
|
56
|
|
|
57
|
|
|
58
|
|
|
59 (defconst gnuserv-rcs-header-id "!Header: gnuserv.el,v 2.1 95/02/16 12:00:16 arup alpha !")
|
|
|
60
|
|
|
61
|
|
|
62 ;; server.el and gnuserv.el can't coexist because of conflicting defvar's and
|
|
|
63 ;; function names.
|
|
|
64
|
|
|
65 (if (and (boundp 'server-buffer-clients)
|
|
|
66 (not (featurep 'gnuserv)))
|
|
|
67 (error "Can't run gnuserv because server.el appears to be loaded already"))
|
|
|
68
|
|
|
69 (defvar gnuserv-frame nil
|
|
|
70 "*If non-nil, the frame to be used to display all edited files.
|
|
|
71 If nil, then a new frame is created for each file edited.
|
|
|
72 This variable has no effect in XEmacs versions older than 19.9.")
|
|
|
73
|
|
|
74 (defvar server-done-function 'kill-buffer
|
|
|
75 "*A function of one argument, a buffer, which removes the buffer after editing.
|
|
|
76 Functions such as 'kill-buffer' and 'bury-buffer' are good values.")
|
|
|
77
|
|
|
78 (defvar server-program "gnuserv"
|
|
|
79 "*The program to use as the edit server")
|
|
|
80
|
|
|
81 (defvar server-process nil
|
|
|
82 "The current server process")
|
|
|
83
|
|
|
84 (defvar server-string ""
|
|
|
85 "The last input string from the server")
|
|
|
86
|
|
|
87 (defvar current-client nil
|
|
|
88 "The client we are currently talking to")
|
|
|
89
|
|
|
90 (defvar server-clients nil
|
|
|
91 "List of current server clients.
|
|
|
92 Each element is (CLIENTID BUFFER...) where CLIENTID is an integer
|
|
|
93 that can be given to the server process to identify a client.
|
|
|
94 When a buffer is killed, it is removed from this list.")
|
|
|
95
|
|
|
96 (defvar server-buffer-clients nil
|
|
|
97 "List of client ids for clients requesting editing of the current buffer.")
|
|
|
98
|
|
|
99 (make-variable-buffer-local 'server-buffer-clients)
|
|
|
100 (setq-default server-buffer-clients nil)
|
|
|
101 (or (assq 'server-buffer-clients minor-mode-alist)
|
|
|
102 (setq minor-mode-alist (cons '(server-buffer-clients " Server")
|
|
|
103 minor-mode-alist)))
|
|
|
104
|
|
|
105 (defun server-log (string)
|
|
|
106 "If a *server* buffer exists, write STRING to it for logging purposes."
|
|
|
107 (if (get-buffer "*server*")
|
|
|
108 (save-excursion
|
|
|
109 (set-buffer "*server*")
|
|
|
110 (goto-char (point-max))
|
|
|
111 (insert string)
|
|
|
112 (or (bolp) (newline)))))
|
|
|
113
|
|
|
114
|
|
|
115 (defun server-sentinel (proc msg)
|
|
|
116 (cond ((eq (process-status proc) 'exit)
|
|
|
117 (server-log (message "Server subprocess exited")))
|
|
|
118 ((eq (process-status proc) 'signal)
|
|
|
119 (server-log (message "Server subprocess killed")))))
|
|
|
120
|
|
|
121
|
|
|
122 (defun server-process-display-error (string)
|
|
|
123 "Whenever a gnuserv error is reported, display it in a pop-up window."
|
|
|
124 (let ((cur (selected-window))
|
|
|
125 (pop-up-windows t))
|
|
|
126 (pop-to-buffer (get-buffer-create "*server*"))
|
|
|
127 (set-window-start (selected-window) (point))
|
|
|
128 (server-log string)
|
|
|
129 (select-window cur)))
|
|
|
130
|
|
|
131
|
|
|
132 (defun server-process-filter (proc string)
|
|
|
133 "Process client gnuserv requests to execute Emacs commands."
|
|
|
134 (setq server-string (concat server-string string))
|
|
|
135 (if (string-match "\^D$" server-string) ; requests end with ctrl-D
|
|
|
136 (if (string-match "^[0-9]+" server-string) ; client request id
|
|
|
137 (progn
|
|
|
138 (server-log server-string)
|
|
|
139 (let ((header (read-from-string server-string)))
|
|
|
140 (setq current-client (car header))
|
|
|
141 (condition-case oops
|
|
|
142 (eval (car (read-from-string server-string
|
|
|
143 (cdr header))))
|
|
|
144 (error (setq server-string "")
|
|
|
145 (server-write-to-client current-client oops)
|
|
|
146 (setq current-client nil)
|
|
|
147 (signal (car oops) (cdr oops)))
|
|
|
148 (quit (setq server-string "")
|
|
|
149 (server-write-to-client current-client oops)
|
|
|
150 (setq current-client nil)
|
|
|
151 (signal 'quit nil)))
|
|
|
152 (setq server-string "")))
|
|
|
153 (progn ;error string from server
|
|
|
154 (server-process-display-error server-string)
|
|
|
155 (setq server-string "")))))
|
|
|
156
|
|
|
157
|
|
|
158 (defun server-release-outstanding-buffers ()
|
|
|
159 "Release all buffers that have clients waiting for them to be finished."
|
|
|
160 (interactive)
|
|
|
161 (while server-clients
|
|
|
162 (let ((buffer (nth 1 (car server-clients)))) ; for all buffers...
|
|
|
163 (server-buffer-done buffer)))) ; destructively modifies server-clients
|
|
|
164
|
|
|
165 ;;;###autoload
|
|
|
166 (defun gnuserv-start (&optional leave-dead)
|
|
|
167 "Allow this Emacs process to be a server for client processes.
|
|
|
168 This starts a server communications subprocess through which
|
|
|
169 client \"editors\" (gnuclient and gnudoit) can send editing commands to
|
|
|
170 this Emacs job. See the gnuserv(1) manual page for more details.
|
|
|
171
|
|
|
172 Prefix arg means just kill any existing server communications subprocess."
|
|
|
173 (interactive "P")
|
|
|
174 ;; kill it dead!
|
|
|
175 (if server-process
|
|
|
176 (progn
|
|
|
177 (server-release-outstanding-buffers)
|
|
|
178 (set-process-sentinel server-process nil)
|
|
|
179 (condition-case ()
|
|
|
180 (delete-process server-process)
|
|
|
181 (error nil))))
|
|
|
182 ;; If we already had a server, clear out associated status.
|
|
|
183 (if leave-dead
|
|
|
184 nil
|
|
|
185 (if server-process
|
|
|
186 (server-log (message "Restarting server")))
|
|
|
187 (setq server-string "")
|
|
|
188 (setq current-client nil)
|
|
|
189 (let ((process-connection-type t))
|
|
|
190 (setq server-process
|
|
|
191 (start-process "server" nil server-program)))
|
|
|
192 (set-process-sentinel server-process 'server-sentinel)
|
|
|
193 (set-process-filter server-process 'server-process-filter)
|
|
|
194 (process-kill-without-query server-process)))
|
|
|
195
|
|
|
196 ;; make gnuserv-start an alias to server-start, for backward compatibility
|
|
|
197 (fset 'server-start (function gnuserv-start))
|
|
|
198
|
|
|
199
|
|
|
200 (defun server-write-to-client (client form)
|
|
|
201 "Write the given form to the given client via the server process."
|
|
|
202 (if (and client
|
|
|
203 (eq (process-status server-process) 'run))
|
|
|
204 (let* ((result (format "%s" form))
|
|
|
205 (s (format "%s/%d:%s\n" client (length result) result)))
|
|
|
206 (process-send-string server-process s)
|
|
|
207 (server-log s))))
|
|
|
208
|
|
|
209 (defun server-eval (form)
|
|
|
210 "Evaluate form and return result to client."
|
|
|
211 (server-write-to-client current-client (eval form))
|
|
|
212 (setq current-client nil))
|
|
|
213
|
|
|
214
|
|
|
215 (defun server-eval-quickly (form)
|
|
|
216 "Let client know that we've received the request, but eval the form
|
|
|
217 afterwards in order to not keep the client waiting."
|
|
|
218 (server-write-to-client current-client nil)
|
|
|
219 (setq current-client nil)
|
|
|
220 (eval form))
|
|
|
221
|
|
|
222
|
|
|
223 (defun server-make-window-visible ()
|
|
|
224 "Try to make this window even more visible."
|
|
2
|
225 (and (or (and (boundp 'window-system)
|
|
|
226 (boundp 'window-system-version)
|
|
|
227 (eq window-system 'x)
|
|
|
228 (eq window-system-version 11))
|
|
|
229 (and (fboundp 'console-type)
|
|
|
230 (eq 'x (console-type))))
|
|
0
|
231 (cond ((fboundp 'raise-frame)
|
|
|
232 (raise-frame (selected-frame)))
|
|
|
233 ((fboundp 'deiconify-screen)
|
|
|
234 (deiconify-screen (selected-screen))
|
|
|
235 (raise-screen (selected-screen)))
|
|
|
236 ((fboundp 'mapraised-screen)
|
|
|
237 (mapraised-screen))
|
|
|
238 ((fboundp 'x-remap-window)
|
|
|
239 (x-remap-window)
|
|
|
240 ;; give window chance to re-display text
|
|
|
241 (accept-process-output)))))
|
|
|
242
|
|
|
243 (defun server-tty-find-file (tty termtype file)
|
|
|
244 (let ((device (make-tty-device tty termtype)))
|
|
|
245 (select-frame (make-frame nil device))
|
|
|
246 (if (not file)
|
|
|
247 (switch-to-buffer (get-buffer-create "*scratch*"))
|
|
|
248 (find-file file))))
|
|
|
249
|
|
|
250 (defun server-find-file (file)
|
|
|
251 "Edit file FILENAME.
|
|
|
252 Switch to a buffer visiting file FILENAME,
|
|
|
253 creating one if none already exists."
|
|
|
254 (let ((obuf (get-file-buffer file))
|
|
|
255 ;; XEmacs addition.
|
|
|
256 (force-dialog-box-use t))
|
|
|
257 (if (and obuf (set-buffer obuf))
|
|
|
258 (if (file-exists-p file)
|
|
|
259 (if (or (not (verify-visited-file-modtime obuf))
|
|
|
260 (buffer-modified-p obuf))
|
|
|
261 (revert-buffer t nil))
|
|
|
262 (if (y-or-n-p
|
|
|
263 (concat "File no longer exists: "
|
|
|
264 file
|
|
|
265 ", write buffer to file? "))
|
|
|
266 (write-file file))))
|
|
|
267 (cond ((and window-system
|
|
|
268 gnuserv-frame (fboundp 'frame-live-p) ;; v19 & XEmacs 19.12+
|
|
|
269 (frame-live-p gnuserv-frame))
|
|
|
270 (select-frame gnuserv-frame)
|
|
|
271 (find-file file))
|
|
|
272
|
|
|
273 ((and window-system
|
|
|
274 gnuserv-frame (fboundp 'live-screen-p) ;; XEmacs 19.9+
|
|
|
275 (live-screen-p gnuserv-frame))
|
|
|
276 (select-screen gnuserv-frame)
|
|
|
277 (find-file file))
|
|
|
278
|
|
|
279 ((and window-system
|
|
|
280 (fboundp 'select-frame)) ;; v19 & XEmacs 19.12+
|
|
|
281 (select-frame (make-frame))
|
|
|
282 (find-file file))
|
|
|
283
|
|
|
284 ((and window-system
|
|
|
285 (fboundp 'select-screen) ;; XEmacs 19.10+
|
|
|
286 (fboundp 'make-screen))
|
|
|
287 (select-screen (make-screen))
|
|
|
288 (find-file file))
|
|
|
289
|
|
|
290 ((and (eq window-system 'x) ;; XEmacs 19.9-
|
|
|
291 (fboundp 'select-screen)
|
|
|
292 (fboundp 'x-create-screen))
|
|
|
293 (select-screen (x-create-screen nil))
|
|
|
294 (find-file file))
|
|
|
295
|
|
|
296 ((and window-system
|
|
|
297 (fboundp 'create-screen)) ;; epoch
|
|
|
298 (if (screenp gnuserv-frame)
|
|
|
299 (progn (select-screen gnuserv-frame)
|
|
|
300 (find-file file))
|
|
|
301 (select-screen (create-screen (find-file-noselect file)))))
|
|
|
302
|
|
|
303 (t (find-file file))))) ;; emacs18+
|
|
|
304
|
|
|
305
|
|
|
306 (defun server-edit-files-quickly (list)
|
|
|
307 "For each (line-number . file) pair in LIST, edit the file at line-number.
|
|
|
308 Unlike (server-edit-files), no information is saved about clients waiting on
|
|
|
309 edits to this buffer."
|
|
|
310 (server-write-to-client current-client nil)
|
|
|
311 (setq current-client nil)
|
|
|
312 (while list
|
|
|
313 (let ((line (car (car list)))
|
|
|
314 (path (cdr (car list))))
|
|
|
315 (server-find-file path)
|
|
|
316 (server-make-window-visible)
|
|
|
317 (goto-line line))
|
|
|
318 (setq list (cdr list))))
|
|
|
319
|
|
|
320
|
|
|
321 (defun server-edit-files (list)
|
|
|
322 "For each (line-number . file) pair in LIST, edit the file at line-number.
|
|
|
323 Save enough information for (server-kill-buffer) to inform the client when
|
|
|
324 the edit is finished."
|
|
|
325 (while list
|
|
|
326 (let ((line (car (car list)))
|
|
|
327 (path (cdr (car list))))
|
|
|
328 (server-find-file path)
|
|
|
329 (server-make-window-visible)
|
|
|
330 (let ((old-clients (assq current-client server-clients))
|
|
|
331 (buffer (current-buffer)))
|
|
|
332 (goto-line line)
|
|
|
333 (setq server-buffer-clients
|
|
|
334 (cons current-client server-buffer-clients))
|
|
|
335 (if old-clients ;client already waiting for buffers?
|
|
|
336 (nconc old-clients (list buffer)) ;yes -- append this one as well
|
|
|
337 (setq server-clients ;nope -- make a new record
|
|
|
338 (cons (list current-client buffer)
|
|
|
339 server-clients)))))
|
|
|
340 (setq list (cdr list)))
|
|
|
341 (message (substitute-command-keys
|
|
|
342 (if (and (boundp 'infodock-version) window-system)
|
|
|
343 "Type {\\[server-edit]} or select Frame/Delete to finish edit."
|
|
|
344 "When done with a buffer, type \\[server-edit]."))))
|
|
|
345
|
|
|
346 (defun server-tty-edit-files (tty termtype list)
|
|
|
347 "For each (line-number . file) pair in LIST, edit the file at line-number.
|
|
|
348 Save enough information for (server-kill-buffer) to inform the client when
|
|
|
349 the edit is finished."
|
|
|
350 (or list (setq list '((1 . nil))))
|
|
|
351 (while list
|
|
|
352 (let ((line (car (car list)))
|
|
|
353 (path (cdr (car list))))
|
|
|
354 (server-tty-find-file tty termtype path)
|
|
|
355 (server-make-window-visible)
|
|
|
356 (let ((old-clients (assq current-client server-clients))
|
|
|
357 (buffer (current-buffer)))
|
|
|
358 (goto-line line)
|
|
|
359 (setq server-buffer-clients
|
|
|
360 (cons current-client server-buffer-clients))
|
|
|
361 (if old-clients ;client already waiting for buffers?
|
|
|
362 (nconc old-clients (list buffer)) ;yes -- append this one as well
|
|
|
363 (setq server-clients ;nope -- make a new record
|
|
|
364 (cons (list current-client buffer)
|
|
|
365 server-clients)))))
|
|
|
366 (setq list (cdr list)))
|
|
|
367 (message (substitute-command-keys
|
|
|
368 (if (and (boundp 'infodock-version) window-system)
|
|
|
369 "Type {\\[server-edit]} or select Frame/Delete to finish edit."
|
|
|
370 "When done with a buffer, type \\[server-edit]."))))
|
|
|
371
|
|
|
372 (defun server-get-buffer (buffer)
|
|
|
373 "One arg, a BUFFER or a buffer name. Return the buffer object even if killed.
|
|
|
374 Signal an error if there is no record of BUFFER."
|
|
|
375 (if (null buffer)
|
|
|
376 (current-buffer)
|
|
|
377 (let ((buf (get-buffer buffer)))
|
|
|
378 (if (null buf)
|
|
|
379 (if (bufferp buffer)
|
|
|
380 buffer
|
|
|
381 (if (stringp buffer)
|
|
|
382 (error "No buffer named %s" buffer)
|
|
|
383 (error "Invalid buffer argument")))
|
|
|
384 buf))))
|
|
|
385
|
|
|
386 (defun server-kill-buffer (buffer)
|
|
|
387 "Kill the BUFFER. The argument may be a buffer object or buffer name.
|
|
|
388 NOTE: This function has been enhanced to allow for remote editing
|
|
|
389 in the following way:
|
|
|
390
|
|
|
391 If the buffer is waited upon by one or more clients, and a client is
|
|
|
392 not waiting for other buffers to be killed, then the client is told
|
|
|
393 that the buffer has been killed."
|
|
|
394 (interactive "bKill buffer ")
|
|
|
395 (setq buffer (server-get-buffer buffer))
|
|
|
396 (if (buffer-name buffer)
|
|
|
397 (save-excursion
|
|
|
398 (set-buffer buffer)
|
|
|
399 (let ((old-clients server-clients))
|
|
|
400 (server-real-kill-buffer buffer) ;try to kill it
|
|
|
401 (if (buffer-name buffer) ;succeeded in killing?
|
|
|
402 nil ;nope
|
|
|
403 (while old-clients
|
|
|
404 (let ((client (car old-clients)))
|
|
|
405 (delq buffer client)
|
|
|
406 (if (cdr client) ;pending buffers?
|
|
|
407 nil ;yep
|
|
|
408 (server-write-to-client (car client) nil) ;nope, tell client
|
|
|
409 (setq server-clients (delq client server-clients))))
|
|
|
410 (setq old-clients (cdr old-clients))))))))
|
|
|
411
|
|
|
412
|
|
|
413 (defun server-kill-all-local-variables ()
|
|
|
414 "Eliminate all the buffer-local variable values of the current buffer.
|
|
|
415 This buffer will then see the default values of all variables.
|
|
|
416 NOTE: This function has been modified to ignore the variable
|
|
|
417 server-buffer-clients."
|
|
|
418 (let ((clients server-buffer-clients))
|
|
|
419 (server-real-kill-all-local-variables)
|
|
|
420 (if clients
|
|
|
421 (setq server-buffer-clients clients))))
|
|
|
422
|
|
|
423
|
|
|
424 (or (fboundp 'server-real-kill-buffer)
|
|
|
425 (fset 'server-real-kill-buffer (symbol-function 'kill-buffer)))
|
|
|
426
|
|
|
427 (fset 'kill-buffer 'server-kill-buffer)
|
|
|
428
|
|
|
429 (or (fboundp 'server-real-kill-all-local-variables)
|
|
|
430 (fset 'server-real-kill-all-local-variables
|
|
|
431 (symbol-function 'kill-all-local-variables)))
|
|
|
432
|
|
|
433 (fset 'kill-all-local-variables 'server-kill-all-local-variables)
|
|
|
434
|
|
|
435
|
|
|
436 (defun server-buffer-done (buffer)
|
|
|
437 "Mark BUFFER as \"done\" for its client(s).
|
|
|
438 Buries the buffer, and returns another server buffer as a suggestion for the
|
|
|
439 new current buffer."
|
|
|
440 (let ((next-buffer nil)
|
|
|
441 (old-clients server-clients))
|
|
|
442 (while old-clients
|
|
|
443 (let ((client (car old-clients)))
|
|
|
444 (or next-buffer
|
|
|
445 (setq next-buffer (nth 1 (memq buffer client))))
|
|
|
446 (delq buffer client)
|
|
|
447 ;; If client now has no pending buffers,
|
|
|
448 ;; tell it that it is done, and forget it entirely.
|
|
|
449 (if (cdr client)
|
|
|
450 nil
|
|
|
451 (server-write-to-client (car client) nil)
|
|
|
452 (setq server-clients (delq client server-clients))))
|
|
|
453 (setq old-clients (cdr old-clients)))
|
|
|
454 (if (buffer-name buffer)
|
|
|
455 (save-excursion
|
|
|
456 (set-buffer buffer)
|
|
|
457 (setq server-buffer-clients nil)))
|
|
|
458 (funcall server-done-function buffer)
|
|
|
459 next-buffer))
|
|
|
460
|
|
|
461
|
|
|
462 (defun mh-draft-p (buffer)
|
|
|
463 "Return non-nil if this BUFFER is an mh <draft> file. Since MH deletes
|
|
|
464 draft *BEFORE* it is edited, the server treats them specially."
|
|
|
465 ;; This may not be appropriately robust for all cases.
|
|
|
466 (string= (buffer-name buffer) "draft"))
|
|
|
467
|
|
|
468
|
|
|
469 (defun server-done ()
|
|
|
470 "Offer to save current buffer and mark it as \"done\" for clients.
|
|
|
471 Also bury it, and return a suggested new current buffer."
|
|
|
472 (let ((buffer (current-buffer)))
|
|
|
473 (if server-buffer-clients
|
|
|
474 (progn
|
|
|
475 (if (mh-draft-p buffer)
|
|
|
476 (progn (save-buffer)
|
|
|
477 (write-region (point-min) (point-max)
|
|
|
478 (concat buffer-file-name "~"))
|
|
|
479 (kill-buffer buffer))
|
|
|
480 (if (and (buffer-modified-p)
|
|
|
481 (y-or-n-p (concat "Save file " buffer-file-name "? ")))
|
|
|
482 (save-buffer buffer)))
|
|
|
483 (server-buffer-done buffer)))))
|
|
|
484
|
|
|
485
|
|
|
486 (defun server-edit (&optional arg)
|
|
|
487 "Switch to next server editing buffer and mark current one as \"done\".
|
|
|
488 If a server buffer is current, it is marked \"done\" and optionally saved.
|
|
|
489 MH <draft> files are always saved and backed up, no questions asked.
|
|
|
490 When all of a client's buffers are marked as \"done\", the client is notified.
|
|
|
491
|
|
|
492 If invoked with a prefix argument, or if there is no server process running,
|
|
|
493 starts server process and that is all. Invoked by \\[server-edit]."
|
|
|
494 (interactive "P")
|
|
|
495 (if (or arg
|
|
|
496 (not server-process)
|
|
|
497 (memq (process-status server-process) '(signal exit)))
|
|
|
498 (server-start nil)
|
|
|
499 (if server-buffer-clients
|
|
|
500 (progn (server-switch-buffer (server-done))
|
|
2
|
501 (cond ((fboundp 'console-type) ;; XEmacs 19.14+
|
|
|
502 (or (and (equal (console-type) 'x)
|
|
|
503 gnuserv-frame
|
|
|
504 (frame-live-p gnuserv-frame))
|
|
|
505 (condition-case ()
|
|
|
506 (delete-frame (selected-frame) nil)
|
|
|
507 (error
|
|
|
508 (message "Not deleting last visible frame...")))))
|
|
|
509 ((or (not window-system)
|
|
0
|
510 (and gnuserv-frame
|
|
|
511 (or (and (fboundp 'frame-live-p)
|
|
|
512 (frame-live-p gnuserv-frame))
|
|
|
513 (and (fboundp 'live-screen-p)
|
|
|
514 (live-screen-p gnuserv-frame))
|
|
|
515 (and (fboundp 'create-screen)
|
|
|
516 (screenp gnuserv-frame)))))
|
|
|
517 ()) ;; do nothing
|
|
|
518 ((fboundp 'delete-frame)
|
|
|
519 (delete-frame (selected-frame) t))
|
|
|
520 ((fboundp 'delete-screen)
|
|
|
521 (delete-screen))))
|
|
|
522 (error
|
|
|
523 "(server-edit): Use only on buffers created by external programs.")
|
|
|
524 )))
|
|
|
525
|
|
|
526 (defun server-switch-buffer (next-buffer)
|
|
|
527 "Switch to NEXT-BUFFER if a live buffer, otherwise switch to another buffer
|
|
|
528 with gnuserv clients. If no such buffer is available, simply choose another
|
|
|
529 one."
|
|
|
530 (if next-buffer
|
|
|
531 (if (and (bufferp next-buffer)
|
|
|
532 (buffer-name next-buffer))
|
|
|
533 (switch-to-buffer next-buffer)
|
|
|
534 ;; If NEXT-BUFFER is a dead buffer,
|
|
|
535 ;; remove the server records for it
|
|
|
536 ;; and try the next surviving server buffer.
|
|
|
537 (server-switch-buffer
|
|
|
538 (server-buffer-done next-buffer)))
|
|
|
539 (if server-clients
|
|
|
540 (server-switch-buffer (nth 1 (car server-clients)))
|
|
|
541 (switch-to-buffer (other-buffer)))))
|
|
|
542
|
|
|
543 (global-set-key "\C-x#" 'server-edit)
|
|
|
544
|
|
|
545 (provide 'gnuserv)
|
|
|
546
|
