Mercurial > emacs
changeset 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 | 7ec801358b7e |
children | 5966dbd88eb3 |
files | lisp/simple.el |
diffstat | 1 files changed, 90 insertions(+), 7 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/simple.el Sun Mar 17 20:20:33 2002 +0000 +++ b/lisp/simple.el Sun Mar 17 20:28:53 2002 +0000 @@ -1,6 +1,6 @@ ;;; simple.el --- basic editing commands for Emacs -;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 2000, 2001 +;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -3932,17 +3932,18 @@ (setq newname (substring newname 0 (match-beginning 0)))) (when (memq (process-status process) '(run stop open)) (let* ((process-connection-type (process-tty-name process)) - (old-kwoq (process-kill-without-query process nil)) (new-process (if (memq (process-status process) '(open)) - (apply 'open-network-stream newname - (if (process-buffer process) (current-buffer)) - (process-contact process)) + (let ((args (process-contact process t))) + (setq args (plist-put args :name newname)) + (setq args (plist-put args :buffer + (if (process-buffer process) (current-buffer)))) + (apply 'make-network-process args)) (apply 'start-process newname (if (process-buffer process) (current-buffer)) (process-command process))))) - (process-kill-without-query new-process old-kwoq) - (process-kill-without-query process old-kwoq) + (set-process-query-on-exit-flag + new-process (process-query-on-exit-flag process)) (set-process-inherit-coding-system-flag new-process (process-inherit-coding-system-flag process)) (set-process-filter new-process (process-filter process)) @@ -4203,6 +4204,88 @@ (if normal-erase-is-backspace "forward" "backward")))) +;;; make-network-process wrappers + +(if (fboundp 'make-network-process) + (progn + +(defun open-network-stream (name buffer host service) + "Open a TCP connection for a service to a host. +Returns a subprocess-object to represent the connection. +Input and output work as for subprocesses; `delete-process' closes it. +Args are NAME BUFFER HOST SERVICE. +NAME is name for process. It is modified if necessary to make it unique. +BUFFER is the buffer (or buffer-name) to associate with the process. + Process output goes at end of that buffer, unless you specify + an output stream or filter function to handle the output. + BUFFER may be also nil, meaning that this process is not associated + with any buffer +Third arg is name of the host to connect to, or its IP address. +Fourth arg SERVICE is name of the service desired, or an integer +specifying a port number to connect to." + (make-network-process :name name :buffer buffer + :host host :service service)) + +(defun open-network-stream-nowait (name buffer host service &optional sentinel filter) + "Initiate connection to a TCP connection for a service to a host. +It returns nil if non-blocking connects are not supported; otherwise, +it returns a subprocess-object to represent the connection. + +This function is similar to `open-network-stream', except that this +function returns before the connection is established. When the +connection is completed, the sentinel function will be called with +second arg matching `open' (if successful) or `failed' (on error). + +Args are NAME BUFFER HOST SERVICE SENTINEL FILTER. +NAME, BUFFER, HOST, and SERVICE are as for `open-network-stream'. +Optional args, SENTINEL and FILTER specifies the sentinel and filter +functions to be used for this network stream." + (if (make-network-process :feature :nowait t) + (make-network-process :name name :buffer buffer :nowait t + :host host :service service + :filter filter :sentinel sentinel))) + +(defun open-network-stream-server (name buffer service &optional sentinel filter) + "Create a network server process for a TCP service. +It returns nil if server processes are not supported; otherwise, +it returns a subprocess-object to represent the server. + +When a client connects to the specified service, a new subprocess +is created to handle the new connection, and the sentinel function +is called for the new process. + +Args are NAME BUFFER SERVICE SENTINEL FILTER. +NAME is name for the server process. Client processes are named by +appending the ip-address and port number of the client to NAME. +BUFFER is the buffer (or buffer-name) to associate with the server +process. Client processes will not get a buffer if a process filter +is specified or BUFFER is nil; otherwise, a new buffer is created for +the client process. The name is similar to the process name. +Third arg SERVICE is name of the service desired, or an integer +specifying a port number to connect to. It may also be t to selected +an unused port number for the server. +Optional args, SENTINEL and FILTER specifies the sentinel and filter +functions to be used for the client processes; the server process +does not use these function." + (if (make-network-process :feature :server t) + (make-network-process :name name :buffer buffer + :service service :server t :noquery t))) + +)) ;; (fboundp 'make-network-process) + + +;; compatibility + +(defun process-kill-without-query (process &optional flag) + "Say no query needed if PROCESS is running when Emacs is exited. +Optional second argument if non-nil says to require a query. +Value is t if a query was formerly required. +New code should not use this function; use `process-query-on-exit-flag' +or `set-process-query-on-exit-flag' instead." + (let ((old (process-query-on-exit-flag process))) + (set-process-query-on-exit-flag process nil) + old)) + ;;; Misc (defun byte-compiling-files-p ()