Mercurial > hg > xemacs-beta

comparison lisp/process.el @ 440:8de8e3f6228a r21-2-28

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-28
author cvs
date Mon, 13 Aug 2007 11:33:38 +0200
parents 84b14dcb0985
children abe6d1db359e
comparison
equal deleted inserted replaced
439:357dd071b03c 440:8de8e3f6228a
31 ;; This file is dumped with XEmacs. 31 ;; This file is dumped with XEmacs.
32 32
33 ;;; Code: 33 ;;; Code:
34 34
35 35
36 (defvar binary-process-output)
37 (defvar buffer-file-type)
38
39 (defgroup processes nil 36 (defgroup processes nil
40 "Process, subshell, compilation, and job control support." 37 "Process, subshell, compilation, and job control support."
41 :group 'external 38 :group 'external
42 :group 'development) 39 :group 'development)
43 40
113 and returns a numeric exit status or a signal description string. 110 and returns a numeric exit status or a signal description string.
114 If you quit, the process is first killed with SIGINT, then with SIGKILL if 111 If you quit, the process is first killed with SIGINT, then with SIGKILL if
115 you quit again before the process exits." 112 you quit again before the process exits."
116 (let ((temp 113 (let ((temp
117 (make-temp-name 114 (make-temp-name
118 (concat (file-name-as-directory (temp-directory)) 115 (concat (file-name-as-directory (temp-directory)) "emacs"))))
119 (if (memq system-type '(ms-dos windows-nt)) "em" "emacs")))))
120 (unwind-protect 116 (unwind-protect
121 (progn 117 (progn
122 (if (memq system-type '(ms-dos windows-nt)) 118 (write-region start end temp nil 'silent)
123 (let ((buffer-file-type binary-process-output))
124 (write-region start end temp nil 'silent))
125 (write-region start end temp nil 'silent))
126 (if deletep (delete-region start end)) 119 (if deletep (delete-region start end))
127 (apply #'call-process program temp buffer displayp args)) 120 (apply #'call-process program temp buffer displayp args))
128 (ignore-file-errors (delete-file temp))))) 121 (ignore-file-errors (delete-file temp)))))
129 122
130 123
325 lost packets." 318 lost packets."
326 (open-network-stream-internal name buffer host service protocol)) 319 (open-network-stream-internal name buffer host service protocol))
327 320
328 (defun shell-quote-argument (argument) 321 (defun shell-quote-argument (argument)
329 "Quote an argument for passing as argument to an inferior shell." 322 "Quote an argument for passing as argument to an inferior shell."
330 (if (eq system-type 'ms-dos) 323 (if (eq system-type 'windows-nt)
331 ;; MS-DOS shells don't have quoting, so don't do any. 324 (nt-quote-process-args (list shell-file-name argument))
332 argument 325 ;; Quote everything except POSIX filename characters.
333 (if (eq system-type 'windows-nt) 326 ;; This should be safe enough even for really weird shells.
334 (concat "\"" argument "\"") 327 (let ((result "") (start 0) end)
335 ;; Quote everything except POSIX filename characters. 328 (while (string-match "[^-0-9a-zA-Z_./]" argument start)
336 ;; This should be safe enough even for really weird shells. 329 (setq end (match-beginning 0)
337 (let ((result "") (start 0) end) 330 result (concat result (substring argument start end)
338 (while (string-match "[^-0-9a-zA-Z_./]" argument start) 331 "\\" (substring argument end (1+ end)))
339 (setq end (match-beginning 0) 332 start (1+ end)))
340 result (concat result (substring argument start end) 333 (concat result (substring argument start)))))
341 "\\" (substring argument end (1+ end)))
342 start (1+ end)))
343 (concat result (substring argument start))))))
344 334
345 (defun shell-command-to-string (command) 335 (defun shell-command-to-string (command)
346 "Execute shell command COMMAND and return its output as a string." 336 "Execute shell command COMMAND and return its output as a string."
347 (with-output-to-string 337 (with-output-to-string
348 (call-process shell-file-name nil t nil shell-command-switch command))) 338 (call-process shell-file-name nil t nil shell-command-switch command)))