From: "rick sheridan" <rick.sheridan@channel1.com>
Newsgroups: gnu.emacs.help
Subject: bc++ w/demacs     #02
Date: 29 Aug 92 21:46:42 EST
Reply-To: "rick sheridan" <rick.sheridan@channel1.com>
Distribution: gnu
Organization: Channel 1 Communications

          ... Continued from previous message... Part 2 of 4

	    "No more grep hits" "grep"))

(defun compile1 (command error-message &optional name-of-mode)
  (save-some-buffers)
  (if compilation-process
      (if (or (not (eq (process-status compilation-process) 'run))
	      (yes-or-no-p "A compilation process is running; kill it? "))
	  (condition-case ()
	      (let ((comp-proc compilation-process))
		(interrupt-process comp-proc)
		(sit-for 1)
		(delete-process comp-proc))
	    (error nil))
	(error "Cannot have two compilation processes")))
  (setq compilation-process nil)
  (compilation-forget-errors)
  (setq compilation-error-list t)
  (setq compilation-error-message error-message)
  (if (not (eq system-type 'ms-dos))
      (setq compilation-process
	    (start-process "compilation" "*compilation*"
			   shell-file-name
			   "-c" (concat "exec " command)))
    (get-buffer-create "*compilation*"))
  (with-output-to-temp-buffer "*compilation*"
    (princ "cd ")
    (princ default-directory)
    (terpri)
    (princ command)
    (terpri))
  (let ((regexp compilation-error-regexp))
    (save-excursion
      (set-buffer "*compilation*")
      (make-local-variable 'compilation-error-regexp)
      (setq compilation-error-regexp regexp)))
  (if (not (eq system-type 'ms-dos))
      (set-process-sentinel compilation-process 'compilation-sentinel))
  (let* ((thisdir default-directory)
	 (outbuf (if (not (eq system-type 'ms-dos))
		     (process-buffer compilation-process)
		   (get-buffer "*compilation*")))		
	 (outwin (get-buffer-window outbuf)))
    (if (eq outbuf (current-buffer))
	(goto-char (point-max)))
    (save-excursion
      (set-buffer outbuf)
      (buffer-flush-undo outbuf)
      (let ((start (save-excursion (set-buffer outbuf) (point-min))))
	(set-window-start outwin start)
	(or (eq outwin (selected-window))
	    (set-window-point outwin start)))
      (setq default-directory thisdir)
      (fundamental-mode)
      (setq mode-name (or name-of-mode "Compilation"))
      ;; Make log buffer's mode line show process state
      (if (not (eq system-type 'ms-dos))
	  (setq mode-line-process '(": %s"))
	(progn
	  (message "Running program...")
	  (goto-char (point-max))
	  (call-process shell-file-name nil standard-output nil "\/c" command)
	  (message "Running program...done"))))))


;; Called when compilation process changes state.

(defun compilation-sentinel (proc msg)
  (cond ((null (buffer-name (process-buffer proc)))
	 ;; buffer killed
	 (set-process-buffer proc nil))
	((memq (process-status proc) '(signal exit))
	 (let* ((obuf (current-buffer))
		omax opoint)
	   ;; save-excursion isn't the right thing if
	   ;;  process-buffer is current-buffer
	   (unwind-protect
	       (progn
		 ;; Write something in *compilation* and hack its mode line,
		 (set-buffer (process-buffer proc))
		 (setq omax (point-max) opoint (point))
		 (goto-char (point-max))
		 (insert ?\n mode-name " " msg)
		 (forward-char -1)
		 (insert " at "
			 (substring (current-time-string) 0 -5))
		 (forward-char 1)
		 (setq mode-line-process
		       (concat ": "
			       (symbol-name (process-status proc))))
		 ;; If buffer and mode line will show that the process
		 ;; is dead, we can delete it now.  Otherwise it
		 ;; will stay around until M-x list-processes.
		 (delete-process proc))


                 Stay Tuned ... Continued in next message

---
  PMDBM DEMO V1.5 #0  Evaluation Copy
--
Channel 1 (R)   Cambridge, MA