;;; Name:              callp-err.el
;;; Author:            Juergen Nickelsen <Juergen.Nickelsen@cs.tu-berlin.de>
;;; Version:           1.2 
;;; State:             frozen
;;; Last modification: Fri Jun 25 16:41:54 1993 by andy@cs.tu-berlin.de

(defvar callp-err-copyright
  " Copyright (C) 1993 by the author(s).
 
 This software is published in the hope that it will be useful, but
 WITHOUT ANY WARRANTY for any part of this software to work correctly
 or as described in the manuals. See the ShapeTools Public License
 for details.

 Permission is granted to use, copy, modify, or distribute any part of
 this software but only under the conditions described in the ShapeTools 
 Public License. A copy of this license is supposed to have been given
 to you along with ShapeTools in a file named LICENSE. Among other
 things, this copyright notice and the Public License must be
 preserved on all copies.
"
  "Copyright notice for this file.")

(provide 'callp-err)

(defun call-process-with-error (command buffer &optional noerror)
  "Call the shell-command in COMMAND in a separate process.  Insert
output in BUFFER before point; t means current buffer; nil for BUFFER
means discard it. BUFFER may be a buffer name.
Optional third arg NOERROR non-nil means don't raise an error but
silently return nil.
This function waits for COMMAND to terminate; if you quit, the process
is killed.
On succesful termination of COMMAND t is returned.
If the command returns a non-zero exit status and NOERROR is not given
or nil, the command output is displayed in a separate window and an
error is raised.
The implementation is a weird hack since the exit status of the
inferior process is tested by a shell, which inserts a message into a
buffer. Commands containing an exit statement for the shell are not
properly handled.
Based on code from levin@eos.ncsu.edu (Dr. Hal Levin)."
  (let* ((old-buffer (current-buffer))
	 (process-error-string "\nProcess terminated with error")
	 (bourne-shell "/bin/sh")
	 (process-ok-string "OK")
	 (bufname "*Process Error*")
	 (error-buffer (get-buffer-create bufname)))
    (set-buffer error-buffer)
    (erase-buffer)
    (call-process bourne-shell nil error-buffer nil
		  "-c" (concat command 
			       ";if test $? != 0\nthen\necho '"
			       process-error-string
			       "'\nelse\necho "
			       process-ok-string
			       "\nfi"))
    (if (string-match (concat process-error-string "\n$")
		      (buffer-string))
	(if noerror 
	    nil
	  (progn
	    (goto-char (point-max))
	    (pop-to-buffer error-buffer)
	    (other-window 1)
	    (error (substitute-command-keys 
		    "Type \\[delete-other-windows] to remove error window"))))
      (if buffer
	  (progn
	    (delete-region (1+ (string-match (concat process-ok-string "\n$")
					   (buffer-string)))
			 (point-max))
	    (let ((contents (buffer-string))
		  (target-buffer (cond ((eq buffer t) old-buffer)
				       ((stringp buffer) 
					(generate-new-buffer buffer))
				       (t buffer))))
	      (set-buffer target-buffer)
	      (insert contents))))
      (set-buffer old-buffer)
      (kill-buffer error-buffer)
      t)))