jgk@osc.COM (Joe Keane) (08/29/90)
Here is the latest and greatest version of background mode for GNU Emacs.
Basically, as they name says, it lets you run commands in the background.
It's got all sorts of nifty goodies, but you'll just have to try it to find
them. I don't know of any bugs, but you can consider this a beta-test
version. All comments are appreciated. To use it, stick the following stuff
in a file called `background.el' somewhere in your load path. Then put
something like this in your `.emacs':
(autoload 'background "background" nil t)
(global-set-key "\M-!" 'background)
- - - everything after this line goes in `background.el' - - -
;; Background jobs in GNU Emacs
;; Copyright (C) 1990 Joe Keane <jgk@osc.com>
;; Refer to the GNU Emacs General Public License for copyright info
(require 'shell)
(provide 'background)
;; define global variables
(defvar background-minibuffer-map (make-keymap)
"The keymap to use when prompting the user for a background command.")
(defvar background-history-size 0
"The number of commands in the background command history.")
(defvar background-history-vector (make-vector 16 nil)
"A vector containing the background command history. Position zero is unused.")
(defvar background-search-last-string ""
"Last string searched for by a background search.")
;; add bindings to shell-mode-map
(define-key shell-mode-map "\C-c\C-k" 'kill-shell-subjob)
(define-key shell-mode-map "\C-c\C-m" 'continue-shell-subjob)
(define-key shell-mode-map "\C-c\C-z" 'stop-shell-subjob)
;; add bindings to background-minibuffer-map
(define-key background-minibuffer-map "\C-g" 'abort-recursive-edit)
(define-key background-minibuffer-map "\C-m" 'exit-minibuffer)
(define-key background-minibuffer-map "\C-n" 'background-next-command)
(define-key background-minibuffer-map "\C-p" 'background-previous-command)
(define-key background-minibuffer-map "\C-r" 'background-search-backward)
(define-key background-minibuffer-map "\C-s" 'background-search-forward)
;; missing from shell-mode
(defun continue-shell-subjob ()
"Send continue signal to this shell's current subjob."
(interactive)
(continue-process nil t))
;; move around in command history
(defun background-next-command (arg)
"Go to the ARG'th next background command."
(interactive "p")
(background-previous-command (- arg)))
(defun background-previous-command (arg)
"Go to ARG'th previous background command."
(interactive "p")
(setq scrolling t)
(setq
history-index
(if (>= arg 0)
(let
((index (- (or history-index (1+ background-history-size)) arg)))
(and (<= index 0) (error "Beginning of command history"))
index)
(let
((index (- (or history-index 0) arg)))
(and (> index background-history-size) (error "End of command history"))
index)))
(exit-minibuffer))
;; search in command history
(defun background-search-backward ()
"Search backward through the background command history. If you know how to
use isearch you should be able to figure this out."
(interactive)
(background-search nil))
(defun background-search-forward ()
"Same as background-search-backward except forward."
(interactive)
(background-search t))
(defun background-search (forward)
"Function to do the work of searching through background command history."
(let
((search-string "")
failing
wrapped
(search-index (or history-index (if forward 1 background-history-size)))
loop-index)
(while
(progn
(message
"%s%s%s\"%s\" %d%% %s"
(if failing "F" "")
(if wrapped "W" "")
(if forward "S" "R")
search-string
search-index
(aref background-history-vector search-index))
(setq loop-index search-index)
(let
((char (read-char))
(continue t))
(cond
((= char search-exit-char)
(setq continue nil))
((= char search-reverse-char)
(and (string-equal search-string "")
(setq search-string background-search-last-string))
(setq
loop-index
(if (and failing (not forward))
(progn (setq wrapped t) background-history-size)
(1- search-index)))
(setq forward nil))
((= char search-repeat-char)
(and (string-equal search-string "")
(setq search-string background-search-last-string))
(setq
loop-index
(if (and failing forward)
(progn (setq wrapped t) 1)
(1+ search-index)))
(setq forward t))
((= char search-delete-char)
(setq failing nil)
(setq
search-string
(if (string-equal search-string "")
background-search-last-string
(substring search-string 0 -1))))
((= char search-quote-char)
(message "quote")
(setq
search-string
(concat search-string (char-to-string (read-quoted-char)))))
((or (< char 32) (>= char 128))
(setq unread-command-char char)
(setq continue nil))
(t
(setq
search-string
(concat search-string (char-to-string char)))))
continue))
(if forward
(while
(if (> loop-index background-history-size)
(progn (setq failing t) nil)
(or
(not
(string-match
search-string
(aref background-history-vector loop-index)))
(progn
(setq failing nil)
(setq search-index loop-index)
nil)))
(setq loop-index (1+ loop-index)))
(while
(if (<= loop-index 0)
(progn (setq failing t) nil)
(or
(not
(string-match
search-string
(aref background-history-vector loop-index)))
(progn
(setq failing nil)
(setq search-index loop-index)
nil)))
(setq loop-index (1- loop-index)))))
(setq scrolling t)
(setq history-index search-index)
(setq background-search-last-string search-string))
(exit-minibuffer))
;; main function
(defun background (command)
"Run COMMAND as a background job like csh. When entering the command, ^P and
^N and ^R and ^S do interesting things with the command history. Some bang
commands are interpreted. A message is displayed when the job starts and
finishes, or otherwise changes state. The job's buffer is in shell mode, so
you can send input and signals to the job. A prefix argument suggest a job
number, which is useful to store output."
(interactive
(list
(let
((prompt "% ")
default-command
command
history-index)
(while
(progn
(while
(let
(scrolling)
(setq
command
(read-from-minibuffer
prompt
default-command
background-minibuffer-map))
scrolling)
(setq prompt (concat history-index "% "))
(setq
default-command
(aref background-history-vector history-index)))
(string-match "^!" command))
(cond
((string-match "^!!" command)
(setq history-index background-history-size))
((string-match "^!-?[0-9]+" command)
(let
((index
(if (string-match "^!-" command)
(-
(1+ background-history-size)
(string-to-int (substring command 2)))
(string-to-int (substring command 1)))))
(if (and (> index 0) (<= index background-history-size))
(setq history-index index)
(progn (message "Bad history index") (sit-for 1)))))
(t
(let*
((index background-history-size)
(flag (string-match "^!\\?" command))
(event (substring command (if flag 2 1)))
(pattern (if flag event (concat "^" event))))
(while
(if (<= index 0)
(progn
(message "%s: Event not found" event)
(sit-for 1)
nil)
(or
(not
(string-match
pattern
(aref background-history-vector index)))
(progn (setq history-index index) nil)))
(setq index (1- index))))))
(and history-index
(progn
(setq prompt (concat history-index "% "))
(setq
default-command
(aref background-history-vector history-index)))))
command)))
(prog1
(let*
((job-number (if (numberp current-prefix-arg) current-prefix-arg 1))
(process
(let (job-name)
(while
(get-process (setq job-name (concat "%" job-number)))
(setq job-number (1+ job-number)))
(setq default-directory
(prog1
(if (not (string-match
"^[\t ]*cd[\t ]+\\([^\t ;]+\\)[\t ]*;[\t ]*"
command))
default-directory
(prog1
(file-name-as-directory
(expand-file-name
(substring
command
(match-beginning 1)
(match-end 1))))
(setq command (substring command (match-end 0)))))
(if (equal current-prefix-arg '(4))
(pop-to-buffer job-name)
(or (numberp current-prefix-arg)
(with-output-to-temp-buffer job-name))
(set-buffer (get-buffer-create job-name)))
(erase-buffer)))
(start-process
job-name (current-buffer) shell-file-name "-c" command))))
(insert "*** Start \"" command "\" in " default-directory " at "
(substring (current-time-string) 11 19) ?\n)
(set-marker (process-mark process) (point))
(set-process-sentinel
process
(function
(lambda (process info)
(message
"[%s] %s %s"
(substring (process-name process) 1)
(setq
info
(cond
((string-equal info "finished\n") "Done")
((string-match "^exit" info)
(concat "Exit " (process-exit-status process)))
((string-equal info "") "Continuing")
(t
(concat (upcase (substring info 0 1)) (substring info 1 -1)))))
(nth 2 (process-command process)))
(let
((buffer (process-buffer process)))
(if (null (buffer-name buffer))
(set-process-buffer process nil)
(and
(memq (process-status process) '(signal exit))
(save-excursion
(set-buffer buffer)
(goto-char (point-max))
(insert "*** " info " at "
(substring (current-time-string) 11 19) ?\n)
(set-buffer-modified-p nil)
(undo-boundary))))))))
(message "[%d] %d" job-number (process-id process))
process)
(shell-mode)
(setq mode-name "Background")
(or
(let
((previous-command
(aref background-history-vector background-history-size)))
(and previous-command (string-equal command previous-command)))
(progn
(let
((capacity (length background-history-vector)))
(and
(>=
(setq background-history-size (1+ background-history-size))
capacity)
(progn
(let*
((history-index 0)
(new-vector (make-vector (* 2 capacity) nil)))
(while
(progn
(aset
new-vector
history-index
(aref background-history-vector history-index))
(<
(setq history-index (1+ history-index))
background-history-size)))
(setq background-history-vector new-vector)))))
(aset background-history-vector background-history-size command)))))