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