annotate lisp/gnuserv.el @ 814:a634e3b7acc8

[xemacs-hg @ 2002-04-14 12:41:59 by ben] latest changes TODO.ben-mule-21-5: Update. make-docfile.c: Add basic support for handling ISO 2022 doc strings -- we parse the basic charset designation sequences so we know whether we're in ASCII and have to pay attention to end quotes and such. Reformat code according to coding standards. abbrev.el: Add `global-abbrev-mode', which turns on or off abbrev-mode in all buffers. Added `defining-abbrev-turns-on-abbrev-mode' -- if non-nil, defining an abbrev through an interactive function will automatically turn on abbrev-mode, either globally or locally depending on the command. This is the "what you'd expect" behavior. indent.el: general function for indenting a balanced expression in a mode-correct way. Works similar to indent-region in that a mode can specify a specific command to do the whole operation; if not, figure out the region using forward-sexp and indent each line using indent-according-to-mode. keydefs.el: Removed. Modify M-C-backslash to do indent-region-or-balanced-expression. Make S-Tab just insert a TAB char, like it's meant to do. make-docfile.el: Now that we're using the call-process-in-lisp, we need to load an extra file win32-native.el because we're running a bare temacs. menubar-items.el: Totally redo the Cmds menu so that most used commands appear directly on the menu and less used commands appear in submenus. The old way may have been very pretty, but rather impractical. process.el: Under Windows, don't ever use old-call-process-internal, even in batch mode. We can do processes in batch mode. subr.el: Someone recoded truncate-string-to-width, saying "the FSF version is too complicated and does lots of hard-to-understand stuff" but the resulting recoded version was *totally* wrong! it misunderstood the basic point of this function, which is work in *columns* not chars. i dumped ours and copied the version from FSF 21.1. Also added truncate-string-with-continuation-dots, since this idiom is used often. config.inc.samp, xemacs.mak: Separate out debug and optimize flags. Remove all vestiges of USE_MINIMAL_TAGBITS, USE_INDEXED_LRECORD_IMPLEMENTATION, and GUNG_HO, since those ifdefs have long been removed. Make error-checking support actually work. Some rearrangement of config.inc.samp to make it more logical. Remove callproc.c and ntproc.c from xemacs.mak, no longer used. Make pdump the default. lisp.h: Add support for strong type-checking of Bytecount, Bytebpos, Charcount, Charbpos, and others, by making them classes, overloading the operators to provide integer-like operation and carefully controlling what operations are allowed. Not currently enabled in C++ builds because there are still a number of compile errors, and it won't really work till we merge in my "8-bit-Mule" workspace, in which I make use of the new types Charxpos, Bytexpos, Memxpos, representing a "position" either in a buffer or a string. (This is especially important in the extent code.) abbrev.c, alloc.c, eval.c, buffer.c, buffer.h, editfns.c, fns.c, text.h: Warning fixes, some of them related to new C++ strict type checking of Bytecount, Charbpos, etc. dired.c: Caught an actual error due to strong type checking -- char len being passed when should be byte len. alloc.c, backtrace.h, bytecode.c, bytecode.h, eval.c, sysdep.c: Further optimize Ffuncall: -- process arg list at compiled-function creation time, converting into an array for extra-quick access at funcall time. -- rewrite funcall_compiled_function to use it, and inline this function. -- change the order of check for magic stuff in SPECBIND_FAST_UNSAFE to be faster. -- move the check for need to garbage collect into the allocation code, so only a single flag needs to be checked in funcall. buffer.c, symbols.c: add debug funs to check on mule optimization info in buffers and strings. eval.c, emacs.c, text.c, regex.c, scrollbar-msw.c, search.c: Fix evil crashes due to eistrings not properly reinitialized under pdump. Redo a bit some of the init routines; convert some complex_vars_of() into simple vars_of(), because they didn't need complex processing. callproc.c, emacs.c, event-stream.c, nt.c, process.c, process.h, sysdep.c, sysdep.h, syssignal.h, syswindows.h, ntproc.c: Delete. Hallelujah, praise the Lord, there is no god but Allah!!! fix so that processes can be invoked in bare temacs -- thereby eliminating any need for callproc.c. (currently only eliminated under NT.) remove all crufty and unnecessary old process code in ntproc.c and elsewhere. move non-callproc-specific stuff (mostly environment) into process.c, so callproc.c can be left out under NT. console-tty.c, doc.c, file-coding.c, file-coding.h, lstream.c, lstream.h: fix doc string handling so it works with Japanese, etc docs. change handling of "character mode" so callers don't have to manually set it (quite error-prone). event-msw.c: spacing fixes. lread.c: eliminate unused crufty vintage-19 "FSF defun hack" code. lrecord.h: improve pdump description docs. buffer.c, ntheap.c, unexnt.c, win32.c, emacs.c: Mule-ize some unexec and startup code. It was pseudo-Mule-ized before by simply always calling the ...A versions of functions, but that won't cut it -- eventually we want to be able to run properly even if XEmacs has been installed in a Japanese directory. (The current problem is the timing of the loading of the Unicode tables; this will eventually be fixed.) Go through and fix various other places where the code was not Mule-clean. Provide a function mswindows_get_module_file_name() to get our own name without resort to PATH_MAX and such. Add a big comment in main() about the problem with Unicode table load timing that I just alluded to. emacs.c: When error-checking is enabled (interpreted as "user is developing XEmacs"), don't ask user to "pause to read messages" when a fatal error has occurred, because it will wedge if we are in an inner modal loop (typically when a menu is popped up) and make us unable to get a useful stack trace in the debugger. text.c: Correct update_entirely_ascii_p_flag to actually work. lisp.h, symsinit.h: declarations for above changes.
author ben
date Sun, 14 Apr 2002 12:43:31 +0000
parents a00780ef853d
children 0a85daf64258
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; gnuserv.el --- Lisp interface code between Emacs and gnuserv
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 ;; Copyright (C) 1989-1997 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 434
diff changeset
4 ;; Version: 3.12
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Author: Andy Norman (ange@hplb.hpl.hp.com), originally based on server.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Hrvoje Niksic <hniksic@xemacs.org>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Maintainer: Jan Vroonhof <vroonhof@math.ethz.ch>,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Hrvoje Niksic <hniksic@xemacs.org>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;; Keywords: environment, processes, terminals
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; along with XEmacs; see the file COPYING. If not, write to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; Free Software Foundation, 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 ;;; Synched up with: Not in FSF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 ;; Gnuserv is run when Emacs needs to operate as a server for other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;; processes. Specifically, any number of files can be attached for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; editing to a running XEmacs process using the `gnuclient' program.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;; Use `M-x gnuserv-start' to start the server and `gnuclient files'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;; to load them to XEmacs. When you are done with a buffer, press
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; `C-x #' (`M-x gnuserv-edit'). You can put (gnuserv-start) to your
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;; .emacs, and enable `gnuclient' as your Unix "editor". When all the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; buffers for a client have been edited and exited with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 ;; `gnuserv-edit', the client "editor" will return to the program that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; invoked it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 ;; Your editing commands and Emacs' display output go to and from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ;; terminal or X display in the usual way. If you are running under
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 ;; X, a new X frame will be open for each gnuclient. If you are on a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ;; TTY, this TTY will be attached as a new device to the running
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 ;; XEmacs, and will be removed once you are done with the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;; To evaluate a Lisp form in a running Emacs, use the `-eval'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 ;; argument of gnuclient. To simplify this, we provide the `gnudoit'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 ;; shell script. For example `gnudoit "(+ 2 3)"' will print `5',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 ;; whereas `gnudoit "(gnus)"' will fire up your favorite newsreader.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 ;; Like gnuclient, `gnudoit' requires the server to be started prior
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 ;; to using it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;; For more information you can refer to man pages of gnuclient,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 ;; gnudoit and gnuserv, distributed with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 ;; gnuserv.el was originally written by Andy Norman as an improvement
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 ;; over William Sommerfeld's server.el. Since then, a number of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 ;; people have worked on it, including Bob Weiner, Darell Kindred,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 ;; Arup Mukherjee, Ben Wing and Jan Vroonhof. It was completely
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 ;; rewritten (labeled as version 3) by Hrvoje Niksic in May 1997. The
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 ;; new code will not run on GNU Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 ;; Jan Vroonhof <vroonhof@math.ethz.ch> July/1996
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 ;; ported the server-temp-file-regexp feature from server.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 ;; ported server hooks from server.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 ;; ported kill-*-query functions from server.el (and made it optional)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 ;; synced other behavior with server.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 ;; Jan Vroonhof
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 ;; Customized.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 ;; Hrvoje Niksic <hniksic@xemacs.org> May/1997
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 ;; Completely rewritten. Now uses `defstruct' and other CL stuff
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 ;; to define clients cleanly. Many thanks to Dave Gillespie!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 ;; Mike Scheidler <c23mts@eng.delcoelect.com> July, 1997
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 ;; Added 'Done' button to the menubar.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 (defgroup gnuserv nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 "The gnuserv suite of programs to talk to Emacs from outside."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 :group 'environment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 :group 'processes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 :group 'terminals)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91
710
a00780ef853d [xemacs-hg @ 2001-12-22 07:20:57 by youngs]
youngs
parents: 462
diff changeset
92 ;;;###autoload
a00780ef853d [xemacs-hg @ 2001-12-22 07:20:57 by youngs]
youngs
parents: 462
diff changeset
93 (defcustom gnuserv-mode-line-string " Server"
a00780ef853d [xemacs-hg @ 2001-12-22 07:20:57 by youngs]
youngs
parents: 462
diff changeset
94 "*String to display in the modeline when Gnuserv is active.
a00780ef853d [xemacs-hg @ 2001-12-22 07:20:57 by youngs]
youngs
parents: 462
diff changeset
95 Set this to nil if you don't want a modeline indicator."
a00780ef853d [xemacs-hg @ 2001-12-22 07:20:57 by youngs]
youngs
parents: 462
diff changeset
96 :type '(choice string
a00780ef853d [xemacs-hg @ 2001-12-22 07:20:57 by youngs]
youngs
parents: 462
diff changeset
97 (const :tag "none" nil))
a00780ef853d [xemacs-hg @ 2001-12-22 07:20:57 by youngs]
youngs
parents: 462
diff changeset
98 :group 'gnuserv)
a00780ef853d [xemacs-hg @ 2001-12-22 07:20:57 by youngs]
youngs
parents: 462
diff changeset
99
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 ;; Provide the old variables as aliases, to avoid breaking .emacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 ;; files. However, they are obsolete and should be converted to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 ;; new forms. This ugly crock must be before the variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 ;; declaration, or the scheme fails.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 (define-obsolete-variable-alias 'server-frame 'gnuserv-frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 (define-obsolete-variable-alias 'server-done-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 'gnuserv-done-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 (define-obsolete-variable-alias 'server-done-temp-file-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 'gnuserv-done-temp-file-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 (define-obsolete-variable-alias 'server-find-file-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 'gnuserv-find-file-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 (define-obsolete-variable-alias 'server-program
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 'gnuserv-program)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 (define-obsolete-variable-alias 'server-visit-hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 'gnuserv-visit-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 (define-obsolete-variable-alias 'server-done-hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 'gnuserv-done-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 (define-obsolete-variable-alias 'server-kill-quietly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 'gnuserv-kill-quietly)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 (define-obsolete-variable-alias 'server-temp-file-regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 'gnuserv-temp-file-regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 (define-obsolete-variable-alias 'server-make-temp-file-backup
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 'gnuserv-make-temp-file-backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 (defcustom gnuserv-frame nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 "*The frame to be used to display all edited files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 If nil, then a new frame is created for each file edited.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 If t, then the currently selected frame will be used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 If a function, then this will be called with a symbol `x' or `tty' as the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 only argument, and its return value will be interpreted as above."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 :tag "Gnuserv Frame"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 :type '(radio (const :tag "Create new frame each time" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 (const :tag "Use selected frame" t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 (function-item :tag "Use main Emacs frame"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 gnuserv-main-frame-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 (function-item :tag "Use visible frame, otherwise create new"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 gnuserv-visible-frame-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 (function-item :tag "Create special Gnuserv frame and use it"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 gnuserv-special-frame-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 (function :tag "Other"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 :group 'gnuserv
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 :group 'frames)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 (defcustom gnuserv-frame-plist nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 "*Plist of frame properties for creating a gnuserv frame."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 :type 'plist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 :group 'gnuserv
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 :group 'frames)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 (defcustom gnuserv-done-function 'kill-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 "*Function used to remove a buffer after editing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 It is called with one BUFFER argument. Functions such as `kill-buffer' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 `bury-buffer' are good values. See also `gnuserv-done-temp-file-function'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 :type '(radio (function-item kill-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 (function-item bury-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 (function :tag "Other"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 :group 'gnuserv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 (defcustom gnuserv-done-temp-file-function 'kill-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 "*Function used to remove a temporary buffer after editing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 It is called with one BUFFER argument. Functions such as `kill-buffer' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 `bury-buffer' are good values. See also `gnuserv-done-temp-file-function'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 :type '(radio (function-item kill-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (function-item bury-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 (function :tag "Other"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 :group 'gnuserv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 (defcustom gnuserv-find-file-function 'find-file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 "*Function to visit a file with.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 It takes one argument, a file name to visit."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 :type 'function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 :group 'gnuserv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 (defcustom gnuserv-view-file-function 'view-file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 "*Function to view a file with.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 It takes one argument, a file name to view."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 :type '(radio (function-item view-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 (function-item find-file-read-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 (function :tag "Other"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 :group 'gnuserv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 (defcustom gnuserv-program "gnuserv"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 "*Program to use as the editing server."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 :type 'string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 :group 'gnuserv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 (defcustom gnuserv-visit-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 "*Hook run after visiting a file."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 :type 'hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 :group 'gnuserv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 (defcustom gnuserv-done-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 "*Hook run when done editing a buffer for the Emacs server.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 The hook functions are called after the file has been visited, with the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 current buffer set to the visiting buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 :type 'hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 :group 'gnuserv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 (defcustom gnuserv-init-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 "*Hook run after the server is started."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 :type 'hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 :group 'gnuserv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 (defcustom gnuserv-shutdown-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 "*Hook run before the server exits."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 :type 'hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 :group 'gnuserv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 (defcustom gnuserv-kill-quietly nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 "*Non-nil means to kill buffers with clients attached without requiring confirmation."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 :group 'gnuserv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 (defcustom gnuserv-temp-file-regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 (concat "^" (temp-directory) "/Re\\|/draft$")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 "*Regexp which should match filenames of temporary files deleted
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 and reused by the programs that invoke the Emacs server."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 :type 'regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 :group 'gnuserv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 (defcustom gnuserv-make-temp-file-backup nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 "*Non-nil makes the server backup temporary files also."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 :group 'gnuserv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 ;;; Internal variables:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 (defstruct gnuclient
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 "An object that encompasses several buffers in one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 Normally, a client connecting to Emacs will be assigned an id, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 will request editing of several files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 ID - Client id (integer).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 BUFFERS - List of buffers that \"belong\" to the client.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 NOTE: one buffer can belong to several clients.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 DEVICE - The device this client is on. If the device was also created.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 by a client, it will be placed to `gnuserv-devices' list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 FRAME - Frame created by the client, or nil if the client didn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 create a frame.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 All the slots default to nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 (id nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 (buffers nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 (device nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 (frame nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 (defvar gnuserv-process nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 "The current gnuserv process.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 (defvar gnuserv-string ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 "The last input string from the server.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 (defvar gnuserv-current-client nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 "The client we are currently talking to.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 (defvar gnuserv-clients nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 "List of current gnuserv clients.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 Each element is a gnuclient structure that identifies a client.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 (defvar gnuserv-devices nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 "List of devices created by clients.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 (defvar gnuserv-special-frame nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 "Frame created specially for Server.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 ;; We want the client-infested buffers to have some modeline
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 ;; identification, so we'll make a "minor mode".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 (defvar gnuserv-minor-mode nil)
710
a00780ef853d [xemacs-hg @ 2001-12-22 07:20:57 by youngs]
youngs
parents: 462
diff changeset
272 (make-variable-buffer-local 'gnuserv-minor-mode)
a00780ef853d [xemacs-hg @ 2001-12-22 07:20:57 by youngs]
youngs
parents: 462
diff changeset
273 ;;(pushnew '(gnuserv-minor-mode "Server") minor-mode-alist
a00780ef853d [xemacs-hg @ 2001-12-22 07:20:57 by youngs]
youngs
parents: 462
diff changeset
274 ;; :test 'equal)
a00780ef853d [xemacs-hg @ 2001-12-22 07:20:57 by youngs]
youngs
parents: 462
diff changeset
275 (add-minor-mode 'gnuserv-minor-mode 'gnuserv-mode-line-string)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 ;; Sample gnuserv-frame functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 (defun gnuserv-main-frame-function (type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 "Return a sensible value for the main Emacs frame."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 (if (or (eq type 'x)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 456
diff changeset
283 (eq type 'gtk)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 (eq type 'mswindows))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (car (frame-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 (defun gnuserv-visible-frame-function (type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 "Return a frame if there is a frame that is truly visible, nil otherwise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 This is meant in the X sense, so it will not return frames that are on another
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 visual screen. Totally visible frames are preferred. If none found, return nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 (if (or (eq type 'x)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 456
diff changeset
293 (eq type 'gtk)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 (eq type 'mswindows))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (cond ((car (filtered-frame-list 'frame-totally-visible-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 (selected-device))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 ((car (filtered-frame-list (lambda (frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 ;; eq t as in not 'hidden
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 (eq t (frame-visible-p frame)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 (selected-device)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 (defun gnuserv-special-frame-function (type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 "Create a special frame for Gnuserv and return it on later invocations."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (unless (frame-live-p gnuserv-special-frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 (setq gnuserv-special-frame (make-frame gnuserv-frame-plist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 gnuserv-special-frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 ;;; Communication functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 ;; We used to restart the server here, but it's too risky -- if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 ;; something goes awry, it's too easy to wind up in a loop.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 (defun gnuserv-sentinel (proc msg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (let ((msgstring (concat "Gnuserv process %s; restart with `%s'"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (keystring (substitute-command-keys "\\[gnuserv-start]")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (case (process-status proc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 (exit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 (message msgstring "exited" keystring)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 (gnuserv-prepare-shutdown))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 (signal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 (message msgstring "killed" keystring)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 (gnuserv-prepare-shutdown))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 (closed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 (message msgstring "closed" keystring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 (gnuserv-prepare-shutdown))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 ;; This function reads client requests from our current server. Every
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 ;; client is identified by a unique ID within the server
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 ;; (incidentally, the same ID is the file descriptor the server uses
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 ;; to communicate to client).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 ;; The request string can arrive in several chunks. As the request
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 ;; ends with \C-d, we check for that character at the end of string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 ;; If not found, keep reading, and concatenating to former strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 ;; So, if at first read we receive "5 (gn", that text will be stored
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 ;; to gnuserv-string. If we then receive "us)\C-d", the two will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 ;; concatenated, `current-client' will be set to 5, and `(gnus)' form
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 ;; will be evaluated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 ;; Server will send the following:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 ;; "ID <text>\C-d" (no quotes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 ;; ID - file descriptor of the given client;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 ;; <text> - the actual contents of the request.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (defun gnuserv-process-filter (proc string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 "Process gnuserv client requests to execute Emacs commands."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (setq gnuserv-string (concat gnuserv-string string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 ;; C-d means end of request.
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 434
diff changeset
351 (when (string-match "\C-d\n?\\'" gnuserv-string)
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 434
diff changeset
352 (cond ((string-match "\\`[0-9]+" gnuserv-string) ; client request id
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 (let ((header (read-from-string gnuserv-string)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 ;; Set the client we are talking to.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 (setq gnuserv-current-client (car header))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 ;; Evaluate the expression
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (condition-case oops
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 (eval (car (read-from-string gnuserv-string (cdr header))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 ;; In case of an error, write the description to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 ;; client, and then signal it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (error (setq gnuserv-string "")
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
362 (when gnuserv-current-client
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
363 (gnuserv-write-to-client gnuserv-current-client oops))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 (setq gnuserv-current-client nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 (signal (car oops) (cdr oops)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 (quit (setq gnuserv-string "")
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
367 (when gnuserv-current-client
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
368 (gnuserv-write-to-client gnuserv-current-client oops))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 (setq gnuserv-current-client nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (signal 'quit nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 (setq gnuserv-string "")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 (t
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 434
diff changeset
373 (let ((response (car (split-string gnuserv-string "\C-d"))))
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 434
diff changeset
374 (setq gnuserv-string "")
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 434
diff changeset
375 (error "%s: invalid response from gnuserv" response))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 ;; This function is somewhat of a misnomer. Actually, we write to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 ;; server (using `process-send-string' to gnuserv-process), which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 ;; interprets what we say and forwards it to the client. The
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 ;; incantation server understands is (from gnuserv.c):
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 ;; "FD/LEN:<text>\n" (no quotes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 ;; FD - file descriptor of the given client (which we obtained from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 ;; the server earlier);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 ;; LEN - length of the stuff we are about to send;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 ;; <text> - the actual contents of the request.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 (defun gnuserv-write-to-client (client-id form)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 "Write the given form to the given client via the gnuserv process."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 (when (eq (process-status gnuserv-process) 'run)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 (let* ((result (format "%s" form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 (s (format "%s/%d:%s\n" client-id
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 (length result) result)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 (process-send-string gnuserv-process s))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 ;; The following two functions are helper functions, used by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 ;; gnuclient.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (defun gnuserv-eval (form)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 "Evaluate form and return result to client."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (gnuserv-write-to-client gnuserv-current-client (eval form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (setq gnuserv-current-client nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (defun gnuserv-eval-quickly (form)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 "Let client know that we've received the request, and then eval the form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 This order is important as not to keep the client waiting."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 (gnuserv-write-to-client gnuserv-current-client nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 (setq gnuserv-current-client nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 (eval form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 ;; "Execute" a client connection, called by gnuclient. This is the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 ;; backbone of gnuserv.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 (defun gnuserv-edit-files (type list &rest flags)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 "For each (line-number . file) pair in LIST, edit the file at line-number.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 The visited buffers are memorized, so that when \\[gnuserv-edit] is invoked
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 in such a buffer, or when it is killed, or the client's device deleted, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 client will be invoked that the edit is finished.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 TYPE should either be a (tty TTY TERM PID) list, or (x DISPLAY) list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 If a flag is `quick', just edit the files in Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 If a flag is `view', view the files read-only."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 (let (quick view)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 (mapc (lambda (flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 (case flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 (quick (setq quick t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 (view (setq view t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 (t (error "Invalid flag %s" flag))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 flags)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 (let* ((old-device-num (length (device-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 (new-frame nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 (dest-frame (if (functionp gnuserv-frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 (funcall gnuserv-frame (car type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 gnuserv-frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 ;; The gnuserv-frame dependencies are ugly, but it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 ;; extremely hard to make that stuff cleaner without
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 ;; breaking everything in sight.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (device (cond ((frame-live-p dest-frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 (frame-device dest-frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 ((null dest-frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 (case (car type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 (tty (apply 'make-tty-device (cdr type)))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 456
diff changeset
442 (gtk (make-gtk-device))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 (x (make-x-device (cadr type)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 (mswindows (make-mswindows-device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 (t (error "Invalid device type"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 (selected-device))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 (frame (cond ((frame-live-p dest-frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 dest-frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 ((null dest-frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 (setq new-frame (make-frame gnuserv-frame-plist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 new-frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 (t (selected-frame))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 (client (make-gnuclient :id gnuserv-current-client
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 :device device
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 :frame new-frame)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 (select-frame frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 (setq gnuserv-current-client nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 ;; If the device was created by this client, push it to the list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 (and (/= old-device-num (length (device-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 (push device gnuserv-devices))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 (and (frame-iconified-p frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 (deiconify-frame frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 ;; Visit all the listed files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 (while list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (let ((line (caar list)) (path (cdar list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 (select-frame frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 ;; Visit the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 (funcall (if view
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 gnuserv-view-file-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 gnuserv-find-file-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 (goto-line line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 ;; Don't memorize the quick and view buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 (unless (or quick view)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 (pushnew (current-buffer) (gnuclient-buffers client))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 (setq gnuserv-minor-mode t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 ;; Add the "Done" button to the menubar, only in this buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 (if (and (featurep 'menubar) current-menubar)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 (progn (set-buffer-menubar current-menubar)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 (add-menu-button nil ["Done" gnuserv-edit]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 (run-hooks 'gnuserv-visit-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 (pop list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 ((and (or quick view)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 (device-on-window-system-p device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 ;; Exit if on X device, and quick or view. NOTE: if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 ;; client is to finish now, it must absolutely /not/ be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 ;; included to the list of clients. This way the client-ids
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 ;; should be unique.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 (gnuserv-write-to-client (gnuclient-id client) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 ;; Else, the client gets a vote.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 (push client gnuserv-clients)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 ;; Explain buffer exit options. If dest-frame is nil, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 ;; user can exit via `delete-frame'. OTOH, if FLAGS are nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 ;; and there are some buffers, the user can exit via
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 ;; `gnuserv-edit'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 (if (and (not (or quick view))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 (gnuclient-buffers client))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 (message "%s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 (substitute-command-keys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 "Type `\\[gnuserv-edit]' to finish editing"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 (or dest-frame
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 (message "%s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 (substitute-command-keys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 "Type `\\[delete-frame]' to finish editing")))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 ;;; Functions that hook into Emacs in various way to enable operation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 ;; Defined later.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 (add-hook 'kill-emacs-hook 'gnuserv-kill-all-clients t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 ;; A helper function; used by others. Try avoiding it whenever
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 ;; possible, because it is slow, and conses a list. Use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 ;; `gnuserv-buffer-p' when appropriate, for instance.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 (defun gnuserv-buffer-clients (buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 "Return a list of clients to which BUFFER belongs."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 (let (res)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 (dolist (client gnuserv-clients)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 (when (memq buffer (gnuclient-buffers client))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 (push client res)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 res))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 ;; Like `gnuserv-buffer-clients', but returns a boolean; doesn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 ;; collect a list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 (defun gnuserv-buffer-p (buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 (member* buffer gnuserv-clients
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 :test 'memq
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 :key 'gnuclient-buffers))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 ;; This function makes sure that a killed buffer is deleted off the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 ;; list for the particular client.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 ;; This hooks into `kill-buffer-hook'. It is *not* a replacement for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 ;; `kill-buffer' (thanks God).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 (defun gnuserv-kill-buffer-function ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 "Remove the buffer from the buffer lists of all the clients it belongs to.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 Any client that remains \"empty\" after the removal is informed that the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 editing has ended."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 (let* ((buf (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 (dolist (client (gnuserv-buffer-clients buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 (callf2 delq buf (gnuclient-buffers client))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 ;; If no more buffers, kill the client.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 (when (null (gnuclient-buffers client))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 (gnuserv-kill-client client)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 (add-hook 'kill-buffer-hook 'gnuserv-kill-buffer-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 ;; Ask for confirmation before killing a buffer that belongs to a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 ;; living client.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 (defun gnuserv-kill-buffer-query-function ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 (or gnuserv-kill-quietly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 (not (gnuserv-buffer-p (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 (yes-or-no-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 (format "Buffer %s belongs to gnuserv client(s); kill anyway? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 (current-buffer)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 (add-hook 'kill-buffer-query-functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 'gnuserv-kill-buffer-query-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 (defun gnuserv-kill-emacs-query-function ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 (or gnuserv-kill-quietly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 (not (some 'gnuclient-buffers gnuserv-clients))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 (yes-or-no-p "Gnuserv buffers still have clients; exit anyway? ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 (add-hook 'kill-emacs-query-functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 'gnuserv-kill-emacs-query-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 ;; If the device of a client is to be deleted, the client should die
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 ;; as well. This is why we hook into `delete-device-hook'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 (defun gnuserv-check-device (device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 (when (memq device gnuserv-devices)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 (dolist (client gnuserv-clients)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 (when (eq device (gnuclient-device client))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 ;; we must make sure that the server kill doesn't result in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 ;; killing the device, because it would cause a device-dead
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 ;; error when `delete-device' tries to do the job later.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 (gnuserv-kill-client client t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 (callf2 delq device gnuserv-devices))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 (add-hook 'delete-device-hook 'gnuserv-check-device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 (defun gnuserv-temp-file-p (buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 "Return non-nil if BUFFER contains a file considered temporary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 These are files whose names suggest they are repeatedly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 reused to pass information to another program.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 The variable `gnuserv-temp-file-regexp' controls which filenames
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 are considered temporary."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 (and (buffer-file-name buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 (string-match gnuserv-temp-file-regexp (buffer-file-name buffer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 (defun gnuserv-kill-client (client &optional leave-frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 "Kill the gnuclient CLIENT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 This will do away with all the associated buffers. If LEAVE-FRAME,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 the function will not remove the frames associated with the client."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 ;; Order is important: first delete client from gnuserv-clients, to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 ;; prevent gnuserv-buffer-done-1 calling us recursively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 (callf2 delq client gnuserv-clients)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 ;; Process the buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 (mapc 'gnuserv-buffer-done-1 (gnuclient-buffers client))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 (unless leave-frame
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 (let ((device (gnuclient-device client)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 ;; kill frame created by this client (if any), unless
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 ;; specifically requested otherwise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 ;; note: last frame on a device will not be deleted here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 (when (and (gnuclient-frame client)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 (frame-live-p (gnuclient-frame client))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 (second (device-frame-list device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 (delete-frame (gnuclient-frame client)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 ;; If the device is live, created by a client, and no longer used
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 ;; by any client, delete it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 (when (and (device-live-p device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 (memq device gnuserv-devices)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 (second (device-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 (not (member* device gnuserv-clients
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 :key 'gnuclient-device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 ;; `gnuserv-check-device' will remove it from `gnuserv-devices'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 (delete-device device))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 ;; Notify the client.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 (gnuserv-write-to-client (gnuclient-id client) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 ;; Do away with the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 (defun gnuserv-buffer-done-1 (buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 (dolist (client (gnuserv-buffer-clients buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 (callf2 delq buffer (gnuclient-buffers client))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 (when (null (gnuclient-buffers client))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 (gnuserv-kill-client client)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 ;; Get rid of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 (run-hooks 'gnuserv-done-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 (setq gnuserv-minor-mode nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 ;; Delete the menu button.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 (if (and (featurep 'menubar) current-menubar)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 (delete-menu-item '("Done")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 (funcall (if (gnuserv-temp-file-p buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 gnuserv-done-temp-file-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 gnuserv-done-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 ;;; Higher-level functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 ;; Choose a `next' server buffer, according to several criteria, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 ;; return it. If none are found, return nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 (defun gnuserv-next-buffer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 (let* ((frame (selected-frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 (device (selected-device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 client)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 ;; If we have a client belonging to this frame, return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 ;; the first buffer from it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 ((setq client
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 (car (member* frame gnuserv-clients :key 'gnuclient-frame)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 (car (gnuclient-buffers client)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 ;; Else, look for a device.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 ((and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 (memq (selected-device) gnuserv-devices)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 (setq client
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 (car (member* device gnuserv-clients :key 'gnuclient-device))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 (car (gnuclient-buffers client)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 ;; Else, try to find any client with at least one buffer, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 ;; return its first buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 ((setq client
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 (car (member-if-not #'null gnuserv-clients
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 :key 'gnuclient-buffers)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 (car (gnuclient-buffers client)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 ;; Oh, give up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 (t nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 (defun gnuserv-buffer-done (buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 "Mark BUFFER as \"done\" for its client(s).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 Does the save/backup queries first, and calls `gnuserv-done-function'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 ;; Check whether this is the real thing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 (unless (gnuserv-buffer-p buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 (error "%s does not belong to a gnuserv client" buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 ;; Backup/ask query.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 (if (gnuserv-temp-file-p buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 ;; For a temp file, save, and do NOT make a non-numeric backup
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 ;; Why does server.el explicitly back up temporary files?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 (let ((version-control nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 (buffer-backed-up (not gnuserv-make-temp-file-backup)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 (save-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 (if (and (buffer-modified-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 (y-or-n-p (concat "Save file " buffer-file-name "? ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 (save-buffer buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 (gnuserv-buffer-done-1 buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 ;; Called by `gnuserv-start-1' to clean everything. Hooked into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 ;; `kill-emacs-hook', too.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 (defun gnuserv-kill-all-clients ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 "Kill all the gnuserv clients. Ruthlessly."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 (mapc 'gnuserv-kill-client gnuserv-clients))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 ;; This serves to run the hook and reset
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 ;; `allow-deletion-of-last-visible-frame'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 (defun gnuserv-prepare-shutdown ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 (setq allow-deletion-of-last-visible-frame nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 (run-hooks 'gnuserv-shutdown-hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 ;; This is a user-callable function, too.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 (defun gnuserv-shutdown ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 "Shutdown the gnuserv server, if one is currently running.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 All the clients will be disposed of via the normal methods."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 (gnuserv-kill-all-clients)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 (when gnuserv-process
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 (set-process-sentinel gnuserv-process nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 (gnuserv-prepare-shutdown)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 (delete-process gnuserv-process)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 (error nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 (setq gnuserv-process nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 ;; Actually start the process. Kills all the clients before-hand.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 (defun gnuserv-start-1 (&optional leave-dead)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 ;; Shutdown the existing server, if any.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 (gnuserv-shutdown)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 ;; If we already had a server, clear out associated status.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 (unless leave-dead
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 (setq gnuserv-string ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 gnuserv-current-client nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 (let ((process-connection-type t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 (setq gnuserv-process
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 (start-process "gnuserv" nil gnuserv-program)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 (set-process-sentinel gnuserv-process 'gnuserv-sentinel)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 (set-process-filter gnuserv-process 'gnuserv-process-filter)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 (process-kill-without-query gnuserv-process)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 (setq allow-deletion-of-last-visible-frame t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 (run-hooks 'gnuserv-init-hook)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 ;;; User-callable functions:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 (defun gnuserv-running-p ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 "Return non-nil if a gnuserv process is running from this XEmacs session."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 (not (not gnuserv-process)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 (defun gnuserv-start (&optional leave-dead)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 "Allow this Emacs process to be a server for client processes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 This starts a gnuserv communications subprocess through which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 client \"editors\" (gnuclient and gnudoit) can send editing commands to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 this Emacs job. See the gnuserv(1) manual page for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 Prefix arg means just kill any existing server communications subprocess."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 (and gnuserv-process
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 (not leave-dead)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 (message "Restarting gnuserv"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 (gnuserv-start-1 leave-dead))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 (defun gnuserv-edit (&optional count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 "Mark the current gnuserv editing buffer as \"done\", and switch to next one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 Run with a numeric prefix argument, repeat the operation that number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 of times. If given a universal prefix argument, close all the buffers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 of this buffer's clients.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 The `gnuserv-done-function' (bound to `kill-buffer' by default) is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 called to dispose of the buffer after marking it as done.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 Files that match `gnuserv-temp-file-regexp' are considered temporary and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 are saved unconditionally and backed up if `gnuserv-make-temp-file-backup'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 is non-nil. They are disposed of using `gnuserv-done-temp-file-function'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 \(also bound to `kill-buffer' by default).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 When all of a client's buffers are marked as \"done\", the client is notified."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 (when (null count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 (setq count 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 (cond ((numberp count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 (while (natnump (decf count))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 (let ((frame (selected-frame)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 (gnuserv-buffer-done (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 (when (eq frame (selected-frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 ;; Switch to the next gnuserv buffer. However, do this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 ;; only if we remain in the same frame.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 (let ((next (gnuserv-next-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 (when next
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 (switch-to-buffer next)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 (count
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 (let* ((buf (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 (clients (gnuserv-buffer-clients buf)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 (unless clients
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 (error "%s does not belong to a gnuserv client" buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 (mapc 'gnuserv-kill-client (gnuserv-buffer-clients buf))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 (global-set-key "\C-x#" 'gnuserv-edit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 (provide 'gnuserv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 ;;; gnuserv.el ends here