Mercurial > hg > xemacs-beta
annotate lisp/gnuserv.el @ 5882:bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
lisp/ChangeLog addition:
2015-04-01 Aidan Kehoe <kehoea@parhasard.net>
When calling #'string-match with a REGEXP without regular
expression special characters, call #'search, #'mismatch, #'find,
etc. instead, making our code less likely to side-effect other
functions' match data and a little faster.
* apropos.el (apropos-command):
* apropos.el (apropos):
Call (position ?\n ...) rather than (string-match "\n" ...) here.
* buff-menu.el:
* buff-menu.el (buffers-menu-omit-invisible-buffers):
Don't fire up the regexp engine just to check if a string starts
with a space.
* buff-menu.el (select-buffers-tab-buffers-by-mode):
Don't fire up the regexp engine just to compare mode basenames.
* buff-menu.el (format-buffers-tab-line):
* buff-menu.el (build-buffers-tab-internal): Moved to being a
label within the following.
* buff-menu.el (buffers-tab-items): Use the label.
* bytecomp.el (byte-compile-log-1):
Don't fire up the regexp engine just to look for a newline.
* cus-edit.el (get):
Ditto.
* cus-edit.el (custom-variable-value-create):
Ditto, but for a colon.
* descr-text.el (describe-text-sexp):
Ditto.
* descr-text.el (describe-char-unicode-data):
Use #'split-string-by-char given that we're just looking for a
semicolon.
* descr-text.el (describe-char):
Don't fire up the regexp engine just to look for a newline.
* disass.el (disassemble-internal):
Ditto.
* files.el (file-name-sans-extension):
Implement this using #'position.
* files.el (file-name-extension):
Correct this function's docstring, implement it in terms of
#'position.
* files.el (insert-directory):
Don't fire up the regexp engine to split a string by space; don't
reverse the list of switches, this is actually a longstand bug as
far as I can see.
* gnuserv.el (gnuserv-process-filter):
Use #'position here, instead of consing inside #'split-string
needlessly.
* gtk-file-dialog.el (gtk-file-dialog-update-dropdown):
Use #'split-string-by-char here, don't fire up #'split-string for
directory-sep-char.
* gtk-font-menu.el (hack-font-truename):
Implement this more cheaply in terms of #'find,
#'split-string-by-char, #'equal, rather than #'string-match,
#'split-string, #'string-equal.
* hyper-apropos.el (hyper-apropos-grok-functions):
* hyper-apropos.el (hyper-apropos-grok-variables):
Look for a newline using #'position rather than #'string-match in
these functions.
* info.el (Info-insert-dir):
* info.el (Info-insert-file-contents):
* info.el (Info-follow-reference):
* info.el (Info-extract-menu-node-name):
* info.el (Info-menu):
Look for fixed strings using #'position or #'search as appropriate
in this file.
* ldap.el (ldap-decode-string):
* ldap.el (ldap-encode-string):
#'encode-coding-string, #'decode-coding-string are always
available, don't check if they're fboundp.
* ldap.el (ldap-decode-address):
* ldap.el (ldap-encode-address):
Use #'split-string-by-char in these functions.
* lisp-mnt.el (lm-creation-date):
* lisp-mnt.el (lm-last-modified-date):
Don't fire up the regexp engine just to look for spaces in this file.
* menubar-items.el (default-menubar):
Use (not (mismatch ...)) rather than #'string-match here, for
simple regexp.
Use (search "beta" ...) rather than (string-match "beta" ...)
* menubar-items.el (sort-buffers-menu-alphabetically):
* menubar-items.el (sort-buffers-menu-by-mode-then-alphabetically):
* menubar-items.el (group-buffers-menu-by-mode-then-alphabetically):
Don't fire up the regexp engine to check if a string starts with
a space or an asterisk.
Use the more fine-grained results of #'compare-strings; compare
case-insensitively for the buffer menu.
* menubar-items.el (list-all-buffers):
* menubar-items.el (tutorials-menu-filter):
Use #'equal rather than #'string-equal, which, in this context,
has the drawback of not having a bytecode, and no redeeming
features.
* minibuf.el:
* minibuf.el (un-substitute-in-file-name):
Use #'count, rather than counting the occurences of $ using the
regexp engine.
* minibuf.el (read-file-name-internal-1):
Don't fire up the regexp engine to search for ?=.
* mouse.el (mouse-eval-sexp):
Check for newline with #'find.
* msw-font-menu.el (mswindows-reset-device-font-menus):
Split a string by newline with #'split-string-by-char.
* mule/japanese.el:
* mule/japanese.el ("Japanese"):
Use #'search rather than #'string-match; canoncase before
comparing; fix a bug I had introduced where I had been making case
insensitive comparisons where the case mattered.
* mule/korea-util.el (default-korean-keyboard):
Look for ?3 using #'find, not #'string-march.
* mule/korea-util.el (quail-hangul-switch-hanja):
Search for a fixed string using #'search.
* mule/mule-cmds.el (set-locale-for-language-environment):
#'position, #'substitute rather than #'string-match,
#'replace-in-string.
* newcomment.el (comment-make-extra-lines):
Use #'search rather than #'string-match for a simple string.
* package-get.el (package-get-remote-filename):
Use #'position when looking for ?@
* process.el (setenv):
* process.el (read-envvar-name):
Use #'position when looking for ?=.
* replace.el (map-query-replace-regexp):
Use #'split-string-by-char instead of using an inline
implementation of it.
* select.el (select-convert-from-cf-text):
* select.el (select-convert-from-cf-unicodetext):
Use #'position rather than #'string-match in these functions.
* setup-paths.el (paths-emacs-data-root-p):
Use #'search when looking for simple string.
* sound.el (load-sound-file):
Use #'split-string-by-char rather than an inline reimplementation
of same.
* startup.el (splash-screen-window-body):
* startup.el (splash-screen-tty-body):
Search for simple strings using #'search.
* version.el (emacs-version):
Ditto.
* x-font-menu.el (hack-font-truename):
Implement this more cheaply in terms of #'find,
#'split-string-by-char, #'equal, rather than #'string-match,
#'split-string, #'string-equal.
* x-font-menu.el (x-reset-device-font-menus-core):
Use #'split-string-by-char here.
* x-init.el (x-initialize-keyboard):
Search for a simple string using #'search.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 01 Apr 2015 14:28:20 +0100 |
| parents | cc6f0266bc36 |
| children | 5a93f519accc |
| rev | line source |
|---|---|
| 428 | 1 ;;; gnuserv.el --- Lisp interface code between Emacs and gnuserv |
| 2 ;; Copyright (C) 1989-1997 Free Software Foundation, Inc. | |
| 3 | |
| 456 | 4 ;; Version: 3.12 |
| 428 | 5 ;; Author: Andy Norman (ange@hplb.hpl.hp.com), originally based on server.el |
| 6 ;; Hrvoje Niksic <hniksic@xemacs.org> | |
| 7 ;; Maintainer: Jan Vroonhof <vroonhof@math.ethz.ch>, | |
| 8 ;; Hrvoje Niksic <hniksic@xemacs.org> | |
| 9 ;; Keywords: environment, processes, terminals | |
| 10 | |
| 11 ;; This file is part of XEmacs. | |
| 12 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4866
diff
changeset
|
13 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4866
diff
changeset
|
14 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4866
diff
changeset
|
15 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4866
diff
changeset
|
16 ;; option) any later version. |
| 428 | 17 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4866
diff
changeset
|
18 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4866
diff
changeset
|
19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4866
diff
changeset
|
20 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4866
diff
changeset
|
21 ;; for more details. |
| 428 | 22 |
| 23 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4866
diff
changeset
|
24 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 25 |
| 26 ;;; Synched up with: Not in FSF. | |
| 27 | |
| 28 ;;; Commentary: | |
| 29 | |
| 30 ;; Gnuserv is run when Emacs needs to operate as a server for other | |
| 31 ;; processes. Specifically, any number of files can be attached for | |
| 32 ;; editing to a running XEmacs process using the `gnuclient' program. | |
| 33 | |
| 34 ;; Use `M-x gnuserv-start' to start the server and `gnuclient files' | |
| 35 ;; to load them to XEmacs. When you are done with a buffer, press | |
| 36 ;; `C-x #' (`M-x gnuserv-edit'). You can put (gnuserv-start) to your | |
| 37 ;; .emacs, and enable `gnuclient' as your Unix "editor". When all the | |
| 38 ;; buffers for a client have been edited and exited with | |
| 39 ;; `gnuserv-edit', the client "editor" will return to the program that | |
| 40 ;; invoked it. | |
| 41 | |
| 42 ;; Your editing commands and Emacs' display output go to and from the | |
| 43 ;; terminal or X display in the usual way. If you are running under | |
| 44 ;; X, a new X frame will be open for each gnuclient. If you are on a | |
| 45 ;; TTY, this TTY will be attached as a new device to the running | |
| 46 ;; XEmacs, and will be removed once you are done with the buffer. | |
| 47 | |
| 48 ;; To evaluate a Lisp form in a running Emacs, use the `-eval' | |
| 49 ;; argument of gnuclient. To simplify this, we provide the `gnudoit' | |
| 50 ;; shell script. For example `gnudoit "(+ 2 3)"' will print `5', | |
| 51 ;; whereas `gnudoit "(gnus)"' will fire up your favorite newsreader. | |
| 52 ;; Like gnuclient, `gnudoit' requires the server to be started prior | |
| 53 ;; to using it. | |
| 54 | |
| 55 ;; For more information you can refer to man pages of gnuclient, | |
| 56 ;; gnudoit and gnuserv, distributed with XEmacs. | |
| 57 | |
| 58 ;; gnuserv.el was originally written by Andy Norman as an improvement | |
| 59 ;; over William Sommerfeld's server.el. Since then, a number of | |
| 60 ;; people have worked on it, including Bob Weiner, Darell Kindred, | |
| 61 ;; Arup Mukherjee, Ben Wing and Jan Vroonhof. It was completely | |
| 62 ;; rewritten (labeled as version 3) by Hrvoje Niksic in May 1997. The | |
| 63 ;; new code will not run on GNU Emacs. | |
| 64 | |
| 65 ;; Jan Vroonhof <vroonhof@math.ethz.ch> July/1996 | |
| 66 ;; ported the server-temp-file-regexp feature from server.el | |
| 67 ;; ported server hooks from server.el | |
| 68 ;; ported kill-*-query functions from server.el (and made it optional) | |
| 69 ;; synced other behavior with server.el | |
| 70 ;; | |
| 71 ;; Jan Vroonhof | |
| 72 ;; Customized. | |
| 73 ;; | |
| 74 ;; Hrvoje Niksic <hniksic@xemacs.org> May/1997 | |
| 75 ;; Completely rewritten. Now uses `defstruct' and other CL stuff | |
| 76 ;; to define clients cleanly. Many thanks to Dave Gillespie! | |
| 77 ;; | |
| 78 ;; Mike Scheidler <c23mts@eng.delcoelect.com> July, 1997 | |
| 79 ;; Added 'Done' button to the menubar. | |
| 80 | |
| 81 | |
| 82 ;;; Code: | |
| 83 | |
| 84 (defgroup gnuserv nil | |
| 85 "The gnuserv suite of programs to talk to Emacs from outside." | |
| 86 :group 'environment | |
| 87 :group 'processes | |
| 88 :group 'terminals) | |
| 89 | |
| 710 | 90 ;;;###autoload |
| 91 (defcustom gnuserv-mode-line-string " Server" | |
| 92 "*String to display in the modeline when Gnuserv is active. | |
| 93 Set this to nil if you don't want a modeline indicator." | |
| 94 :type '(choice string | |
| 95 (const :tag "none" nil)) | |
| 96 :group 'gnuserv) | |
| 97 | |
| 428 | 98 |
| 99 ;; Provide the old variables as aliases, to avoid breaking .emacs | |
| 100 ;; files. However, they are obsolete and should be converted to the | |
| 101 ;; new forms. This ugly crock must be before the variable | |
| 102 ;; declaration, or the scheme fails. | |
| 103 | |
| 104 (define-obsolete-variable-alias 'server-frame 'gnuserv-frame) | |
| 105 (define-obsolete-variable-alias 'server-done-function | |
| 106 'gnuserv-done-function) | |
| 107 (define-obsolete-variable-alias 'server-done-temp-file-function | |
| 108 'gnuserv-done-temp-file-function) | |
| 109 (define-obsolete-variable-alias 'server-find-file-function | |
| 110 'gnuserv-find-file-function) | |
| 111 (define-obsolete-variable-alias 'server-program | |
| 112 'gnuserv-program) | |
| 113 (define-obsolete-variable-alias 'server-visit-hook | |
| 114 'gnuserv-visit-hook) | |
| 115 (define-obsolete-variable-alias 'server-done-hook | |
| 116 'gnuserv-done-hook) | |
| 117 (define-obsolete-variable-alias 'server-kill-quietly | |
| 118 'gnuserv-kill-quietly) | |
| 119 (define-obsolete-variable-alias 'server-temp-file-regexp | |
| 120 'gnuserv-temp-file-regexp) | |
| 121 (define-obsolete-variable-alias 'server-make-temp-file-backup | |
| 122 'gnuserv-make-temp-file-backup) | |
| 123 | |
| 124 ;;;###autoload | |
| 125 (defcustom gnuserv-frame nil | |
| 126 "*The frame to be used to display all edited files. | |
| 127 If nil, then a new frame is created for each file edited. | |
| 128 If t, then the currently selected frame will be used. | |
| 129 If a function, then this will be called with a symbol `x' or `tty' as the | |
| 130 only argument, and its return value will be interpreted as above." | |
| 131 :tag "Gnuserv Frame" | |
| 132 :type '(radio (const :tag "Create new frame each time" nil) | |
| 133 (const :tag "Use selected frame" t) | |
| 134 (function-item :tag "Use main Emacs frame" | |
| 135 gnuserv-main-frame-function) | |
| 136 (function-item :tag "Use visible frame, otherwise create new" | |
| 137 gnuserv-visible-frame-function) | |
| 138 (function-item :tag "Create special Gnuserv frame and use it" | |
| 139 gnuserv-special-frame-function) | |
| 140 (function :tag "Other")) | |
| 141 :group 'gnuserv | |
| 142 :group 'frames) | |
| 143 | |
| 144 (defcustom gnuserv-frame-plist nil | |
| 145 "*Plist of frame properties for creating a gnuserv frame." | |
| 146 :type 'plist | |
| 147 :group 'gnuserv | |
| 148 :group 'frames) | |
| 149 | |
| 150 (defcustom gnuserv-done-function 'kill-buffer | |
| 151 "*Function used to remove a buffer after editing. | |
| 152 It is called with one BUFFER argument. Functions such as `kill-buffer' and | |
| 153 `bury-buffer' are good values. See also `gnuserv-done-temp-file-function'." | |
| 154 :type '(radio (function-item kill-buffer) | |
| 155 (function-item bury-buffer) | |
| 156 (function :tag "Other")) | |
| 157 :group 'gnuserv) | |
| 158 | |
| 159 (defcustom gnuserv-done-temp-file-function 'kill-buffer | |
| 160 "*Function used to remove a temporary buffer after editing. | |
| 161 It is called with one BUFFER argument. Functions such as `kill-buffer' and | |
| 162 `bury-buffer' are good values. See also `gnuserv-done-temp-file-function'." | |
| 163 :type '(radio (function-item kill-buffer) | |
| 164 (function-item bury-buffer) | |
| 165 (function :tag "Other")) | |
| 166 :group 'gnuserv) | |
| 167 | |
| 168 (defcustom gnuserv-find-file-function 'find-file | |
| 169 "*Function to visit a file with. | |
| 170 It takes one argument, a file name to visit." | |
| 171 :type 'function | |
| 172 :group 'gnuserv) | |
| 173 | |
| 174 (defcustom gnuserv-view-file-function 'view-file | |
| 175 "*Function to view a file with. | |
| 176 It takes one argument, a file name to view." | |
| 177 :type '(radio (function-item view-file) | |
| 178 (function-item find-file-read-only) | |
| 179 (function :tag "Other")) | |
| 180 :group 'gnuserv) | |
| 181 | |
|
4866
8b7644c73fd2
Specifically look for gnuserv in `exec-directory'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4684
diff
changeset
|
182 (defcustom gnuserv-program (expand-file-name "gnuserv" exec-directory) |
| 428 | 183 "*Program to use as the editing server." |
| 184 :type 'string | |
| 185 :group 'gnuserv) | |
| 186 | |
| 187 (defcustom gnuserv-visit-hook nil | |
| 188 "*Hook run after visiting a file." | |
| 189 :type 'hook | |
| 190 :group 'gnuserv) | |
| 191 | |
| 192 (defcustom gnuserv-done-hook nil | |
| 193 "*Hook run when done editing a buffer for the Emacs server. | |
| 194 The hook functions are called after the file has been visited, with the | |
| 195 current buffer set to the visiting buffer." | |
| 196 :type 'hook | |
| 197 :group 'gnuserv) | |
| 198 | |
| 199 (defcustom gnuserv-init-hook nil | |
| 200 "*Hook run after the server is started." | |
| 201 :type 'hook | |
| 202 :group 'gnuserv) | |
| 203 | |
| 204 (defcustom gnuserv-shutdown-hook nil | |
| 205 "*Hook run before the server exits." | |
| 206 :type 'hook | |
| 207 :group 'gnuserv) | |
| 208 | |
| 209 (defcustom gnuserv-kill-quietly nil | |
| 210 "*Non-nil means to kill buffers with clients attached without requiring confirmation." | |
| 211 :type 'boolean | |
| 212 :group 'gnuserv) | |
| 213 | |
| 214 (defcustom gnuserv-temp-file-regexp | |
|
4436
a72dc882abf1
Quote temp-directory regexp in gnuserv.
Mike Sperber <sperber@deinprogramm.de>
parents:
2437
diff
changeset
|
215 (concat "^" (regexp-quote (temp-directory)) "/Re\\|/draft$") |
| 428 | 216 "*Regexp which should match filenames of temporary files deleted |
| 217 and reused by the programs that invoke the Emacs server." | |
| 218 :type 'regexp | |
| 219 :group 'gnuserv) | |
| 220 | |
| 221 (defcustom gnuserv-make-temp-file-backup nil | |
| 222 "*Non-nil makes the server backup temporary files also." | |
| 223 :type 'boolean | |
| 224 :group 'gnuserv) | |
| 225 | |
| 226 | |
| 227 ;;; Internal variables: | |
| 228 | |
| 229 (defstruct gnuclient | |
| 230 "An object that encompasses several buffers in one. | |
| 231 Normally, a client connecting to Emacs will be assigned an id, and | |
| 232 will request editing of several files. | |
| 233 | |
| 234 ID - Client id (integer). | |
| 235 BUFFERS - List of buffers that \"belong\" to the client. | |
| 236 NOTE: one buffer can belong to several clients. | |
| 237 DEVICE - The device this client is on. If the device was also created. | |
| 238 by a client, it will be placed to `gnuserv-devices' list. | |
| 239 FRAME - Frame created by the client, or nil if the client didn't | |
| 240 create a frame. | |
| 241 | |
| 242 All the slots default to nil." | |
| 243 (id nil) | |
| 244 (buffers nil) | |
| 245 (device nil) | |
| 246 (frame nil)) | |
| 247 | |
| 248 (defvar gnuserv-process nil | |
| 249 "The current gnuserv process.") | |
| 250 | |
| 251 (defvar gnuserv-string "" | |
| 252 "The last input string from the server.") | |
| 253 | |
| 254 (defvar gnuserv-current-client nil | |
| 255 "The client we are currently talking to.") | |
| 256 | |
| 257 (defvar gnuserv-clients nil | |
| 258 "List of current gnuserv clients. | |
| 259 Each element is a gnuclient structure that identifies a client.") | |
| 260 | |
| 261 (defvar gnuserv-devices nil | |
| 262 "List of devices created by clients.") | |
| 263 | |
| 264 (defvar gnuserv-special-frame nil | |
| 265 "Frame created specially for Server.") | |
| 266 | |
| 267 ;; We want the client-infested buffers to have some modeline | |
| 268 ;; identification, so we'll make a "minor mode". | |
| 269 (defvar gnuserv-minor-mode nil) | |
| 710 | 270 (make-variable-buffer-local 'gnuserv-minor-mode) |
| 271 ;;(pushnew '(gnuserv-minor-mode "Server") minor-mode-alist | |
| 272 ;; :test 'equal) | |
| 273 (add-minor-mode 'gnuserv-minor-mode 'gnuserv-mode-line-string) | |
| 428 | 274 |
| 275 | |
| 276 ;; Sample gnuserv-frame functions | |
| 277 | |
| 278 (defun gnuserv-main-frame-function (type) | |
| 279 "Return a sensible value for the main Emacs frame." | |
| 280 (if (or (eq type 'x) | |
| 462 | 281 (eq type 'gtk) |
| 428 | 282 (eq type 'mswindows)) |
| 283 (car (frame-list)) | |
| 284 nil)) | |
| 285 | |
| 286 (defun gnuserv-visible-frame-function (type) | |
| 287 "Return a frame if there is a frame that is truly visible, nil otherwise. | |
| 288 This is meant in the X sense, so it will not return frames that are on another | |
| 289 visual screen. Totally visible frames are preferred. If none found, return nil." | |
| 290 (if (or (eq type 'x) | |
| 462 | 291 (eq type 'gtk) |
| 428 | 292 (eq type 'mswindows)) |
| 293 (cond ((car (filtered-frame-list 'frame-totally-visible-p | |
| 294 (selected-device)))) | |
| 295 ((car (filtered-frame-list (lambda (frame) | |
| 296 ;; eq t as in not 'hidden | |
| 297 (eq t (frame-visible-p frame))) | |
| 298 (selected-device))))) | |
| 299 nil)) | |
| 300 | |
| 301 (defun gnuserv-special-frame-function (type) | |
| 302 "Create a special frame for Gnuserv and return it on later invocations." | |
| 303 (unless (frame-live-p gnuserv-special-frame) | |
| 304 (setq gnuserv-special-frame (make-frame gnuserv-frame-plist))) | |
| 305 gnuserv-special-frame) | |
| 306 | |
| 307 | |
| 308 ;;; Communication functions | |
| 309 | |
| 310 ;; We used to restart the server here, but it's too risky -- if | |
| 311 ;; something goes awry, it's too easy to wind up in a loop. | |
| 312 (defun gnuserv-sentinel (proc msg) | |
| 313 (let ((msgstring (concat "Gnuserv process %s; restart with `%s'")) | |
| 314 (keystring (substitute-command-keys "\\[gnuserv-start]"))) | |
| 315 (case (process-status proc) | |
| 316 (exit | |
| 317 (message msgstring "exited" keystring) | |
| 318 (gnuserv-prepare-shutdown)) | |
| 319 (signal | |
| 320 (message msgstring "killed" keystring) | |
| 321 (gnuserv-prepare-shutdown)) | |
| 322 (closed | |
| 323 (message msgstring "closed" keystring)) | |
| 324 (gnuserv-prepare-shutdown)))) | |
| 325 | |
| 326 ;; This function reads client requests from our current server. Every | |
| 327 ;; client is identified by a unique ID within the server | |
| 328 ;; (incidentally, the same ID is the file descriptor the server uses | |
| 329 ;; to communicate to client). | |
| 330 ;; | |
| 331 ;; The request string can arrive in several chunks. As the request | |
| 332 ;; ends with \C-d, we check for that character at the end of string. | |
| 333 ;; If not found, keep reading, and concatenating to former strings. | |
| 334 ;; So, if at first read we receive "5 (gn", that text will be stored | |
| 335 ;; to gnuserv-string. If we then receive "us)\C-d", the two will be | |
| 336 ;; concatenated, `current-client' will be set to 5, and `(gnus)' form | |
| 337 ;; will be evaluated. | |
| 338 ;; | |
| 339 ;; Server will send the following: | |
| 340 ;; | |
| 341 ;; "ID <text>\C-d" (no quotes) | |
| 342 ;; | |
| 343 ;; ID - file descriptor of the given client; | |
| 344 ;; <text> - the actual contents of the request. | |
| 345 (defun gnuserv-process-filter (proc string) | |
| 346 "Process gnuserv client requests to execute Emacs commands." | |
| 347 (setq gnuserv-string (concat gnuserv-string string)) | |
| 348 ;; C-d means end of request. | |
| 456 | 349 (when (string-match "\C-d\n?\\'" gnuserv-string) |
| 350 (cond ((string-match "\\`[0-9]+" gnuserv-string) ; client request id | |
| 428 | 351 (let ((header (read-from-string gnuserv-string))) |
| 352 ;; Set the client we are talking to. | |
| 353 (setq gnuserv-current-client (car header)) | |
| 354 ;; Evaluate the expression | |
| 355 (condition-case oops | |
| 356 (eval (car (read-from-string gnuserv-string (cdr header)))) | |
| 357 ;; In case of an error, write the description to the | |
| 358 ;; client, and then signal it. | |
| 359 (error (setq gnuserv-string "") | |
| 434 | 360 (when gnuserv-current-client |
| 361 (gnuserv-write-to-client gnuserv-current-client oops)) | |
| 428 | 362 (setq gnuserv-current-client nil) |
| 363 (signal (car oops) (cdr oops))) | |
| 364 (quit (setq gnuserv-string "") | |
| 434 | 365 (when gnuserv-current-client |
| 366 (gnuserv-write-to-client gnuserv-current-client oops)) | |
| 428 | 367 (setq gnuserv-current-client nil) |
| 368 (signal 'quit nil))) | |
| 369 (setq gnuserv-string ""))) | |
| 370 (t | |
|
5882
bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
371 (let ((response (subseq gnuserv-string 0 |
|
bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
372 (position ?\C-d gnuserv-string)))) |
| 456 | 373 (setq gnuserv-string "") |
| 374 (error "%s: invalid response from gnuserv" response)))))) | |
| 428 | 375 |
| 376 ;; This function is somewhat of a misnomer. Actually, we write to the | |
| 377 ;; server (using `process-send-string' to gnuserv-process), which | |
| 378 ;; interprets what we say and forwards it to the client. The | |
| 379 ;; incantation server understands is (from gnuserv.c): | |
| 380 ;; | |
| 381 ;; "FD/LEN:<text>\n" (no quotes) | |
| 382 ;; FD - file descriptor of the given client (which we obtained from | |
| 383 ;; the server earlier); | |
| 384 ;; LEN - length of the stuff we are about to send; | |
| 385 ;; <text> - the actual contents of the request. | |
| 386 (defun gnuserv-write-to-client (client-id form) | |
| 387 "Write the given form to the given client via the gnuserv process." | |
| 388 (when (eq (process-status gnuserv-process) 'run) | |
| 389 (let* ((result (format "%s" form)) | |
| 390 (s (format "%s/%d:%s\n" client-id | |
| 391 (length result) result))) | |
| 392 (process-send-string gnuserv-process s)))) | |
| 393 | |
| 394 ;; The following two functions are helper functions, used by | |
| 395 ;; gnuclient. | |
| 396 | |
| 397 (defun gnuserv-eval (form) | |
| 398 "Evaluate form and return result to client." | |
| 399 (gnuserv-write-to-client gnuserv-current-client (eval form)) | |
| 400 (setq gnuserv-current-client nil)) | |
| 401 | |
| 402 (defun gnuserv-eval-quickly (form) | |
| 403 "Let client know that we've received the request, and then eval the form. | |
| 404 This order is important as not to keep the client waiting." | |
| 405 (gnuserv-write-to-client gnuserv-current-client nil) | |
| 406 (setq gnuserv-current-client nil) | |
| 407 (eval form)) | |
| 408 | |
| 409 | |
| 1700 | 410 |
| 411 (defun make-x-device-with-gtk-fallback (device) | |
| 412 (or (condition-case () | |
| 413 (make-x-device device) | |
| 414 (error nil)) | |
| 415 (make-gtk-device))) | |
| 416 | |
| 428 | 417 ;; "Execute" a client connection, called by gnuclient. This is the |
| 418 ;; backbone of gnuserv.el. | |
| 419 (defun gnuserv-edit-files (type list &rest flags) | |
| 420 "For each (line-number . file) pair in LIST, edit the file at line-number. | |
| 2437 | 421 The visited buffers are recorded, so that when \\[gnuserv-edit] is invoked |
| 428 | 422 in such a buffer, or when it is killed, or the client's device deleted, the |
| 2437 | 423 client will be informed that the edit is finished. |
| 428 | 424 |
| 2437 | 425 TYPE should be a list in one of the forms (tty TTY TERM PID), (x DISPLAY), |
| 426 \(gtk DISPLAY), or (mswindows DISPLAY). Currently GTK and MS Windows do not | |
| 427 support multiple displays, so the DISPLAY member is ignored. Conventionally | |
| 428 it is set to nil. | |
| 428 | 429 If a flag is `quick', just edit the files in Emacs. |
| 430 If a flag is `view', view the files read-only." | |
| 431 (let (quick view) | |
| 432 (mapc (lambda (flag) | |
| 433 (case flag | |
| 434 (quick (setq quick t)) | |
| 435 (view (setq view t)) | |
| 436 (t (error "Invalid flag %s" flag)))) | |
| 437 flags) | |
| 438 (let* ((old-device-num (length (device-list))) | |
| 439 (new-frame nil) | |
| 440 (dest-frame (if (functionp gnuserv-frame) | |
| 441 (funcall gnuserv-frame (car type)) | |
| 442 gnuserv-frame)) | |
| 443 ;; The gnuserv-frame dependencies are ugly, but it's | |
| 444 ;; extremely hard to make that stuff cleaner without | |
| 445 ;; breaking everything in sight. | |
| 446 (device (cond ((frame-live-p dest-frame) | |
| 447 (frame-device dest-frame)) | |
| 448 ((null dest-frame) | |
| 449 (case (car type) | |
| 450 (tty (apply 'make-tty-device (cdr type))) | |
| 462 | 451 (gtk (make-gtk-device)) |
| 1700 | 452 (x (make-x-device-with-gtk-fallback (cadr type))) |
| 428 | 453 (mswindows (make-mswindows-device)) |
| 454 (t (error "Invalid device type")))) | |
| 455 (t | |
| 456 (selected-device)))) | |
| 457 (frame (cond ((frame-live-p dest-frame) | |
| 458 dest-frame) | |
| 459 ((null dest-frame) | |
| 460 (setq new-frame (make-frame gnuserv-frame-plist | |
| 461 device)) | |
| 462 new-frame) | |
| 463 (t (selected-frame)))) | |
| 464 (client (make-gnuclient :id gnuserv-current-client | |
| 465 :device device | |
| 466 :frame new-frame))) | |
| 467 (select-frame frame) | |
| 468 (setq gnuserv-current-client nil) | |
| 469 ;; If the device was created by this client, push it to the list. | |
|
5366
f00192e1cd49
Examining the result of #'length: `eql', not `=', it's better style & cheaper
Aidan Kehoe <kehoea@parhasard.net>
parents:
4866
diff
changeset
|
470 (and (not (eql old-device-num (length (device-list)))) |
| 428 | 471 (push device gnuserv-devices)) |
| 472 (and (frame-iconified-p frame) | |
| 473 (deiconify-frame frame)) | |
| 474 ;; Visit all the listed files. | |
| 475 (while list | |
| 476 (let ((line (caar list)) (path (cdar list))) | |
| 477 (select-frame frame) | |
| 478 ;; Visit the file. | |
| 479 (funcall (if view | |
| 480 gnuserv-view-file-function | |
| 481 gnuserv-find-file-function) | |
| 482 path) | |
|
4684
15c42a3f4065
Do not move cursor position in gnuclient started buffer if user did
It's me FKtPp \;) <m_pupil@yahoo.com.cn>
parents:
4436
diff
changeset
|
483 (when line (goto-line line)) |
| 428 | 484 ;; Don't memorize the quick and view buffers. |
| 485 (unless (or quick view) | |
| 486 (pushnew (current-buffer) (gnuclient-buffers client)) | |
| 487 (setq gnuserv-minor-mode t) | |
| 488 ;; Add the "Done" button to the menubar, only in this buffer. | |
| 489 (if (and (featurep 'menubar) current-menubar) | |
| 490 (progn (set-buffer-menubar current-menubar) | |
| 491 (add-menu-button nil ["Done" gnuserv-edit])) | |
| 492 )) | |
| 493 (run-hooks 'gnuserv-visit-hook) | |
| 494 (pop list))) | |
| 495 (cond | |
| 496 ((and (or quick view) | |
| 497 (device-on-window-system-p device)) | |
| 498 ;; Exit if on X device, and quick or view. NOTE: if the | |
| 499 ;; client is to finish now, it must absolutely /not/ be | |
| 500 ;; included to the list of clients. This way the client-ids | |
| 501 ;; should be unique. | |
| 502 (gnuserv-write-to-client (gnuclient-id client) nil)) | |
| 503 (t | |
| 504 ;; Else, the client gets a vote. | |
| 505 (push client gnuserv-clients) | |
| 506 ;; Explain buffer exit options. If dest-frame is nil, the | |
| 507 ;; user can exit via `delete-frame'. OTOH, if FLAGS are nil | |
| 508 ;; and there are some buffers, the user can exit via | |
| 509 ;; `gnuserv-edit'. | |
| 510 (if (and (not (or quick view)) | |
| 511 (gnuclient-buffers client)) | |
| 512 (message "%s" | |
| 513 (substitute-command-keys | |
| 514 "Type `\\[gnuserv-edit]' to finish editing")) | |
| 515 (or dest-frame | |
| 516 (message "%s" | |
| 517 (substitute-command-keys | |
| 518 "Type `\\[delete-frame]' to finish editing"))))))))) | |
| 519 | |
| 520 | |
| 521 ;;; Functions that hook into Emacs in various way to enable operation | |
| 522 | |
| 523 ;; Defined later. | |
| 524 (add-hook 'kill-emacs-hook 'gnuserv-kill-all-clients t) | |
| 525 | |
| 526 ;; A helper function; used by others. Try avoiding it whenever | |
| 527 ;; possible, because it is slow, and conses a list. Use | |
| 528 ;; `gnuserv-buffer-p' when appropriate, for instance. | |
| 529 (defun gnuserv-buffer-clients (buffer) | |
| 530 "Return a list of clients to which BUFFER belongs." | |
| 531 (let (res) | |
| 532 (dolist (client gnuserv-clients) | |
| 533 (when (memq buffer (gnuclient-buffers client)) | |
| 534 (push client res))) | |
| 535 res)) | |
| 536 | |
| 537 ;; Like `gnuserv-buffer-clients', but returns a boolean; doesn't | |
| 538 ;; collect a list. | |
| 539 (defun gnuserv-buffer-p (buffer) | |
| 540 (member* buffer gnuserv-clients | |
| 541 :test 'memq | |
| 542 :key 'gnuclient-buffers)) | |
| 543 | |
| 544 ;; This function makes sure that a killed buffer is deleted off the | |
| 545 ;; list for the particular client. | |
| 546 ;; | |
| 547 ;; This hooks into `kill-buffer-hook'. It is *not* a replacement for | |
| 548 ;; `kill-buffer' (thanks God). | |
| 549 (defun gnuserv-kill-buffer-function () | |
| 550 "Remove the buffer from the buffer lists of all the clients it belongs to. | |
| 551 Any client that remains \"empty\" after the removal is informed that the | |
| 552 editing has ended." | |
| 553 (let* ((buf (current-buffer))) | |
| 554 (dolist (client (gnuserv-buffer-clients buf)) | |
|
5652
cc6f0266bc36
Avoid #'delq in core Lisp, for the sake of style, a very slightly smaller binary
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
555 (callf2 delete* buf (gnuclient-buffers client)) |
| 428 | 556 ;; If no more buffers, kill the client. |
| 557 (when (null (gnuclient-buffers client)) | |
| 558 (gnuserv-kill-client client))))) | |
| 559 | |
| 560 (add-hook 'kill-buffer-hook 'gnuserv-kill-buffer-function) | |
| 561 | |
| 562 ;; Ask for confirmation before killing a buffer that belongs to a | |
| 563 ;; living client. | |
| 564 (defun gnuserv-kill-buffer-query-function () | |
| 565 (or gnuserv-kill-quietly | |
| 566 (not (gnuserv-buffer-p (current-buffer))) | |
| 567 (yes-or-no-p | |
| 568 (format "Buffer %s belongs to gnuserv client(s); kill anyway? " | |
| 569 (current-buffer))))) | |
| 570 | |
| 571 (add-hook 'kill-buffer-query-functions | |
| 572 'gnuserv-kill-buffer-query-function) | |
| 573 | |
| 574 (defun gnuserv-kill-emacs-query-function () | |
| 575 (or gnuserv-kill-quietly | |
| 576 (not (some 'gnuclient-buffers gnuserv-clients)) | |
| 577 (yes-or-no-p "Gnuserv buffers still have clients; exit anyway? "))) | |
| 578 | |
| 579 (add-hook 'kill-emacs-query-functions | |
| 580 'gnuserv-kill-emacs-query-function) | |
| 581 | |
| 582 ;; If the device of a client is to be deleted, the client should die | |
| 583 ;; as well. This is why we hook into `delete-device-hook'. | |
| 584 (defun gnuserv-check-device (device) | |
| 585 (when (memq device gnuserv-devices) | |
| 586 (dolist (client gnuserv-clients) | |
| 587 (when (eq device (gnuclient-device client)) | |
| 588 ;; we must make sure that the server kill doesn't result in | |
| 589 ;; killing the device, because it would cause a device-dead | |
| 590 ;; error when `delete-device' tries to do the job later. | |
| 591 (gnuserv-kill-client client t)))) | |
|
5652
cc6f0266bc36
Avoid #'delq in core Lisp, for the sake of style, a very slightly smaller binary
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
592 (callf2 delete* device gnuserv-devices)) |
| 428 | 593 |
| 594 (add-hook 'delete-device-hook 'gnuserv-check-device) | |
| 595 | |
| 596 (defun gnuserv-temp-file-p (buffer) | |
| 597 "Return non-nil if BUFFER contains a file considered temporary. | |
| 598 These are files whose names suggest they are repeatedly | |
| 599 reused to pass information to another program. | |
| 600 | |
| 601 The variable `gnuserv-temp-file-regexp' controls which filenames | |
| 602 are considered temporary." | |
| 603 (and (buffer-file-name buffer) | |
| 604 (string-match gnuserv-temp-file-regexp (buffer-file-name buffer)))) | |
| 605 | |
| 606 (defun gnuserv-kill-client (client &optional leave-frame) | |
| 607 "Kill the gnuclient CLIENT. | |
| 608 This will do away with all the associated buffers. If LEAVE-FRAME, | |
| 609 the function will not remove the frames associated with the client." | |
| 610 ;; Order is important: first delete client from gnuserv-clients, to | |
| 611 ;; prevent gnuserv-buffer-done-1 calling us recursively. | |
|
5652
cc6f0266bc36
Avoid #'delq in core Lisp, for the sake of style, a very slightly smaller binary
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
612 (callf2 delete* client gnuserv-clients) |
| 428 | 613 ;; Process the buffers. |
| 614 (mapc 'gnuserv-buffer-done-1 (gnuclient-buffers client)) | |
| 615 (unless leave-frame | |
| 616 (let ((device (gnuclient-device client))) | |
| 617 ;; kill frame created by this client (if any), unless | |
| 618 ;; specifically requested otherwise. | |
| 619 ;; | |
| 620 ;; note: last frame on a device will not be deleted here. | |
| 621 (when (and (gnuclient-frame client) | |
| 622 (frame-live-p (gnuclient-frame client)) | |
| 623 (second (device-frame-list device))) | |
| 624 (delete-frame (gnuclient-frame client))) | |
| 625 ;; If the device is live, created by a client, and no longer used | |
| 626 ;; by any client, delete it. | |
| 627 (when (and (device-live-p device) | |
| 628 (memq device gnuserv-devices) | |
| 629 (second (device-list)) | |
| 630 (not (member* device gnuserv-clients | |
| 631 :key 'gnuclient-device))) | |
| 632 ;; `gnuserv-check-device' will remove it from `gnuserv-devices'. | |
| 633 (delete-device device)))) | |
| 634 ;; Notify the client. | |
| 635 (gnuserv-write-to-client (gnuclient-id client) nil)) | |
| 636 | |
| 637 ;; Do away with the buffer. | |
| 638 (defun gnuserv-buffer-done-1 (buffer) | |
| 639 (dolist (client (gnuserv-buffer-clients buffer)) | |
|
5652
cc6f0266bc36
Avoid #'delq in core Lisp, for the sake of style, a very slightly smaller binary
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
640 (callf2 delete* buffer (gnuclient-buffers client)) |
| 428 | 641 (when (null (gnuclient-buffers client)) |
| 642 (gnuserv-kill-client client))) | |
| 643 ;; Get rid of the buffer. | |
| 644 (save-excursion | |
| 645 (set-buffer buffer) | |
| 646 (run-hooks 'gnuserv-done-hook) | |
| 647 (setq gnuserv-minor-mode nil) | |
| 648 ;; Delete the menu button. | |
| 649 (if (and (featurep 'menubar) current-menubar) | |
| 650 (delete-menu-item '("Done"))) | |
| 651 (funcall (if (gnuserv-temp-file-p buffer) | |
| 652 gnuserv-done-temp-file-function | |
| 653 gnuserv-done-function) | |
| 654 buffer))) | |
| 655 | |
| 656 | |
| 657 ;;; Higher-level functions | |
| 658 | |
| 659 ;; Choose a `next' server buffer, according to several criteria, and | |
| 660 ;; return it. If none are found, return nil. | |
| 661 (defun gnuserv-next-buffer () | |
| 662 (let* ((frame (selected-frame)) | |
| 663 (device (selected-device)) | |
| 664 client) | |
| 665 (cond | |
| 666 ;; If we have a client belonging to this frame, return | |
| 667 ;; the first buffer from it. | |
| 668 ((setq client | |
| 669 (car (member* frame gnuserv-clients :key 'gnuclient-frame))) | |
| 670 (car (gnuclient-buffers client))) | |
| 671 ;; Else, look for a device. | |
| 672 ((and | |
| 673 (memq (selected-device) gnuserv-devices) | |
| 674 (setq client | |
| 675 (car (member* device gnuserv-clients :key 'gnuclient-device)))) | |
| 676 (car (gnuclient-buffers client))) | |
| 677 ;; Else, try to find any client with at least one buffer, and | |
| 678 ;; return its first buffer. | |
| 679 ((setq client | |
| 680 (car (member-if-not #'null gnuserv-clients | |
| 681 :key 'gnuclient-buffers))) | |
| 682 (car (gnuclient-buffers client))) | |
| 683 ;; Oh, give up. | |
| 684 (t nil)))) | |
| 685 | |
| 686 (defun gnuserv-buffer-done (buffer) | |
| 687 "Mark BUFFER as \"done\" for its client(s). | |
| 688 Does the save/backup queries first, and calls `gnuserv-done-function'." | |
| 689 ;; Check whether this is the real thing. | |
| 690 (unless (gnuserv-buffer-p buffer) | |
| 691 (error "%s does not belong to a gnuserv client" buffer)) | |
| 692 ;; Backup/ask query. | |
| 693 (if (gnuserv-temp-file-p buffer) | |
| 694 ;; For a temp file, save, and do NOT make a non-numeric backup | |
| 695 ;; Why does server.el explicitly back up temporary files? | |
| 696 (let ((version-control nil) | |
| 697 (buffer-backed-up (not gnuserv-make-temp-file-backup))) | |
| 698 (save-buffer)) | |
| 699 (if (and (buffer-modified-p) | |
| 700 (y-or-n-p (concat "Save file " buffer-file-name "? "))) | |
| 701 (save-buffer buffer))) | |
| 702 (gnuserv-buffer-done-1 buffer)) | |
| 703 | |
| 704 ;; Called by `gnuserv-start-1' to clean everything. Hooked into | |
| 705 ;; `kill-emacs-hook', too. | |
| 706 (defun gnuserv-kill-all-clients () | |
| 707 "Kill all the gnuserv clients. Ruthlessly." | |
| 708 (mapc 'gnuserv-kill-client gnuserv-clients)) | |
| 709 | |
| 710 ;; This serves to run the hook and reset | |
| 711 ;; `allow-deletion-of-last-visible-frame'. | |
| 712 (defun gnuserv-prepare-shutdown () | |
| 713 (setq allow-deletion-of-last-visible-frame nil) | |
| 714 (run-hooks 'gnuserv-shutdown-hook)) | |
| 715 | |
| 716 ;; This is a user-callable function, too. | |
| 717 (defun gnuserv-shutdown () | |
| 718 "Shutdown the gnuserv server, if one is currently running. | |
| 719 All the clients will be disposed of via the normal methods." | |
| 720 (interactive) | |
| 721 (gnuserv-kill-all-clients) | |
| 722 (when gnuserv-process | |
| 723 (set-process-sentinel gnuserv-process nil) | |
| 724 (gnuserv-prepare-shutdown) | |
| 725 (condition-case () | |
| 726 (delete-process gnuserv-process) | |
| 727 (error nil)) | |
| 728 (setq gnuserv-process nil))) | |
| 729 | |
| 730 ;; Actually start the process. Kills all the clients before-hand. | |
| 731 (defun gnuserv-start-1 (&optional leave-dead) | |
| 732 ;; Shutdown the existing server, if any. | |
| 733 (gnuserv-shutdown) | |
| 734 ;; If we already had a server, clear out associated status. | |
| 735 (unless leave-dead | |
| 736 (setq gnuserv-string "" | |
| 737 gnuserv-current-client nil) | |
| 738 (let ((process-connection-type t)) | |
| 739 (setq gnuserv-process | |
| 740 (start-process "gnuserv" nil gnuserv-program))) | |
| 741 (set-process-sentinel gnuserv-process 'gnuserv-sentinel) | |
| 742 (set-process-filter gnuserv-process 'gnuserv-process-filter) | |
| 743 (process-kill-without-query gnuserv-process) | |
| 744 (setq allow-deletion-of-last-visible-frame t) | |
| 745 (run-hooks 'gnuserv-init-hook))) | |
| 746 | |
| 747 | |
| 748 ;;; User-callable functions: | |
| 749 | |
| 750 ;;;###autoload | |
| 751 (defun gnuserv-running-p () | |
| 752 "Return non-nil if a gnuserv process is running from this XEmacs session." | |
| 753 (not (not gnuserv-process))) | |
| 754 | |
| 755 ;;;###autoload | |
| 756 (defun gnuserv-start (&optional leave-dead) | |
| 757 "Allow this Emacs process to be a server for client processes. | |
| 758 This starts a gnuserv communications subprocess through which | |
| 759 client \"editors\" (gnuclient and gnudoit) can send editing commands to | |
| 760 this Emacs job. See the gnuserv(1) manual page for more details. | |
| 761 | |
| 762 Prefix arg means just kill any existing server communications subprocess." | |
| 763 (interactive "P") | |
| 764 (and gnuserv-process | |
| 765 (not leave-dead) | |
| 766 (message "Restarting gnuserv")) | |
| 767 (gnuserv-start-1 leave-dead)) | |
| 768 | |
| 769 (defun gnuserv-edit (&optional count) | |
| 770 "Mark the current gnuserv editing buffer as \"done\", and switch to next one. | |
| 771 | |
| 772 Run with a numeric prefix argument, repeat the operation that number | |
| 773 of times. If given a universal prefix argument, close all the buffers | |
| 774 of this buffer's clients. | |
| 775 | |
| 776 The `gnuserv-done-function' (bound to `kill-buffer' by default) is | |
| 777 called to dispose of the buffer after marking it as done. | |
| 778 | |
| 779 Files that match `gnuserv-temp-file-regexp' are considered temporary and | |
| 780 are saved unconditionally and backed up if `gnuserv-make-temp-file-backup' | |
| 781 is non-nil. They are disposed of using `gnuserv-done-temp-file-function' | |
| 782 \(also bound to `kill-buffer' by default). | |
| 783 | |
| 784 When all of a client's buffers are marked as \"done\", the client is notified." | |
| 785 (interactive "P") | |
| 786 (when (null count) | |
| 787 (setq count 1)) | |
| 788 (cond ((numberp count) | |
| 789 (while (natnump (decf count)) | |
| 790 (let ((frame (selected-frame))) | |
| 791 (gnuserv-buffer-done (current-buffer)) | |
| 792 (when (eq frame (selected-frame)) | |
| 793 ;; Switch to the next gnuserv buffer. However, do this | |
| 794 ;; only if we remain in the same frame. | |
| 795 (let ((next (gnuserv-next-buffer))) | |
| 796 (when next | |
| 797 (switch-to-buffer next))))))) | |
| 798 (count | |
| 799 (let* ((buf (current-buffer)) | |
| 800 (clients (gnuserv-buffer-clients buf))) | |
| 801 (unless clients | |
| 802 (error "%s does not belong to a gnuserv client" buf)) | |
| 803 (mapc 'gnuserv-kill-client (gnuserv-buffer-clients buf)))))) | |
| 804 | |
| 805 (global-set-key "\C-x#" 'gnuserv-edit) | |
| 806 | |
| 807 (provide 'gnuserv) | |
| 808 | |
| 809 ;;; gnuserv.el ends here |