Mercurial > hg > xemacs-beta

comparison lisp/gnuserv.el @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children 697ef44129c6
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
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@srce.hr> 6 ;; Hrvoje Niksic <hniksic@xemacs.org>
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@xemacs.org>
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@srce.hr> May/1997 76 ;; Hrvoje Niksic <hniksic@xemacs.org> 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 (gnuserv-write-to-client gnuserv-current-client oops) 351 (when gnuserv-current-client
352 (gnuserv-write-to-client gnuserv-current-client oops))
352 (setq gnuserv-current-client nil) 353 (setq gnuserv-current-client nil)
353 (signal (car oops) (cdr oops))) 354 (signal (car oops) (cdr oops)))
354 (quit (setq gnuserv-string "") 355 (quit (setq gnuserv-string "")
355 (gnuserv-write-to-client gnuserv-current-client oops) 356 (when gnuserv-current-client
357 (gnuserv-write-to-client gnuserv-current-client oops))
356 (setq gnuserv-current-client nil) 358 (setq gnuserv-current-client nil)
357 (signal 'quit nil))) 359 (signal 'quit nil)))
358 (setq gnuserv-string ""))) 360 (setq gnuserv-string "")))
359 (t 361 (t
360 (error "%s: invalid response from gnuserv" gnuserv-string) 362 (error "%s: invalid response from gnuserv" gnuserv-string)
438 new-frame) 440 new-frame)
439 (t (selected-frame)))) 441 (t (selected-frame))))
440 (client (make-gnuclient :id gnuserv-current-client 442 (client (make-gnuclient :id gnuserv-current-client
441 :device device 443 :device device
442 :frame new-frame))) 444 :frame new-frame)))
445 (select-frame frame)
443 (setq gnuserv-current-client nil) 446 (setq gnuserv-current-client nil)
444 ;; If the device was created by this client, push it to the list. 447 ;; If the device was created by this client, push it to the list.
445 (and (/= old-device-num (length (device-list))) 448 (and (/= old-device-num (length (device-list)))
446 (push device gnuserv-devices)) 449 (push device gnuserv-devices))
447 (and (frame-iconified-p frame) 450 (and (frame-iconified-p frame)