-;;; -*-Scheme-*-
-;;;
-;;; $Id: edtstr.scm,v 1.24 2002/11/20 19:45:59 cph Exp $
-;;;
-;;; Copyright (c) 1989-1999 Massachusetts Institute of Technology
-;;;
-;;; This file is part of MIT Scheme.
-;;;
-;;; MIT Scheme is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published
-;;; by the Free Software Foundation; either version 2 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; MIT Scheme is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with MIT Scheme; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;;; 02111-1307, USA.
+#| -*-Scheme-*-
+
+$Id: edtstr.scm,v 1.25 2003/01/09 20:52:21 cph Exp $
+
+Copyright (c) 1989,1990,1991,1992,2003 Massachusetts Institute of Technology
+
+This file is part of MIT Scheme.
+
+MIT Scheme is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published
+by the Free Software Foundation; either version 2 of the License,
+or (at your option) any later version.
+
+MIT Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT Scheme; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+|#
;;;; Editor Data Abstraction
(declare (usual-integrations))
\f
(define-structure (editor (constructor %make-editor))
- (name false read-only true)
- (display-type false read-only true)
+ (name #f read-only #t)
+ (display-type #f read-only #t)
(screens '())
- (selected-screen false)
- (bufferset false read-only true)
- (char-history false read-only true)
- (halt-update? false read-only true)
- (peek-no-hang false read-only true)
- (peek false read-only true)
- (read false read-only true)
- (button-event false)
+ (selected-screen #f)
+ (bufferset #f read-only #t)
+ (char-history #f read-only #t)
+ (halt-update? #f read-only #t)
+ (peek-no-hang #f read-only #t)
+ (peek #f read-only #t)
+ (read #f read-only #t)
+ (button-event #f)
(select-time 1))
(define (make-editor name display-type make-screen-args)
peek-no-hang
peek
read
- false
+ #f
1))))))
(define-integrable (current-display-type)
;;;; Buttons
(define-structure (button-event (conc-name button-event/))
- (window false read-only true)
- (x false read-only true)
- (y false read-only true))
+ (window #f read-only #t)
+ (x #f read-only #t)
+ (y #f read-only #t))
(define (current-button-event)
(or (editor-button-event current-editor)
(lambda ()
(set! old-button-event (editor-button-event current-editor))
(set-editor-button-event! current-editor button-event)
- (set! button-event false)
+ (set! button-event #f)
unspecific)
thunk
(lambda ()
(define button-record-type
(make-record-type 'BUTTON '(NUMBER DOWN?)))
-\f
+
(define make-down-button)
(define make-up-button)
(let ((%make-button
(set! make-down-button
(lambda (number)
(if (>= number (vector-length down-buttons))
- (set! down-buttons (vector-grow down-buttons (1+ number))))
- (%make-button down-buttons number true)))
+ (set! down-buttons (vector-grow down-buttons (+ number 1))))
+ (%make-button down-buttons number #t)))
(set! make-up-button
(lambda (number)
(if (>= number (vector-length up-buttons))
- (set! up-buttons (vector-grow up-buttons (1+ number))))
- (%make-button up-buttons number false))))
-
-(define (make-modified-button modifier button-number up-or-down)
- (let ((button
- (+ button-number
- (case modifier
- ((shift) 5)
- ((control) 10)
- ((meta) 20)
- (else (error "make-modified-button: Bad button modifier"
- modifier))))))
- (cond ((eq? up-or-down 'DOWN)
- (make-down-button button))
- ((eq? up-or-down 'UP)
- (make-up-button button))
- (else (error "make-modified-button: Must specify UP or DOWN"
- up-or-down)))))
+ (set! up-buttons (vector-grow up-buttons (+ number 1))))
+ (%make-button up-buttons number #f))))
(define button?
(record-predicate button-record-type))