![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to subproc.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 subproc.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: subproc.el,v 1.46 88/11/22 20:21:39 layer Exp $ ! 28: ! 29: ;; This file has its (distant) roots in lisp/shell.el, so: ! 30: ;; ! 31: ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc. ! 32: ;; ! 33: ;; This file is derived from part of GNU Emacs. ! 34: ;; ! 35: ;; GNU Emacs is distributed in the hope that it will be useful, ! 36: ;; but WITHOUT ANY WARRANTY. No author or distributor ! 37: ;; accepts responsibility to anyone for the consequences of using it ! 38: ;; or for whether it serves any particular purpose or works at all, ! 39: ;; unless he says so in writing. Refer to the GNU Emacs General Public ! 40: ;; License for full details. ! 41: ;; ! 42: ;; Everyone is granted permission to copy, modify and redistribute ! 43: ;; GNU Emacs, but only under the conditions described in the ! 44: ;; GNU Emacs General Public License. A copy of this license is ! 45: ;; supposed to have been given to you along with GNU Emacs so you ! 46: ;; can know your rights and responsibilities. It should be in a ! 47: ;; file named COPYING. Among other things, the copyright notice ! 48: ;; and this notice must be preserved on all copies. ! 49: ! 50: ;; Low-level subprocess mode guts ! 51: ! 52: ;;;; ! 53: ;;; Variables and Constants ! 54: ;;;; ! 55: ! 56: (defvar fi:common-lisp-image-name "cl" ! 57: "*Default Common Lisp image to invoke from `fi:common-lisp'. If the ! 58: value is a string then it names the image file or image path that ! 59: `fi:common-lisp' invokes. Otherwise, the value of this variable is given ! 60: to funcall, the result of which should yield a string which is the image ! 61: name or path.") ! 62: ! 63: (defvar fi:common-lisp-image-arguments nil ! 64: "*Default Common Lisp image arguments when invoked from `fi:common-lisp', ! 65: which must be a list of strings.") ! 66: ! 67: (defvar fi:common-lisp-prompt-pattern ! 68: "^\\(\\[[0-9]+c?\\] \\|\\[step\\] \\)?<[-A-Za-z]* ?[0-9]*?> " ! 69: "*The regular expression which matches the Common Lisp prompt, used in ! 70: Inferior Common Lisp mode. Anything from beginning of line up to the end ! 71: of what this pattern matches is deemed to be a prompt.") ! 72: ! 73: (defvar fi:franz-lisp-image-name "lisp" ! 74: "*Default Franz Lisp image to invoke from `fi:franz-lisp'. If the value ! 75: is a string then it names the image file or image path that ! 76: `fi:common-lisp' invokes. Otherwise, the value of this variable is given ! 77: to funcall, the result of which should yield a string which is the image ! 78: name or path.") ! 79: ! 80: (defvar fi:franz-lisp-image-arguments nil ! 81: "*Default Franz Lisp image arguments when invoked from `fi:franz-lisp'.") ! 82: ! 83: (defvar fi:franz-lisp-prompt-pattern ! 84: "^[-=]> +\\|^c{[0-9]+} +" ! 85: "*The regular expression which matches the Franz Lisp prompt, used in ! 86: Inferior Franz Lisp mode. Anything from beginning of line up to the end ! 87: of what this pattern matches is deemed to be a prompt.") ! 88: ! 89: (defvar fi:shell-popd-regexp ":?popd" ! 90: "*The regular expression matching the C shell `popd' command. If nil, no ! 91: automatic directory changes will be made.") ! 92: ! 93: (defvar fi:shell-pushd-regexp ":?pushd" ! 94: "*The regular expression matching the C shell `pushd' command. If nil, ! 95: no automatic directory changes will be made.") ! 96: ! 97: (defvar fi:shell-cd-regexp ":?cd" ! 98: "*The regular expression matching the C shell `cd' command. If nil, ! 99: no automatic directory changes will be made.") ! 100: ! 101: (defvar fi:common-lisp-package-regexp ! 102: "(in-package\\>\\|:\\<pa\\>\\|:\\<pac\\>\\|:\\<pack\\>\\|:\\<packa\\>\\|:\\<packag\\>\\|:\\<package\\>" ! 103: "*The regular expression matching the Common Lisp expression(s) to change ! 104: packages. If nil, no automatic package tracking will be done.") ! 105: ! 106: (defvar fi:subprocess-map-nl-to-cr nil ! 107: "*If t, then map newline to carriage-return.") ! 108: ! 109: (defvar fi:subprocess-continuously-show-output-in-visible-buffer t ! 110: "*If t, output from a subprocess to a visible buffer is continuously ! 111: shown. If a subprocess buffer is visible and the window point is beyond ! 112: the process output marker, output to that buffer from its associated ! 113: process will be continuously visible. If the window point is before the ! 114: process output marker, the window is not updated. This is a buffer-local ! 115: symbol.") ! 116: ! 117: (defvar fi:subprocess-write-quantum 120 ! 118: "*Maximum size in bytes of a single write request to a subprocess.") ! 119: ! 120: (defvar fi:subprocess-enable-superkeys nil ! 121: "*If t, certain keys become `superkeys' in subprocess buffers--this ! 122: should be set before starting any subprocesses. The superkeys are C-a, ! 123: C-d, C-o,C-u, C-w, C-z, and C-\\, which will behave as they would in the ! 124: current local keymap when typed at the end of a subprocess buffer. If ! 125: typed elsewhere, these keys have their normal global binding. This is a ! 126: buffer-local symbol. Use setq-default to set the default value for this ! 127: symbol.") ! 128: ! 129: (defvar fi:display-buffer-function 'switch-to-buffer ! 130: "*If non-nil, then it is used as the function which is funcall'd with one ! 131: argument, a buffer, to display a subprocess buffer when it is created (ie, ! 132: from `fi:common-lisp').") ! 133: ! 134: ;;;;;;;;;;;;;;;;;;;;;; internal vars ! 135: ! 136: (defvar fi::cl-package-regexp nil ! 137: "The real Common Lisp package regexp, which is nil in all buffer except ! 138: Inferior Common Lisp buffers.") ! 139: ! 140: (defvar fi::last-input-start nil ! 141: "Marker for start of last input in fi:shell-mode or fi:inferior-lisp-mode ! 142: buffer.") ! 143: ! 144: (defvar fi::last-input-end nil ! 145: "Marker for end of last input in fi:shell-mode or fi:inferior-lisp-mode ! 146: buffer.") ! 147: ! 148: (defvar fi::sublisp-name nil ! 149: "Name of inferior lisp process.") ! 150: ! 151: (defvar fi::freshest-franz-sublisp-name nil ! 152: "Name of franz lisp subprocess most recently invoked.") ! 153: ! 154: (defvar fi::freshest-common-sublisp-name nil ! 155: "Name of common lisp subprocess most recently invoked.") ! 156: ! 157: (defvar fi::shell-directory-stack nil ! 158: "List of directories saved by pushd in this buffer's shell.") ! 159: ! 160: ;;;; ! 161: ;;; User visible functions ! 162: ;;;; ! 163: ! 164: (defun fi:common-lisp (&optional buffer-number) ! 165: "Start a Common Lisp subprocess in a buffer whose name is determined ! 166: from the optional prefix argument BUFFER-NUMBER. Common Lisp buffer names ! 167: start with `*common-lisp' and end with `*', with an optional `-N' in ! 168: between. If BUFFER-NUMBER is not given it defaults to 1. If BUFFER-NUMBER ! 169: is >= 0, then the buffer is named `*common-lisp-<BUFFER-NUMBER>*'. If ! 170: BUFFER-NUMBER is < 0, then the first available buffer name is chosen. ! 171: ! 172: The image file and image arguments are taken from the variables ! 173: `fi:common-lisp-image-name' and `fi:common-lisp-image-arguments'. ! 174: ! 175: See fi:explicit-common-lisp." ! 176: (interactive "p") ! 177: (let ((proc (fi::make-subprocess ! 178: buffer-number "common-lisp" ! 179: 'fi:inferior-common-lisp-mode ! 180: fi:common-lisp-prompt-pattern ! 181: fi:common-lisp-image-name ! 182: fi:common-lisp-image-arguments))) ! 183: (setq fi::freshest-common-sublisp-name (process-name proc)) ! 184: proc)) ! 185: ! 186: (defun fi:explicit-common-lisp (&optional buffer-number ! 187: image-name image-arguments) ! 188: "The same as fi:common-lisp, except that the image and image arguments ! 189: are read from the minibuffer." ! 190: (interactive "p\nsImage name: \nxImage arguments (a list): ") ! 191: (let ((proc (fi::make-subprocess ! 192: buffer-number "common-lisp" ! 193: 'fi:inferior-common-lisp-mode ! 194: fi:common-lisp-prompt-pattern ! 195: image-name image-arguments))) ! 196: (setq fi::freshest-common-sublisp-name (process-name proc)) ! 197: proc)) ! 198: ! 199: (defun fi:remote-common-lisp (&optional buffer-number host) ! 200: "Start a Common Lisp subprocess in a buffer whose name is determined ! 201: from the optional prefix argument BUFFER-NUMBER, where the Common Lisp ! 202: image is run on another machine. Common Lisp buffer names start with ! 203: `*common-lisp' and end with `*', with an optional `-N' in between. If ! 204: BUFFER-NUMBER is not given it defaults to 1. If BUFFER-NUMBER is >= 0, ! 205: then the buffer is named `*common-lisp-<BUFFER-NUMBER>*'. If BUFFER-NUMBER ! 206: is < 0, then the first available buffer name is chosen. ! 207: ! 208: The host on which the image is run is read from the minibuffer. ! 209: ! 210: The image file and image arguments are taken from the variables ! 211: `fi:common-lisp-image-name' and `fi:common-lisp-image-arguments'. ! 212: ! 213: See fi:explicit-remote-common-lisp." ! 214: (interactive "p\nsRemote host name: ") ! 215: (let ((proc (fi::make-subprocess ! 216: buffer-number "common-lisp" ! 217: 'fi:inferior-common-lisp-mode ! 218: fi:common-lisp-prompt-pattern ! 219: "rsh" ! 220: (append (list host fi:common-lisp-image-name) ! 221: fi:common-lisp-image-arguments)))) ! 222: (setq fi::freshest-common-sublisp-name (process-name proc)) ! 223: proc)) ! 224: ! 225: (defun fi:explicit-remote-common-lisp (&optional buffer-number host ! 226: image-name image-arguments) ! 227: "The same as fi:remote-common-lisp, except that the image and image ! 228: arguments are read from the minibuffer." ! 229: (interactive ! 230: "p\nsRemote host name: \nsImage name: \nxImage arguments (a list): ") ! 231: (let ((proc (fi::make-subprocess ! 232: buffer-number "common-lisp" ! 233: 'fi:inferior-common-lisp-mode ! 234: fi:common-lisp-prompt-pattern ! 235: "rsh" ! 236: (append (list host image-name) image-arguments)))) ! 237: (setq fi::freshest-common-sublisp-name (process-name proc)) ! 238: proc)) ! 239: ! 240: (defun fi:tcp-common-lisp (&optional buffer-number) ! 241: "In a buffer whose name is determined from the optional prefix argument ! 242: BUFFER-NAME, connect to a Common Lisp using either a UNIX domain socket ! 243: file or internet port number. Common Lisp buffer names start with ! 244: `*common-lisp' and end with `*', with an optional `-N' in between. If ! 245: BUFFER-NUMBER is not given it defaults to 1. If BUFFER-NUMBER is >= 0,then ! 246: the buffer is named `*common-lisp-<BUFFER-NUMBER>*'. If BUFFER-NUMBER is < ! 247: 0, then the first available buffer name is chosen. ! 248: ! 249: See `fi:unix-domain' and `fi:explicit-tcp-common-lisp'." ! 250: (interactive "p") ! 251: (let ((proc (fi::make-tcp-connection ! 252: buffer-number "tcp-common-lisp" 'fi:tcp-common-lisp-mode ! 253: fi:common-lisp-prompt-pattern))) ! 254: (setq fi::freshest-common-sublisp-name (process-name proc)) ! 255: proc)) ! 256: ! 257: (defun fi:explicit-tcp-common-lisp (&optional buffer-number host service) ! 258: "The same as fi:tcp-common-lisp, except that the host name a port number ! 259: are read from the minibuffer. Use a port number of 0 for UNIX domain ! 260: sockets." ! 261: (interactive ! 262: "p\nsHost name: \nnService port number (0 for UNIX domain): ") ! 263: (let ((proc (fi::make-tcp-connection ! 264: buffer-number "tcp-common-lisp" 'fi:tcp-common-lisp-mode ! 265: fi:common-lisp-prompt-pattern ! 266: host service))) ! 267: (setq fi::freshest-common-sublisp-name (process-name proc)) ! 268: proc)) ! 269: ! 270: (defun fi:franz-lisp (&optional buffer-number) ! 271: "Start a Franz Lisp subprocess in a buffer whose name is determined ! 272: from the optional prefix argument BUFFER-NUMBER. Franz Lisp buffer names ! 273: start with `*franz-lisp' and end with `*', with an optional `-N' in ! 274: between. If BUFFER-NUMBER is not given it defaults to 1. If BUFFER-NUMBER ! 275: is >= 0, then the buffer is named `*franz-lisp-<BUFFER-NUMBER>*'. If ! 276: BUFFER-NUMBER is < 0, then the first available buffer name is chosen. ! 277: ! 278: The image file and image arguments are taken from the variables ! 279: `fi:franz-lisp-image-name' and `fi:franz-lisp-image-arguments'. ! 280: ! 281: See fi:explicit-franz-lisp." ! 282: (interactive "p") ! 283: (let ((proc (fi::make-subprocess ! 284: buffer-number "franz-lisp" ! 285: 'fi:inferior-franz-lisp-mode ! 286: fi:franz-lisp-prompt-pattern ! 287: fi:franz-lisp-image-name ! 288: fi:franz-lisp-image-arguments))) ! 289: (setq fi::freshest-franz-sublisp-name (process-name proc)) ! 290: proc)) ! 291: ! 292: (defun fi:explicit-franz-lisp (&optional buffer-number ! 293: image-name image-arguments) ! 294: "The same as fi:franz-lisp, except that the image and image arguments ! 295: are read from the minibuffer." ! 296: (interactive "p\nsImage name: \nxImage arguments (a list): ") ! 297: (let ((proc (fi::make-subprocess ! 298: buffer-number "franz-lisp" ! 299: 'fi:inferior-franz-lisp-mode ! 300: fi:franz-lisp-prompt-pattern ! 301: image-name image-arguments))) ! 302: (setq fi::freshest-franz-sublisp-name (process-name proc)) ! 303: proc)) ! 304: ! 305: ;;;; ! 306: ;;; Internal functions ! 307: ;;;; ! 308: ! 309: (defun fi::make-subprocess (buffer-number process-name mode-function ! 310: image-prompt image-file ! 311: image-arguments) ! 312: (let* ((buffer (fi::make-process-buffer process-name buffer-number)) ! 313: (default-dir default-directory) ! 314: (buffer-name (buffer-name buffer)) ! 315: (process (get-buffer-process buffer)) ! 316: (status (if process (process-status process))) ! 317: (runningp (memq status '(run stop))) ! 318: start-up-feed-name) ! 319: (if (and (not runningp) ! 320: (consp image-file)) ! 321: (setq image-file (funcall image-file))) ! 322: (if fi:display-buffer-function ! 323: (funcall fi:display-buffer-function buffer) ! 324: (switch-to-buffer buffer)) ! 325: (if runningp ! 326: (goto-char (point-max)) ! 327: (setq default-directory default-dir) ! 328: (if process (delete-process process)) ! 329: (setq process (apply 'start-process ! 330: (append (list buffer-name buffer image-file) ! 331: image-arguments))) ! 332: (set-process-sentinel process 'fi::subprocess-sentinel) ! 333: (set-process-filter process 'fi::subprocess-filter) ! 334: (setq start-up-feed-name ! 335: (if image-file ! 336: (concat "~/.emacs_" (file-name-nondirectory image-file)))) ! 337: (cond ! 338: ((and start-up-feed-name (file-exists-p start-up-feed-name)) ! 339: ;; I hope 1 second is enough! ! 340: (sleep-for 1) ! 341: (goto-char (point-max)) ! 342: (insert-file-contents start-up-feed-name) ! 343: (setq start-up-feed-name (buffer-substring (point) (point-max))) ! 344: (delete-region (point) (point-max)) ! 345: (fi::send-string-split process start-up-feed-name ! 346: fi:subprocess-map-nl-to-cr))) ! 347: (goto-char (point-max)) ! 348: (set-marker (process-mark process) (point)) ! 349: (let ((saved-input-ring fi::input-ring)) ! 350: (funcall mode-function) ! 351: (setq fi::input-ring saved-input-ring)) ! 352: (make-local-variable 'subprocess-prompt-pattern) ! 353: (setq subprocess-prompt-pattern image-prompt) ! 354: (fi::make-subprocess-variables)) ! 355: process)) ! 356: ! 357: (defun fi::make-tcp-connection (buffer-number buffer-name mode image-prompt ! 358: &optional given-host ! 359: given-service) ! 360: (let* ((buffer (fi::make-process-buffer buffer-name buffer-number)) ! 361: (default-dir default-directory) ! 362: (buffer-name (buffer-name buffer)) ! 363: (host (if given-host ! 364: (expand-file-name given-host) ! 365: (if fi:unix-domain ! 366: (expand-file-name fi:unix-domain-socket) ! 367: fi:local-host-name))) ! 368: (service (if given-service ! 369: given-service ! 370: (if fi:unix-domain 0 fi:excl-service-name))) ! 371: proc status) ! 372: (if fi:display-buffer-function ! 373: (funcall fi:display-buffer-function buffer) ! 374: (switch-to-buffer buffer)) ! 375: (setq proc (get-buffer-process buffer)) ! 376: (setq status (if proc (process-status proc))) ! 377: (if (eq status 'run) ! 378: (error ! 379: "can't start a TCP Common Lisp in a buffer which has a subprocess")) ! 380: (if (eq status 'open) ! 381: (goto-char (point-max)) ! 382: (setq default-directory default-dir) ! 383: (setq proc (open-network-stream buffer-name buffer host service)) ! 384: ;; ! 385: ;; HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK ! 386: ;; The first input the new (Common Lisp) process is sent is the name ! 387: ;; of the process. This is so that the processes are named similarly ! 388: ;; in Emacs and Lisp. ! 389: ;; ! 390: (process-send-string proc (format "\"%s\"\n" (buffer-name buffer))) ! 391: ! 392: (goto-char (point-max)) ! 393: (set-marker (process-mark proc) (point)) ! 394: (let ((saved-input-ring fi::input-ring)) ! 395: (funcall mode) ! 396: (setq fi::input-ring saved-input-ring)) ! 397: (make-local-variable 'subprocess-prompt-pattern) ! 398: (setq subprocess-prompt-pattern image-prompt) ! 399: (fi::make-subprocess-variables)) ! 400: proc)) ! 401: ! 402: (defun fi::make-process-buffer (name number) ! 403: (let ((buffer-name ! 404: (cond ! 405: ((not (numberp number)) ! 406: (concat "*" name "*")) ! 407: ((> number 1) ! 408: ;; just return the buffer name ! 409: (concat "*" name "-" number "*")) ! 410: ((< number 0) ! 411: ;; search for the first available buffer ! 412: (let (buffer-name n) ! 413: (if (not (fi::process-running ! 414: (setq buffer-name (concat "*" name "*")))) ! 415: buffer-name ! 416: (setq n 2) ! 417: (while (fi::process-running (setq buffer-name ! 418: (concat "*" name "-" n "*"))) ! 419: (setq n (+ n 1))) ! 420: buffer-name))) ! 421: (t (concat "*" name "*"))))) ! 422: (or (get-buffer buffer-name) ! 423: (get-buffer-create buffer-name)))) ! 424: ! 425: (defun fi::make-subprocess-variables () ! 426: (setq fi::input-ring-max fi:default-input-ring-max) ! 427: (setq fi::input-ring-yank-pointer nil) ! 428: (setq fi::shell-directory-stack nil) ! 429: (setq fi::last-input-search-string "") ! 430: (setq fi::last-input-start (make-marker)) ! 431: (setq fi::last-input-end (make-marker))) ! 432: ! 433: (defun fi::send-region-split (process start-position end-position ! 434: &optional nl-cr) ! 435: "Send region to process in small pieces." ! 436: (interactive "sSend region in pieces (to process): \nr") ! 437: (let* ((start (if (markerp start-position) ! 438: (marker-position start-position) ! 439: start-position)) ! 440: (end (if (markerp end-position) ! 441: (marker-position end-position) ! 442: end-position)) ! 443: (string (buffer-substring start end))) ! 444: (fi::send-string-split process string nl-cr))) ! 445: ! 446: (defun fi::send-string-split (process string &optional nl-cr) ! 447: "Send string to process in small pieces using send-string." ! 448: (interactive "sSend (to process): \nsSend to process in pieces (string): ") ! 449: (let ((size (length string)) ! 450: (filtered-string ! 451: (if nl-cr ! 452: (fi::substitute-chars-in-string '((?\n . ?\r)) string) ! 453: string)) ! 454: (start 0)) ! 455: (while (and (> size 0) ! 456: (condition-case nil ! 457: (progn ! 458: (send-string ! 459: process ! 460: (substring filtered-string ! 461: start ! 462: (+ start ! 463: (min size ! 464: fi:subprocess-write-quantum)))) ! 465: t) ! 466: (error ! 467: (message "Error writing to subprocess.") ! 468: nil))) ! 469: (setq size (- size fi:subprocess-write-quantum)) ! 470: (setq start (+ start fi:subprocess-write-quantum))))) ! 471: ! 472: ;;; Sentinel and filter for subprocesses. The sentinel is currently ! 473: ;;; not used. ! 474: (defun fi::subprocess-sentinel (process status) ! 475: t) ! 476: ! 477: (defun fi::subprocess-filter (process output &optional stay) ! 478: "Filter output from processes tied to buffers. ! 479: This function implements continuous output to visible buffers." ! 480: (let* ((old-buffer (current-buffer)) ! 481: (buffer (process-buffer process)) ! 482: (in-buffer (eq buffer old-buffer)) ! 483: (window-of-buffer (get-buffer-window buffer)) ! 484: (no-window (or (null window-of-buffer) ! 485: (not (windowp window-of-buffer)))) ! 486: (xmarker (process-mark process)) ! 487: (marker (if (marker-position xmarker) ! 488: xmarker ! 489: (set-marker (make-marker) 0 buffer))) ! 490: (marker-point (marker-position marker)) ! 491: (output-length (length output)) ! 492: old-point ! 493: point-not-before-marker ! 494: new-point) ! 495: ;; The three symbols below are not bound above because `(window-point)' ! 496: ;; for the selected window does not always return the same thing as the ! 497: ;; function `(point)' in that window! [Version 18 is supposed to fix ! 498: ;; this bug.] ! 499: ;; Note that there is no function that returns all of the windows that ! 500: ;; are currently displaying a buffer. Because of this, not all windows ! 501: ;; will be updated properly by this filter function. What should be ! 502: ;; done is to loop through all windows displaying the buffer and do ! 503: ;; `(set-window-point)' in each. ! 504: (if (not in-buffer) ! 505: (progn ! 506: (set-buffer buffer) ! 507: (setq old-point ! 508: (if no-window ! 509: (point) ! 510: (window-point window-of-buffer)))) ! 511: (setq old-point (point))) ! 512: (setq point-not-before-marker (>= old-point marker-point)) ! 513: (setq new-point (if point-not-before-marker ! 514: (+ old-point output-length) ! 515: old-point)) ! 516: (save-excursion ! 517: ;; Go to point of last output by fi::make-process and insert new ! 518: ;; output there, preserving position of the marker. ! 519: (goto-char marker-point) ! 520: ;; The code below works around what appears to be a display bug ! 521: ;; in GNU Emacs 17. If `(insert-before-markers)' is used when ! 522: ;; the process marker (process-mark), window-start point ! 523: ;; (window-start), and window point (point) are all coincident, ! 524: ;; the window display `sticks' on the topmost line. We use ! 525: ;; `(insert-string)' followed by `(set-marker)' to avoid this ! 526: ;; problem. This also happens to be the way ! 527: ;; `handle_process_output()' deals with this in `process.c'. ! 528: (insert-string output) ! 529: (set-marker marker (point))) ! 530: (if (not in-buffer) ! 531: (if (and fi:subprocess-continuously-show-output-in-visible-buffer ! 532: point-not-before-marker) ! 533: ;; Keep window's notion of `point' in a constant relationship to ! 534: ;; the process output marker. ! 535: (if no-window ! 536: (goto-char new-point) ! 537: (set-window-point window-of-buffer new-point)) ! 538: (if no-window ! 539: t;; Still there. ! 540: (set-window-point window-of-buffer old-point))) ! 541: (goto-char new-point)) ! 542: (cond ! 543: (in-buffer nil) ! 544: (stay old-buffer) ! 545: (t (set-buffer old-buffer))))) ! 546: ! 547: (defun fi::subprocess-watch-for-special-commands () ! 548: "Watch for special commands like, for example, `cd' in a shell." ! 549: (if (null fi::shell-directory-stack) ! 550: (setq fi::shell-directory-stack (list default-directory))) ! 551: (condition-case () ! 552: ;; "To err is really not nice." -dkl 11/21/88 ! 553: (save-excursion ! 554: (goto-char fi::last-input-start) ! 555: (cond ! 556: ((and fi::cl-package-regexp (looking-at fi::cl-package-regexp)) ! 557: (goto-char (match-end 0)) ! 558: (cond ! 559: ((or (looking-at "[ \t]*[':]\\(.*\\)[ \t]*)") ! 560: (looking-at "[ \t]*\"\\(.*\\)\"[ \t]*)")) ! 561: ;; (in-package foo) ! 562: (setq fi:package ! 563: (buffer-substring (match-beginning 1) (match-end 1)))) ! 564: ((looking-at "[ \t]+\\(.*\\)[ \t]*$") ! 565: ;; :pa foo ! 566: (setq fi:package ! 567: (buffer-substring (match-beginning 1) (match-end 1))))) ! 568: ;; need to do something here to force the minibuffer to ! 569: ;; redisplay: ! 570: (set-buffer-modified-p (buffer-modified-p))) ! 571: ((and fi:shell-popd-regexp (looking-at fi:shell-popd-regexp)) ! 572: (goto-char (match-end 0)) ! 573: (cond ! 574: ((looking-at ".*&[ \t]*$") ! 575: ;; "popd ... &" executes in a subshell! ! 576: ) ! 577: (t ! 578: (let ((n (if (looking-at "[ \t]+\\+\\([0-9]*\\)") ! 579: (car ! 580: (read-from-string ! 581: (buffer-substring (match-beginning 1) ! 582: (match-end 1))))))) ! 583: (if (null n) ! 584: (cd (car (setq fi::shell-directory-stack ! 585: (cdr fi::shell-directory-stack)))) ! 586: ;; pop n'th entry ! 587: (if (> n (length fi::shell-directory-stack)) ! 588: (message "Directory stack not that deep.") ! 589: (let ((tail (nthcdr (+ n 1) fi::shell-directory-stack))) ! 590: (rplacd (nthcdr (- n 1) fi::shell-directory-stack) ! 591: nil) ! 592: (setq fi::shell-directory-stack ! 593: (append fi::shell-directory-stack tail))))))))) ! 594: ((and fi:shell-pushd-regexp (looking-at fi:shell-pushd-regexp)) ! 595: (goto-char (match-end 0)) ! 596: (cond ! 597: ((looking-at ".*&[ \t]*$") ! 598: ;; "pushd ... &" executes in a subshell! ! 599: ) ! 600: ((looking-at "[ \t]+\\+\\([0-9]+\\)[ \t]*[;\n]") ! 601: ;; pushd +n ! 602: (let ((n (car (read-from-string ! 603: (buffer-substring (match-beginning 1) ! 604: (match-end 1)))))) ! 605: (if (< n 1) ! 606: (message "Illegal stack element: %s" n) ! 607: (if (> n (length fi::shell-directory-stack)) ! 608: (message "Directory stack not that deep.") ! 609: (let ((head (nthcdr n fi::shell-directory-stack))) ! 610: (rplacd (nthcdr (- n 1) fi::shell-directory-stack) ! 611: nil) ! 612: (setq fi::shell-directory-stack ! 613: (append head fi::shell-directory-stack)) ! 614: (cd (car head))))))) ! 615: ((looking-at "[ \t]+\\([^ \t]+\\)[;\n]") ! 616: ;; pushd dir ! 617: (let ((dir (expand-file-name ! 618: (substitute-in-file-name ! 619: (buffer-substring (match-beginning 1) ! 620: (match-end 1)))))) ! 621: (if (file-directory-p dir) ! 622: (progn ! 623: (setq fi::shell-directory-stack ! 624: (cons dir fi::shell-directory-stack)) ! 625: (cd dir))))) ! 626: ((looking-at "[ \t]*[;\n]") ! 627: ;; pushd ! 628: (if (< (length fi::shell-directory-stack) 2) ! 629: (message "Directory stack not that deep.") ! 630: (setq fi::shell-directory-stack ! 631: (append (list (car (cdr fi::shell-directory-stack)) ! 632: (car fi::shell-directory-stack)) ! 633: (cdr (cdr fi::shell-directory-stack)))) ! 634: (cd (car fi::shell-directory-stack)))))) ! 635: ((and fi:shell-cd-regexp (looking-at fi:shell-cd-regexp)) ! 636: (goto-char (match-end 0)) ! 637: (cond ! 638: ((looking-at ".*&[ \t]*$") ! 639: ;; "cd foo &" executes in a subshell! ! 640: ) ! 641: ((looking-at "[ \t]*[;\n]") ! 642: ;; cd ! 643: (cd (rplaca fi::shell-directory-stack (getenv "HOME")))) ! 644: ((looking-at "[ \t]+\\([^ \t]+\\)[ \t]*[;\n]") ! 645: ;; cd dir ! 646: (let ((dir (expand-file-name ! 647: (substitute-in-file-name ! 648: (buffer-substring (match-beginning 1) ! 649: (match-end 1)))))) ! 650: (if (file-directory-p dir) ! 651: (progn ! 652: (rplaca fi::shell-directory-stack dir) ! 653: (cd dir))))))))) ! 654: (error nil))) ! 655: ! 656: ;;;; ! 657: ;;; Initializations ! 658: ;;;; ! 659: ! 660: (mapcar 'make-variable-buffer-local ! 661: '(fi:shell-popd-regexp ! 662: fi:shell-pushd-regexp ! 663: fi:shell-cd-regexp ! 664: fi::cl-package-regexp ! 665: fi:package ! 666: fi:subprocess-map-nl-to-cr ! 667: fi:subprocess-continuously-show-output-in-visible-buffer ! 668: fi:subprocess-enable-superkeys ! 669: fi:subprocess-super-key-map ! 670: ! 671: fi::shell-directory-stack ! 672: fi::last-input-start ! 673: fi::last-input-end ! 674: fi::input-ring ! 675: fi::input-ring-max ! 676: fi::input-ring-yank-pointer ! 677: fi::last-input-search-string))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.