home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #30 / NN_1992_30.iso / spool / gnu / emacs / sources / 868 < prev    next >
Encoding:
Text File  |  1992-12-16  |  4.2 KB  |  103 lines
  1. Newsgroups: gnu.emacs.sources
  2. Path: sparky!uunet!cis.ohio-state.edu!fly.cnuce.cnr.it!pot
  3. From: pot@fly.cnuce.cnr.it (Francesco Potorti`)
  4. Subject: emacs elisp files for gopher
  5. Message-ID: <m0n1wvB-0001C7C@fly.cnuce.cnr.IT>
  6. Sender: daemon@cis.ohio-state.edu
  7. Reply-To: pot@cnuce.cnr.it
  8. Organization: Source only  Discussion and requests in gnu.emacs.help.
  9. References: <MARCA.92Dec12210219@wintermute.ncsa.uiuc.edu>
  10. Distribution: gnu
  11. Date: Wed, 16 Dec 1992 13:28:00 GMT
  12. Lines: 89
  13.  
  14. A more up to date background.el version that fixes some bugs follows.
  15. Someone from the dired mailing list sent it to me.  It should probably
  16. replace the old one in the elisp archive:
  17.  
  18. ;; Fun with background jobs.
  19. ;; Copyright (C) 1988 Joe Keane <jk3k+@andrew.cmu.edu>
  20. ;; Refer to the GNU Emacs General Public License for copyright info.
  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.  
  35. (provide 'background)
  36. (require 'comint)
  37.  
  38. ;; user variables
  39. (defvar background-show t
  40.   "*If non-nil, background jobs' buffers are shown when they're started.")
  41. (defvar background-select nil
  42.   "*If non-nil, background jobs' buffers are selected when they're started.")
  43.  
  44. (defun background (command)
  45.   "Run COMMAND in the background like csh.  
  46. A message is displayed when the job starts and finishes.  The buffer is in
  47. comint mode, so you can send input and signals to the job.  The process object
  48. is returned if anyone cares.  See also comint-mode and the variables
  49. background-show and background-select."
  50.   (interactive "s%% ")
  51.   (let ((job-number 1)
  52.     (job-name "%1")
  53.     (dir default-directory))
  54.     (while (process-status job-name)
  55.       (setq job-name (concat "%" (setq job-number (1+ job-number)))))
  56.     (if background-select (pop-to-buffer job-name)
  57.       (if background-show (with-output-to-temp-buffer job-name)) ; cute
  58.       (set-buffer (get-buffer-create job-name)))
  59.     (erase-buffer)
  60.     (setq default-directory dir) ; Do this first, in case cd is relative path.
  61.     (cond ((string-match "^cd[\t ]+\\([^\t ;]+\\)[\t ]*;[\t ]*" command)
  62.        (setq dir (substring command (match-beginning 1) (match-end 1))
  63.          command (substring command (match-end 0)))
  64.        (setq default-directory
  65.          (file-name-as-directory
  66.           (expand-file-name dir)))))
  67.     (insert "--- working directory: " default-directory
  68.         "\n% " command ?\n)
  69.     (let ((proc (get-buffer-process
  70.          (comint-exec job-name job-name shell-file-name
  71.                   nil (list "-c" command)))))
  72.       (comint-mode)
  73.       ;; COND because the proc may have died before the G-B-P is called.
  74.       (cond (proc (set-process-sentinel proc 'background-sentinel)
  75.           (message "[%d] %d" job-number (process-id proc))))
  76.       (setq mode-name "Background")
  77.       proc)))
  78.  
  79. (defun background-sentinel (process msg)
  80.   "Called when a background job changes state."
  81.   (let ((msg (cond ((string= msg "finished\n") "Done")
  82.            ((string-match "^exited" msg)
  83.             (concat "Exit " (substring msg 28 -1)))
  84.            ((zerop (length msg)) "Continuing")
  85.            (t (concat (upcase (substring msg 0 1))
  86.                   (substring msg 1 -1))))))
  87.     (message "[%s] %s %s" (substring (process-name process) 1)
  88.                       msg
  89.               (nth 2 (process-command process)))
  90.     (if (null (buffer-name (process-buffer process)))
  91.     (set-process-buffer process nil) ; WHY? Olin.
  92.     (if (memq (process-status process) '(signal exit))
  93.         (save-excursion
  94.           (set-buffer (process-buffer process))
  95.           (let ((at-end (eobp)))
  96.         (save-excursion
  97.           (goto-char (point-max))
  98.           (insert ?\n msg ? 
  99.               (substring (current-time-string) 11 19) ?\n))
  100.         (if at-end (goto-char (point-max))))
  101.           (set-buffer-modified-p nil))))))
  102.  
  103.