|
|
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.