Mercurial > hg > xemacs-beta

comparison lisp/gnuserv.el @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents 74fd4e045ea6
children 11054d720c21
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
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.11 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@xemacs.org> 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@xemacs.org> 8 ;; Hrvoje Niksic <hniksic@srce.hr>
9 ;; Keywords: environment, processes, terminals 9 ;; Keywords: environment, processes, terminals
10 10
11 ;; This file is part of XEmacs. 11 ;; This file is part of XEmacs.
12 12
13 ;; XEmacs is free software; you can redistribute it and/or modify it 13 ;; XEmacs is free software; you can redistribute it and/or modify it
71 ;; synced other behavior with server.el 71 ;; synced other behavior with server.el
72 ;; 72 ;;
73 ;; Jan Vroonhof 73 ;; Jan Vroonhof
74 ;; Customized. 74 ;; Customized.
75 ;; 75 ;;
76 ;; Hrvoje Niksic <hniksic@xemacs.org> May/1997 76 ;; Hrvoje Niksic <hniksic@srce.hr> May/1997
77 ;; Completely rewritten. Now uses `defstruct' and other CL stuff 77 ;; Completely rewritten. Now uses `defstruct' and other CL stuff
78 ;; to define clients cleanly. Many thanks to Dave Gillespie! 78 ;; to define clients cleanly. Many thanks to Dave Gillespie!
79 ;; 79 ;;
80 ;; Mike Scheidler <c23mts@eng.delcoelect.com> July, 1997 80 ;; Mike Scheidler <c23mts@eng.delcoelect.com> July, 1997
81 ;; Added 'Done' button to the menubar. 81 ;; Added 'Done' button to the menubar.
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 (error "%s: invalid response from gnuserv" gnuserv-string) 360 (error "%s: invalid response from gnuserv" gnuserv-string)
440 new-frame) 438 new-frame)
441 (t (selected-frame)))) 439 (t (selected-frame))))
442 (client (make-gnuclient :id gnuserv-current-client 440 (client (make-gnuclient :id gnuserv-current-client
443 :device device 441 :device device
444 :frame new-frame))) 442 :frame new-frame)))
445 (select-frame frame)
446 (setq gnuserv-current-client nil) 443 (setq gnuserv-current-client nil)
447 ;; If the device was created by this client, push it to the list. 444 ;; If the device was created by this client, push it to the list.
448 (and (/= old-device-num (length (device-list))) 445 (and (/= old-device-num (length (device-list)))
449 (push device gnuserv-devices)) 446 (push device gnuserv-devices))
450 (and (frame-iconified-p frame) 447 (and (frame-iconified-p frame)