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