(provide (quote comint)) (defconst comint-version "2.01") (defvar comint-prompt-regexp "^" "\ Regexp to recognise prompts in the inferior process. Defaults to \"^\", the null string at BOL. Good choices: Canonical Lisp: \"^[^> ]*>+:? *\" (Lucid, franz, kcl, T, cscheme, oaklisp) Lucid Common Lisp: \"^\\(>\\|\\(->\\)+\\) *\" franz: \"^\\(->\\|<[0-9]*>:\\) *\" kcl: \"^>+ *\" shell: \"^[^#$%>]*[#$%>] *\" T: \"^>+ *\" This is a good thing to set in mode hooks.") (defvar input-ring-size 30 "\ Size of input history ring.") (defvar comint-get-old-input (function comint-get-old-input-default) "\ Function that submits old text in comint mode. This function is called when return is typed while the point is in old text. It returns the text to be submitted as process input. The default is comint-get-old-input-default, which grabs the current line, and strips off leading text matching comint-prompt-regexp") (defvar comint-input-sentinel (function ignore) "\ Called on each input submitted to comint mode process by comint-send-input. Thus it can, for instance, track cd/pushd/popd commands issued to the csh.") (defvar comint-input-filter (function (lambda (str) (not (string-match "\\`\\s *\\'" str)))) "\ Predicate for filtering additions to input history. Only inputs answering true to this function are saved on the input history list. Default is to save anything that isn't all whitespace") (defvar comint-input-sender (function comint-simple-send) "\ Function to actually send to PROCESS the STRING submitted by user. Usually this is just 'comint-simple-send, but if your mode needs to massage the input string, this is your hook. This is called from the user command comint-send-input. comint-simple-send just sends the string plus a newline.") (defvar comint-eol-on-send (quote T) "\ If non-nil, then jump to the end of the line before sending input to process. See COMINT-SEND-INPUT") (defvar comint-mode-hook (quote nil) "\ Called upon entry into comint-mode") (defvar comint-mode-map nil) (defun comint-mode nil "\ Major mode for interacting with an inferior interpreter. Interpreter name is same as buffer name, sans the asterisks. Return at end of buffer sends line as input. Return not at end copies rest of line to end and sends it. Setting mode variable comint-eol-on-send means jump to the end of the line before submitting new input. This mode is typically customised to create inferior-lisp-mode, shell-mode, etc.. This can be done by setting the hooks comint-input-sentinel, comint-input-filter, comint-input-sender and comint-get-old-input to appropriate functions, and the variable comint-prompt-regexp to the appropriate regular expression. An input history is maintained of size input-ring-size, and can be accessed with the commands comint-next-input [\\[comint-next-input]] and comint-previous-input [\\[comint-previous-input]]. Commands not keybound by default are send-invisible, comint-dynamic-complete, and comint-list-dynamic-completions. If you accidentally suspend your process, use \\[comint-continue-subjob] to continue it. \\{comint-mode-map} Entry to this mode runs the hooks on comint-mode-hook" (interactive) (byte-code "̈ \"!  щ҉Ӊ!! !׉ !!!!ى !!!!!! !!{ !*" [old-ring input-ring old-ptyp comint-ptyp major-mode mode-name mode-line-process comint-mode-map comint-last-input-end comint-last-input-match input-ring-index input-ring-size nil assq buffer-local-variables boundp kill-all-local-variables comint-mode "Comint" (": %s") use-local-map make-local-variable make-marker "" comint-prompt-regexp 0 comint-get-old-input comint-input-sentinel comint-input-filter comint-input-sender comint-eol-on-send run-hooks comint-mode-hook ring-p make-ring] 23)) (if comint-mode-map nil (setq comint-mode-map (make-sparse-keymap)) (define-key comint-mode-map "p" (quote comint-previous-input)) (define-key comint-mode-map "n" (quote comint-next-input)) (define-key comint-mode-map "s" (quote comint-previous-similar-input)) (define-key comint-mode-map " " (quote comint-send-input)) (define-key comint-mode-map "" (quote comint-delchar-or-maybe-eof)) (define-key comint-mode-map "" (quote comint-bol)) (define-key comint-mode-map "" (quote comint-kill-input)) (define-key comint-mode-map "" (quote backward-kill-word)) (define-key comint-mode-map "" (quote comint-interrupt-subjob)) (define-key comint-mode-map "" (quote comint-stop-subjob)) (define-key comint-mode-map "" (quote comint-quit-subjob)) (define-key comint-mode-map "" (quote comint-kill-output)) (define-key comint-mode-map "r" (quote comint-previous-input-matching)) (define-key comint-mode-map "" (quote comint-show-output)) (define-key comint-mode-map "P" (quote comint-msearch-input)) (define-key comint-mode-map "N" (quote comint-psearch-input)) (define-key comint-mode-map "R" (quote comint-msearch-input-matching))) (defun full-copy-sparse-keymap (km) "\ Recursively copy the sparse keymap KM" (byte-code ":@!A!B" [km t full-copy-sparse-keymap] 4)) (defun comint-check-proc (buffer-name) "\ True if there is a process associated w/buffer BUFFER-NAME, and it is alive (status RUN or STOP)." (byte-code " ! !>)" [proc buffer-name get-buffer-process process-status (run stop)] 4)) (defun make-comint (name program &optional startfile &rest switches) (byte-code " Q!! ? !>?(q ) %*" [buffer name proc program startfile switches get-buffer-create "*" get-buffer-process process-status (run stop) comint-mode comint-exec] 10)) (defvar comint-ptyp t "\ True if communications via pty; false if by pipe. Buffer local. This is to work around a bug in emacs process signalling.") (defun comint-exec (buffer name command startfile switches) "\ Fires up a process in buffer for comint modes. Blasts any old process running in the buffer. Doesn't set the buffer mode. You can use this to cheaply run a series of processes in the same comint buffer." (byte-code "q!  !)  $!db !`\")O!db!`d\"`d\" \")" [buffer proc name command switches comint-ptyp process-connection-type startfile get-buffer-process delete-process comint-exec-1 make-local-variable set-marker process-mark sleep-for 1 insert-file-contents buffer-substring delete-region comint-send-string] 13)) (defun comint-exec-1 (name buffer command switches) (byte-code "! \"E\" %)I!!!Վ \"\"\"\" %)+" [process-environment name buffer command switches tcapv termv emv boundp comint-update-env format "TERMCAP=emacs:co#%d:tc=unknown" screen-width "TERM=emacs" "EMACS=t" apply start-process getenv "TERMCAP" "TERM" "EMACS" ((byte-code "\" \" \"" [tcapv termv emv setenv "TERMCAP" "TERM" "EMACS"] 5)) setenv "emacs:co#%d:tc=unknown" "emacs" "t"] 19)) (defun comint-update-env (old-env new) (byte-code " ! \" C @ \" !O A + \"?> 8 B B* !*" [ans new vars old-env vv var reverse mapcar (lambda (vv) (byte-code "\" !O" [vv string-match "^[^=]*=" 0 match-end] 5)) string-match "^[^=]*=" 0 match-end comint-mem nreverse] 8)) (defun comint-mem (item list &optional elt=) "\ Test to see if ITEM is equal to an item in LIST. Option comparison function ELT= defaults to equal." (byte-code "K  ?) @#! % A *" [elt= done nil list item equal funcall] 6)) (defun ring-p (x) "\ T if X is a ring; NIL otherwise." (byte-code ":@!A:A@!AA!" [x integerp vectorp] 4)) (defun make-ring (size) "\ Make a ring that can contain SIZE elts" (byte-code "\\\"BB" [size nil 1 0 make-vector] 5)) (defun ring-plus1 (index veclen) "\ INDEX+1, with wraparound" (byte-code " \\ UĂ)" [new-index index veclen 1 0] 2)) (defun ring-minus1 (index veclen) "\ INDEX-1, with wraparound" (byte-code "U Z" [index veclen 0 1] 2)) (defun ring-length (ring) "\ Number of elts in the ring." (byte-code " @ A@ AAG X Z\\! Z# U,ǂ- )+" [hd ring tl siz len 1 + 0] 5)) (defun ring-empty-p (ring) (byte-code "!U" [ring 0 ring-length] 3)) (defun ring-insert (ring item) "\ Insert a new item onto the ring. If the ring is full, dump the oldest item to make room." (byte-code " AAG @ \" \" I !' A A@ \"\"+" [vec ring len new-hd item ring-minus1 setcar ring-empty-p] 8)) (defun ring-remove (ring) "\ Remove the oldest item retained on the ring." (byte-code "! !\"A@AAA G\"\" H*" [ring tl vec ring-empty-p error "Ring empty" set-car ring-minus1] 7)) (defun ring-rotate (ring n) (byte-code "U?w !!w @ A@ AA GVE \" HI \"Z!Wj \" HI \"ZF) \" A \"+" [n ring hd tl vec len 0 ring-empty-p error "ring empty" ring-plus1 1 ring-minus1 set-car] 10)) (defun comint-mod (n m) "\ Returns N mod M. M is positive. Answer is guaranteed to be non-negative, and less than m." (byte-code " \"Y Y  [\\)" [n m % 0] 4)) (defun ring-ref (ring index) (byte-code " !U!. @ A@ AA \" \\ G\" H-)" [numelts ring hd tl vec index vec-index ring-length 0 error "indexed empty ring" comint-mod] 6)) (defun comint-previous-input (arg) "\ Cycle backwards through input history." (interactive "*p") (byte-code "Lj !X! x ?$! x =2 `\"^ =Cp!!`\"^ VMՂX WWւXɉ`! \\\" T\" \"cω)" [len input-ring t last-command input-ring-index arg this-command nil ring-length 0 message "Empty input ring" ding comint-after-pmark-p "Not after process mark" comint-previous-input delete-region mark comint-previous-similar-input process-mark get-buffer-process -1 1 push-mark comint-mod "%d" ring-ref] 17)) (defun comint-next-input (arg) "\ Cycle forwards through input history." (interactive "*p") (byte-code "[!" [arg nil comint-previous-input] 2)) (defvar comint-last-input-match "" "\ Last string searched for by comint input history search, for defaulting. Buffer local variable.") (defun comint-previous-input-matching (str) "\ Searches backwards through input history for substring match." (interactive (byte-code " \"! \"  C*" [last-command s comint-last-input-match read-from-minibuffer format "Command substring (default %s): " string= ""] 5)) (byte-code "ʈ =?̉ !! \\ W0 \"\"?>\\ WO Z!`=Yˉ ! +" [last-command s comint-last-input-match str input-ring-index len input-ring n t this-command nil comint-previous-input -1 regexp-quote ring-length 1 string-match ring-ref message "Not found." ding] 8)) (defun comint-psearch-input nil "\ Search forwards for next occurrence of prompt and skip to end of line. (prompt is anything matching regexp comint-prompt-regexp)" (interactive) (byte-code "ˆd# !" [comint-prompt-regexp t nil re-search-forward end-of-line error "No occurrence of prompt found"] 4)) (defun comint-msearch-input nil "\ Search backwards for previous occurrence of prompt and skip to end of line. Search starts from beginning of current line." (interactive) (byte-code "È e# `)!b$!)" [p comint-prompt-regexp t nil beginning-of-line re-search-backward end-of-line error "No occurrence of prompt found"] 5)) (defun comint-msearch-input-matching (str) "\ Search backwards for occurrence of prompt followed by STRING. STRING is prompted for, and is NOT a regular expression." (interactive (byte-code " \"!\" C)" [s comint-last-input-match read-from-minibuffer format "Command (default %s): " string= ""] 5)) (byte-code "Lj  !P e# ` ) + b.!*" [s comint-last-input-match str r comint-prompt-regexp p t nil regexp-quote beginning-of-line re-search-backward end-of-line error "No match"] 6)) (defvar comint-last-similar-string "" "\ The string last used in a similar string search.") (defun comint-previous-similar-input (arg) "\ Reenters the last input that matches the string typed so far. If repeated successively older inputs are reentered. If arg is 1, it will go back in the history, if -1 it will go forward." (interactive "p") (byte-code "ʈ ? !=?p!!`\" G ! \\ WN \"G WN  O\"?]\\0 W=x `\"{`! Oc! ! T\"," [last-command input-ring-index comint-last-similar-string size len input-ring n arg entry t nil comint-after-pmark-p error "Not after process mark" comint-previous-similar-input -1 buffer-substring process-mark get-buffer-process ring-length ring-ref equal 0 delete-region mark push-mark message "Not found." ding sit-for 1 "%d"] 17)) (defun comint-send-input nil "\ Send input to process. After the process output mark, sends all text from the process mark to point as input to the process. Before the process output mark, calls value of variable comint-get-old-input to retrieve old input, copies it to the end of the buffer, and sends it. A terminal newline is also inserted into the buffer and sent to the process. In either case, value of variable comint-input-sentinel is called on the input before sending it. The input is entered into the input history ring, if value of variable comint-input-filter returns non-nil when called on the input. If variable comint-eol-on-send is non-nil, then point is moved to the end of line before sending the input. comint-get-old-input, comint-input-sentinel, and comint-input-filter are chosen according to the command interpreter running in the buffer. E.g., If the interpreter is the csh, comint-get-old-input is the default: take the current line, discard any initial string matching regexp comint-prompt-regexp. comint-input-sentinel monitors input for \"cd\", \"pushd\", and \"popd\" commands. When it sees one, it cd's the buffer. comint-input-filter is the default: returns T if the input isn't all white space. If the comint is Lucid Common Lisp, comint-get-old-input snarfs the sexp ending at point. comint-input-sentinel does nothing. comint-input-filter returns NIL if the input matches input-filter-regexp, which matches (1) all whitespace (2) :a, :c, etc. Similarly for Soar, Scheme, etc.." (interactive) (byte-code "̈p!?!f! !` Y- % `\":! b c )c \"K \" \"  #!`\" `\"+)" [proc pmark pmark-val input comint-eol-on-send copy comint-get-old-input comint-input-filter input-ring comint-input-sentinel comint-input-sender comint-last-input-end nil get-buffer-process error "Current buffer has no process" process-mark marker-position end-of-line buffer-substring funcall 10 ring-insert set-marker] 16)) (defun comint-get-old-input-default nil "\ Default for comint-get-old-input: take the current line, and discard any initial text matching comint-prompt-regexp." (byte-code " ` `\"))" [beg beginning-of-line comint-skip-prompt end-of-line buffer-substring] 6)) (defun comint-skip-prompt nil "\ Skip past the text matching regexp comint-prompt-regexp. If this takes us past the end of the current line, don't skip at all." (byte-code " `) !!X!b)" [eol comint-prompt-regexp end-of-line looking-at match-end 0] 5)) (defun comint-after-pmark-p nil "\ Is point after the process output marker?" (byte-code "p!!!`X)" [proc-pos marker-position process-mark get-buffer-process] 5)) (defun comint-simple-send (proc string) "\ Default function for sending to PROC input STRING. This just sends STRING plus a newline. To override this, set the hook COMINT-INPUT-SENDER." (byte-code " \"\"" [proc string comint-send-string " "] 4)) (defun comint-bol (arg) "\ Goes to the beginning of line, then skips past the prompt, if any. If a prefix argument is given (\\[universal-argument]), then no prompt skip -- go straight to column 0. The prompt skip is done by skipping text matching the regular expression comint-prompt-regexp, a buffer local variable. If you don't like this command, reset c-a to beginning-of-line in your hook, comint-mode-hook." (interactive "P") (byte-code " ? " [arg nil beginning-of-line comint-skip-prompt] 3)) (defun comint-read-noecho (prompt) "\ Prompt the user with argument PROMPT. Read a single line of text without echoing, and return it. Note that the keystrokes comprising the text can still be recovered (temporarily) with \\[view-lossage]. This may be a security bug for some applications." (byte-code " ; !\"? !rU$ U?3 !P! +" [echo-keystrokes answ tem prompt 0 "" nil string= message 13 10 char-to-string] 7)) (defun send-invisible (str) "\ Read a string without echoing, and send it to the process running in the current buffer. A new-line is additionally sent. String is not saved on comint input history list. Security bug: your string can still be temporarily recovered with \\[view-lossage]." (interactive "P") (byte-code "ˆp!?!% ; !\"\")" [proc str nil get-buffer-process error "Current buffer has no process" comint-send-string comint-read-noecho "Enter non-echoed text" " "] 7)) (defvar comint-input-chunk-size 512 "\ *Long inputs send to comint processes are broken up into chunks of this size. If your process is choking on big inputs, try lowering the value.") (defun comint-send-string (proc str) "\ Send PROCESS the contents of STRING as input. This is equivalent to process-send-string, except that long input strings are broken up into chunks of size comint-input-chunk-size. Processes are given a chance to output between chunks. This can help prevent processes from hanging when you send them long inputs on some OS's." (byte-code " G ^ O\" W. \\  ^O\" )*" [len str i comint-input-chunk-size proc next-i process-send-string 0 accept-process-output] 9)) (defun comint-send-region (proc start end) "\ Sends to PROC the region delimited by START and END. This is a replacement for process-send-region that tries to keep your process from hanging on long inputs. See comint-send-string." (byte-code " \"\"" [proc start end comint-send-string buffer-substring] 5)) (defun comint-kill-output nil "\ Kill all output from interpreter since last input." (interactive) (byte-code "ˆp!! \"bc`\")" [pmark comint-last-input-end nil process-mark get-buffer-process kill-region "*** output flushed *** " set-marker] 6)) (defun comint-show-output nil "\ Display start of this batch of interpreter output at top of window. Also put cursor there." (interactive) (byte-code "b `\" " [comint-last-input-end nil backward-char beginning-of-line set-window-start selected-window end-of-line] 6)) (defun comint-interrupt-subjob nil "\ Interrupt the current subjob." (interactive) (byte-code " \"" [nil comint-ptyp interrupt-process] 3)) (defun comint-kill-subjob nil "\ Send kill signal to the current subjob." (interactive) (byte-code " \"" [nil comint-ptyp kill-process] 3)) (defun comint-quit-subjob nil "\ Send quit signal to the current subjob." (interactive) (byte-code " \"" [nil comint-ptyp quit-process] 3)) (defun comint-stop-subjob nil "\ Stop the current subjob. WARNING: if there is no current subjob, you can end up suspending the top-level process running in the buffer. If you accidentally do this, use \\[comint-continue-subjob] to resume the process. (This is not a problem with most shells, since they ignore this signal.)" (interactive) (byte-code " \"" [nil comint-ptyp stop-process] 3)) (defun comint-continue-subjob nil "\ Send CONT signal to process buffer's process group. Useful if you accidentally suspend the top-level process." (interactive) (byte-code " \"" [nil comint-ptyp continue-process] 3)) (defun comint-kill-input nil "\ Kill all text from last stuff output by interpreter to point." (interactive) (byte-code "ˆp!!!` V`\"*" [pmark p-pos nil process-mark get-buffer-process marker-position kill-region] 6)) (defun comint-delchar-or-maybe-eof (arg) "\ Delete ARG characters forward, or send an EOF to process if at end of buffer." (interactive "p") (byte-code "m !" [arg nil process-send-eof delete-char] 3)) (defun comint-source-default (previous-dir/file source-modes) (byte-code " >!!B  B" [buffer-file-name major-mode source-modes previous-dir/file t default-directory nil file-name-directory file-name-nondirectory] 4)) (defun comint-check-source (fname) (byte-code " !!!\"!$pq q))" [buff fname old-buffer get-file-buffer buffer-modified-p y-or-n-p format "Save buffer %s first? " buffer-name save-buffer] 7)) (defun comint-extract-string nil "\ Returns string around point that starts the current line or nil." (byte-code "` ` `b #`Tb #(`S 5 5 \"-)" [point bol eol start t end beginning-of-line end-of-line search-backward "\"" search-forward buffer-substring] 7)) (defun comint-get-source (prompt prev-dir/file source-modes mustmatch-p) (byte-code " \"   ! !? ! !#@ . !0AB#D P $!!C." [def prev-dir/file source-modes stringfile sfile-p defdir deffile ans prompt mustmatch-p comint-source-default comint-extract-string file-exists-p file-directory-p file-name-directory file-name-nondirectory read-file-name format "%s(default %s) " expand-file-name substitute-in-file-name] 12)) (defun comint-proc-query (proc str) (byte-code " ! !!q! ! \" ! \"?L ! \"! \"?F!K \")**" [proc-buf proc proc-mark proc-win proc-pt str opoint process-buffer process-mark display-buffer get-buffer-window marker-position comint-send-string accept-process-output pos-visible-in-window-p window-point set-window-point sit-for 0 push-mark] 16)) (defun comint-match-partial-pathname nil "\ Returns the string of an existing filename or causes an error." (byte-code "!!)Ă$!!!!\"!)" [backward-char 1 looking-at "\\s " "" re-search-backward "[^~/A-Za-z0-9---_.$#,]+" re-search-forward "[~/A-Za-z0-9---_.$#,]+" substitute-in-file-name buffer-substring match-beginning 0 match-end] 10)) (defun comint-replace-by-expanded-filename nil "\ Replace the filename at point with an expanded, canonicalised, and completed replacement. \"Expanded\" means environment variables (e.g., $HOME) and ~'s are replaced with the corresponding directories. \"Canonicalised\" means .. and . are removed, and the filename is made absolute instead of relative. See functions expand-file-name and substitute-in-file-name. See also comint-dynamic-complete." (interactive) (byte-code "ƈ !!  \" ?%\" @ =1!@!!\" P!c," [pathname pathdir pathnondir completion default-directory t nil comint-match-partial-pathname file-name-directory file-name-nondirectory file-name-completion message "No completions of %s." ding "Unique completion." delete-region match-beginning 0 match-end expand-file-name] 13)) (defun comint-dynamic-complete nil "\ Dynamically complete the filename at point. This function is similar to comint-replace-by-expanded-filename, except that it won't change parts of the filename already entered in the buffer; it just adds completion characters to the end of the filename." (interactive) (byte-code "ƈ !!  \" ?%\" < =1!<!b GOc," [pathname pathdir pathnondir completion default-directory t nil comint-match-partial-pathname file-name-directory file-name-nondirectory file-name-completion message "No completions of %s." ding "Unique completion." match-end 0] 11)) (defun comint-dynamic-list-completions nil "\ List in help buffer all possible completions of the filename at point." (interactive) (byte-code "Ɉ !!  \" ?%\" P Ґ !!!rUI!N))," [pathname pathdir pathnondir completions default-directory t conf ch unread-command-char nil comint-match-partial-pathname file-name-directory file-name-nondirectory file-name-all-completions message "No completions of %s." ding current-window-configuration "*Help*" display-completion-list sit-for 0 "Hit space to flush." 32 set-window-configuration] 13)) (defvar comint-load-hook nil "\ This hook is run when comint is loaded in. This is a good place to put keybindings.") (run-hooks (quote comint-load-hook))