More pervasive fix for ASCII NUL problem.
This commit is contained in:
parent
ab09c6e08b
commit
d77257ae6b
|
@ -114,9 +114,6 @@
|
||||||
;;; returns a regexp value. R and C are low-level macro rename and compare
|
;;; returns a regexp value. R and C are low-level macro rename and compare
|
||||||
;;; functions.
|
;;; functions.
|
||||||
|
|
||||||
(define *control-charset* (char-set-delete char-set:iso-control
|
|
||||||
(ascii->char 0)))
|
|
||||||
|
|
||||||
(define (parse-sre/context sre case-sensitive? cset? r c)
|
(define (parse-sre/context sre case-sensitive? cset? r c)
|
||||||
(let ((%bos (r 'bos)) (%eos (r 'eos))
|
(let ((%bos (r 'bos)) (%eos (r 'eos))
|
||||||
(%bol (r 'bol)) (%eol (r 'eol))
|
(%bol (r 'bol)) (%eol (r 'eol))
|
||||||
|
@ -291,7 +288,7 @@
|
||||||
((hygn-memq? '(blank)) char-set:blank)
|
((hygn-memq? '(blank)) char-set:blank)
|
||||||
((hygn-memq? '(whitespace space white)) char-set:whitespace)
|
((hygn-memq? '(whitespace space white)) char-set:whitespace)
|
||||||
((hygn-memq? '(printing print)) char-set:printing)
|
((hygn-memq? '(printing print)) char-set:printing)
|
||||||
((hygn-memq? '(control cntrl)) *control-charset*)
|
((hygn-memq? '(control cntrl)) char-set:iso-control)
|
||||||
((hygn-memq? '(hex-digit xdigit hex)) char-set:hex-digit)
|
((hygn-memq? '(hex-digit xdigit hex)) char-set:hex-digit)
|
||||||
((hygn-memq? '(ascii)) char-set:ascii)
|
((hygn-memq? '(ascii)) char-set:ascii)
|
||||||
(else (error "Illegal regular expression" sre)))))
|
(else (error "Illegal regular expression" sre)))))
|
||||||
|
@ -468,7 +465,6 @@
|
||||||
(switch char-set= cs
|
(switch char-set= cs
|
||||||
((char-set:punctuation) punct)
|
((char-set:punctuation) punct)
|
||||||
((char-set:iso-control) ctl)
|
((char-set:iso-control) ctl)
|
||||||
((*control-charset*) ctl)
|
|
||||||
(else #f))))))))
|
(else #f))))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -361,22 +361,27 @@
|
||||||
;;; quadruple.
|
;;; quadruple.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
|
(define *nul* (ascii->char 0))
|
||||||
|
|
||||||
(define (translate-char-set cset)
|
(define (translate-char-set cset)
|
||||||
(if (char-set-full? cset) (values "." 1 0 '#()) ; Full set
|
(if (char-set-full? cset)
|
||||||
|
(values "." 1 0 '#()) ; Full set
|
||||||
|
(let* ((cset (char-set-delete cset *nul*))
|
||||||
|
(nchars (char-set-size cset))
|
||||||
|
(->bracket-string (lambda (cset in?)
|
||||||
|
(receive (loose ranges) (char-set->in-pair cset)
|
||||||
|
(hack-bracket-spec loose ranges in?)))))
|
||||||
|
|
||||||
(let ((nchars (char-set-size cset))
|
(? ((= 0 nchars) (values "[^\000-\177]" 1 0 '#())) ; Empty set
|
||||||
(->bracket-string (lambda (cset in?)
|
|
||||||
(receive (loose ranges) (char-set->in-pair cset)
|
|
||||||
(hack-bracket-spec loose ranges in?)))))
|
|
||||||
|
|
||||||
(? ((= 0 nchars) (values "[^\000-\177]" 1 0 '#())) ; Empty set
|
((= 1 nchars) ; Singleton set
|
||||||
|
|
||||||
((= 1 nchars) ; Singleton set
|
|
||||||
(translate-string (string (car (char-set->list cset)))))
|
(translate-string (string (car (char-set->list cset)))))
|
||||||
|
|
||||||
;; General case. Try both [...] and [^...].
|
;; General case. Try both [...] and [^...].
|
||||||
(else (let ((s- (->bracket-string cset #t))
|
(else (let ((s- (->bracket-string cset #t))
|
||||||
(s+ (->bracket-string (char-set-complement cset) #f)))
|
(s+ (->bracket-string
|
||||||
|
(char-set-delete (char-set-complement cset) *nul*)
|
||||||
|
#f)))
|
||||||
(values (if (< (string-length s-) (string-length s+))
|
(values (if (< (string-length s-) (string-length s+))
|
||||||
s- s+)
|
s- s+)
|
||||||
1 0 '#())))))))
|
1 0 '#())))))))
|
||||||
|
|
Loading…
Reference in New Issue