Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
3965beb0
Commit
3965beb0
authored
Nov 23, 1999
by
Gerd Moellmann
Browse files
Add redirection.from active comint buffers into
another buffer. Written by Peter Breton.
parent
bc165bce
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
355 additions
and
4 deletions
+355
-4
lisp/ChangeLog
lisp/ChangeLog
+9
-4
lisp/comint.el
lisp/comint.el
+346
-0
No files found.
lisp/ChangeLog
View file @
3965beb0
1999-11-23 Gerd Moellmann <gerd@gnu.org>
* comint.el: Add redirection.from active comint buffers into
another buffer. Written by Peter Breton.
1999-11-23 Stefan Monnier <monnier@cs.yale.edu>
* emacs-lisp/autoload.el (make-autoload): Recognize the new
`define-minor-mode'.
`define-minor-mode'.
(define-minor-mode): Specify `doc-string-elt'.
* emacs-lisp/easy-mmode.el: Changed maintainer.
(easy-mmode-define-toggle): New BODY arg; Never append `-mode';
Use defcustom for the hooks; Improve the auto-generated docstrings.
Use defcustom for the hooks; Improve the auto-generated docstrings.
(easy-mmode-define-minor-mode): Renamed `define-minor-mode'.
(define-minor-mode): Add BODY arg; Only declare the keymap if
provided; Improve the auto-generated docstrings.
provided; Improve the auto-generated docstrings.
1999-11-22 Gerd Moellmann <gerd@gnu.org>
* textmodes/text-mode.el (text-mode): Contruct paragraph-start so
* textmodes/text-mode.el (text-mode): Con
s
truct paragraph-start so
that the leading `^' is at the start. This is necessary because
paragraphs.el tries to remove anchors, but can find them only if
they are the first character.
...
...
lisp/comint.el
View file @
3965beb0
...
...
@@ -2371,6 +2371,352 @@ the process mark is at the beginning of the accumulated input."
(set-marker (process-mark proc) (point))
(message "
Process
mark
set
")))
;; Author: Peter Breton <pbreton@ne.mediaone.net>
;; This little add-on for comint is intended to make it easy to get
;; output from currently active comint buffers into another buffer,
;; or buffers, and then go back to using the comint shell.
;;
;; My particular use is SQL interpreters; I want to be able to execute a
;; query using the process associated with a comint-buffer, and save that
;; somewhere else. Because the process might have state (for example, it
;; could be in an uncommitted transaction), just running starting a new
;; process and having it execute the query and then finish, would not
;; work. I'm sure there are other uses as well, although in many cases
;; starting a new process is the simpler, and thus preferable, approach.
;;
;; The basic implementation is as follows: comint-redirect changes the
;; preoutput filter functions (comint-preoutput-filter-functions) to use
;; its own filter. The filter puts the output into the designated buffer,
;; or buffers, until it sees a regexp that tells it to stop (by default,
;; this is the prompt for the interpreter, comint-prompt-regexp). When it
;; sees the stop regexp, it restores the old filter functions, and runs
;; comint-redirect-hook.
;;
;; Each comint buffer may only use one redirection at a time, but any number
;; of different comint buffers may be simultaneously redirected.
;;
;; NOTE: It is EXTREMELY important that `comint-prompt-regexp' be set to the
;; correct prompt for your interpreter, or that you supply a regexp that says
;; when the redirection is finished. Otherwise, redirection will continue
;; indefinitely. The code now does a sanity check to ensure that it can find
;; a prompt in the comint buffer; however, it is still important to ensure that
;; this prompt is set correctly.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defcustom comint-redirect-verbose nil
"
*If
non-nil,
print
messages
each
time
the
redirection
filter
is
invoked.
Also
print
a
message
when
redirection
is
completed.
"
:group 'comint
:type 'boolean)
;; Directly analagous to comint-preoutput-filter-functions
(defvar comint-redirect-filter-functions nil
"
List
of
functions
to
call
before
inserting
redirected
process
output.
Each
function
gets
one
argument,
a
string
containing
the
text
received
from
the
subprocess.
It
should
return
the
string
to
insert,
perhaps
the
same
string
that
was
received,
or
perhaps
a
modified
or
transformed
string.
The
functions
on
the
list
are
called
sequentially,
and
each
one
is
given
the
string
returned
by
the
previous
one.
The
string
returned
by
the
last
function
is
the
text
that
is
actually
inserted
in
the
redirection
buffer.
")
(make-variable-buffer-local 'comint-redirect-filter-functions)
;; Internal variables
(defvar comint-redirect-output-buffer nil
"
The
buffer
or
list
of
buffers
to
put
output
into.
")
(defvar comint-redirect-finished-regexp nil
"
Regular
expression
that
determines
when
to
stop
redirection
in
Comint.
When
the
redirection
filter
function
is
given
output
that
matches
this
regexp,
the
output
is
inserted
as
usual,
and
redirection
is
completed.
")
(defvar comint-redirect-insert-matching-regexp nil
"
If
non-nil,
the
text
that
ends
a
redirection
is
included
in
it.
More
precisely,
the
text
that
matches
`
comint-redirect-finished-regexp
'
and
therefore
terminates
an
output
redirection
is
inserted
in
the
redirection
target
buffer,
along
with
the
preceding
output.
")
(defvar comint-redirect-echo-input nil
"
Non-nil
means
echo
input
in
the
process
buffer
even
during
redirection.
")
(defvar comint-redirect-completed nil
"
Non-nil
if
redirection
has
completed
in
the
current
buffer.
")
(defvar comint-redirect-original-mode-line-process nil
"
Original
mode
line
for
redirected
process.
")
(defvar comint-redirect-perform-sanity-check t
"
If
non-nil,
check
that
redirection
is
likely
to
complete
successfully.
More
precisely,
before
starting
a
redirection,
verify
that
the
regular
expression
`
comint-redirect-finished-regexp
'
that
controls
when
to
terminate
it
actually
matches
some
text
already
in
the
process
buffer.
The
idea
is
that
this
regular
expression
should
match
a
prompt
string,
and
that
there
ought
to
be
at
least
one
copy
of
your
prompt
string
in
the
process
buffer
already.
")
(defvar comint-redirect-original-filter-function nil
"
The
process
filter
that
was
in
place
when
redirection
is
started.
When
redirection
is
completed,
the
process
filter
is
restored
to
this
value.
")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun comint-redirect-setup (output-buffer
comint-buffer
finished-regexp
&optional echo-input)
"
Set
up
for
output
redirection.
This
function
sets
local
variables
that
are
used
by
`
comint-redirect-filter
'
to
perform
redirection.
Output
from
COMINT-BUFFER
is
redirected
to
OUTPUT-BUFFER,
until
something
in
the
output
matches
FINISHED-REGEXP.
If
optional
argument
ECHO-INPUT
is
non-nil,
output
is
echoed
to
the
original
comint
buffer.
This
function
is
called
by
`
comint-redirect-send-command-to-process
',
and
does
not
normally
need
to
be
invoked
by
the
end
user
or
programmer.
"
(with-current-buffer comint-buffer
(make-local-variable 'comint-redirect-original-mode-line-process)
(setq comint-redirect-original-mode-line-process mode-line-process)
(make-local-variable 'comint-redirect-output-buffer)
(setq comint-redirect-output-buffer output-buffer)
(make-local-variable 'comint-redirect-finished-regexp)
(setq comint-redirect-finished-regexp finished-regexp)
(make-local-variable 'comint-redirect-echo-input)
(setq comint-redirect-echo-input echo-input)
(make-local-variable 'comint-redirect-completed)
(setq comint-redirect-completed nil)
(setq mode-line-process
(if mode-line-process
(list (concat (elt mode-line-process 0) "
Redirection
"))
(list "
:%s
Redirection
")))))
(defun comint-redirect-cleanup ()
"
End
a
Comint
redirection.
See
`
comint-redirect-send-command
'.
"
(interactive)
;; Restore the process filter
(set-process-filter (get-buffer-process (current-buffer))
comint-redirect-original-filter-function)
;; Restore the mode line
(setq mode-line-process comint-redirect-original-mode-line-process)
;; Set the completed flag
(setq comint-redirect-completed t))
;; Because the cleanup happens as a callback, it's not easy to guarantee
;; that it really occurs.
(defalias 'comint-redirect-remove-redirection 'comint-redirect-cleanup)
(defun comint-redirect-filter (process input-string)
"
Filter
function
which
redirects
output
from
PROCESS
to
a
buffer
or
buffers.
The
variable
`
comint-redirect-output-buffer
'
says
which
buffer
(
s
)
to
place
output
in.
INPUT-STRING
is
the
input
from
the
comint
process.
This
function
runs
as
a
process
filter,
and
does
not
need
to
be
invoked
by
the
end
user.
"
(and process
(with-current-buffer (process-buffer process)
(comint-redirect-preoutput-filter input-string)
;; If we have to echo output, give it to the original filter function
(and comint-redirect-echo-input
comint-redirect-original-filter-function
(funcall comint-redirect-original-filter-function
process input-string)))))
(defun comint-redirect-preoutput-filter (input-string)
"
Comint
filter
function
which
redirects
comint
output
to
a
buffer
or
buffers.
The
variable
`
comint-redirect-output-buffer
'
says
which
buffer
(
s
)
to
place
output
in.
INPUT-STRING
is
the
input
from
the
comint
process.
This
function
does
not
need
to
be
invoked
by
the
end
user.
"
(let ((output-buffer-list
(if (listp comint-redirect-output-buffer)
comint-redirect-output-buffer
(list comint-redirect-output-buffer)))
(filtered-input-string input-string))
;; If there are any filter functions, give them a chance to modify the string
(let ((functions comint-redirect-filter-functions))
(while (and functions filtered-input-string)
(setq filtered-input-string
(funcall (car functions) filtered-input-string))
(setq functions (cdr functions))))
;; Clobber `comint-redirect-finished-regexp'
(or comint-redirect-insert-matching-regexp
(and (string-match comint-redirect-finished-regexp filtered-input-string)
(setq filtered-input-string
(replace-match "" nil nil filtered-input-string))))
;; Send output to all registered buffers
(save-excursion
(mapcar
(function (lambda(buf)
;; Set this buffer to the output buffer
(set-buffer (get-buffer-create buf))
;; Go to the end of the buffer
(goto-char (point-max))
;; Insert the output
(insert filtered-input-string)))
output-buffer-list))
;; Message
(and comint-redirect-verbose
(message "
Redirected
output
to
buffer
(
s
)
%s
"
(mapconcat 'identity output-buffer-list "
")))
;; If we see the prompt, tidy up
;; We'll look for the prompt in the original string, so nobody can
;; clobber it
(and (string-match comint-redirect-finished-regexp input-string)
(progn
(and comint-redirect-verbose
(message "
Redirection
completed
"))
(comint-redirect-cleanup)
(run-hooks 'comint-redirect-hook)))
;; Echo input?
(if comint-redirect-echo-input
filtered-input-string
"")))
;;;###autoload
(defun comint-redirect-send-command (command output-buffer echo &optional no-display)
"
Send
COMMAND
to
process
in
current
buffer,
with
output
to
OUTPUT-BUFFER.
With
prefix
arg,
echo
output
in
process
buffer.
If
NO-DISPLAY
is
non-nil,
do
not
show
the
output
buffer.
"
(interactive "
sCommand:
\nBOutput
Buffer:
\nP
")
(let ((process (get-buffer-process (current-buffer))))
(if process
(comint-redirect-send-command-to-process
command output-buffer (current-buffer) echo no-display)
(error "
No
process
for
current
buffer
"))))
;;;###autoload
(defun comint-redirect-send-command-to-process
(command output-buffer process echo &optional no-display)
"
Send
COMMAND
to
PROCESS,
with
output
to
OUTPUT-BUFFER.
With
prefix
arg,
echo
output
in
process
buffer.
If
NO-DISPLAY
is
non-nil,
do
not
show
the
output
buffer.
"
(interactive "
sCommand:
\nBOutput
Buffer:
\nbProcess
Buffer:
\nP
")
(let* (;; The process buffer
(process-buffer (if (processp process)
(process-buffer process)
process))
(proc (get-buffer-process process-buffer)))
;; Change to the process buffer
(set-buffer process-buffer)
;; Make sure there's a prompt in the current process buffer
(and comint-redirect-perform-sanity-check
(save-excursion
(goto-char (point-max))
(or (re-search-backward comint-prompt-regexp nil t)
(error "
No
prompt
found
or
`
comint-prompt-regexp
'
not
set
properly
"))))
;;;;;;;;;;;;;;;;;;;;;
;; Set up for redirection
;;;;;;;;;;;;;;;;;;;;;
(comint-redirect-setup
;; Output Buffer
output-buffer
;; Comint Buffer
(current-buffer)
;; Finished Regexp
comint-prompt-regexp
;; Echo input
echo)
;;;;;;;;;;;;;;;;;;;;;
;; Set the filter
;;;;;;;;;;;;;;;;;;;;;
;; Save the old filter
(setq comint-redirect-original-filter-function
(process-filter proc))
(set-process-filter proc 'comint-redirect-filter)
;;;;;;;;;;;;;;;;;;;;;
;; Send the command
;;;;;;;;;;;;;;;;;;;;;
(process-send-string
(current-buffer)
(concat command "
\n
"))
;;;;;;;;;;;;;;;;;;;;;
;; Show the output
;;;;;;;;;;;;;;;;;;;;;
(or no-display
(display-buffer
(get-buffer-create
(if (listp output-buffer)
(car output-buffer)
output-buffer))))))
;;;###autoload
(defun comint-redirect-results-list (command regexp regexp-group)
"
Send
COMMAND
to
current
process.
Return
a
list
of
expressions
in
the
output
which
match
REGEXP.
REGEXP-GROUP
is
the
regular
expression
group
in
REGEXP
to
use.
"
(interactive)
(comint-redirect-results-list-from-process
(get-buffer-process (current-buffer))
command regexp regexp-group))
;;;###autoload
(defun comint-redirect-results-list-from-process (process command regexp regexp-group)
"
Send
COMMAND
to
PROCESS.
Return
a
list
of
expressions
in
the
output
which
match
REGEXP.
REGEXP-GROUP
is
the
regular
expression
group
in
REGEXP
to
use.
"
(interactive)
(let ((output-buffer "
*Comint
Redirect
Work
Buffer*
")
results)
(save-excursion
(set-buffer (get-buffer-create output-buffer))
(erase-buffer)
(comint-redirect-send-command-to-process command
output-buffer process nil t)
;; Wait for the process to complete
(set-buffer (process-buffer process))
(while (null comint-redirect-completed)
(accept-process-output nil 1))
;; Collect the output
(set-buffer output-buffer)
(goto-char (point-min))
;; Skip past the command, if it was echoed
(and (looking-at command)
(forward-line))
(while (re-search-forward regexp nil t)
(setq results
(cons (buffer-substring-no-properties
(match-beginning regexp-group)
(match-end regexp-group))
results)))
results)))
;; Converting process modes to use comint mode
;; ===========================================================================
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment