|
|
1.1 root 1: ;; Run asynchronous VMS subprocesses under Emacs
2: ;; Copyright (C) 1986 Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is free software; you can redistribute it and/or modify
7: ;; it under the terms of the GNU General Public License as published by
8: ;; the Free Software Foundation; either version 1, or (at your option)
9: ;; any later version.
10:
11: ;; GNU Emacs is distributed in the hope that it will be useful,
12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: ;; GNU General Public License for more details.
15:
16: ;; You should have received a copy of the GNU General Public License
17: ;; along with GNU Emacs; see the file COPYING. If not, write to
18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19:
20: ;; Written by Mukesh Prasad.
21:
22: (defvar display-subprocess-window nil
23: "If non-nil, the suprocess window is displayed whenever input is received.")
24:
25: (defvar command-prefix-string "$ "
26: "String to insert to distinguish commands entered by user.")
27:
28: (defvar subprocess-running nil)
29: (defvar command-mode-map nil)
30:
31: (if command-mode-map
32: nil
33: (setq command-mode-map (make-sparse-keymap))
34: (define-key command-mode-map "\C-m" 'command-send-input)
35: (define-key command-mode-map "\C-u" 'command-kill-line))
36:
37: (defun subprocess-input (name str)
38: "Handles input from a subprocess. Called by Emacs."
39: (if display-subprocess-window
40: (display-buffer subprocess-buf))
41: (let ((old-buffer (current-buffer)))
42: (set-buffer subprocess-buf)
43: (goto-char (point-max))
44: (insert str)
45: (insert ?\n)
46: (set-buffer old-buffer)))
47:
48: (defun subprocess-exit (name)
49: "Called by Emacs upon subprocess exit."
50: (setq subprocess-running nil))
51:
52: (defun start-subprocess ()
53: "Spawns an asynchronous subprocess with output redirected to
54: the buffer *COMMAND*. Within this buffer, use C-m to send
55: the last line to the subprocess or to bring another line to
56: the end."
57: (if subprocess-running
58: (return t))
59: (setq subprocess-buf (get-buffer-create "*COMMAND*"))
60: (save-excursion
61: (set-buffer subprocess-buf)
62: (use-local-map command-mode-map))
63: (setq subprocess-running (spawn-subprocess 1 'subprocess-input
64: 'subprocess-exit))
65: ;; Initialize subprocess so it doesn't panic and die upon
66: ;; encountering the first error.
67: (and subprocess-running
68: (send-command-to-subprocess 1 "ON SEVERE_ERROR THEN CONTINUE")))
69:
70: (defun subprocess-command ()
71: "Starts asynchronous subprocess if not running and switches to its window."
72: (interactive)
73: (if (not subprocess-running)
74: (start-subprocess))
75: (and subprocess-running
76: (progn (pop-to-buffer subprocess-buf) (goto-char (point-max)))))
77:
78: (defun command-send-input ()
79: "If at last line of buffer, sends the current line to
80: the spawned subprocess. Otherwise brings back current
81: line to the last line for resubmission."
82: (interactive)
83: (beginning-of-line)
84: (let ((current-line (buffer-substring (point)
85: (progn (end-of-line) (point)))))
86: (if (eobp)
87: (progn
88: (if (not subprocess-running)
89: (start-subprocess))
90: (if subprocess-running
91: (progn
92: (beginning-of-line)
93: (send-command-to-subprocess 1 current-line)
94: (if command-prefix-string
95: (progn (beginning-of-line) (insert command-prefix-string)))
96: (next-line 1))))
97: ;; else -- if not at last line in buffer
98: (end-of-buffer)
99: (backward-char)
100: (next-line 1)
101: (if (string-equal command-prefix-string
102: (substring current-line 0 (length command-prefix-string)))
103: (insert (substring current-line (length command-prefix-string)))
104: (insert current-line)))))
105:
106: (defun command-kill-line()
107: "Kills the current line. Used in command mode."
108: (interactive)
109: (beginning-of-line)
110: (kill-line))
111:
112: (define-key esc-map "$" 'subprocess-command)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.