From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 4 Oct 2001 15:54:20 +0000 (+0000)
Subject: Move MATCH-UTF8-CHAR-IN-ALPHABET into parser-buffer abstraction.
X-Git-Tag: 20090517-FFI~2530
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3b08f6d8bd03bd601298f9b175a6ff8e62b091eb;p=mit-scheme.git

Move MATCH-UTF8-CHAR-IN-ALPHABET into parser-buffer abstraction.
---

diff --git a/v7/src/star-parser/buffer.scm b/v7/src/star-parser/buffer.scm
index 3f38d80f8..4ef454588 100644
--- a/v7/src/star-parser/buffer.scm
+++ b/v7/src/star-parser/buffer.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: buffer.scm,v 1.9 2001/10/04 15:50:40 cph Exp $
+;;; $Id: buffer.scm,v 1.10 2001/10/04 15:53:52 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -169,6 +169,18 @@
   (char-matcher not-char-ci (not (char-ci=? char reference)))
   (char-matcher char-in-set (char-set-member? reference char)))
 
+(define (match-utf8-char-in-alphabet buffer alphabet)
+  (if (let ((n
+	     (read-utf8-code-point-from-source
+	      (lambda ()
+		(read-parser-buffer-char buffer)))))
+	(and n
+	     (code-point-in-alphabet? n alphabet)))
+      #t
+      (begin
+	(set-parser-buffer-pointer! buffer p)
+	#f)))
+
 (let-syntax
     ((string-matcher
       (lambda (suffix)
diff --git a/v7/src/star-parser/parser.pkg b/v7/src/star-parser/parser.pkg
index 56efb9964..ea0b0e523 100644
--- a/v7/src/star-parser/parser.pkg
+++ b/v7/src/star-parser/parser.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: parser.pkg,v 1.10 2001/10/04 15:53:16 cph Exp $
+;;; $Id: parser.pkg,v 1.11 2001/10/04 15:54:20 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -49,6 +49,7 @@
 	  match-parser-buffer-substring-ci
 	  match-parser-buffer-substring-ci-no-advance
 	  match-parser-buffer-substring-no-advance
+	  match-utf8-char-in-alphabet
 	  parser-buffer-line
 	  parser-buffer-pointer-index
 	  parser-buffer-pointer-line