Mercurial > emacs
comparison lisp/simple.el @ 43969:927028937c0b
Update copyright.
(clone-process): Use make-network-process to clone network
processes. Get command list via (process-contact ... t).
Use set-process-query-on-exit-flag and process-query-on-exit-flag
instead of process-kill-without-query.
(open-network-stream): Replaces C-version from process.c.
(open-network-stream-nowait, open-network-stream-server): New
functions.
(process-kill-without-query): Replaces C-version from process.c.
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Sun, 17 Mar 2002 20:28:53 +0000 |
parents | 8acd1399d389 |
children | a980adfcce47 |
comparison
equal
deleted
inserted
replaced
43968:7ec801358b7e | 43969:927028937c0b |
---|---|
1 ;;; simple.el --- basic editing commands for Emacs | 1 ;;; simple.el --- basic editing commands for Emacs |
2 | 2 |
3 ;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 2000, 2001 | 3 ;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002 |
4 ;; Free Software Foundation, Inc. | 4 ;; Free Software Foundation, Inc. |
5 | 5 |
6 ;; This file is part of GNU Emacs. | 6 ;; This file is part of GNU Emacs. |
7 | 7 |
8 ;; GNU Emacs is free software; you can redistribute it and/or modify | 8 ;; GNU Emacs is free software; you can redistribute it and/or modify |
3930 (setq newname (or newname (process-name process))) | 3930 (setq newname (or newname (process-name process))) |
3931 (if (string-match "<[0-9]+>\\'" newname) | 3931 (if (string-match "<[0-9]+>\\'" newname) |
3932 (setq newname (substring newname 0 (match-beginning 0)))) | 3932 (setq newname (substring newname 0 (match-beginning 0)))) |
3933 (when (memq (process-status process) '(run stop open)) | 3933 (when (memq (process-status process) '(run stop open)) |
3934 (let* ((process-connection-type (process-tty-name process)) | 3934 (let* ((process-connection-type (process-tty-name process)) |
3935 (old-kwoq (process-kill-without-query process nil)) | |
3936 (new-process | 3935 (new-process |
3937 (if (memq (process-status process) '(open)) | 3936 (if (memq (process-status process) '(open)) |
3938 (apply 'open-network-stream newname | 3937 (let ((args (process-contact process t))) |
3939 (if (process-buffer process) (current-buffer)) | 3938 (setq args (plist-put args :name newname)) |
3940 (process-contact process)) | 3939 (setq args (plist-put args :buffer |
3940 (if (process-buffer process) (current-buffer)))) | |
3941 (apply 'make-network-process args)) | |
3941 (apply 'start-process newname | 3942 (apply 'start-process newname |
3942 (if (process-buffer process) (current-buffer)) | 3943 (if (process-buffer process) (current-buffer)) |
3943 (process-command process))))) | 3944 (process-command process))))) |
3944 (process-kill-without-query new-process old-kwoq) | 3945 (set-process-query-on-exit-flag |
3945 (process-kill-without-query process old-kwoq) | 3946 new-process (process-query-on-exit-flag process)) |
3946 (set-process-inherit-coding-system-flag | 3947 (set-process-inherit-coding-system-flag |
3947 new-process (process-inherit-coding-system-flag process)) | 3948 new-process (process-inherit-coding-system-flag process)) |
3948 (set-process-filter new-process (process-filter process)) | 3949 (set-process-filter new-process (process-filter process)) |
3949 (set-process-sentinel new-process (process-sentinel process)) | 3950 (set-process-sentinel new-process (process-sentinel process)) |
3950 new-process))) | 3951 new-process))) |
4201 (if (interactive-p) | 4202 (if (interactive-p) |
4202 (message "Delete key deletes %s" | 4203 (message "Delete key deletes %s" |
4203 (if normal-erase-is-backspace "forward" "backward")))) | 4204 (if normal-erase-is-backspace "forward" "backward")))) |
4204 | 4205 |
4205 | 4206 |
4207 ;;; make-network-process wrappers | |
4208 | |
4209 (if (fboundp 'make-network-process) | |
4210 (progn | |
4211 | |
4212 (defun open-network-stream (name buffer host service) | |
4213 "Open a TCP connection for a service to a host. | |
4214 Returns a subprocess-object to represent the connection. | |
4215 Input and output work as for subprocesses; `delete-process' closes it. | |
4216 Args are NAME BUFFER HOST SERVICE. | |
4217 NAME is name for process. It is modified if necessary to make it unique. | |
4218 BUFFER is the buffer (or buffer-name) to associate with the process. | |
4219 Process output goes at end of that buffer, unless you specify | |
4220 an output stream or filter function to handle the output. | |
4221 BUFFER may be also nil, meaning that this process is not associated | |
4222 with any buffer | |
4223 Third arg is name of the host to connect to, or its IP address. | |
4224 Fourth arg SERVICE is name of the service desired, or an integer | |
4225 specifying a port number to connect to." | |
4226 (make-network-process :name name :buffer buffer | |
4227 :host host :service service)) | |
4228 | |
4229 (defun open-network-stream-nowait (name buffer host service &optional sentinel filter) | |
4230 "Initiate connection to a TCP connection for a service to a host. | |
4231 It returns nil if non-blocking connects are not supported; otherwise, | |
4232 it returns a subprocess-object to represent the connection. | |
4233 | |
4234 This function is similar to `open-network-stream', except that this | |
4235 function returns before the connection is established. When the | |
4236 connection is completed, the sentinel function will be called with | |
4237 second arg matching `open' (if successful) or `failed' (on error). | |
4238 | |
4239 Args are NAME BUFFER HOST SERVICE SENTINEL FILTER. | |
4240 NAME, BUFFER, HOST, and SERVICE are as for `open-network-stream'. | |
4241 Optional args, SENTINEL and FILTER specifies the sentinel and filter | |
4242 functions to be used for this network stream." | |
4243 (if (make-network-process :feature :nowait t) | |
4244 (make-network-process :name name :buffer buffer :nowait t | |
4245 :host host :service service | |
4246 :filter filter :sentinel sentinel))) | |
4247 | |
4248 (defun open-network-stream-server (name buffer service &optional sentinel filter) | |
4249 "Create a network server process for a TCP service. | |
4250 It returns nil if server processes are not supported; otherwise, | |
4251 it returns a subprocess-object to represent the server. | |
4252 | |
4253 When a client connects to the specified service, a new subprocess | |
4254 is created to handle the new connection, and the sentinel function | |
4255 is called for the new process. | |
4256 | |
4257 Args are NAME BUFFER SERVICE SENTINEL FILTER. | |
4258 NAME is name for the server process. Client processes are named by | |
4259 appending the ip-address and port number of the client to NAME. | |
4260 BUFFER is the buffer (or buffer-name) to associate with the server | |
4261 process. Client processes will not get a buffer if a process filter | |
4262 is specified or BUFFER is nil; otherwise, a new buffer is created for | |
4263 the client process. The name is similar to the process name. | |
4264 Third arg SERVICE is name of the service desired, or an integer | |
4265 specifying a port number to connect to. It may also be t to selected | |
4266 an unused port number for the server. | |
4267 Optional args, SENTINEL and FILTER specifies the sentinel and filter | |
4268 functions to be used for the client processes; the server process | |
4269 does not use these function." | |
4270 (if (make-network-process :feature :server t) | |
4271 (make-network-process :name name :buffer buffer | |
4272 :service service :server t :noquery t))) | |
4273 | |
4274 )) ;; (fboundp 'make-network-process) | |
4275 | |
4276 | |
4277 ;; compatibility | |
4278 | |
4279 (defun process-kill-without-query (process &optional flag) | |
4280 "Say no query needed if PROCESS is running when Emacs is exited. | |
4281 Optional second argument if non-nil says to require a query. | |
4282 Value is t if a query was formerly required. | |
4283 New code should not use this function; use `process-query-on-exit-flag' | |
4284 or `set-process-query-on-exit-flag' instead." | |
4285 (let ((old (process-query-on-exit-flag process))) | |
4286 (set-process-query-on-exit-flag process nil) | |
4287 old)) | |
4288 | |
4206 ;;; Misc | 4289 ;;; Misc |
4207 | 4290 |
4208 (defun byte-compiling-files-p () | 4291 (defun byte-compiling-files-p () |
4209 "Return t if currently byte-compiling files." | 4292 "Return t if currently byte-compiling files." |
4210 (and (boundp 'byte-compile-current-file) | 4293 (and (boundp 'byte-compile-current-file) |