Mercurial > hg > xemacs-beta

comparison lisp/gnuserv.el @ 371:cc15677e0335 r21-2b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b1
author cvs
date Mon, 13 Aug 2007 11:03:08 +0200
parents 1d62742628b6
children 8626e4521993
comparison
equal deleted inserted replaced
370:bd866891f083 371:cc15677e0335
1 ;;; gnuserv.el --- Lisp interface code between Emacs and gnuserv 1 ;;; gnuserv.el --- Lisp interface code between Emacs and gnuserv
2 ;; Copyright (C) 1989-1997 Free Software Foundation, Inc. 2 ;; Copyright (C) 1989-1997 Free Software Foundation, Inc.
3 3
4 ;; Version: 3.12 4 ;; Version: 3.11
5 ;; Author: Andy Norman (ange@hplb.hpl.hp.com), originally based on server.el 5 ;; Author: Andy Norman (ange@hplb.hpl.hp.com), originally based on server.el
6 ;; Hrvoje Niksic <hniksic@srce.hr> 6 ;; Hrvoje Niksic <hniksic@srce.hr>
7 ;; Maintainer: Jan Vroonhof <vroonhof@math.ethz.ch>, 7 ;; Maintainer: Jan Vroonhof <vroonhof@math.ethz.ch>,
8 ;; Hrvoje Niksic <hniksic@srce.hr> 8 ;; Hrvoje Niksic <hniksic@srce.hr>
9 ;; Keywords: environment, processes, terminals 9 ;; Keywords: environment, processes, terminals
66 66
67 ;; Jan Vroonhof <vroonhof@math.ethz.ch> July/1996 67 ;; Jan Vroonhof <vroonhof@math.ethz.ch> July/1996
68 ;; ported the server-temp-file-regexp feature from server.el 68 ;; ported the server-temp-file-regexp feature from server.el
69 ;; ported server hooks from server.el 69 ;; ported server hooks from server.el
70 ;; ported kill-*-query functions from server.el (and made it optional) 70 ;; ported kill-*-query functions from server.el (and made it optional)
71 ;; synced other behavior with server.el 71 ;; synced other behaviour with server.el
72 ;; 72 ;;
73 ;; Jan Vroonhof 73 ;; Jan Vroonhof
74 ;; Customized. 74 ;; Customized.
75 ;; 75 ;;
76 ;; Hrvoje Niksic <hniksic@srce.hr> May/1997 76 ;; Hrvoje Niksic <hniksic@srce.hr> May/1997
335 ;; <text> - the actual contents of the request. 335 ;; <text> - the actual contents of the request.
336 (defun gnuserv-process-filter (proc string) 336 (defun gnuserv-process-filter (proc string)
337 "Process gnuserv client requests to execute Emacs commands." 337 "Process gnuserv client requests to execute Emacs commands."
338 (setq gnuserv-string (concat gnuserv-string string)) 338 (setq gnuserv-string (concat gnuserv-string string))
339 ;; C-d means end of request. 339 ;; C-d means end of request.
340 (when (string-match "\C-d\n?\\'" gnuserv-string) 340 (when (string-match "\C-d\\'" gnuserv-string)
341 (cond ((string-match "\\`[0-9]+" gnuserv-string) ; client request id 341 (cond ((string-match "^[0-9]+" gnuserv-string) ; client request id
342 (let ((header (read-from-string gnuserv-string))) 342 (let ((header (read-from-string gnuserv-string)))
343 ;; Set the client we are talking to. 343 ;; Set the client we are talking to.
344 (setq gnuserv-current-client (car header)) 344 (setq gnuserv-current-client (car header))
345 ;; Evaluate the expression 345 ;; Evaluate the expression
346 (condition-case oops 346 (condition-case oops
347 (eval (car (read-from-string gnuserv-string (cdr header)))) 347 (eval (car (read-from-string gnuserv-string (cdr header))))
348 ;; In case of an error, write the description to the 348 ;; In case of an error, write the description to the
349 ;; client, and then signal it. 349 ;; client, and then signal it.
350 (error (setq gnuserv-string "") 350 (error (setq gnuserv-string "")
351 (when gnuserv-current-client 351 (gnuserv-write-to-client gnuserv-current-client oops)
352 (gnuserv-write-to-client gnuserv-current-client oops))
353 (setq gnuserv-current-client nil) 352 (setq gnuserv-current-client nil)
354 (signal (car oops) (cdr oops))) 353 (signal (car oops) (cdr oops)))
355 (quit (setq gnuserv-string "") 354 (quit (setq gnuserv-string "")
356 (when gnuserv-current-client 355 (gnuserv-write-to-client gnuserv-current-client oops)
357 (gnuserv-write-to-client gnuserv-current-client oops))
358 (setq gnuserv-current-client nil) 356 (setq gnuserv-current-client nil)
359 (signal 'quit nil))) 357 (signal 'quit nil)))
360 (setq gnuserv-string ""))) 358 (setq gnuserv-string "")))
361 (t 359 (t
362 (let ((response (car (split-string gnuserv-string "\C-d")))) 360 (error "%s: invalid response from gnuserv" gnuserv-string)
363 (setq gnuserv-string "") 361 (setq gnuserv-string "")))))
364 (error "%s: invalid response from gnuserv" response))))))
365 362
366 ;; This function is somewhat of a misnomer. Actually, we write to the 363 ;; This function is somewhat of a misnomer. Actually, we write to the
367 ;; server (using `process-send-string' to gnuserv-process), which 364 ;; server (using `process-send-string' to gnuserv-process), which
368 ;; interprets what we say and forwards it to the client. The 365 ;; interprets what we say and forwards it to the client. The
369 ;; incantation server understands is (from gnuserv.c): 366 ;; incantation server understands is (from gnuserv.c):