home *** CD-ROM | disk | FTP | other *** search
/ The Pier Shareware 6 / The_Pier_Shareware_Number_6_(The_Pier_Exchange)_(1995).iso / 033 / atcp40de.zip / BACKGROU.EL < prev    next >
Lisp/Scheme  |  1994-10-07  |  4KB  |  116 lines
  1. ;From arpa-unix-emacs-request@ALEXANDER.BBN.COM Thu Jan 28 22:54:04 1988
  2. ;Received: from alexander by ALEXANDER.BBN.COM id aa26822; 28 Jan 88 22:18 EST
  3. ;Received: from [128.89.0.122] by ALEXANDER.BBN.COM id aa26818;
  4. ;          28 Jan 88 22:18 EST
  5. ;Received: from po5.andrew.cmu.edu by BBN.COM id aa27563; 28 Jan 88 22:17 EST
  6. ;Received: by po5.andrew.cmu.edu (5.54/3.15) id <AA01448> for unix-emacs@bbn.com; Thu, 28 Jan 88 22:15:01 EST
  7. ;Received: via switchmail; Thu, 28 Jan 88 22:14:57 -0500 (EST)
  8. ;Received: FROM kittanning.andrew.cmu.edu VIA qmail
  9. ;          ID </cmu/common/mailqs/q004/QF.kittanning.andrew.cmu.edu.21fffc3b.c93a>;
  10. ;          Thu, 28 Jan 88 22:13:05 -0500 (EST)
  11. ;Received: FROM kittanning.andrew.cmu.edu VIA qmail
  12. ;          ID </cmu/math/jk3k/.Outgoing/QF.kittanning.andrew.cmu.edu.21fffbf6.43019e>;
  13. ;          Thu, 28 Jan 88 22:11:52 -0500 (EST)
  14. ;Received: from Messages.6.02.CUILIB.3.41.SNAP.NOT.LINKED.kittanning.andrew.cmu.edu.vax.11
  15. ;          via MS.4.1.kittanning.andrew.cmu.edu.vax_11;
  16. ;          Thu, 28 Jan 88 22:11:49 -0500 (EST)
  17. ;Message-Id: <kVzzjpyT2k-0UNs0XY@andrew.cmu.edu>
  18. ;Date: Thu, 28 Jan 88 22:11:49 -0500 (EST)
  19. ;From: "Joseph G. Keane" <jk3k+@ANDREW.CMU.EDU>
  20. ;X-Andrew-Message-Size: 3169+0
  21. ;To: unix-emacs@BBN.COM
  22. ;Subject: background.el
  23. ;
  24. ;
  25. ;Here's a useful file which provides a csh-like interface to background jobs.  
  26. ;I like to bind background to ESC !.  Please send back any modifications.  
  27. ;--Joe
  28. ;;; Fun with background jobs.
  29. ;; Copyright (C) 1988 Joe Keane <jk3k+@andrew.cmu.edu>
  30. ;; Refer to the GNU Emacs General Public License for copyright info
  31.  
  32. ;; user variables
  33. (defvar background-show t
  34.   "*If non-nil, background jobs' buffers are shown when they're started.")
  35. (defvar background-select nil
  36.   "*If non-nil, background jobs' buffers are selected when they're started.")
  37.  
  38. ;; patches to shell-mode
  39. (require 'shell)
  40. (define-key shell-mode-map "\C-c\C-f" 'continue-shell-subjob)
  41. (define-key shell-mode-map "\C-c\C-k" 'kill-shell-subjob)
  42. (defun continue-shell-subjob ()
  43.   "Continue this shell's current subjob."
  44.   (interactive)
  45.   (continue-process nil t))
  46.  
  47. (defun background (command)
  48.   "Run COMMAND in the background like csh.  A message is displayed when
  49. the job starts and finishes.  The buffer is in shell mode, so among
  50. other things you can control the job and send input to it.  The
  51. process object is returned if anyone cares.  See also shell-mode and
  52. the variables background-show and background-select."
  53.   (interactive "s%% ")
  54.   (let*
  55.       ((job-number 1)
  56.        (process
  57.     (let ((job-name "%1"))
  58.       (while (process-status job-name)
  59.         (setq job-name (concat "%" (setq job-number (1+ job-number)))))
  60.       (setq default-directory
  61.        (prog1
  62.            (if (string-match
  63.             "^cd[\t ]+\\([^\t ;]+\\)[\t ]*;[\t ]*"
  64.             command)
  65.            (prog1
  66.                (file-name-as-directory
  67.             (expand-file-name
  68.              (substring command
  69.               (match-beginning 1) (match-end 1))))
  70.              (setq command (substring command (match-end 0))))
  71.          default-directory)
  72.          (if background-select (pop-to-buffer job-name)
  73.            (and background-show (with-output-to-temp-buffer job-name))
  74.            (set-buffer (get-buffer-create job-name)))))
  75.       (start-process job-name job-name shell-file-name "-c" command))))
  76.     (message "[%d] %d" job-number (process-id process))
  77.     (erase-buffer)
  78.     (insert "% cd " default-directory "\n% " command ?\n)
  79.     (set-marker (process-mark process) (point))
  80.     (set-process-sentinel process 'background-sentinel)
  81.     (shell-mode)
  82.     (setq mode-name "Background")
  83.     process))
  84.  
  85. (defun background-sentinel (process msg)
  86.   "Called when a background job changes state."
  87.   (message
  88.    "[%s] %s %s"
  89.    (substring (process-name process) 1)
  90.    (setq msg
  91.     (cond
  92.      ((string= msg "finished\n") "Done")
  93.      ((string-match "^exited" msg)
  94.       (concat "Exit " (substring msg 28 -1)))
  95.      ((zerop (length msg)) "Continuing") ;;Emacs bug
  96.      (t (concat (upcase (substring msg 0 1)) (substring msg 1 -1)))))
  97.    (nth 2 (process-command process)))
  98.   (if (buffer-name (process-buffer process))
  99.       (and
  100.        (memq (process-status process) '(signal exit))
  101.        (set-buffer
  102.     (prog1 (current-buffer)
  103.       (set-buffer (process-buffer process))
  104.       (and
  105.        (prog1 (eobp)
  106.          (save-excursion
  107.            (goto-char (point-max))
  108.            (insert ?\n msg ? 
  109.         (substring (current-time-string) 11 19) ?\n)))
  110.        (goto-char (point-max)))
  111.       (set-buffer-modified-p nil))))
  112.     (set-process-buffer process nil)))
  113.  
  114.  
  115.  
  116.