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)