MERGE-BUCKY-BITS. Use new bucky-bit abstractions from runtime.
#| -*-Scheme-*-
-$Id: basic.scm,v 1.144 2005/10/24 01:55:50 cph Exp $
+$Id: basic.scm,v 1.145 2006/10/24 04:13:14 cph Exp $
Copyright 1987,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
-Copyright 1999,2000,2005 Massachusetts Institute of Technology
+Copyright 1999,2000,2005,2006 Massachusetts Institute of Technology
This file is part of MIT/GNU Scheme.
This command followed by an = is equivalent to a Control-=."
()
(lambda ()
- (read-extension-key char-controlify)))
+ (read-extension-key
+ (lambda (char)
+ (merge-bucky-bits char char-bit:control)))))
(define-command meta-prefix
"Sets Meta-bit of following character.
()
(lambda ()
(read-extension-key
- (if (let ((char (current-command-key)))
- (and (char? char)
- (char=? #\altmode char)))
- char-metafy
- (lambda (char)
- (char-metafy (char-base char)))))))
+ (lambda (char)
+ (merge-bucky-bits (if (eqv? (current-command-key) #\altmode)
+ char
+ (char-base char))
+ char-bit:meta)))))
(define-command control-meta-prefix
"Sets Control- and Meta-bits of following character.
Turns a following A (or C-A) into a Control-Meta-A."
()
(lambda ()
- (read-extension-key char-control-metafy)))
+ (read-extension-key
+ (lambda (char)
+ (merge-bucky-bits char (fix:or char-bit:control char-bit:meta))))))
(define execute-extended-keys?
#t)
#| -*-Scheme-*-
-$Id: calias.scm,v 1.32 2006/10/22 16:09:24 cph Exp $
+$Id: calias.scm,v 1.33 2006/10/24 04:13:23 cph Exp $
Copyright 1986,1989,1991,1992,1994,1995 Massachusetts Institute of Technology
Copyright 1998,2000,2001,2002,2003,2006 Massachusetts Institute of Technology
(cond (entry
(remap-alias-key (cdr entry)))
((and (char? key)
- (odd? (quotient (char-bits key) 2))) ;Control bit is set
+ (char-bits-set? char-bit:control key))
(let ((code (char-code key))
(remap
(lambda (code)
- (make-char code (- (char-bits key) 2)))))
+ (make-char code
+ (fix:andc (char-bits key) char-bit:control)))))
(cond ((<= #x40 code #x5F) (remap (- code #x40)))
((<= #x61 code #x7A) (remap (- code #x60)))
(else key))))
(= code #x0D) ;return
(= code #x1B) ;altmode
)))
- (even? (quotient (char-bits key) 2)))
+ (char-bits-clear? char-bit:control key))
(unmap-alias-key
(make-char (let ((code (char-code key)))
(+ code (if (<= #x01 code #x1A) #x60 #x40)))
- (+ (char-bits key) 2)))
+ (fix:or (char-bits key) char-bit:control)))
(let ((entry
(list-search-positive alias-keys
(lambda (entry)
"DEL"
(vector-ref (ref-variable char-image-strings #f)
code)))))
- (cond ((< bits 2) ; no bits or Meta only
+ (cond ((or (fix:= bits 0)
+ (fix:= bits char-bit:meta))
(process-code bits))
- ((and handle-prefixes? (< bits 4))
- (string-append (if (= 2 bits) "C-^ " "C-z ")
+ ((and handle-prefixes?
+ (not (fix:= 0 (fix:and bits
+ (fix:or char-bit:control
+ char-bit:meta)))))
+ (string-append (if (fix:= bits char-bit:control)
+ "C-^ "
+ "C-z ")
(process-code 0)))
(else
(char->name (unmap-alias-key key))))))
#| -*-Scheme-*-
-$Id: edwin.pkg,v 1.297 2006/10/22 16:09:41 cph Exp $
+$Id: edwin.pkg,v 1.298 2006/10/24 04:13:31 cph Exp $
Copyright 1989,1990,1991,1992,1993,1994 Massachusetts Institute of Technology
Copyright 1995,1996,1997,1998,1999,2000 Massachusetts Institute of Technology
(export (edwin)
append-command-prompt!
append-message
- char-base
- char-control-metafy
- char-controlify
- char-metafy
clear-message
command-prompt
keyboard-read
#| -*-Scheme-*-
-$Id: os2term.scm,v 1.26 2006/10/22 16:09:48 cph Exp $
+$Id: os2term.scm,v 1.27 2006/10/24 04:13:41 cph Exp $
Copyright 1994,1995,1996,1997,2000,2003 Massachusetts Institute of Technology
Copyright 2006 Massachusetts Institute of Technology
(let ((process-code
(lambda (code)
(if (and (fix:<= #x40 code) (fix:< code #x60)
- (fix:= (fix:and bits #x1) #x1))
- (make-char (fix:and code #o037) (fix:andc bits #x1))
+ (fix:= (fix:and bits char-bit:control)
+ char-bit:control))
+ (make-char (fix:and code #x1F)
+ (fix:andc bits char-bit:control))
(make-char code bits)))))
(if (fix:= 0 (fix:and flags KC_VIRTUALKEY))
(and (fix:< code #x80)
#| -*-Scheme-*-
-$Id: tterm.scm,v 1.42 2005/12/25 17:04:39 riastradh Exp $
+$Id: tterm.scm,v 1.43 2006/10/24 04:13:51 cph Exp $
Copyright 1990,1991,1993,1994,1998,1999 Massachusetts Institute of Technology
-Copyright 2001,2002,2003,2004,2005 Massachusetts Institute of Technology
+Copyright 2001,2002,2003,2004,2005,2006 Massachusetts Institute of Technology
This file is part of MIT/GNU Scheme.
(let ((code (vector-8b-ref string start)))
(if (fix:< code #x80)
(make-char code 0)
- (make-char (fix:and code #x7f) 1))))))
+ (make-char (fix:and code #x7F)
+ char-bit:meta))))))
(let* ((key-seq (caar key-pairs))
(n-seq (string-length key-seq)))
(cond ((and (fix:<= n-seq n-chars)
#| -*-Scheme-*-
-$Id: utils.scm,v 1.56 2006/10/22 16:09:54 cph Exp $
+$Id: utils.scm,v 1.57 2006/10/24 04:14:01 cph Exp $
Copyright 1987,1989,1991,1992,1993,1994 Massachusetts Institute of Technology
Copyright 1996,1997,1999,2001,2002,2005 Massachusetts Institute of Technology
(and (fix:>= k 0)
(fix:< k 10)
(loop (fix:+ index 1) (+ (* n 10) k)))))))
-\f
+
(define char-set:null
(char-set))
(define char-set:not-space
(char-set-invert (char-set #\space)))
-(define (ascii-controlified? char)
- (fix:< (char-code char) #x20))
-
-(define (char-controlify char)
+(define (merge-bucky-bits char bits)
(make-char (char-code char)
- (if (ascii-controlified? char)
- (fix:andc (char-bits char) #x2)
- (fix:or (char-bits char) #x2))))
-
-(define (char-controlified? char)
- (if (ascii-controlified? char)
- #t
- (fix:= #x2 (fix:and (char-bits char) #x2))))
+ (let ((bits (fix:or (char-bits char) bits)))
+ (if (ascii-controlified? char)
+ (fix:andc bits char-bit:control)
+ bits))))
-(define (char-metafy char)
- (make-char (char-code char)
- (fix:or (char-bits char) #x1)))
-
-(define (char-metafied? char)
- (fix:= #x1 (fix:and (char-bits char) #x1)))
-
-(define (char-control-metafy char)
- (char-metafy (char-controlify char)))
+(define (ascii-controlified? char)
+ (fix:< (char-code char) #x20))
(define (char-base char)
(make-char (char-code char) 0))
#| -*-Scheme-*-
-$Id: xterm.scm,v 1.77 2006/10/22 16:10:06 cph Exp $
+$Id: xterm.scm,v 1.78 2006/10/24 04:14:11 cph Exp $
Copyright 1989,1990,1991,1992,1993,1995 Massachusetts Institute of Technology
Copyright 1996,1998,1999,2000,2001,2002 Massachusetts Institute of Technology
(vector-ref event 3)))
((fix:= end 1)
(let ((char
- (let ((code (char-code (string-ref string 0)))
- (bucky-bits (vector-ref event 3)))
- (make-char code
- ;; Remove the control bit if this
- ;; already is a control character.
- (if (fix:< code #x20)
- (fix:andc bucky-bits 2)
- bucky-bits)))))
+ (merge-bucky-bits (string-ref string 0)
+ (vector-ref event 3))))
(if (and signal-interrupts? (char=? char #\BEL))
(begin
(signal-interrupt!)
projects / mit-scheme.git / commitdiff