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