[COMMIT] shell-command(-on-region) API compliance with GNU

Hi, APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Mats Lidell <mats.lidell(a)cag.se&gt; # Date 1312068549 -7200 # Node ID 11da5b828d1047278de9af4978ff0755fc25748a # Parent 1b054bc2ac40913a80076e3958dc7b81e840253d shell-command and shell-command-on-region API compliant with FSF 23.3.1 diff -r 1b054bc2ac40 -r 11da5b828d10 lisp/ChangeLog --- a/lisp/ChangeLog Sun Jul 03 14:17:39 2011 +0100 +++ b/lisp/ChangeLog Sun Jul 31 01:29:09 2011 +0200 ＠＠ -1,3 +1,9 ＠＠ +2011-07-29 Mats Lidell <matsl(a)xemacs.org&gt; + + * process.el (shell-command): + * process.el (shell-command-on-region): API compatible/synced with + FSF 23.3.1. + 2011-07-03 Aidan Kehoe <kehoea(a)parhasard.net&gt; * cl.el (cl-macroexpand): diff -r 1b054bc2ac40 -r 11da5b828d10 lisp/process.el --- a/lisp/process.el Sun Jul 03 14:17:39 2011 +0100 +++ b/lisp/process.el Sun Jul 31 01:29:09 2011 +0200 ＠＠ -1,6 +1,6 ＠＠ ;;; process.el --- commands for subprocesses; split out of simple.el -;; Copyright (C) 1985-7, 1993,4, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1985-7, 1993,4, 1997, 2011 Free Software Foundation, Inc. ;; Copyright (C) 1995, 2000, 2001, 2002 Ben Wing. ;; Author: Ben Wing ＠＠ -24,6 +24,7 ＠＠ ;;; Synched up with: FSF 19.30, except for setenv/getenv (synched with FSF ;;; 21.2.1). +;;; shell-command and shell-command-on-region synced with FSF 23.3.1. ;;; Authorship: ＠＠ -57,6 +58,12 ＠＠ (defvar shell-command-switch "-c" "Switch used to have the shell execute its command line argument.") +(defvar shell-command-default-error-buffer nil + "*Buffer name for `shell-command' and `shell-command-on-region' error output. +This buffer is used when `shell-command' or `shell-command-on-region' +is run interactively. A value of nil means that output to stderr and +stdout will be intermixed in the output stream.") + (defun start-process-shell-command (name buffer &rest args) "Start a program in a subprocess. Return the process object for it. NAME is name for process. It is modified if necessary to make it unique. ＠＠ -316,12 +323,12 ＠＠ (error nil)))))  -(defun shell-command (command &optional output-buffer) +(defun shell-command (command &optional output-buffer error-buffer) "Execute string COMMAND in inferior shell; display output, if any. -If COMMAND ends in ampersand, execute it asynchronously. -The output appears in the buffer `*Async Shell Command*'. -That buffer is in shell mode. +If COMMAND ends in ampersand, execute it asynchronously. The command +is executed using the background package. See `background' for +details. Otherwise, COMMAND is executed synchronously. The output appears in the buffer `*Shell Command Output*'. ＠＠ -336,9 +343,16 ＠＠ If OUTPUT-BUFFER is a buffer or buffer name, put the output there. If OUTPUT-BUFFER is not a buffer and not nil, insert output in current buffer. (This cannot be done asynchronously.) -In either case, the output is inserted after point (leaving mark after it)." +In either case, the output is inserted after point (leaving mark after it). + +If the optional third argument ERROR-BUFFER is non-nil, it is a buffer +or buffer name to which to direct the command's standard error output. +If it is nil, error output is mingled with regular output. In an +interactive call, the variable `shell-command-default-error-buffer' +specifies the value of ERROR-BUFFER." (interactive (list (read-shell-command "Shell command: ") - current-prefix-arg)) + current-prefix-arg + shell-command-default-error-buffer)) (if (and output-buffer (not (or (bufferp output-buffer) (stringp output-buffer)))) (progn (barf-if-buffer-read-only) ＠＠ -363,7 +377,7 ＠＠ 'unimplemented "backgrounding a shell command requires package `background'"))) - (shell-command-on-region (point) (point) command output-buffer))))) + (shell-command-on-region (point) (point) command output-buffer nil error-buffer))))) ;; We have a sentinel to prevent insertion of a termination message ;; in the buffer itself. ＠＠ -374,7 +388,8 ＠＠ (substring signal 0 -1)))) (defun shell-command-on-region (start end command - &optional output-buffer replace) + &optional output-buffer replace + error-buffer display-error-buffer) "Execute string COMMAND in inferior shell with region as input. Normally display output (if any) in temp buffer `*Shell Command Output*'; Prefix arg means replace the region with it. ＠＠ -394,7 +409,15 ＠＠ If OUTPUT-BUFFER is a buffer or buffer name, put the output there. If OUTPUT-BUFFER is not a buffer and not nil, insert output in the current buffer. -In either case, the output is inserted after point (leaving mark after it)." +In either case, the output is inserted after point (leaving mark after it). + +If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer +or buffer name to which to direct the command's standard error output. +If it is nil, error output is mingled with regular output. +If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there +were any errors. (This is always t, interactively.) +In an interactive call, the variable `shell-command-default-error-buffer' +specifies the value of ERROR-BUFFER." (interactive (let ((string ;; Do this before calling region-beginning ;; and region-end, in case subprocess output ＠＠ -405,79 +428,142 ＠＠ (list (region-beginning) (region-end) string current-prefix-arg - current-prefix-arg))) - (if (or replace - (and output-buffer - (not (or (bufferp output-buffer) (stringp output-buffer))))) - ;; Replace specified region with output from command. - (let ((swap (and replace (< start end)))) - ;; Don't muck with mark unless REPLACE says we should. - (goto-char start) - (and replace (push-mark)) - (call-process-region start end shell-file-name t t nil - shell-command-switch command) - (let ((shell-buffer (get-buffer "*Shell Command Output*"))) - (and shell-buffer (not (eq shell-buffer (current-buffer))) - (kill-buffer shell-buffer))) - ;; Don't muck with mark unless REPLACE says we should. - (and replace swap (exchange-point-and-mark t))) + current-prefix-arg + shell-command-default-error-buffer + t))) + (let ((error-file + (if error-buffer + (make-temp-file + (expand-file-name "scor" + (or small-temporary-file-directory + (temp-directory)))) + nil)) + (exit-status nil)) + (if (or replace + (and output-buffer + (not (or (bufferp output-buffer) (stringp output-buffer))))) + ;; Replace specified region with output from command. + (let ((swap (and replace (< start end)))) + ;; Don't muck with mark unless REPLACE says we should. + (goto-char start) + (and replace (push-mark)) + (setq exit-status (call-process-region start end shell-file-name t + (if error-file + (list t error-file) + t) + nil shell-command-switch command)) + (let ((shell-buffer (get-buffer "*Shell Command Output*"))) + (and shell-buffer (nnot (eq shell-buffer (current-buffer))) + (kill-buffer shell-buffer))) + ;; Don't muck with mark unless REPLACE says we should. + (and replace swap (exchange-point-and-mark t))) ;; No prefix argument: put the output in a temp buffer, ;; replacing its entire contents. - (let ((buffer (get-buffer-create - (or output-buffer "*Shell Command Output*"))) - (success nil) - (exit-status nil) - (directory default-directory)) - (unwind-protect - (if (eq buffer (current-buffer)) - ;; If the input is the same buffer as the output, - ;; delete everything but the specified region, - ;; then replace that region with the output. - (progn (setq buffer-read-only nil) - (delete-region (max start end) (point-max)) - (delete-region (point-min) (min start end)) - (setq exit-status - (call-process-region (point-min) (point-max) - shell-file-name t t nil - shell-command-switch command)) - (setq success t)) - ;; Clear the output buffer, - ;; then run the command with output there. - (save-excursion - (set-buffer buffer) - (setq buffer-read-only nil) - ;; XEmacs change - (setq default-directory directory) - (erase-buffer)) - (setq exit-status - (call-process-region start end shell-file-name - nil buffer nil - shell-command-switch command)) - (setq success t)) - ;; Report the amount of output. - (let ((lines (save-excursion - (set-buffer buffer) - (if (= (buffer-size) 0) - 0 - (count-lines (point-min) (point-max)))))) - (cond ((= lines 0) - (if success - (display-message - 'command - (if (eql exit-status 0) - "(Shell command succeeded with no output)" - "(Shell command failed with no output)"))) - (kill-buffer buffer)) - ((and success (= lines 1)) - (message "%s" - (save-excursion - (set-buffer buffer) - (goto-char (point-min)) - (buffer-substring (point) - (progn (end-of-line) - (point)))))) - (t - (set-window-start (display-buffer buffer) 1)))))))) + (let ((buffer (get-buffer-create + (or output-buffer "*Shell Command Output*"))) + (directory default-directory)) + (unwind-protect + (if (eq buffer (current-buffer)) + ;; If the input is the same buffer as the output, + ;; delete everything but the specified region, + ;; then replace that region with the output. + (progn (setq buffer-read-only nil) + (delete-region (max start end) (point-max)) + (delete-region (point-min) (min start end)) + (setq exit-status + (call-process-region (point-min) (point-max) + shell-file-name t + (if error-file + (list t error-file) + t) + nil shell-command-switch + command))) + ;; Clear the output buffer, + ;; then run the command with output there. + (save-excursion + (set-buffer buffer) + (setq buffer-read-only nil) + ;; XEmacs change + (setq default-directory directory) + (erase-buffer)) + (setq exit-status + (call-process-region start end shell-file-name + nil + (if error-file + (list buffer error-file) + buffer) + nil shell-command-switch command))) + + ;; Report the output. + (with-current-buffer buffer + (setq modeline-process + (cond ((null exit-status) + " - Error") + ((stringp exit-status) + (format " - Signal [%s]" exit-status)) + ((not (equal 0 exit-status)) + (format " - Exit [%d]" exit-status))))) + (if (with-current-buffer buffer (> (point-max) (point-min))) + ;; There's some output, display it + (let ((lines (save-excursion + (set-buffer buffer) + (if (= (buffer-size) 0) + 0 + (count-lines (point-min) (point-max)))))) + (cond ((= lines 0) + (display-message + 'command + (if (eql exit-status 0) + "(Shell command succeeded with no output)" + "(Shell command failed with no output)")) + (kill-buffer buffer)) + ((= lines 1) + (message "%s" + (save-excursion + (set-buffer buffer) + (goto-char (point-min)) + (buffer-substring (point) + (progn (end-of-line) + (point)))))) + (t + (set-window-start (display-buffer buffer) 1)))) + ;; No output; error? + (let ((output + (if (and error-file + (< 0 (nth 7 (file-attributes error-file)))) + "some error output" + "no output"))) + (cond ((null exit-status) + (message "(Shell command failed with error)")) + ((equal 0 exit-status) + (message "(Shell command succeeded with %s)" + output)) + ((stringp exit-status) + (message "(Shell command killed by signal %s)" + exit-status)) + (t + (message "(Shell command failed with code %d and %s)" + exit-status output)))) + ;; Don't kill: there might be useful info in the undo-log. + ;; (kill-buffer buffer) + )))) + + (when (and error-file (file-exists-p error-file)) + (if (< 0 (nth 7 (file-attributes error-file))) + (with-current-buffer (get-buffer-create error-buffer) + (let ((pos-from-end (- (point-max) (point)))) + (or (bobp) + (insert "\f\n")) + ;; Do no formatting while reading error file, + ;; because that can run a shell command, and we + ;; don't want that to cause an infinite recursion. + (format-insert-file error-file nil) + ;; Put point after the inserted errors. + (goto-char (- (point-max) pos-from-end))) + (and display-error-buffer + (display-buffer (current-buffer))))) + (delete-file error-file)) + exit-status)) (defun shell-quote-argument (argument) "Quote an argument for passing as argument to an inferior shell." diff -r 1b054bc2ac40 -r 11da5b828d10 tests/ChangeLog --- a/tests/ChangeLog Sun Jul 03 14:17:39 2011 +0100 +++ b/tests/ChangeLog Sun Jul 31 01:29:09 2011 +0200 ＠＠ -1,3 +1,7 ＠＠ +2011-07-31 Mats Lidell <matsl(a)xemacs.org&gt; + + * automated/process-tests.el: shell-command tests. + 2011-06-28 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/mule-tests.el: diff -r 1b054bc2ac40 -r 11da5b828d10 tests/automated/process-tests.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/automated/process-tests.el Sun Jul 31 01:29:09 2011 +0200 ＠＠ -0,0 +1,70 ＠＠ +;; Copyright (C) 2011 Free Software Foundation, Inc. + +;; Author: Mats Lidell <matsl(a)xemacs.org&gt; +;; Maintainer: +;; Created: 2011 +;; Keywords: tests + +;; This file is part of XEmacs. + +;; XEmacs is free software: you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by the +;; Free Software Foundation, either version 3 of the License, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>;. + +;;; Synched up with: Not in FSF. + +;;; Commentary: + +;; Test tag support. +;; See test-harness.el for instructions on how to run these tests. + +(require 'test-harness) + +(when (equal system-type 'linux) + (setenv "LANG" "C") + + ;; One line output + (Assert (= 0 (shell-command "echo hello"))) + (Assert (equal "hello" (message-displayed-p t))) + (with-current-buffer " *Echo Area*" + (goto-char (point-min)) + (Assert (looking-at "hello"))) + + ;; Two lines. No output in echo area. (GNU resizes minibuffer but we + ;; haven't implemented that.) + (message "") + (Assert (= 0 (shell-command "echo -e \"foo\nbar\n\""))) + (with-current-buffer " *Echo Area*" + (Assert (= 0 (buffer-size)))) + (with-current-buffer "*Shell Command Output*" + (goto-char (point-min)) + (Assert (looking-at "foo"))): + + (Assert (= 127 (shell-command "unknown_command"))) + (Assert (= 2 (shell-command "exit 2"))) + (Assert (equal "(Shell command failed with code 2 and no output)" (message-displayed-p t))) + + ;; Output to stderr With error buffer + (Assert (= 0 (shell-command "echo -e \"foo\nbar\n\" 1>&2" "Output buffer" "Error buffer"))) + (Assert (equal "(Shell command succeeded with some error output)" (message-displayed-p t))) + (with-current-buffer "Error buffer" + (goto-char (point-min)) + (Assert (looking-at "foo"))) + (with-current-buffer "Output buffer" + (Assert (= 0 (buffer-size)))) + + ;; Output to stderr but no error buffer + (Assert (= 0 (shell-command "echo -e \"foobar\nfoobar\n\" 1>&2" "Output buffer"))) + (with-current-buffer "Output buffer" + (goto-char (point-min)) + (Assert (looking-at "foobar"))) +) Yours -- %% Mats _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches