Mercurial > hg > xemacs-beta

comparison lisp/packages/gnuserv.el @ 207:e45d5e7c476e r20-4b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b2
author cvs
date Mon, 13 Aug 2007 10:03:52 +0200
parents acd284d43ca1
children 1f0dabaa0855
comparison
equal deleted inserted replaced
206:d3e9274cbc4e 207:e45d5e7c476e
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.9 4 ;; Version: 3.10
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
56 56
57 ;; For more information you can refer to man pages of gnuclient, 57 ;; For more information you can refer to man pages of gnuclient,
58 ;; gnudoit and gnuserv, distributed with XEmacs. 58 ;; gnudoit and gnuserv, distributed with XEmacs.
59 59
60 ;; gnuserv.el was originally written by Andy Norman as an improvement 60 ;; gnuserv.el was originally written by Andy Norman as an improvement
61 ;; over William Sommerfeld's server.el. Since then, a number of people 61 ;; over William Sommerfeld's server.el. Since then, a number of
62 ;; have worked on it, including Bob Weiner, Darell Kindred, Arup 62 ;; people have worked on it, including Bob Weiner, Darell Kindred,
63 ;; Mukherjee, Ben Wing and Jan Vroonhof. It was completely rewritten 63 ;; Arup Mukherjee, Ben Wing and Jan Vroonhof. It was completely
64 ;; (labeled as version 3) by Hrvoje Niksic in May 1997. 64 ;; rewritten (labeled as version 3) by Hrvoje Niksic in May 1997. The
65 ;; new code will not run on GNU Emacs.
65 66
66 ;; Jan Vroonhof <vroonhof@math.ethz.ch> July/1996 67 ;; Jan Vroonhof <vroonhof@math.ethz.ch> July/1996
67 ;; ported the server-temp-file-regexp feature from server.el 68 ;; ported the server-temp-file-regexp feature from server.el
68 ;; ported server hooks from server.el 69 ;; ported server hooks from server.el
69 ;; ported kill-*-query functions from server.el (and made it optional) 70 ;; ported kill-*-query functions from server.el (and made it optional)
129 (function-item :tag "Use visible frame, otherwise create new" 130 (function-item :tag "Use visible frame, otherwise create new"
130 gnuserv-visible-frame-function) 131 gnuserv-visible-frame-function)
131 (function-item :tag "Create special Gnuserv frame and use it" 132 (function-item :tag "Create special Gnuserv frame and use it"
132 gnuserv-special-frame-function) 133 gnuserv-special-frame-function)
133 (function :tag "Other")) 134 (function :tag "Other"))
134 :group 'gnuserv) 135 :group 'gnuserv
136 :group 'frames)
137
138 (defcustom gnuserv-frame-plist nil
139 "*Plist of frame properties for creating a gnuserv frame."
140 :type '(repeat (group :inline t
141 (symbol :tag "Property")
142 (sexp :tag "Value")))
143 :group 'gnuserv
144 :group 'frames)
135 145
136 (defcustom gnuserv-done-function 'kill-buffer 146 (defcustom gnuserv-done-function 'kill-buffer
137 "*Function used to remove a buffer after editing. 147 "*Function used to remove a buffer after editing.
138 It is called with one BUFFER argument. Functions such as `kill-buffer' and 148 It is called with one BUFFER argument. Functions such as `kill-buffer' and
139 `bury-buffer' are good values. See also `gnuserv-done-temp-file-function'." 149 `bury-buffer' are good values. See also `gnuserv-done-temp-file-function'."
279 nil)) 289 nil))
280 290
281 (defun gnuserv-special-frame-function (type) 291 (defun gnuserv-special-frame-function (type)
282 "Creates a special frame for Gnuserv and returns it on later invocations." 292 "Creates a special frame for Gnuserv and returns it on later invocations."
283 (unless (frame-live-p gnuserv-special-frame) 293 (unless (frame-live-p gnuserv-special-frame)
284 (setq gnuserv-special-frame (make-frame))) 294 (setq gnuserv-special-frame (make-frame gnuserv-frame-plist)))
285 gnuserv-special-frame) 295 gnuserv-special-frame)
286 296
287 297
288 ;;; Communication functions 298 ;;; Communication functions
289 299
404 (let* ((old-device-num (length (device-list))) 414 (let* ((old-device-num (length (device-list)))
405 (new-frame nil) 415 (new-frame nil)
406 (dest-frame (if (functionp gnuserv-frame) 416 (dest-frame (if (functionp gnuserv-frame)
407 (funcall gnuserv-frame (car type)) 417 (funcall gnuserv-frame (car type))
408 gnuserv-frame)) 418 gnuserv-frame))
409 ;; The gnuserv-frame dependencies are ugly. 419 ;; The gnuserv-frame dependencies are ugly, but it's
420 ;; extremely hard to make that stuff cleaner without
421 ;; breaking everything in sight.
410 (device (cond ((frame-live-p dest-frame) 422 (device (cond ((frame-live-p dest-frame)
411 (frame-device dest-frame)) 423 (frame-device dest-frame))
412 ((null dest-frame) 424 ((null dest-frame)
413 (case (car type) 425 (case (car type)
414 (tty (apply 'make-tty-device (cdr type))) 426 (tty (apply 'make-tty-device (cdr type)))
417 (t 429 (t
418 (selected-device)))) 430 (selected-device))))
419 (frame (cond ((frame-live-p dest-frame) 431 (frame (cond ((frame-live-p dest-frame)
420 dest-frame) 432 dest-frame)
421 ((null dest-frame) 433 ((null dest-frame)
422 (setq new-frame (make-frame nil device)) 434 (setq new-frame (make-frame gnuserv-frame-plist
435 device))
423 new-frame) 436 new-frame)
424 (t (selected-frame)))) 437 (t (selected-frame))))
425 (client (make-gnuclient :id gnuserv-current-client 438 (client (make-gnuclient :id gnuserv-current-client
426 :device device 439 :device device
427 :frame new-frame))) 440 :frame new-frame)))