home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #19 / NN_1992_19.iso / spool / gnu / emacs / help / 3890 < prev    next >
Encoding:
Text File  |  1992-08-30  |  3.7 KB  |  116 lines
  1. Path: sparky!uunet!channel1![rick.sheridan@channel1.com]
  2. From: "rick sheridan" <rick.sheridan@channel1.com>
  3. Newsgroups: gnu.emacs.help
  4. Subject: bc++ w/demacs     #02
  5. Message-ID: <1992Aug29.1277.2639@channel1>
  6. Date: 29 Aug 92 21:46:42 EST
  7. Reply-To: "rick sheridan" <rick.sheridan@channel1.com>
  8. Distribution: gnu
  9. Organization: Channel 1 Communications
  10. Lines: 104
  11.  
  12.           ... Continued from previous message... Part 2 of 4
  13.  
  14.         "No more grep hits" "grep"))
  15.  
  16. (defun compile1 (command error-message &optional name-of-mode)
  17.   (save-some-buffers)
  18.   (if compilation-process
  19.       (if (or (not (eq (process-status compilation-process) 'run))
  20.           (yes-or-no-p "A compilation process is running; kill it? "))
  21.       (condition-case ()
  22.           (let ((comp-proc compilation-process))
  23.         (interrupt-process comp-proc)
  24.         (sit-for 1)
  25.         (delete-process comp-proc))
  26.         (error nil))
  27.     (error "Cannot have two compilation processes")))
  28.   (setq compilation-process nil)
  29.   (compilation-forget-errors)
  30.   (setq compilation-error-list t)
  31.   (setq compilation-error-message error-message)
  32.   (if (not (eq system-type 'ms-dos))
  33.       (setq compilation-process
  34.         (start-process "compilation" "*compilation*"
  35.                shell-file-name
  36.                "-c" (concat "exec " command)))
  37.     (get-buffer-create "*compilation*"))
  38.   (with-output-to-temp-buffer "*compilation*"
  39.     (princ "cd ")
  40.     (princ default-directory)
  41.     (terpri)
  42.     (princ command)
  43.     (terpri))
  44.   (let ((regexp compilation-error-regexp))
  45.     (save-excursion
  46.       (set-buffer "*compilation*")
  47.       (make-local-variable 'compilation-error-regexp)
  48.       (setq compilation-error-regexp regexp)))
  49.   (if (not (eq system-type 'ms-dos))
  50.       (set-process-sentinel compilation-process 'compilation-sentinel))
  51.   (let* ((thisdir default-directory)
  52.      (outbuf (if (not (eq system-type 'ms-dos))
  53.              (process-buffer compilation-process)
  54.            (get-buffer "*compilation*")))        
  55.      (outwin (get-buffer-window outbuf)))
  56.     (if (eq outbuf (current-buffer))
  57.     (goto-char (point-max)))
  58.     (save-excursion
  59.       (set-buffer outbuf)
  60.       (buffer-flush-undo outbuf)
  61.       (let ((start (save-excursion (set-buffer outbuf) (point-min))))
  62.     (set-window-start outwin start)
  63.     (or (eq outwin (selected-window))
  64.         (set-window-point outwin start)))
  65.       (setq default-directory thisdir)
  66.       (fundamental-mode)
  67.       (setq mode-name (or name-of-mode "Compilation"))
  68.       ;; Make log buffer's mode line show process state
  69.       (if (not (eq system-type 'ms-dos))
  70.       (setq mode-line-process '(": %s"))
  71.     (progn
  72.       (message "Running program...")
  73.       (goto-char (point-max))
  74.       (call-process shell-file-name nil standard-output nil "\/c" command)
  75.       (message "Running program...done"))))))
  76.  
  77.  
  78. ;; Called when compilation process changes state.
  79.  
  80. (defun compilation-sentinel (proc msg)
  81.   (cond ((null (buffer-name (process-buffer proc)))
  82.      ;; buffer killed
  83.      (set-process-buffer proc nil))
  84.     ((memq (process-status proc) '(signal exit))
  85.      (let* ((obuf (current-buffer))
  86.         omax opoint)
  87.        ;; save-excursion isn't the right thing if
  88.        ;;  process-buffer is current-buffer
  89.        (unwind-protect
  90.            (progn
  91.          ;; Write something in *compilation* and hack its mode line,
  92.          (set-buffer (process-buffer proc))
  93.          (setq omax (point-max) opoint (point))
  94.          (goto-char (point-max))
  95.          (insert ?\n mode-name " " msg)
  96.          (forward-char -1)
  97.          (insert " at "
  98.              (substring (current-time-string) 0 -5))
  99.          (forward-char 1)
  100.          (setq mode-line-process
  101.                (concat ": "
  102.                    (symbol-name (process-status proc))))
  103.          ;; If buffer and mode line will show that the process
  104.          ;; is dead, we can delete it now.  Otherwise it
  105.          ;; will stay around until M-x list-processes.
  106.          (delete-process proc))
  107.  
  108.  
  109.                  Stay Tuned ... Continued in next message
  110.  
  111. ---
  112.  ■ PMDBM DEMO V1.5ß #0 ■ Evaluation Copy
  113. --
  114. Channel 1 (R)   Cambridge, MA
  115.  
  116.