/[emacs]/emacs/lisp/comint.el
ViewVC logotype

Diff of /emacs/lisp/comint.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.272 by miles, Mon Jun 10 08:14:26 2002 UTC revision 1.272.2.1 by miles, Fri Apr 4 06:20:00 2003 UTC
# Line 384  field boundaries in a natural way)." Line 384  field boundaries in a natural way)."
384    :type 'boolean    :type 'boolean
385    :group 'comint)    :group 'comint)
386    
387  (defcustom comint-mode-hook '()  (defcustom comint-mode-hook '(turn-on-font-lock)
388    "Called upon entry into `comint-mode'    "Called upon entry into `comint-mode'
389  This is run before the process is cranked up."  This is run before the process is cranked up."
390    :type 'hook    :type 'hook
# Line 501  Entry to this mode runs the hooks on `co Line 501  Entry to this mode runs the hooks on `co
501    (make-local-variable 'comint-scroll-to-bottom-on-input)    (make-local-variable 'comint-scroll-to-bottom-on-input)
502    (make-local-variable 'comint-scroll-to-bottom-on-output)    (make-local-variable 'comint-scroll-to-bottom-on-output)
503    (make-local-variable 'comint-scroll-show-maximum-output)    (make-local-variable 'comint-scroll-show-maximum-output)
504      ;; This makes it really work to keep point at the bottom.
505      (make-local-variable 'scroll-conservatively)
506      (setq scroll-conservatively 10000)
507    (add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom t t)    (add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom t t)
508    (make-local-variable 'comint-ptyp)    (make-local-variable 'comint-ptyp)
509    (make-local-variable 'comint-process-echoes)    (make-local-variable 'comint-process-echoes)
510    (make-local-variable 'comint-file-name-chars)    (make-local-variable 'comint-file-name-chars)
511    (make-local-variable 'comint-file-name-quote-list)    (make-local-variable 'comint-file-name-quote-list)
512    (set (make-local-variable 'comint-accum-marker) (make-marker))    (set (make-local-variable 'comint-accum-marker) (make-marker))
513    (set (make-local-variable 'font-lock-defaults)    (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
        '(nil t nil nil nil (font-lock-core-only . t)))  
514    ;; This behavior is not useful in comint buffers, and is annoying    ;; This behavior is not useful in comint buffers, and is annoying
515    (set (make-local-variable 'next-line-add-newlines) nil))    (set (make-local-variable 'next-line-add-newlines) nil))
516    
# Line 781  buffer.  The hook `comint-exec-hook' is Line 783  buffer.  The hook `comint-exec-hook' is
783             (process-mark (get-buffer-process (current-buffer))))             (process-mark (get-buffer-process (current-buffer))))
784         (point))         (point))
785        ;; Insert the clicked-upon input        ;; Insert the clicked-upon input
786        (insert-buffer-substring        (insert (buffer-substring-no-properties
787         (current-buffer)                 (previous-single-char-property-change (1+ pos) 'field)
788         (previous-single-char-property-change (1+ pos) 'field)                 (next-single-char-property-change pos 'field))))))
        (next-single-char-property-change pos 'field)))))  
789    
790    
791    
# Line 1446  Similarly for Soar, Scheme, etc." Line 1447  Similarly for Soar, Scheme, etc."
1447    
1448            (let ((beg (marker-position pmark))            (let ((beg (marker-position pmark))
1449                  (end (if no-newline (point) (1- (point)))))                  (end (if no-newline (point) (1- (point)))))
1450              (when (not (> beg end))     ; handle a special case              (when (> end beg)
1451                ;; Set text-properties for the input field                ;; Set text-properties for the input field
1452                (add-text-properties                (add-text-properties
1453                 beg end                 beg end
# Line 1461  Similarly for Soar, Scheme, etc." Line 1462  Similarly for Soar, Scheme, etc."
1462                  ;; `boundary' field to make cursor movement between input                  ;; `boundary' field to make cursor movement between input
1463                  ;; and output fields smoother.                  ;; and output fields smoother.
1464                  (put-text-property beg end 'field 'input)))                  (put-text-property beg end 'field 'input)))
1465              (unless comint-use-prompt-regexp-instead-of-fields              (unless (or no-newline comint-use-prompt-regexp-instead-of-fields)
1466                ;; Cover the terminating newline                ;; Cover the terminating newline
1467                (add-text-properties end (1+ end)                (add-text-properties end (1+ end)
1468                                     '(rear-nonsticky t                                     '(rear-nonsticky t
# Line 1528  redirection buffer. Line 1529  redirection buffer.
1529  You can use `add-hook' to add functions to this list  You can use `add-hook' to add functions to this list
1530  either globally or locally.")  either globally or locally.")
1531    
1532    (defvar comint-inhibit-carriage-motion nil
1533      "If nil, comint will interpret `carriage control' characters in output.
1534    See `comint-carriage-motion' for details.")
1535    
1536  ;; When non-nil, this is an overlay over the last recognized prompt in  ;; When non-nil, this is an overlay over the last recognized prompt in
1537  ;; the buffer; it is used when highlighting the prompt.  ;; the buffer; it is used when highlighting the prompt.
1538  (defvar comint-last-prompt-overlay nil)  (defvar comint-last-prompt-overlay nil)
# Line 1537  either globally or locally.") Line 1542  either globally or locally.")
1542  ;; prompt overlay.  ;; prompt overlay.
1543  (defun comint-snapshot-last-prompt ()  (defun comint-snapshot-last-prompt ()
1544    (when comint-last-prompt-overlay    (when comint-last-prompt-overlay
1545      (add-text-properties (overlay-start comint-last-prompt-overlay)      (let ((inhibit-read-only t))
1546                           (overlay-end comint-last-prompt-overlay)        (add-text-properties (overlay-start comint-last-prompt-overlay)
1547                           (overlay-properties comint-last-prompt-overlay))))                             (overlay-end comint-last-prompt-overlay)
1548                               (overlay-properties comint-last-prompt-overlay)))))
1549    
1550  (defun comint-carriage-motion (string)  (defun comint-carriage-motion (start end)
1551    "Handle carriage control characters in comint output.    "Interpret carriage control characters in the region from START to END.
1552  Translate carriage return/linefeed sequences to linefeeds.  Translate carriage return/linefeed sequences to linefeeds.
1553  Make single carriage returns delete to the beginning of the line.  Make single carriage returns delete to the beginning of the line.
1554  Make backspaces delete the previous character.  Make backspaces delete the previous character."
1555      (save-excursion
1556  This function should be in the list `comint-output-filter-functions'."      ;; First do a quick check to see if there are any applicable
1557    (save-match-data      ;; characters, so we can avoid calling save-match-data and
1558      ;; We first check to see if STRING contains any magic characters, to      ;; save-restriction if not.
1559      ;; avoid overhead in the common case where it does not      (goto-char start)
1560      (when (string-match "[\r\b]" string)      (when (< (skip-chars-forward "^\b\r" end) (- end start))
1561        (let ((pmark (process-mark (get-buffer-process (current-buffer)))))        (save-match-data
1562          (save-excursion          (save-restriction
1563            (save-restriction            (widen)
1564              (widen)            (let ((inhibit-field-text-motion t)
1565              (let ((inhibit-field-text-motion t)                  (buffer-read-only nil))
1566                    (buffer-read-only nil))              ;; CR LF -> LF
1567                ;; CR LF -> LF              ;; Note that this won't work properly when the CR and LF
1568                ;; Note that this won't work properly when the CR and LF              ;; are in different output chunks, but this is probably an
1569                ;; are in different output chunks, but this is probably an              ;; exceedingly rare case (because they are generally
1570                ;; exceedingly rare case (because they are generally              ;; written as a unit), and to delay interpretation of a
1571                ;; written as a unit), and to delay interpretation of a              ;; trailing CR in a chunk would result in odd interactive
1572                ;; trailing CR in a chunk would result in odd interactive              ;; behavior (and this case is probably far more common).
1573                ;; behavior (and this case is probably far more common).              (while (re-search-forward "\r$" end t)
1574                (goto-char comint-last-output-start)                (delete-char -1))
1575                (while (re-search-forward "\r$" pmark t)              ;; bare CR -> delete preceding line
1576                  (delete-char -1))              (goto-char start)
1577                ;; bare CR -> delete preceding line              (while (search-forward "\r" end t)
1578                (goto-char comint-last-output-start)                (delete-region (point) (line-beginning-position)))
1579                (while (search-forward "\r" pmark t)              ;; BS -> delete preceding character
1580                  (delete-region (point) (line-beginning-position)))              (goto-char start)
1581                ;; BS -> delete preceding character              (while (search-forward "\b" end t)
1582                (goto-char comint-last-output-start)                (delete-char -2))))))))
               (while (search-forward "\b" pmark t)  
                 (delete-char -2)))))))))  
   
 (add-hook 'comint-output-filter-functions 'comint-carriage-motion)  
1583    
1584  ;; The purpose of using this filter for comint processes  ;; The purpose of using this filter for comint processes
1585  ;; is to keep comint-last-input-end from moving forward  ;; is to keep comint-last-input-end from moving forward
# Line 1662  This function should be in the list `com Line 1664  This function should be in the list `com
1664              ;; Advance process-mark              ;; Advance process-mark
1665              (set-marker (process-mark process) (point))              (set-marker (process-mark process) (point))
1666    
1667                (unless comint-inhibit-carriage-motion
1668                  ;; Interpret any carriage motion characters (newline, backspace)
1669                  (comint-carriage-motion comint-last-output-start (point)))
1670    
1671                (run-hook-with-args 'comint-output-filter-functions string)
1672    
1673                (goto-char (process-mark process)) ; in case a filter moved it
1674    
1675              (unless comint-use-prompt-regexp-instead-of-fields              (unless comint-use-prompt-regexp-instead-of-fields
1676                (add-text-properties comint-last-output-start (point)                (let ((inhibit-read-only t))
1677                                     '(rear-nonsticky t                  (add-text-properties comint-last-output-start (point)
1678                                       field output                                       '(rear-nonsticky t
1679                                       inhibit-line-move-field-capture t)))                                         field output
1680                                           inhibit-line-move-field-capture t))))
1681    
1682              ;; Highlight the prompt, where we define `prompt' to mean              ;; Highlight the prompt, where we define `prompt' to mean
1683              ;; the most recent output that doesn't end with a newline.              ;; the most recent output that doesn't end with a newline.
# Line 1685  This function should be in the list `com Line 1696  This function should be in the list `com
1696                    (overlay-put comint-last-prompt-overlay                    (overlay-put comint-last-prompt-overlay
1697                                 'font-lock-face 'comint-highlight-prompt))))                                 'font-lock-face 'comint-highlight-prompt))))
1698    
1699              (goto-char saved-point)              (goto-char saved-point)))))))
   
             (run-hook-with-args 'comint-output-filter-functions string)))))))  
1700    
1701  (defun comint-preinput-scroll-to-bottom ()  (defun comint-preinput-scroll-to-bottom ()
1702    "Go to the end of buffer in all windows showing it.    "Go to the end of buffer in all windows showing it.
# Line 1747  This function should be in the list `com Line 1756  This function should be in the list `com
1756                       ;; Optionally scroll so that the text                       ;; Optionally scroll so that the text
1757                       ;; ends at the bottom of the window.                       ;; ends at the bottom of the window.
1758                       (if (and comint-scroll-show-maximum-output                       (if (and comint-scroll-show-maximum-output
1759                                (>= (point) (process-mark process)))                                (= (point) (point-max)))
1760                           (save-excursion                           (save-excursion
1761                             (goto-char (point-max))                             (goto-char (point-max))
1762                             (recenter -1)))                             (recenter -1)))
# Line 1795  the current line with any initial string Line 1804  the current line with any initial string
1804  `comint-prompt-regexp' removed."  `comint-prompt-regexp' removed."
1805    (let ((bof (field-beginning)))    (let ((bof (field-beginning)))
1806      (if (eq (get-char-property bof 'field) 'input)      (if (eq (get-char-property bof 'field) 'input)
1807          (field-string bof)          (field-string-no-properties bof)
1808        (comint-bol)        (comint-bol)
1809        (buffer-substring-no-properties (point) (line-end-position)))))        (buffer-substring-no-properties (point) (line-end-position)))))
1810    
# Line 2059  Sets mark to the value of point when thi Line 2068  Sets mark to the value of point when thi
2068  This command also kills the pending input  This command also kills the pending input
2069  between the process-mark and point."  between the process-mark and point."
2070    (interactive)    (interactive)
2071    (comint-kill-input)    (comint-skip-input)
2072    (interrupt-process nil comint-ptyp))    (interrupt-process nil comint-ptyp))
2073    
2074  (defun comint-kill-subjob ()  (defun comint-kill-subjob ()
# Line 2067  between the process-mark and point." Line 2076  between the process-mark and point."
2076  This command also kills the pending input  This command also kills the pending input
2077  between the process-mark and point."  between the process-mark and point."
2078    (interactive)    (interactive)
2079    (comint-kill-input)    (comint-skip-input)
2080    (kill-process nil comint-ptyp))    (kill-process nil comint-ptyp))
2081    
2082  (defun comint-quit-subjob ()  (defun comint-quit-subjob ()
# Line 2075  between the process-mark and point." Line 2084  between the process-mark and point."
2084  This command also kills the pending input  This command also kills the pending input
2085  between the process-mark and point."  between the process-mark and point."
2086    (interactive)    (interactive)
2087    (comint-kill-input)    (comint-skip-input)
2088    (quit-process nil comint-ptyp))    (quit-process nil comint-ptyp))
2089    
2090  (defun comint-stop-subjob ()  (defun comint-stop-subjob ()
# Line 2088  the top-level process running in the buf Line 2097  the top-level process running in the buf
2097  this, use \\[comint-continue-subjob] to resume the process. (This  this, use \\[comint-continue-subjob] to resume the process. (This
2098  is not a problem with most shells, since they ignore this signal.)"  is not a problem with most shells, since they ignore this signal.)"
2099    (interactive)    (interactive)
2100    (comint-kill-input)    (comint-skip-input)
2101    (stop-process nil comint-ptyp))    (stop-process nil comint-ptyp))
2102    
2103  (defun comint-continue-subjob ()  (defun comint-continue-subjob ()
# Line 2097  Useful if you accidentally suspend the t Line 2106  Useful if you accidentally suspend the t
2106    (interactive)    (interactive)
2107    (continue-process nil comint-ptyp))    (continue-process nil comint-ptyp))
2108    
2109    (defun comint-skip-input ()
2110      "Skip all pending input, from last stuff output by interpreter to point.
2111    This means mark it as if it had been sent as input, without sending it."
2112      (let ((comint-input-sender 'ignore)
2113            (comint-input-filter-functions nil))
2114        (comint-send-input t))
2115      (end-of-line)
2116      (let ((pos (point))
2117            (marker (process-mark (get-buffer-process (current-buffer)))))
2118        (insert "  " (key-description (this-command-keys)))
2119        (if (= marker pos)
2120            (set-marker marker (point)))))
2121    
2122  (defun comint-kill-input ()  (defun comint-kill-input ()
2123    "Kill all text from last stuff output by interpreter to point."    "Kill all text from last stuff output by interpreter to point."
2124    (interactive)    (interactive)
# Line 2167  If N is negative, find the previous or N Line 2189  If N is negative, find the previous or N
2189    "Move to end of Nth next prompt in the buffer.    "Move to end of Nth next prompt in the buffer.
2190  If `comint-use-prompt-regexp-instead-of-fields' is nil, then this means  If `comint-use-prompt-regexp-instead-of-fields' is nil, then this means
2191  the beginning of the Nth next `input' field, otherwise, it means the Nth  the beginning of the Nth next `input' field, otherwise, it means the Nth
2192  occurance of text matching `comint-prompt-regexp'."  occurrence of text matching `comint-prompt-regexp'."
2193    (interactive "p")    (interactive "p")
2194    (if comint-use-prompt-regexp-instead-of-fields    (if comint-use-prompt-regexp-instead-of-fields
2195        ;; Use comint-prompt-regexp        ;; Use comint-prompt-regexp
# Line 2204  occurance of text matching `comint-promp Line 2226  occurance of text matching `comint-promp
2226    "Move to end of Nth previous prompt in the buffer.    "Move to end of Nth previous prompt in the buffer.
2227  If `comint-use-prompt-regexp-instead-of-fields' is nil, then this means  If `comint-use-prompt-regexp-instead-of-fields' is nil, then this means
2228  the beginning of the Nth previous `input' field, otherwise, it means the Nth  the beginning of the Nth previous `input' field, otherwise, it means the Nth
2229  occurance of text matching `comint-prompt-regexp'."  occurrence of text matching `comint-prompt-regexp'."
2230    (interactive "p")    (interactive "p")
2231    (comint-next-prompt (- n)))    (comint-next-prompt (- n)))
2232    
# Line 2514  This is used by comint's and shell's com Line 2536  This is used by comint's and shell's com
2536  directory tracking functions.")  directory tracking functions.")
2537    
2538  (defvar comint-file-name-chars  (defvar comint-file-name-chars
2539    (if (memq system-type '(ms-dos windows-nt))    (if (memq system-type '(ms-dos windows-nt cygwin))
2540        "~/A-Za-z0-9_^$!#%&{}@`'.,:()-"        "~/A-Za-z0-9_^$!#%&{}@`'.,:()-"
2541      "~/A-Za-z0-9+@:_.$#%,={}-")      "~/A-Za-z0-9+@:_.$#%,={}-")
2542    "String of characters valid in a file name.    "String of characters valid in a file name.
# Line 2639  Returns t if successful." Line 2661  Returns t if successful."
2661  (defun comint-dynamic-complete-as-filename ()  (defun comint-dynamic-complete-as-filename ()
2662    "Dynamically complete at point as a filename.    "Dynamically complete at point as a filename.
2663  See `comint-dynamic-complete-filename'.  Returns t if successful."  See `comint-dynamic-complete-filename'.  Returns t if successful."
2664    (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt)))    (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin)))
2665           (completion-ignored-extensions comint-completion-fignore)           (completion-ignored-extensions comint-completion-fignore)
2666           ;; If we bind this, it breaks remote directory tracking in rlogin.el.           ;; If we bind this, it breaks remote directory tracking in rlogin.el.
2667           ;; I think it was originally bound to solve file completion problems,           ;; I think it was originally bound to solve file completion problems,
# Line 2728  Returns `partial' if completed as far as Line 2750  Returns `partial' if completed as far as
2750  Returns `listed' if a completion listing was shown.  Returns `listed' if a completion listing was shown.
2751    
2752  See also `comint-dynamic-complete-filename'."  See also `comint-dynamic-complete-filename'."
2753    (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt)))    (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin)))
2754           (suffix (cond ((not comint-completion-addsuffix) "")           (suffix (cond ((not comint-completion-addsuffix) "")
2755                         ((not (consp comint-completion-addsuffix)) " ")                         ((not (consp comint-completion-addsuffix)) " ")
2756                         (t (cdr comint-completion-addsuffix))))                         (t (cdr comint-completion-addsuffix))))
# Line 2769  See also `comint-dynamic-complete-filena Line 2791  See also `comint-dynamic-complete-filena
2791  (defun comint-dynamic-list-filename-completions ()  (defun comint-dynamic-list-filename-completions ()
2792    "List in help buffer possible completions of the filename at point."    "List in help buffer possible completions of the filename at point."
2793    (interactive)    (interactive)
2794    (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt)))    (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin)))
2795           ;; If we bind this, it breaks remote directory tracking in rlogin.el.           ;; If we bind this, it breaks remote directory tracking in rlogin.el.
2796           ;; I think it was originally bound to solve file completion problems,           ;; I think it was originally bound to solve file completion problems,
2797           ;; but subsequent changes may have made this unnecessary.  sm.           ;; but subsequent changes may have made this unnecessary.  sm.
# Line 2785  See also `comint-dynamic-complete-filena Line 2807  See also `comint-dynamic-complete-filena
2807         (mapcar 'comint-quote-filename completions)))))         (mapcar 'comint-quote-filename completions)))))
2808    
2809    
2810    ;; This is bound locally in a *Completions* buffer to the list of
2811    ;; completions displayed, and is used to detect the case where the same
2812    ;; command is repeatedly used without the set of completions changing.
2813    (defvar comint-displayed-dynamic-completions nil)
2814    
2815  (defun comint-dynamic-list-completions (completions)  (defun comint-dynamic-list-completions (completions)
2816    "List in help buffer sorted COMPLETIONS.    "List in help buffer sorted COMPLETIONS.
2817  Typing SPC flushes the help buffer."  Typing SPC flushes the help buffer."
2818    (let ((window (get-buffer-window "*Completions*")))    (let ((window (get-buffer-window "*Completions*")))
2819        (setq completions (sort completions 'string-lessp))
2820      (if (and (eq last-command this-command)      (if (and (eq last-command this-command)
2821               window (window-live-p window) (window-buffer window)               window (window-live-p window) (window-buffer window)
2822               (buffer-name (window-buffer window)))               (buffer-name (window-buffer window))
2823                 ;; The above tests are not sufficient to detect the case where we
2824                 ;; should scroll, because the top-level interactive command may
2825                 ;; not have displayed a completions window the last time it was
2826                 ;; invoked, and there may be such a window left over from a
2827                 ;; previous completion command with a different set of
2828                 ;; completions.  To detect that case, we also test that the set
2829                 ;; of displayed completions is in fact the same as the previously
2830                 ;; displayed set.
2831                 (equal completions
2832                        (buffer-local-value 'comint-displayed-dynamic-completions
2833                                            (window-buffer window))))
2834          ;; If this command was repeated, and          ;; If this command was repeated, and
2835          ;; there's a fresh completion window with a live buffer,          ;; there's a fresh completion window with a live buffer,
2836          ;; and this command is repeated, scroll that window.          ;; and this command is repeated, scroll that window.
# Line 2804  Typing SPC flushes the help buffer." Line 2843  Typing SPC flushes the help buffer."
2843    
2844        (let ((conf (current-window-configuration)))        (let ((conf (current-window-configuration)))
2845          (with-output-to-temp-buffer "*Completions*"          (with-output-to-temp-buffer "*Completions*"
2846            (display-completion-list (sort completions 'string-lessp)))            (display-completion-list completions))
2847          (message "Type space to flush; repeat completion command to scroll")          (message "Type space to flush; repeat completion command to scroll")
2848          (let (key first)          (let (key first)
2849            (if (save-excursion            (if (save-excursion
2850                  (set-buffer (get-buffer "*Completions*"))                  (set-buffer (get-buffer "*Completions*"))
2851                    (set (make-local-variable
2852                          'comint-displayed-dynamic-completions)
2853                         completions)
2854                  (setq key (read-key-sequence nil)                  (setq key (read-key-sequence nil)
2855                        first (aref key 0))                        first (aref key 0))
2856                  (and (consp first) (consp (event-start first))                  (and (consp first) (consp (event-start first))

Legend:
Removed from v.1.272  
changed lines
  Added in v.1.272.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26