![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to keys.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / dist-1.3 / fi|
Return to keys.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / dist-1.3 / fi |
1.1 root 1: ;;
2: ;; copyright (C) 1987, 1988 Franz Inc, Berkeley, Ca.
3: ;;
4: ;; The software, data and information contained herein are the property
5: ;; of Franz, Inc.
6: ;;
7: ;; This file (or any derivation of it) may be distributed without
8: ;; further permission from Franz Inc. as long as:
9: ;;
10: ;; * it is not part of a product for sale,
11: ;; * no charge is made for the distribution, other than a tape
12: ;; fee, and
13: ;; * all copyright notices and this notice are preserved.
14: ;;
15: ;; If you have any comments or questions on this interface, please feel
16: ;; free to contact Franz Inc. at
17: ;; Franz Inc.
18: ;; Attn: Kevin Layer
19: ;; 1995 University Ave
20: ;; Suite 275
21: ;; Berkeley, CA 94704
22: ;; (415) 548-3600
23: ;; or
24: ;; emacs-info%[email protected]
25: ;; ucbvax!franz!emacs-info
26:
27: ;; $Header: keys.el,v 1.19 89/02/14 17:17:52 layer Exp $
28:
29: ;;;;
30: ;;; Key defs
31: ;;;;
32:
33: (defun fi::subprocess-mode-super-keys (map mode)
34: "Setup keys in MAP as a subprocess super-key map. MODE is either
35: shell, rlogin, sub-lisp or tcp-lisp."
36: (define-key map "\C-a" 'fi:subprocess-beginning-of-line)
37: (define-key map "\C-k" 'fi:subprocess-kill-output)
38: (define-key map "\C-l" 'fi:list-input-ring)
39: (define-key map "\C-m" 'fi:subprocess-input-region)
40: (define-key map "\C-n" 'fi:push-input)
41: (define-key map "\C-o" 'fi:subprocess-send-flush)
42: (define-key map "\C-p" 'fi:pop-input)
43: (define-key map "\C-r" 'fi:re-search-backward-input)
44: (define-key map "\C-s" 'fi:re-search-forward-input)
45: (define-key map "\C-u" 'fi:subprocess-kill-input)
46: (define-key map "\C-v" 'fi:subprocess-show-output)
47: (define-key map "\C-w" 'fi:subprocess-backward-kill-word)
48:
49: (cond
50: ((memq mode '(sub-lisp shell))
51: (if (eq mode 'shell)
52: (define-key map "\C-z" 'fi:subprocess-suspend))
53: (define-key map "\C-c" 'fi:subprocess-interrupt)
54: (define-key map "\C-d" 'fi:subprocess-send-eof)
55: (define-key map "\C-\\" 'fi:subprocess-quit))
56: ((eq mode 'tcp-lisp)
57: (define-key map "\C-c" 'fi:tcp-lisp-interrupt-process)
58: (define-key map "\C-d" 'fi:tcp-lisp-send-eof)
59: (define-key map "\C-\\" 'fi:tcp-lisp-kill-process)))
60: map)
61:
62: (defun fi::subprocess-mode-commands (map supermap mode)
63: "Define subprocess mode commands on MAP, using SUPERMAP as the supermap.
64: MODE is either sub-lisp, tcp-lisp, shell or rlogin."
65: (define-key map "\C-m" 'fi:subprocess-send-input)
66: (if fi:subprocess-enable-superkeys
67: (progn
68: (define-key map "\C-a" 'fi:subprocess-superkey)
69: ;; \C-c points to supermap
70: (define-key map "\C-d" 'fi:subprocess-superkey)
71: (define-key map "\C-o" 'fi:subprocess-superkey)
72: (define-key map "\C-u" 'fi:subprocess-superkey)
73: (define-key map "\C-w" 'fi:subprocess-superkey)
74: (define-key map "\C-z" 'fi:subprocess-superkey)
75: (define-key map "\C-\\" 'fi:subprocess-superkey)))
76: (if supermap (define-key map "\C-c" supermap))
77: map)
78:
79: (defun fi::lisp-mode-commands (map supermap mode)
80: (define-key map "\e" (make-sparse-keymap))
81: (define-key map "\C-x" (make-sparse-keymap))
82:
83: (if supermap (define-key map "\C-c" supermap))
84:
85: (define-key map "\t" 'lisp-indent-line)
86: (define-key map "\e\C-q" 'indent-sexp)
87: (define-key map "\C-?" 'backward-delete-char-untabify)
88:
89: (cond
90: ((memq mode '(sub-lisp tcp-lisp))
91: (define-key map "\r" 'fi:inferior-lisp-newline)
92: (define-key map "\e\r" 'fi:inferior-lisp-input-sexp)
93: (define-key map "\C-x\r" 'fi:inferior-lisp-input-list))
94: (t (define-key map "\r" 'fi:lisp-reindent-newline-indent)))
95:
96: (cond
97: ((memq major-mode '(fi:common-lisp-mode fi:inferior-common-lisp-mode
98: fi:tcp-common-lisp-mode))
99: (define-key map "\e." 'fi:lisp-find-tag)
100: (define-key map "\e," 'fi:lisp-tags-loop-continue)
101: (define-key map "\e\t" 'fi:lisp-complete-symbol)
102: (define-key map "\eA" 'fi:lisp-arglist)
103: (define-key map "\eC" 'fi:lisp-who-calls)
104: (define-key map "\eD" 'fi:lisp-describe)
105: (define-key map "\eF" 'fi:lisp-function-documentation)
106: (define-key map "\eM" 'fi:lisp-macroexpand)
107: (define-key map "\eW" 'fi:lisp-walk)))
108: (cond
109: ((eq major-mode 'fi:emacs-lisp-mode)
110: (define-key map "\e\C-x" 'eval-defun))
111: ((memq major-mode '(fi:common-lisp-mode fi:franz-lisp-mode
112: fi:lisp-mode))
113: (define-key map "\e\C-x" 'fi:lisp-eval-defun)
114: (define-key map "\C-c\C-b" 'fi:lisp-eval-current-buffer)
115: (define-key map "\C-c\C-s" 'fi:lisp-eval-last-sexp)
116: (define-key map "\C-c\C-r" 'fi:lisp-eval-region)))
117: map)
118:
119: (defun fi::tcp-common-lisp-mode-commands (map supermap)
120: (fi::lisp-mode-commands (fi::subprocess-mode-commands map supermap 'tcp-lisp)
121: supermap
122: 'tcp-lisp))
123:
124: (defun fi::inferior-lisp-mode-commands (map supermap)
125: (fi::lisp-mode-commands (fi::subprocess-mode-commands map supermap 'sub-lisp)
126: supermap
127: 'sub-lisp))
128:
129: ;;;;;;;;;;;;;;;;;;;;; inferior lisp mode related functions
130:
131: (defun fi:lisp-reindent-newline-indent ()
132: "Indent the current line, insert a newline and indent to the proper
133: column."
134: (interactive)
135: (save-excursion (funcall indent-line-function))
136: (newline)
137: (funcall indent-line-function))
138:
139: (defun fi:inferior-lisp-newline ()
140: "Bound to RET in an inferior Lisp buffer. At the end of the buffer it
141: inserts a newline and performs automatic indentation. Whole expressions
142: are sent to Lisp (not each piece after each newline is typed). This allows
143: previously typed lines to be edited before Lisp is sent the input. Typed
144: anywhere else in the buffer, this functions causes the input previously
145: typed (around the point) to be copied to the end of the subprocess buffer
146: and send to Lisp."
147: (interactive)
148: (if (eobp)
149: (let ((start (marker-position
150: (process-mark (get-buffer-process (current-buffer)))))
151: (have-list nil))
152: (save-excursion
153: (goto-char start)
154: (if (looking-at "(") (setq have-list t)))
155: (if have-list
156: (let ((send-sexp t))
157: (goto-char start)
158: (condition-case nil
159: (forward-sexp 1)
160: (error (setq send-sexp nil)))
161: (end-of-buffer)
162: (if send-sexp
163: (fi:subprocess-send-input)
164: ;; not a complete sexp, so newline and indent
165: (progn
166: (newline)
167: (funcall indent-line-function))))
168: ;; a non-list s-exp, so just send it off...
169: (fi:subprocess-send-input)))
170: ;;NOT AT THE END OF THE BUFFER!
171: ;; find the user's input contained around the cursor and send that to
172: ;; the inferior lisp
173: (let ((start-of-last-prompt
174: (save-excursion
175: (or (and (re-search-backward subprocess-prompt-pattern nil t)
176: (point))
177: (point-max))))
178: start end)
179: (if (or (and (bolp) (looking-at "("))
180: (re-search-backward "^(" start-of-last-prompt t)
181: (prog1 (re-search-backward subprocess-prompt-pattern nil t)
182: (goto-char (match-end 0))))
183: (progn
184: (setq start (point))
185: (let* ((eol (save-excursion (end-of-line) (point)))
186: (state (save-excursion (parse-partial-sexp start eol)))
187: (depth (car state)))
188: (if (zerop depth)
189: (setq end eol)
190: (setq end
191: (condition-case ()
192: (save-excursion
193: (if (< depth 0)
194: (up-list (- depth))
195: (goto-char eol)
196: (up-list depth))
197: (point))
198: (error nil))))
199:
200: (if (or (null end) (= end (point-max)))
201: (progn
202: (goto-char (point-max))
203: (fi:inferior-lisp-newline))
204: (fi:subprocess-input-region start end))))
205: (error "couldn't find start of input")))))
206:
207: (defun fi:subprocess-input-region (start end)
208: "Send the region defined by the point and mark to the Lisp subprocess."
209: (interactive "r")
210: (let* ((process (get-buffer-process (current-buffer)))
211: (string (buffer-substring start end)))
212: (goto-char (point-max))
213: (setq start (point))
214: (move-marker fi::last-input-start (point))
215: (insert string)
216: (if (not (bolp)) (insert "\n"))
217: (setq end (point))
218: (move-marker fi::last-input-end (point))
219: (fi::send-region-split process start end fi:subprocess-map-nl-to-cr)
220: (fi::input-ring-save fi::last-input-start (1- fi::last-input-end))
221: (set-marker (process-mark process) (point))))
222:
223: (defun fi:inferior-lisp-input-sexp (&optional arg)
224: "Send the sexp on which the point resides to the Lisp subprocess. With a
225: numeric prefix argument, send that many sexps."
226: (interactive "P")
227: (fi:inferior-lisp-send-input arg 'sexp))
228:
229: (defun fi:inferior-lisp-input-list (&optional arg)
230: "Send the list before the point to the Lisp subprocess. With a numeric
231: prefix argument, send that many lists."
232: (interactive "P")
233: (fi:inferior-lisp-send-input arg 'lists))
234:
235: (defun fi:lisp-eval-last-sexp (compile-file-p)
236: "Send the sexp before the point to the Lisp subprocess associated with
237: this buffer. If a Lisp subprocess has not been started, then one is
238: started. With a prefix argument, the source sent to the subprocess is
239: compiled."
240: (interactive "P")
241: (let ((start (save-excursion
242: (forward-sexp -1)
243: (point))))
244: (fi::eval-send start (point) compile-file-p)))
245:
246: (defun fi:lisp-eval-defun (compile-file-p)
247: "Send the current top-level (or nearest previous) form to the Lisp
248: subprocess associated with this buffer. A `top-level' form is one that
249: starts in column 1. If a Lisp subprocess has not been started, then one is
250: started. With a prefix argument, the source sent to the subprocess is
251: compiled."
252: (interactive "P")
253: (let* ((end (save-excursion (end-of-defun) (point)))
254: (start (save-excursion
255: (beginning-of-defun)
256: (point))))
257: (fi::eval-send start end compile-file-p)))
258:
259: (defun fi:lisp-eval-region (compile-file-p)
260: "Send the text in the region to the Lisp subprocess associated with this
261: buffer, one expression at a time if there is more than one complete
262: expression. If a Lisp subprocess has not been started, then one is
263: started. With a prefix argument, the source sent to the subprocess is
264: compiled."
265: (interactive "P")
266: (fi::eval-send (min (point) (mark))
267: (max (point) (mark))
268: compile-file-p))
269:
270: (defun fi:lisp-eval-current-buffer (compile-file-p)
271: "Send the entire buffer to the Lisp subprocess associated with this
272: buffer. If a Lisp subprocess has not been started, then one is started.
273: With a prefix argument, the source sent to the subprocess is compiled."
274: (interactive "P")
275: (fi::eval-send (point-min) (point-max) compile-file-p))
276:
277:
278: ;;;;;;;;;;;;;;;;;;;;; TCP lisp mode related functions
279:
280: (defun fi::get-default-symbol (prompt &optional up-p)
281: (let* ((symbol-at-point
282: (condition-case ()
283: (save-excursion
284: (if up-p
285: (progn
286: (if (= (following-char) ?\() (forward-char 1))
287: (if (= (preceding-char) ?\)) (forward-char -1))
288: (up-list -1)
289: (forward-char 1)))
290: (while (looking-at "\\sw\\|\\s_")
291: (forward-char 1))
292: (if (re-search-backward "\\sw\\|\\s_" nil t)
293: (progn (forward-char 1)
294: (buffer-substring
295: (point)
296: (progn (forward-sexp -1)
297: (while (looking-at "\\s'")
298: (forward-char 1))
299: (point))))
300: nil))
301: (error nil)))
302: (read-symbol
303: (read-string
304: (if symbol-at-point
305: (format "%s: (default %s) " prompt symbol-at-point)
306: (format "%s: " prompt))))
307: (symbol (if (string= read-symbol "")
308: symbol-at-point
309: read-symbol))
310: (colonp (string-match ":?:" symbol nil)))
311: (if (and (not colonp) fi:package)
312: (setq symbol (format "%s::%s" fi:package symbol)))
313: (list symbol)))
314:
315: (defun fi:lisp-find-tag (tag &optional next)
316: "Find the Common Lisp source for a symbol, using the characters around
317: the point as the default tag."
318: (interactive (if current-prefix-arg
319: '(nil t)
320: (fi::get-default-symbol "Lisp locate source")))
321: (fi::lisp-find-tag-common tag next nil))
322:
323: (defun fi:lisp-find-tag-other-window (tag &optional next)
324: "Find the Common Lisp source for a symbol, using the characters around
325: the point as the default tag."
326: (interactive (if current-prefix-arg
327: '(nil t)
328: (fi::get-default-symbol "Lisp locate source other window")))
329: (fi::lisp-find-tag-common tag next t))
330:
331: (defun fi:lisp-tags-loop-continue ()
332: "Find the next occurrence of the tag last used by fi:lisp-find-tag."
333: (interactive)
334: (fi:lisp-tags-loop-continue-common))
335:
336: (defun fi:lisp-arglist (symbol)
337: "Print the arglist (using excl:arglist) for a symbol, which is read from
338: the minibuffer. The word around the point is used as the default."
339: (interactive (fi::get-default-symbol "Function" t))
340: (let ((string
341: (format "(progn
342: (format t \"~:[()~;~:*~{~a~^ ~}~]\"
343: (cond
344: ((macro-function '%s) '(\"%s is a macro\"))
345: ((special-form-p '%s) '(\"%s is a special form\"))
346: ((not (fboundp '%s)) '(\"%s has no function binding\"))
347: (t (excl::arglist '%s))))
348: (values))\n"
349: symbol symbol symbol symbol symbol symbol symbol)))
350: (if (fi::background-sublisp-process)
351: (process-send-string fi::backdoor-process string)
352: (fi::eval-string-send string nil t))))
353:
354: (defun fi:lisp-describe (symbol)
355: "Describe a symbol, which is read from the minibuffer. The word around
356: the point is used as the default."
357: (interactive (fi::get-default-symbol "Describe symbol"))
358: (let ((string (format "(progn (lisp:describe '%s) (values))\n" symbol)))
359: (if (fi::background-sublisp-process)
360: (process-send-string fi::backdoor-process string)
361: (fi::eval-string-send string nil t))))
362:
363: (defun fi:lisp-function-documentation (symbol)
364: "Print the function documentation for a symbol, which is read from the
365: minibuffer. The word around the point is used as the default."
366: (interactive
367: (fi::get-default-symbol "Function documentation for symbol"))
368: (let ((string (format "(princ (lisp:documentation '%s 'lisp:function))\n"
369: symbol)))
370: (if (fi::background-sublisp-process)
371: (process-send-string fi::backdoor-process string)
372: (fi::eval-string-send string nil t))))
373:
374: (defun fi:lisp-macroexpand ()
375: "Print the macroexpansion of the form at the point."
376: (interactive)
377: (fi::lisp-macroexpand-common "lisp:macroexpand" "macroexpand"))
378:
379: (defun fi:lisp-walk (arg)
380: "Print the full macroexpansion the form at the point.
381: With a prefix argument, macroexpand the code as the compiler would."
382: (interactive "P")
383: (fi::lisp-macroexpand-common
384: (if arg "excl::compiler-walk" "excl::walk")
385: "walk"))
386:
387: (defun fi::lisp-macroexpand-common (handler type)
388: (let* ((start (condition-case ()
389: (fi::find-other-end-of-list)
390: (error nil)))
391: (filename (format "%s/%s,mexp" fi:emacs-to-lisp-transaction-directory
392: (user-login-name)))
393: (string
394: (format fi::lisp-macroexpand-command
395: (if (and (boundp 'fi:package) fi:package)
396: (format "(or (find-package :%s) (make-package :%s))"
397: fi:package fi:package)
398: "*package*")
399: filename
400: handler)))
401: (if start
402: (write-region start (point) filename nil 'nomessage)
403: (let ((form (read-string (format "form to %s: " type)))
404: (obuf (current-buffer))
405: (tbuf (get-buffer-create "*cl-macroexpand-temp*")))
406: (set-buffer tbuf)
407: (erase-buffer)
408: (insert form)
409: (write-region (point-min) (point-max) filename nil 'nomessage)
410: (set-buffer obuf)))
411: (if (fi::background-sublisp-process)
412: (process-send-string fi::backdoor-process string)
413: (fi::eval-string-send string nil t))))
414:
415: (defun fi:lisp-who-calls (&optional symbol)
416: "Print all the callers of a function. The default symbol name is taken
417: from the sexp around the point."
418: (interactive (fi::get-default-symbol "Find references to symbol"))
419: ;; Since this takes a while, tell the user that it has started.
420: (message "finding callers of %s..." symbol)
421: (let ((string (format
422: "(progn (excl::who-references '%s) (values))\n" symbol)))
423: (if (fi::background-sublisp-process)
424: (process-send-string fi::backdoor-process string)
425: (fi::eval-string-send string nil t))))
426:
427: (defun fi:lisp-complete-symbol ()
428: "Perform completion on the Common Lisp symbol preceding the point. That
429: symbol is compared to symbols that exist in the Common Lisp, to which there
430: is a TCP/IP connection (see fi:eval-in-lisp). If the symbol starts just
431: after an open-parenthesis, then only symbols (in the Common Lisp) with
432: function defintions are considered. Otherwise all symbols are considered."
433: (interactive)
434: (let* ((end (point))
435: package real-beg
436: (beg (save-excursion
437: (backward-sexp 1)
438: (while (= (char-syntax (following-char)) ?\')
439: (forward-char 1))
440: (setq real-beg (point))
441: (let ((opoint (point)))
442: (if (re-search-forward ":?:" end t)
443: (setq package
444: (concat
445: ":" (buffer-substring opoint (match-beginning 0))))))
446: (point)))
447: (pattern (buffer-substring beg end))
448: (functions-only (if (eq (char-after (1- real-beg)) ?\() t nil))
449: (completions
450: (progn
451: ;; first, go into that package
452: (if (null (fi:eval-in-lisp "(packagep (in-package :%s))"
453: (or fi:package "user")))
454: (error "subprocess is in unknown package: %s" fi:package))
455: ;; then evaluate our expr
456: (fi:eval-in-lisp "(excl::list-all-completions \"%s\" %s %s)"
457: pattern package functions-only)))
458: (alist
459: (if (consp completions)
460: (apply 'list
461: (mapcar
462: (function
463: (lambda (x)
464: (let* ((whole-name (symbol-name x))
465: (name (progn
466: (string-match "^\\(.*::?\\)?\\(.*\\)$"
467: whole-name)
468: (substring whole-name
469: (match-beginning 2)
470: (match-end 2)))))
471: (cons name whole-name))))
472: completions))))
473: (completion (if alist (try-completion pattern alist))))
474: (cond ((eq completion t))
475: ((null completion)
476: (message "Can't find completion for \"%s\"" pattern)
477: (ding))
478: ((not (string= pattern completion))
479: (let ((new (cdr (assoc completion alist))))
480: (if new
481: (progn
482: (delete-region real-beg end)
483: (insert new))
484: (delete-region beg end)
485: (insert completion))))
486: (t
487: (message "Making completion list...")
488: (with-output-to-temp-buffer "*Help*"
489: (display-completion-list
490: (all-completions pattern alist)))
491: (message "Making completion list...done")))))
492:
493: (defun fi:tcp-lisp-send-eof ()
494: "Simulate an EOF on the tcp-lisp process via a db:debug-pop spoken to the
495: backdoor Common Lisp listener."
496: (interactive)
497: (fi:backdoor-eval
498: "(db:debug-pop (mp::process-name-to-process \"%s\"))\n"
499: (buffer-name (current-buffer))))
500:
501: (defun fi:tcp-lisp-kill-process ()
502: "Kill a tcp-lisp process via a mp:process-kill spoken to the backdoor
503: Common Lisp listener."
504: (interactive)
505: (fi:backdoor-eval
506: "(mp:process-kill (mp::process-name-to-process \"%s\"))\n"
507: (buffer-name (current-buffer))))
508:
509: (defun fi:tcp-lisp-interrupt-process ()
510: "Interrupt the tcp-lisp process via a mp:process-interrupt spoken to the
511: backdoor Common Lisp listener."
512: (interactive)
513: (fi:backdoor-eval
514: "(mp:process-interrupt
515: (mp::process-name-to-process \"%s\")
516: #'break \"interrupt from emacs\")\n"
517: (buffer-name (current-buffer))))
518:
519:
520: ;;;;;;;;;;;;;;;;;;;;; general subprocess related functions
521:
522: (defun fi:subprocess-superkey (&optional special-binding)
523: "This function implements superkeys in subprocess buffers.
524: A superkey is treated specially when at the end of a subprocess buffer,
525: but has its normal, global, binding when used elsewhere in the buffer.
526: At the end of the buffer the key has SPECIAL-BINDING. If SPECIAL-BINDING
527: is not given, the key takes its binding from the
528: fi:subprocess-super-key-map keymap."
529: (interactive)
530: (if (eobp)
531: (if special-binding
532: (call-interactively special-binding)
533: (fi::subprocess-reprocess-keys fi:subprocess-super-key-map))
534: (fi::subprocess-reprocess-keys global-map)))
535:
536: (defun fi::subprocess-reprocess-keys (&optional map key)
537: "Reprocess KEY or the last key sequence (which may be incomplete) in MAP.
538: This is used to reprocess a key sequence as if it were seen in another
539: context, e.g. to process global bindings of keys from a subprocess
540: buffer (in fi:shell-mode or fi:inferior-lisp-mode) when some keys are hit
541: other than at the end of the buffer."
542: (if (null map) (setq map global-map))
543: (let* ((last-key (if key
544: (if (integerp key)
545: (char-to-string key)
546: key)
547: (this-command-keys)))
548: (last-binding (lookup-key map last-key)))
549: (while (keymapp last-binding)
550: (setq last-binding
551: (lookup-key last-binding
552: (setq last-key (char-to-string (read-char))))))
553: (if (commandp last-binding)
554: (call-interactively last-binding)
555: (ding))))
556:
557: (defun fi:subprocess-beginning-of-line (arg)
558: "Moves point to beginning of line, just like (beginning-of-line),
559: except that if the pattern at the beginning of the line matches the
560: current subprocess prompt pattern, this function skips over it."
561: (interactive "P")
562: (beginning-of-line arg)
563: (if (looking-at subprocess-prompt-pattern)
564: (re-search-forward subprocess-prompt-pattern nil t)))
565:
566: (defun fi:subprocess-backward-kill-word (words)
567: "Kill previous word in current subprocess input line. This function
568: takes care not to delete past most recent subprocess output."
569: (interactive "p")
570: (save-restriction
571: (narrow-to-region
572: (marker-position (process-mark (get-buffer-process (current-buffer))))
573: (point))
574: (backward-kill-word words)))
575:
576: (defun fi:subprocess-send-input ()
577: "Send input to the subprocess. At end of buffer, sends all text after
578: last output as input to the subshell, including a newline inserted at the
579: end. Not at end, copies current line to the end of the buffer and sends it,
580: after first attempting to discard any prompt at the beginning of the line
581: by matching the regexp that is the value of subprocess-prompt-pattern if
582: possible. This regexp should start with \"^\"."
583: (interactive)
584: (if fi::shell-completions-window (fi::shell-completion-cleanup))
585: (end-of-line)
586: (if (eobp)
587: (progn
588: (move-marker fi::last-input-start
589: (process-mark (get-buffer-process (current-buffer))))
590: (insert "\n")
591: (move-marker fi::last-input-end (point)))
592: (let ((max (point)))
593: (beginning-of-line)
594: (re-search-forward subprocess-prompt-pattern max t))
595: (let ((copy (buffer-substring (point)
596: (progn (forward-line 1) (point)))))
597: (goto-char (point-max))
598: (move-marker fi::last-input-start (point))
599: (insert copy)
600: (move-marker fi::last-input-end (point))))
601: (fi::subprocess-watch-for-special-commands)
602: (let ((process (get-buffer-process (current-buffer))))
603: (fi::send-region-split process fi::last-input-start fi::last-input-end
604: fi:subprocess-map-nl-to-cr)
605: (fi::input-ring-save fi::last-input-start (1- fi::last-input-end))
606: (set-marker (process-mark process) (point))))
607:
608: (defun fi:subprocess-send-eof ()
609: "Send an end of file to the subprocess."
610: (interactive)
611: (process-send-eof))
612:
613: (defun fi:subprocess-kill-output ()
614: "Kill all output from the subprocess since the last input."
615: (interactive)
616: (goto-char (point-max))
617: (kill-region fi::last-input-end (point))
618: (insert "[output flushed]\n")
619: (set-marker (process-mark (get-buffer-process (current-buffer))) (point)))
620:
621: (defun fi:subprocess-send-flush ()
622: "Send the `flush output' character (^O) to subprocess."
623: (interactive)
624: (send-string (get-buffer-process (current-buffer)) "\C-o"))
625:
626: (defun fi:subprocess-show-output ()
627: "Display the start of this batch of shell output at top of window.
628: Also move the point there."
629: (interactive)
630: (set-window-start (selected-window) fi::last-input-end)
631: (goto-char fi::last-input-end))
632:
633: (defun fi:subprocess-interrupt ()
634: "Interrupt the current subprocess."
635: (interactive)
636: (interrupt-process nil t))
637:
638: (defun fi:subprocess-kill ()
639: "Send a `kill' (SIGKILL) signal to the current subprocess."
640: (interactive)
641: (kill-process nil t))
642:
643: (defun fi:subprocess-quit ()
644: "Send a quit signal to the subprocess."
645: (interactive)
646: (quit-process nil t))
647:
648: (defun fi:subprocess-suspend ()
649: "Suspend, with a SIGSTOP, the current subprocess."
650: (interactive)
651: (stop-process nil t))
652:
653: (defun fi:subprocess-kill-input ()
654: "Kill all input since the last output by the subprocess."
655: (interactive)
656: (kill-region (process-mark (get-buffer-process (current-buffer)))
657: (point)))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.