|
|
1.1 ! root 1: ;; Run subshell under Emacs ! 2: ;; Copyright (C) 1985 Richard M. Stallman. ! 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: ! 22: (provide 'shell) ! 23: ! 24: (defvar last-input-start nil ! 25: "In a shell-mode buffer, marker for start of last unit of input.") ! 26: (defvar last-input-end nil ! 27: "In a shell-mode buffer, marker for start of last unit of input.") ! 28: ! 29: (defvar shell-mode-map nil) ! 30: ! 31: (defvar shell-directory-stack nil ! 32: "List of directories saved by pushd in this buffer's shell.") ! 33: ! 34: (defvar shell-popd-regexp "popd" ! 35: "*Regexp to match subshell commands equivalent to popd.") ! 36: ! 37: (defvar shell-pushd-regexp "pushd" ! 38: "*Regexp to match subshell commands equivalent to pushd.") ! 39: ! 40: (defvar shell-cd-regexp "cd" ! 41: "*Regexp to match subshell commands equivalent to cd.") ! 42: ! 43: (defvar explicit-shell-file-name nil ! 44: "*If non-nil, is file name to use for explicitly requested inferior shell.") ! 45: ! 46: ;In loaddefs.el now. ! 47: ;(defconst shell-prompt-pattern ! 48: ; "^[^#$%>]*[#$%>] *" ! 49: ; "*Regexp used by Newline command to match subshell prompts. ! 50: ;Anything from beginning of line up to the end of what this pattern matches ! 51: ;is deemed to be prompt, and is not reexecuted.") ! 52: ! 53: (defun shell-mode () ! 54: "Major mode for interacting with an inferior shell. ! 55: Shell name is same as buffer name, sans the asterisks. ! 56: Return at end of buffer sends line as input. ! 57: Return not at end copies rest of line to end and sends it. ! 58: ! 59: The following commands imitate the usual Unix interrupt and ! 60: editing control characters: ! 61: \\{shell-mode-map} ! 62: ! 63: Entry to this mode calls the value of shell-mode-hook with no args, ! 64: if that value is non-nil. ! 65: ! 66: cd, pushd and popd commands given to the shell are watched ! 67: by Emacs to keep this buffer's default directory ! 68: the same as the shell's working directory. ! 69: Variables shell-cd-regexp, shell-pushd-regexp and shell-popd-regexp ! 70: are used to match these command names. ! 71: ! 72: You can send text to the shell (or its subjobs) from other buffers ! 73: using the commands send-region, send-string and lisp-send-defun." ! 74: (interactive) ! 75: (kill-all-local-variables) ! 76: (setq major-mode 'shell-mode) ! 77: (setq mode-name "Shell") ! 78: (setq mode-line-format ! 79: "--%1*%1*-Emacs: %17b %M %[(%m: %s)%]----%3p--%-") ! 80: (use-local-map shell-mode-map) ! 81: (make-local-variable 'shell-directory-stack) ! 82: (setq shell-directory-stack nil) ! 83: (make-local-variable 'last-input-start) ! 84: (setq last-input-start (make-marker)) ! 85: (make-local-variable 'last-input-end) ! 86: (setq last-input-end (make-marker)) ! 87: (run-hooks 'shell-mode-hook)) ! 88: ! 89: (if shell-mode-map ! 90: nil ! 91: (setq shell-mode-map (make-sparse-keymap)) ! 92: (define-key shell-mode-map "\C-m" 'shell-send-input) ! 93: (define-key shell-mode-map "\C-c\C-d" 'shell-send-eof) ! 94: (define-key shell-mode-map "\C-c\C-u" 'kill-shell-input) ! 95: (define-key shell-mode-map "\C-c\C-w" 'backward-kill-word) ! 96: (define-key shell-mode-map "\C-c\C-c" 'interrupt-shell-subjob) ! 97: (define-key shell-mode-map "\C-c\C-z" 'stop-shell-subjob) ! 98: (define-key shell-mode-map "\C-c\C-\\" 'quit-shell-subjob) ! 99: (define-key shell-mode-map "\C-c\C-o" 'kill-output-from-shell) ! 100: (define-key shell-mode-map "\C-c\C-r" 'show-output-from-shell) ! 101: (define-key shell-mode-map "\C-c\C-y" 'copy-last-shell-input)) ! 102: ! 103: (defun shell () ! 104: "Run an inferior shell, with I/O through buffer *shell*. ! 105: If buffer exists but shell process is not running, make new shell. ! 106: Program used comes from variable explicit-shell-file-name, ! 107: or (if that is nil) from the ESHELL environment variable, ! 108: or else from SHELL if there is no ESHELL. ! 109: If a file ~/.emacs_SHELLNAME exists, it is given as initial input ! 110: (Note that this may lose due to a timing error if the shell ! 111: discards input when it starts up.) ! 112: The buffer is put in shell-mode, giving commands for sending input ! 113: and controlling the subjobs of the shell. See shell-mode. ! 114: See also variable shell-prompt-pattern. ! 115: ! 116: Note that many people's .cshrc files unconditionally clear the prompt. ! 117: If yours does, you will probably want to change it." ! 118: (interactive) ! 119: (let* ((prog (or explicit-shell-file-name ! 120: (getenv "ESHELL") ! 121: (if (eq system-type 'hpux) "sh" ! 122: ;; On hpux people normally use csh, ! 123: ;; but the csh in hpux has stty sanity checking ! 124: ;; so it does not work under emacs. ! 125: (getenv "SHELL")) ! 126: "/bin/sh")) ! 127: (name (file-name-nondirectory prog))) ! 128: (switch-to-buffer ! 129: (make-shell "shell" prog ! 130: (if (file-exists-p (concat "~/.emacs_" name)) ! 131: (concat "~/.emacs_" name)) ! 132: "-i")))) ! 133: ! 134: (defun make-shell (name program &optional startfile &rest switches) ! 135: (let ((buffer (get-buffer-create (concat "*" name "*"))) ! 136: proc status size) ! 137: (setq proc (get-buffer-process buffer)) ! 138: (if proc ! 139: (setq status (process-status proc))) ! 140: (save-excursion ! 141: (set-buffer buffer) ! 142: ;; (setq size (buffer-size)) ! 143: (if (memq status '(run stop)) ! 144: nil ! 145: (if proc (delete-process proc)) ! 146: (setq proc (apply 'start-process (append (list name buffer program) switches))) ! 147: (cond (startfile ! 148: ;;This is guaranteed to wait long enough ! 149: ;;but has bad results if the shell does not prompt at all ! 150: ;; (while (= size (buffer-size)) ! 151: ;; (sleep-for 1)) ! 152: ;;I hope 1 second is enough! ! 153: (sleep-for 1) ! 154: (goto-char (point-max)) ! 155: (insert-file-contents startfile) ! 156: (setq startfile (buffer-substring (point) (point-max))) ! 157: (delete-region (point) (point-max)) ! 158: (send-string proc startfile))) ! 159: (setq name (process-name proc))) ! 160: (goto-char (point-max)) ! 161: (set-marker (process-mark proc) (point)) ! 162: (shell-mode)) ! 163: buffer)) ! 164: ! 165: (defun shell-send-input () ! 166: "Send input to subshell. ! 167: At end of buffer, sends all text after last output ! 168: as input to the subshell, including a newline inserted at the end. ! 169: Not at end, copies current line to the end of the buffer and sends it, ! 170: after first attempting to discard any prompt at the beginning of the line ! 171: by matching the regexp that is the value of shell-prompt-pattern if possible. ! 172: This regexp should start with \"^\"." ! 173: (interactive) ! 174: (end-of-line) ! 175: (if (eobp) ! 176: (progn ! 177: (move-marker last-input-start ! 178: (process-mark (get-buffer-process (current-buffer)))) ! 179: (insert ?\n) ! 180: (move-marker last-input-end (point))) ! 181: (beginning-of-line) ! 182: (re-search-forward shell-prompt-pattern nil t) ! 183: (let ((copy (buffer-substring (point) ! 184: (progn (forward-line 1) (point))))) ! 185: (goto-char (point-max)) ! 186: (move-marker last-input-start (point)) ! 187: (insert copy) ! 188: (move-marker last-input-end (point)))) ! 189: ;; Even if we get an error trying to hack the working directory, ! 190: ;; still send the input to the subshell. ! 191: (condition-case () ! 192: (save-excursion ! 193: (goto-char last-input-start) ! 194: (cond ((and (looking-at shell-popd-regexp) ! 195: (memq (char-after (match-end 0)) '(?\; ?\n))) ! 196: (if shell-directory-stack ! 197: (progn ! 198: (cd (car shell-directory-stack)) ! 199: (setq shell-directory-stack (cdr shell-directory-stack))))) ! 200: ((looking-at shell-pushd-regexp) ! 201: (cond ((memq (char-after (match-end 0)) '(?\; ?\n)) ! 202: (if shell-directory-stack ! 203: (let ((old default-directory)) ! 204: (cd (car shell-directory-stack)) ! 205: (setq shell-directory-stack ! 206: (cons old (cdr shell-directory-stack)))))) ! 207: ((memq (char-after (match-end 0)) '(?\ ?\t)) ! 208: (let (dir) ! 209: (skip-chars-forward "^ ") ! 210: (skip-chars-forward " \t") ! 211: (if (file-directory-p ! 212: (setq dir ! 213: (expand-file-name ! 214: (substitute-in-file-name ! 215: (buffer-substring ! 216: (point) ! 217: (progn ! 218: (skip-chars-forward "^\n \t;") ! 219: (point))))))) ! 220: (progn ! 221: (setq shell-directory-stack ! 222: (cons default-directory shell-directory-stack)) ! 223: (cd dir))))))) ! 224: ((looking-at shell-cd-regexp) ! 225: (cond ((memq (char-after (match-end 0)) '(?\; ?\n)) ! 226: (cd (getenv "HOME"))) ! 227: ((memq (char-after (match-end 0)) '(?\ ?\t)) ! 228: (let (dir) ! 229: (forward-char 3) ! 230: (skip-chars-forward " \t") ! 231: (if (file-directory-p ! 232: (setq dir ! 233: (expand-file-name ! 234: (substitute-in-file-name ! 235: (buffer-substring ! 236: (point) ! 237: (progn ! 238: (skip-chars-forward "^\n \t;") ! 239: (point))))))) ! 240: (cd dir)))))))) ! 241: (error nil)) ! 242: (let ((process (get-buffer-process (current-buffer)))) ! 243: (send-region process last-input-start last-input-end) ! 244: (set-marker (process-mark process) (point)))) ! 245: ! 246: (defun shell-send-eof () ! 247: "Send eof to subshell (or to the program running under it)." ! 248: (interactive) ! 249: (process-send-eof)) ! 250: ! 251: (defun kill-output-from-shell () ! 252: "Kill all output from shell since last input." ! 253: (interactive) ! 254: (goto-char (point-max)) ! 255: (kill-region last-input-end (point)) ! 256: (insert "> output flushed ***\n")) ! 257: ! 258: (defun show-output-from-shell () ! 259: "Display start of this batch of shell output at top of window. ! 260: Also put cursor there." ! 261: (interactive) ! 262: (set-window-start (selected-window) last-input-end) ! 263: (goto-char last-input-end)) ! 264: ! 265: (defun copy-last-shell-input () ! 266: "Copy previous shell input, sans newline, and insert before point." ! 267: (interactive) ! 268: (insert (buffer-substring last-input-end last-input-start)) ! 269: (delete-char -1)) ! 270: ! 271: (defun interrupt-shell-subjob () ! 272: "Interrupt this shell's current subjob." ! 273: (interactive) ! 274: (interrupt-process nil t)) ! 275: ! 276: (defun kill-shell-subjob () ! 277: "Send kill signal to this shell's current subjob." ! 278: (interactive) ! 279: (kill-process nil t)) ! 280: ! 281: (defun quit-shell-subjob () ! 282: "Send quit signal to this shell's current subjob." ! 283: (interactive) ! 284: (quit-process nil t)) ! 285: ! 286: (defun stop-shell-subjob () ! 287: "Stop this shell's current subjob." ! 288: (interactive) ! 289: (stop-process nil t)) ! 290: ! 291: (defun kill-shell-input () ! 292: "Kill all text since last stuff output by the shell or its subjobs." ! 293: (interactive) ! 294: (kill-region (process-mark (get-buffer-process (current-buffer))) ! 295: (point))) ! 296: ! 297: (defvar inferior-lisp-mode-map nil) ! 298: (if inferior-lisp-mode-map ! 299: nil ! 300: (setq inferior-lisp-mode-map (copy-alist shell-mode-map)) ! 301: (lisp-mode-commands inferior-lisp-mode-map) ! 302: (define-key inferior-lisp-mode-map "\e\C-x" 'lisp-send-defun)) ! 303: ! 304: (defun inferior-lisp-mode () ! 305: "Major mode for interacting with an inferior Lisp process. ! 306: ! 307: The following commands are available: ! 308: \\{inferior-lisp-mode-map} ! 309: ! 310: Entry to this mode calls the value of lisp-mode-hook with no arguments, ! 311: if that value is non-nil. Likewise with the value of shell-mode-hook. ! 312: lisp-mode-hook is called after shell-mode-hook. ! 313: ! 314: You can send text to the inferior Lisp from other buffers ! 315: using the commands send-region, send-string and \\[lisp-send-defun]. ! 316: ! 317: Commands: ! 318: Delete converts tabs to spaces as it moves back. ! 319: Tab indents for Lisp; with argument, shifts rest ! 320: of expression rigidly with the current line. ! 321: Meta-Control-Q does Tab on each line starting within following expression. ! 322: Paragraphs are separated only by blank lines. Semicolons start comments. ! 323: ! 324: Return at end of buffer sends line as input. ! 325: Return not at end copies rest of line to end and sends it. ! 326: C-d at end of buffer sends end-of-file as input. ! 327: C-d not at end or with arg deletes or kills characters. ! 328: C-u and C-w are kill commands, imitating normal Unix input editing. ! 329: C-c interrupts the shell or its current subjob if any. ! 330: C-z stops, likewise. C-\\ sends quit signal, likewise. ! 331: ! 332: C-x C-k deletes last batch of output from shell. ! 333: C-x C-v puts top of last batch of output at top of window." ! 334: (interactive) ! 335: (kill-all-local-variables) ! 336: (setq major-mode 'inferior-lisp-mode) ! 337: (setq mode-name "Inferior Lisp") ! 338: (setq mode-line-format ! 339: "--%1*%1*-Emacs: %17b %M %[(%m: %s)%]----%3p--%-") ! 340: (lisp-mode-variables) ! 341: (use-local-map inferior-lisp-mode-map) ! 342: (make-local-variable 'last-input-start) ! 343: (setq last-input-start (make-marker)) ! 344: (make-local-variable 'last-input-end) ! 345: (setq last-input-end (make-marker)) ! 346: (run-hooks 'shell-mode-hook 'lisp-mode-hook)) ! 347: ! 348: (defun run-lisp () ! 349: "Run an inferior Lisp process, input and output via buffer *lisp*." ! 350: (interactive) ! 351: (switch-to-buffer (make-shell "lisp" "lisp")) ! 352: (inferior-lisp-mode)) ! 353: ! 354: (defun lisp-send-defun () ! 355: "Send the current defun to the Lisp process made by M-x run-lisp." ! 356: (interactive) ! 357: (save-excursion ! 358: (end-of-defun) ! 359: (let ((end (point))) ! 360: (beginning-of-defun) ! 361: (send-region "lisp" (point) end) ! 362: (send-string "lisp" "\n")))) ! 363: ! 364: (defun lisp-send-defun-and-go () ! 365: "Send the current defun to the inferior Lisp, and switch to *lisp* buffer." ! 366: (interactive) ! 367: (lisp-send-defun) ! 368: (switch-to-buffer "*lisp*"))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.