home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / comint / background.el next >
Encoding:
Text File  |  1995-04-17  |  4.6 KB  |  113 lines
  1. ;;; background.el --- fun with background jobs
  2.  
  3. ;; Copyright (C) 1988 Joe Keane <jk3k+@andrew.cmu.edu>
  4. ;; Keywords: processes
  5.  
  6. ;; This file is part of XEmacs.
  7. ;; 
  8. ;; XEmacs is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 2 of the License, or
  11. ;; (at your option) any later version.
  12. ;; 
  13. ;; XEmacs is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;; GNU General Public License for more details.
  17. ;; 
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with XEmacs; if not, write to the Free Software
  20. ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ;; - Adapted to use comint and cleaned up somewhat. Olin Shivers 5/90
  23. ;; - Background failed to set the process buffer's working directory
  24. ;;   in some cases. Fixed. Olin 6/14/90
  25. ;; - Background failed to strip leading cd's off the command string
  26. ;;   after performing them. This screwed up relative pathnames.
  27. ;;   Furthermore, the proc buffer's default dir wasn't initialised 
  28. ;;   to the user's buffer's default dir before doing the leading cd.
  29. ;;   This also screwed up relative pathnames if the proc buffer already
  30. ;;   existed and was set to a different default dir. Hopefully we've
  31. ;;   finally got it right. The pwd is now reported in the buffer
  32. ;;   just to let the user know. Bug reported by Piet Van Oostrum.
  33. ;;   Olin 10/19/90
  34. ;; - Fixed up the sentinel to protect match-data around invocations.
  35. ;;   Also slightly rearranged the cd match code for similar reasons.
  36. ;;   Olin 7/16/91
  37.  
  38. (provide 'background)
  39. (require 'comint)
  40.  
  41. ;; user variables
  42. (defvar background-show t
  43.   "*If non-nil, background jobs' buffers are shown when they're started.")
  44. (defvar background-select nil
  45.   "*If non-nil, background jobs' buffers are selected when they're started.")
  46.  
  47. (defun background (command)
  48.   "Run COMMAND in the background like csh.  
  49. A message is displayed when the job starts and finishes.  The buffer is in
  50. comint mode, so you can send input and signals to the job.  The process object
  51. is returned if anyone cares.  See also comint-mode and the variables
  52. background-show and background-select."
  53.   (interactive "s%% ")
  54.   (let ((job-number 1)
  55.         job-name
  56.         buffer-name
  57.     (dir default-directory))
  58.     (while (get-process (setq job-name (format "background-%d" job-number)))
  59.       (setq job-number (1+ job-number)))
  60.     (setq buffer-name (format "*%s*" job-name))
  61.     (if background-select (pop-to-buffer buffer-name)
  62.       (if background-show (with-output-to-temp-buffer buffer-name)) ; cute
  63.       (set-buffer (get-buffer-create buffer-name)))
  64.     (erase-buffer)
  65.  
  66.     (setq default-directory dir) ; Do this first, in case cd is relative path.
  67.     (if (string-match "^cd[\t ]+\\([^\t ;]+\\)[\t ]*;[\t ]*" command)
  68.     (let ((dir (substring command (match-beginning 1) (match-end 1))))
  69.        (setq command (substring command (match-end 0)))
  70.        (setq default-directory
  71.          (file-name-as-directory (expand-file-name dir)))))
  72.  
  73.     (insert "--- working directory: " default-directory
  74.         "\n% " command ?\n)
  75.  
  76.     (let ((proc (get-buffer-process
  77.          (comint-exec buffer-name job-name shell-file-name
  78.                   nil (list "-c" command)))))
  79.       (comint-mode)
  80.       ;; COND because the proc may have died before the G-B-P is called.
  81.       (cond (proc (set-process-sentinel proc 'background-sentinel)
  82.           (message "[%d] %d" job-number (process-id proc))))
  83.       (setq mode-name "Background")
  84.       proc)))
  85.  
  86.  
  87. (defun background-sentinel (process msg)
  88.   "Called when a background job changes state."
  89.   (let ((ms (match-data))) ; barf
  90.     (unwind-protect
  91.      (let ((msg (cond ((string= msg "finished\n") "Done")
  92.               ((string-match "^exited" msg)
  93.                (concat "Exit " (substring msg 28 -1)))
  94.               ((zerop (length msg)) "Continuing")
  95.               (t (concat (upcase (substring msg 0 1))
  96.                      (substring msg 1 -1))))))
  97.        (message "[%s] %s %s" (substring (process-name process) 1)
  98.             msg
  99.             (nth 2 (process-command process)))
  100.        (if (null (buffer-name (process-buffer process)))
  101.            (set-process-buffer process nil) ; WHY? Olin.
  102.            (if (memq (process-status process) '(signal exit))
  103.            (save-excursion
  104.              (set-buffer (process-buffer process))
  105.              (let ((at-end (eobp)))
  106.                (save-excursion
  107.              (goto-char (point-max))
  108.              (insert ?\n msg ? 
  109.                  (substring (current-time-string) 11 19) ?\n))
  110.                (if at-end (goto-char (point-max))))
  111.              (set-buffer-modified-p nil)))))
  112.       (store-match-data ms))))
  113.