~ubuntu-branches/ubuntu/intrepid/mit-scheme/intrepid-updates

« back to all changes in this revision

Viewing changes to src/edwin/xterm.scm

  • Committer: Bazaar Package Importer
  • Author(s): Chris Hanson
  • Date: 2005-01-18 00:33:57 UTC
  • mfrom: (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20050118003357-pv3i8iqlm5m80tl5
Tags: 7.7.90-5
* Add "libx11-dev" to build-depends.  (closes: Bug#290845)
* Fix debian/control and debian/menu to eliminate some lintian errors
  and warnings.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
;;; -*-Scheme-*-
2
 
;;;
3
 
;;; $Id: xterm.scm,v 1.69 2002/03/06 20:05:44 cph Exp $
4
 
;;;
5
 
;;; Copyright (c) 1989-2002 Massachusetts Institute of Technology
6
 
;;;
7
 
;;; This program is free software; you can redistribute it and/or
8
 
;;; modify it under the terms of the GNU General Public License as
9
 
;;; published by the Free Software Foundation; either version 2 of the
10
 
;;; License, or (at your option) any later version.
11
 
;;;
12
 
;;; This program is distributed in the hope that it will be useful,
13
 
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14
 
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15
 
;;; General Public License for more details.
16
 
;;;
17
 
;;; You should have received a copy of the GNU General Public License
18
 
;;; along with this program; if not, write to the Free Software
19
 
;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
20
 
;;; 02111-1307, USA.
 
1
#| -*-Scheme-*-
 
2
 
 
3
$Id: xterm.scm,v 1.72 2003/02/14 18:28:14 cph Exp $
 
4
 
 
5
Copyright 1989,1990,1991,1992,1993,1995 Massachusetts Institute of Technology
 
6
Copyright 1996,1998,1999,2000,2001,2002 Massachusetts Institute of Technology
 
7
Copyright 2003 Massachusetts Institute of Technology
 
8
 
 
9
This file is part of MIT/GNU Scheme.
 
10
 
 
11
MIT/GNU Scheme is free software; you can redistribute it and/or modify
 
12
it under the terms of the GNU General Public License as published by
 
13
the Free Software Foundation; either version 2 of the License, or (at
 
14
your option) any later version.
 
15
 
 
16
MIT/GNU Scheme is distributed in the hope that it will be useful, but
 
17
WITHOUT ANY WARRANTY; without even the implied warranty of
 
18
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
19
General Public License for more details.
 
20
 
 
21
You should have received a copy of the GNU General Public License
 
22
along with MIT/GNU Scheme; if not, write to the Free Software
 
23
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
 
24
USA.
 
25
 
 
26
|#
21
27
 
22
28
;;;; X Terminal
23
29
;;; Package: (edwin x-screen)
554
560
                 event:process-status)
555
561
                (else
556
562
                 (let ((flag
557
 
                        (test-for-input-on-descriptor
 
563
                        (test-for-io-on-descriptor
558
564
                         (x-display-descriptor display)
559
 
                         block?)))
 
565
                         block?
 
566
                         'READ)))
560
567
                   (set-interrupt-enables! interrupt-mask)
561
568
                   (case flag
562
569
                     ((#F) #f)
566
573
 
567
574
(define (preview-event-stream)
568
575
  (set! previewer-registration
569
 
        (permanently-register-input-thread-event
 
576
        (permanently-register-io-thread-event
570
577
         (x-display-descriptor x-display-data)
 
578
         'READ
571
579
         (current-thread)
572
 
         (lambda ()
 
580
         (lambda (mode)
 
581
           mode
573
582
           (if (not reading-event?)
574
583
               (let ((event (x-display-process-events x-display-data 2)))
575
584
                 (if event
1310
1319
     preview-event-stream
1311
1320
     (lambda () (receiver (lambda (thunk) (thunk)) '()))
1312
1321
     (lambda ()
1313
 
       (deregister-input-thread-event previewer-registration)))))
 
1322
       (deregister-io-thread-event previewer-registration)))))
1314
1323
 
1315
1324
(define (with-x-interrupts-enabled thunk)
1316
1325
  (with-signal-interrupts #t thunk))