|
|
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 distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
21: ;; Written by Mukesh Prasad.
22:
23: (defvar display-subprocess-window nil
24: "If non-nil, the suprocess window is displayed whenever input is received.")
25:
26: (defvar command-prefix-string "$ "
27: "String to insert to distinguish commands entered by user.")
28:
29: (defvar subprocess-running nil)
30: (defvar command-mode-map nil)
31:
32: (if command-mode-map
33: nil
34: (setq command-mode-map (make-sparse-keymap))
35: (define-key command-mode-map "\C-m" 'command-send-input)
36: (define-key command-mode-map "\C-u" 'command-kill-line))
37:
38: (defun subprocess-input (name str)
39: "Handles input from a subprocess. Called by Emacs."
40: (if display-subprocess-window
41: (display-buffer subprocess-buf))
42: (let ((old-buffer (current-buffer)))
43: (set-buffer subprocess-buf)
44: (goto-char (point-max))
45: (insert str)
46: (insert ?\n)
47: (set-buffer old-buffer)))
48:
49: (defun subprocess-exit (name)
50: "Called by Emacs upon subprocess exit."
51: (setq subprocess-running nil))
52:
53: (defun start-subprocess ()
54: "Spawns an asynchronous subprocess with output redirected to
55: the buffer *COMMAND*. Within this buffer, use C-m to send
56: the last line to the subprocess or to bring another line to
57: the end."
58: (if subprocess-running
59: (return t))
60: (setq subprocess-buf (get-buffer-create "*COMMAND*"))
61: (save-excursion
62: (set-buffer subprocess-buf)
63: (use-local-map command-mode-map))
64: (setq subprocess-running (spawn-subprocess 1 'subprocess-input
65: 'subprocess-exit))
66: ;; Initialize subprocess so it doesn't panic and die upon
67: ;; encountering the first error.
68: (and subprocess-running
69: (send-command-to-subprocess 1 "ON SEVERE_ERROR THEN CONTINUE")))
70:
71: (defun subprocess-command ()
72: "Starts asynchronous subprocess if not running and switches to its window."
73: (interactive)
74: (if (not subprocess-running)
75: (start-subprocess))
76: (and subprocess-running
77: (progn (pop-to-buffer subprocess-buf) (goto-char (point-max)))))
78:
79: (defun command-send-input ()
80: "If at last line of buffer, sends the current line to
81: the spawned subprocess. Otherwise brings back current
82: line to the last line for resubmission."
83: (interactive)
84: (beginning-of-line)
85: (let ((current-line (buffer-substring (point)
86: (progn (end-of-line) (point)))))
87: (if (eobp)
88: (progn
89: (if (not subprocess-running)
90: (start-subprocess))
91: (if subprocess-running
92: (progn
93: (beginning-of-line)
94: (send-command-to-subprocess 1 current-line)
95: (if command-prefix-string
96: (progn (beginning-of-line) (insert command-prefix-string)))
97: (next-line 1))))
98: ;; else -- if not at last line in buffer
99: (end-of-buffer)
100: (backward-char)
101: (next-line 1)
102: (if (string-equal command-prefix-string
103: (substring current-line 0 (length command-prefix-string)))
104: (insert (substring current-line (length command-prefix-string)))
105: (insert current-line)))))
106:
107: (defun command-kill-line()
108: "Kills the current line. Used in command mode."
109: (interactive)
110: (beginning-of-line)
111: (kill-line))
112:
113: (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.