From a477c1f5a9164505334ea34314c0de55ed630fb5 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 5 Apr 1989 18:15:52 +0000
Subject: [PATCH] Create procedure `ascii-controlified?' which is true of
 characters which are ASCII control characters (not counting things like RET,
 LFD, TAB, etc.).

---
 v7/src/edwin/calias.scm | 38 ++++++++++++++++++++++----------------
 1 file changed, 22 insertions(+), 16 deletions(-)

diff --git a/v7/src/edwin/calias.scm b/v7/src/edwin/calias.scm
index a8f1849ed..96c7b5fbc 100644
--- a/v7/src/edwin/calias.scm
+++ b/v7/src/edwin/calias.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/calias.scm,v 1.3 1989/03/14 07:59:34 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/calias.scm,v 1.4 1989/04/05 18:15:52 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -69,21 +69,27 @@
 	  (else char))))
 
 (define (unmap-alias-char char)
-  (let ((code (char-code char))
-	(bits (char-bits char)))
-    (if (or (>= code #x20)
-	    (memv code '(#x09 #x0A #x0C #x0D #x1B))
-	    (odd? (quotient bits 2)))
-	(let ((entry
-	       (list-search-positive alias-characters
-		 (lambda (entry)
-		   (eqv? (cdr entry) char)))))
-	  (if entry
-	      (unmap-alias-char (car entry))
-	      char))
-	(unmap-alias-char
-	 (make-char (+ code (if (<= #x01 code #x1A) #x60 #x40))
-		    (+ bits 2))))))
+  (if (ascii-controlified? char)
+      (unmap-alias-char
+       (make-char (let ((code (char-code char)))
+		    (+ code (if (<= #x01 code #x1A) #x60 #x40)))
+		  (+ (char-bits char) 2)))
+      (let ((entry
+	     (list-search-positive alias-characters
+	       (lambda (entry)
+		 (eqv? (cdr entry) char)))))
+	(if entry
+	    (unmap-alias-char (car entry))
+	    char))))
 
+(define (ascii-controlified? char)
+  (and (even? (quotient (char-bits char) 2))
+       (let ((code (char-code char)))
+	 (or (< code #x09)
+	     (= code #x0B)
+	     (if (< code #x1B)
+		 (< #x0D code)
+		 (and (< code #x20)
+		      (< #x1B code)))))))
 (define-integrable (char-name char)
   (char->name (unmap-alias-char char)))
\ No newline at end of file
-- 
2.25.1