1
;; with-output.jl -- call a command/function redirecting stdout
2
;; $Id: with-output.jl,v 1.7 2000/09/11 07:44:42 john Exp $
4
;; Copyright (C) 2000 John Harper <john@dcs.warwick.ac.uk>
6
;; This file is part of sawmill.
8
;; sawmill is free software; you can redistribute it and/or modify it
9
;; under the terms of the GNU General Public License as published by
10
;; the Free Software Foundation; either version 2, or (at your option)
13
;; sawmill is distributed in the hope that it will be useful, but
14
;; WITHOUT ANY WARRANTY; without even the implied warranty of
15
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16
;; GNU General Public License for more details.
18
;; You should have received a copy of the GNU General Public License
19
;; along with sawmill; see the file COPYING. If not, write to
20
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22
(define-structure sawfish.wm.util.with-output
24
(export call-with-output-to-screen
25
with-output-to-screen)
31
(define-structure-alias with-output sawfish.wm.util.with-output)
33
(define (call-with-output-to-screen thunk)
34
"Call the zero-parameter function THUNK with the `standard-output'
35
stream bound so that output is collected. After THUNK returns, the
36
emitted text will be display on the screen."
38
(let ((standard-output (make-string-output-stream)))
41
(let ((out (get-output-stream-string standard-output)))
42
(unless (string= out "")
43
;; display-message doesn't grok TAB characters,
44
;; this is grossly inefficient; wtf..
45
(while (string-match "\t" out)
46
(setq out (concat (substring out 0 (match-start))
47
#\space (substring out (match-end)))))
48
(display-message out))))))
50
(defmacro with-output-to-screen (#!rest forms)
51
"Evaluate FORMS. Any data they print to standard-output will be
52
displayed on the screen after they return."
53
`(call-with-output-to-screen (lambda () ,@forms))))
added
removed
lisp/sawfish/wm/util/with-output.jl
