a loadable option.
#| -*-Scheme-*-
-$Id: comhst.scm,v 1.6 1999/01/02 06:11:34 cph Exp $
+$Id: comhst.scm,v 1.7 1999/05/13 03:06:36 cph Exp $
Copyright (c) 1992-1999 Massachusetts Institute of Technology
(set-command-message! comint-input-ring-tag
start left right)
(editor-failure "Not found"))
- ((re-string-search pattern
- (ring-ref ring (- index 1))
- #f
- syntax-table)
+ ((re-string-search-forward pattern
+ (ring-ref ring (- index 1))
+ #f
+ syntax-table)
(set-variable! comint-last-input-match string)
((ref-command comint-previous-input) (- index start)))
(else
#| -*-Scheme-*-
-$Id: decls.scm,v 1.63 1999/01/14 21:37:52 cph Exp $
+$Id: decls.scm,v 1.64 1999/05/13 03:06:36 cph Exp $
Copyright (c) 1989-1999 Massachusetts Institute of Technology
"paths"
"rcsparse"
"rename"
- "rgxcmp"
"ring"
"strpad"
"strtab"
#| -*-Scheme-*-
-$Id: ed-ffi.scm,v 1.46 1999/01/14 21:37:56 cph Exp $
+$Id: ed-ffi.scm,v 1.47 1999/05/13 03:06:37 cph Exp $
Copyright (c) 1990-1999 Massachusetts Institute of Technology
syntax-table/system-internal)
("replaz" (edwin)
edwin-syntax-table)
- ("rgxcmp" (edwin regular-expression-compiler)
- syntax-table/system-internal)
("ring" (edwin)
syntax-table/system-internal)
("rmail" (edwin rmail)
#| -*-Scheme-*-
-$Id: edwin.ldr,v 1.64 1999/02/01 03:53:42 cph Exp $
+$Id: edwin.ldr,v 1.65 1999/05/13 03:06:38 cph Exp $
Copyright (c) 1989-1999 Massachusetts Institute of Technology
(load-option 'SYNCHRONOUS-SUBPROCESS)))
(load-option 'RB-TREE)
(load-option 'HASH-TABLE)
+ (load-option 'REGULAR-EXPRESSION)
(let ((environment (->environment '(EDWIN))))
(load "utils" environment)
(load "tparse" environment)
(load "syntax" environment)
(load "regexp" (->environment '(EDWIN REGULAR-EXPRESSION)))
- (load "rgxcmp" (->environment '(EDWIN REGULAR-EXPRESSION-COMPILER)))
(load "comatch" environment)
(load "keyparse" (->environment '(EDWIN KEYPARSER)))
(load "linden" (->environment '(EDWIN LISP-INDENTATION)))
#| -*-Scheme-*-
-$Id: edwin.pkg,v 1.237 1999/05/11 20:31:06 cph Exp $
+$Id: edwin.pkg,v 1.238 1999/05/13 03:06:39 cph Exp $
Copyright (c) 1989-1999 Massachusetts Institute of Technology
make-output-buffer
output-buffer/drain-block
output-buffer/write-substring-block)
+ (import (runtime char-syntax)
+ char-syntax-table/entries)
(export (edwin class-macros)
class-instance-transforms)
(export ()
editor-frame-windows
make-editor-frame))
-
(define-package (edwin window combination)
(files "comwin")
(parent (edwin window))
re-match-buffer-forward
re-match-data
re-match-end
- re-match-end-index
re-match-forward
re-match-start
- re-match-start-index
- re-match-string-forward
- re-match-substring-forward
re-search-backward
re-search-buffer-backward
re-search-buffer-forward
re-search-forward
- re-search-string-backward
- re-search-string-forward
- re-search-substring-backward
- re-search-substring-forward
- re-string-match
- re-string-search
- re-substring-match
- re-substring-search
re-substitute-registers
- regexp-group
replace-match
search-backward
search-forward
- set-re-match-data!))
-
-(define-package (edwin regular-expression-compiler)
- (files "rgxcmp")
- (parent (edwin))
- (export (edwin)
- compiled-regexp?
- compiled-regexp/byte-stream
- compiled-regexp/translation-table
- condition-type:re-compile-pattern
- re-compile-char
- re-compile-char-set
- re-compile-pattern
- re-compile-string
- re-disassemble-pattern
- re-quote-string
- re-translation-table))
+ set-re-match-data!)
+ (import (runtime regular-expression)
+ registers))
(define-package (edwin lisp-indentation)
(files "linden")
;;; -*-Scheme-*-
;;;
-;;; $Id: evlcom.scm,v 1.61 1999/01/31 04:09:21 cph Exp $
+;;; $Id: evlcom.scm,v 1.62 1999/05/13 03:06:40 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
;;;
(lambda (object)
(or (not object)
(symbol? object)
- (scheme-syntax-table? object))))
+ (syntax-table? object))))
(let ((daemon
(lambda (buffer variable)
(let ((syntax-table (ref-variable scheme-syntax-table buffer)))
(cond ((or (not syntax-table) (eq? 'DEFAULT syntax-table))
(environment-syntax-table environment))
- ((scheme-syntax-table? syntax-table)
+ ((syntax-table? syntax-table)
syntax-table)
((symbol? syntax-table)
(or (and (not (lexical-unreferenceable? environment syntax-table))
(let ((syntax-table
(lexical-reference environment syntax-table)))
- (and (scheme-syntax-table? syntax-table)
+ (and (syntax-table? syntax-table)
syntax-table)))
(editor-error "Undefined syntax table: " syntax-table)))
(else
(editor-error "Illegal syntax table: " syntax-table)))))
-
-(define scheme-syntax-table?
- (access syntax-table? system-global-environment))
\f
(define-variable run-light
"Scheme run light. Not intended to be modified by users.
;;; -*-Scheme-*-
;;;
-;;; $Id: lspcom.scm,v 1.158 1999/01/02 06:11:34 cph Exp $
+;;; $Id: lspcom.scm,v 1.159 1999/05/13 03:06:42 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
;;;
(if argument
(set-current-point! (skip-chars-forward " \t"))
(or (group-start? (current-point))
- (memv (char->syntax-code standard-syntax-table
+ (memv (char->syntax-code standard-char-syntax-table
(mark-left-char (current-point)))
'(#\\ #\> #\( #\space #\.))
(insert-char #\space)))
(current-point)))
(or argument
(group-end? (current-point))
- (memv (char->syntax-code standard-syntax-table
+ (memv (char->syntax-code standard-char-syntax-table
(mark-right-char (current-point)))
'(#\\ #\> #\( #\) #\space))
(insert-char #\space))
;;; -*-Scheme-*-
;;;
-;;; $Id: regexp.scm,v 1.71 1999/01/02 06:11:34 cph Exp $
+;;; $Id: regexp.scm,v 1.72 1999/05/13 03:06:42 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
;;;
(declare (usual-integrations))
\f
-(define registers (make-vector 20))
-(define hash-of-false (object-hash false))
+(define hash-of-false (object-hash #f))
(define match-group hash-of-false)
-(define-integrable (re-match-start-index i)
- (vector-ref registers i))
-
-(define-integrable (re-match-end-index i)
- (vector-ref registers (+ i 10)))
-
(define (re-match-start i)
- (guarantee-re-register i 'RE-MATCH-START)
(let ((index (re-match-start-index i)))
(and index
(make-mark (re-match-group) index))))
(define (re-match-end i)
- (guarantee-re-register i 'RE-MATCH-END)
(let ((index (re-match-end-index i)))
(and index
(make-mark (re-match-group) index))))
-(define (guarantee-re-register i operator)
- (if (not (and (exact-nonnegative-integer? i) (< i 10)))
- (error:wrong-type-argument i "RE register" operator)))
-
(define (re-match-group)
(let ((group (object-unhash match-group)))
(if (not group)
(let ((group (object-unhash match-group)))
(cons group
(if group
- (let ((v (make-vector 20 false)))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (let ((index (vector-ref registers i)))
+ (let ((v (make-vector 20 #f))
+ (rv (re-registers)))
+ (do ((i 0 (fix:+ i 1)))
+ ((fix:= i 20))
+ (let ((index (vector-ref rv i)))
(if index
(vector-set!
v i
;; Start marks are right-inserting,
;; end marks are left-inserting.
- (make-permanent-mark group index (>= i 10))))))
+ (make-permanent-mark group index (fix:>= i 10))))))
v)
- (vector-copy registers)))))
+ (re-registers)))))
(define (set-re-match-data! data)
(let ((group (car data))
(marks (cdr data)))
(set! match-group (if group (group-hash-number group) hash-of-false))
- (set! registers
- (if group
- (vector-map marks
- (lambda (mark)
- (and mark
- (let ((index (mark-index mark)))
- (mark-temporary! mark)
- index))))
- marks)))
- unspecific)
+ (set-re-registers!
+ (if group
+ (vector-map marks
+ (lambda (mark)
+ (and mark
+ (let ((index (mark-index mark)))
+ (mark-temporary! mark)
+ index))))
+ marks))))
(define (preserving-match-data thunk)
(let ((data unspecific))
(unwind-protect (lambda () (set! data (re-match-data)) unspecific)
thunk
(lambda () (set-re-match-data! data)))))
-
-(define-integrable (syntax-table-argument syntax-table)
- (syntax-table/entries (or syntax-table standard-syntax-table)))
\f
(define (replace-match replacement #!optional preserve-case? literal?)
(let ((start (re-match-start 0))
(group-delete! group start (re-match-end-index 0))
(make-mark group start)))
\f
-(define (re-search-buffer-forward regexp syntax-table group start end)
- (let ((index
- ((ucode-primitive re-search-buffer-forward)
- (compiled-regexp/byte-stream regexp)
- (compiled-regexp/translation-table regexp)
- (syntax-table-argument syntax-table)
- registers group start end)))
- (set! match-group (compute-match-group group index))
- index))
-
-(define (re-search-buffer-backward regexp syntax-table group start end)
- (let ((index
- ((ucode-primitive re-search-buffer-backward)
- (compiled-regexp/byte-stream regexp)
- (compiled-regexp/translation-table regexp)
- (syntax-table-argument syntax-table)
- registers group start end)))
- (set! match-group (compute-match-group group index))
- index))
-
-(define (re-match-buffer-forward regexp syntax-table group start end)
- (let ((index
- ((ucode-primitive re-match-buffer)
- (compiled-regexp/byte-stream regexp)
- (compiled-regexp/translation-table regexp)
- (syntax-table-argument syntax-table)
- registers group start end)))
- (set! match-group (compute-match-group group index))
- index))
-
-(define (compute-match-group group index)
- (if index
- (group-hash-number group)
- hash-of-false))
-
-(define (re-match-string-forward regexp syntax-table string)
- (re-match-substring-forward regexp syntax-table
- string 0 (string-length string)))
-
-(define (re-match-substring-forward regexp syntax-table string start end)
- (set! match-group hash-of-false)
- ((ucode-primitive re-match-substring)
- (compiled-regexp/byte-stream regexp)
- (compiled-regexp/translation-table regexp)
- (syntax-table-argument syntax-table)
- registers string start end))
-
-(define (re-search-string-forward regexp syntax-table string)
- (re-search-substring-forward regexp syntax-table
- string 0 (string-length string)))
-
-(define (re-search-substring-forward regexp syntax-table string start end)
- (set! match-group hash-of-false)
- ((ucode-primitive re-search-substring-forward)
- (compiled-regexp/byte-stream regexp)
- (compiled-regexp/translation-table regexp)
- (syntax-table-argument syntax-table)
- registers string start end))
-
-(define (re-search-string-backward regexp syntax-table string)
- (re-search-substring-backward regexp syntax-table
- string 0 (string-length string)))
-
-(define (re-search-substring-backward regexp syntax-table string start end)
- (set! match-group hash-of-false)
- ((ucode-primitive re-search-substring-backward)
- (compiled-regexp/byte-stream regexp)
- (compiled-regexp/translation-table regexp)
- (syntax-table-argument syntax-table)
- registers string start end))
-\f
(define-macro (default-end-mark start end)
`(IF (DEFAULT-OBJECT? ,end)
(GROUP-END ,start)
(mark-index end))))
(and index
(make-mark group index)))))
-\f
+
(define (re-match-forward regexp start #!optional end case-fold-search)
(let ((end (default-end-mark start end))
(case-fold-search (default-case-fold-search case-fold-search start))
(mark-index end))))
(and index
(make-mark group index)))))
+\f
+(define (re-search-buffer-forward regexp syntax-table group start end)
+ (let ((index
+ ((ucode-primitive re-search-buffer-forward)
+ (compiled-regexp/byte-stream regexp)
+ (compiled-regexp/translation-table regexp)
+ (syntax-table-argument syntax-table)
+ registers group start end)))
+ (set! match-group (compute-match-group group index))
+ index))
-(define (re-string-match regexp string #!optional case-fold syntax-table)
- (let ((case-fold (if (default-object? case-fold) #f case-fold))
- (syntax-table (if (default-object? syntax-table) #f syntax-table)))
- (re-match-string-forward (if (compiled-regexp? regexp)
- regexp
- (re-compile-pattern regexp case-fold))
- syntax-table
- string)))
-
-(define (re-substring-match regexp string start end
- #!optional case-fold syntax-table)
- (let ((case-fold (if (default-object? case-fold) #f case-fold))
- (syntax-table (if (default-object? syntax-table) #f syntax-table)))
- (re-match-substring-forward (if (compiled-regexp? regexp)
- regexp
- (re-compile-pattern regexp case-fold))
- syntax-table
- string start end)))
+(define (re-search-buffer-backward regexp syntax-table group start end)
+ (let ((index
+ ((ucode-primitive re-search-buffer-backward)
+ (compiled-regexp/byte-stream regexp)
+ (compiled-regexp/translation-table regexp)
+ (syntax-table-argument syntax-table)
+ registers group start end)))
+ (set! match-group (compute-match-group group index))
+ index))
-(define (re-string-search regexp string #!optional case-fold syntax-table)
- (let ((case-fold (if (default-object? case-fold) #f case-fold))
- (syntax-table (if (default-object? syntax-table) #f syntax-table)))
- (re-search-string-forward (if (compiled-regexp? regexp)
- regexp
- (re-compile-pattern regexp case-fold))
- syntax-table
- string)))
+(define (re-match-buffer-forward regexp syntax-table group start end)
+ (let ((index
+ ((ucode-primitive re-match-buffer)
+ (compiled-regexp/byte-stream regexp)
+ (compiled-regexp/translation-table regexp)
+ (syntax-table-argument syntax-table)
+ registers group start end)))
+ (set! match-group (compute-match-group group index))
+ index))
-(define (re-substring-search regexp string start end
- #!optional case-fold syntax-table)
- (let ((case-fold (if (default-object? case-fold) #f case-fold))
- (syntax-table (if (default-object? syntax-table) #f syntax-table)))
- (re-search-substring-forward (if (compiled-regexp? regexp)
- regexp
- (re-compile-pattern regexp case-fold))
- syntax-table
- string start end)))
+(define-integrable (syntax-table-argument syntax-table)
+ (char-syntax-table/entries (or syntax-table standard-char-syntax-table)))
-(define (regexp-group . alternatives)
- (let ((alternatives
- (list-transform-positive alternatives identity-procedure)))
- (if (null? alternatives)
- "\\(\\)"
- (apply string-append
- (cons "\\("
- (let loop ((alternatives alternatives))
- (cons (car alternatives)
- (if (null? (cdr alternatives))
- (list "\\)")
- (cons "\\|" (loop (cdr alternatives)))))))))))
\ No newline at end of file
+(define (compute-match-group group index)
+ (if index
+ (group-hash-number group)
+ hash-of-false))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Id: rmail.scm,v 1.61 1999/02/01 03:47:02 cph Exp $
+;;; $Id: rmail.scm,v 1.62 1999/05/13 03:06:43 cph Exp $
;;;
;;; Copyright (c) 1991-1999 Massachusetts Institute of Technology
;;;
(message-id
;; Append from field to message-id if needed.
(let ((from (rfc822-first-address from)))
- (if (re-string-search
- (if (re-string-search "@[^@]*\\'" from #f)
+ (if (re-string-search-forward
+ (if (re-string-search-forward "@[^@]*\\'" from #f)
(string-head from (re-match-start-index 0))
from)
message-id #t)
;;; -*-Scheme-*-
;;;
-;;; $Id: rmailsrt.scm,v 1.10 1999/01/02 06:11:34 cph Exp $
+;;; $Id: rmailsrt.scm,v 1.11 1999/05/13 03:06:45 cph Exp $
;;;
;;; Copyright (c) 1991-1999 Massachusetts Institute of Technology
;;;
;; added [ ]+ to the regexp to handle date string put out
;; by hx.lcs.mit.edu (they use 2 spaces instead of 1)
;; made seconds optional since research.att.com doesn't send it out
- (if (re-string-search
+ (if (re-string-search-forward
"\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\)[ ]+\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\):?\\([0-9]*\\)"
date)
(string-append
(define mail-strip-quoted-names
(lambda (address)
- (if (re-string-search "\\`[ \t\n]*" address)
+ (if (re-string-search-forward "\\`[ \t\n]*" address)
(set! address (string-tail address (re-match-end-index 0))))
;; strip surrounding whitespace
- (if (re-string-search "[ \t\n]*\\'" address)
+ (if (re-string-search-forward "[ \t\n]*\\'" address)
(set! address (string-head address (re-match-start-index 0))))
(let loop ()
- (if (re-string-search "[ \t]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*)"
- address)
+ (if (re-string-search-forward "[ \t]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*)"
+ address)
(begin
(set! address (mail-string-delete
address
(loop the-pos))))))
;; Retain only part of address in <> delims, if there is such a thing.
(let loop ()
- (if (re-string-search "\\(,\\|\\`\\)[^,]*<\\([^>,]*>\\)" address)
+ (if (re-string-search-forward "\\(,\\|\\`\\)[^,]*<\\([^>,]*>\\)" address)
(let ((junk-beg (re-match-end-index 1))
(junk-end (re-match-start-index 2))
(close (re-match-end-index 0)))
;;; -*-Scheme-*-
;;;
-;;; $Id: rmailsum.scm,v 1.34 1999/01/02 06:11:34 cph Exp $
+;;; $Id: rmailsum.scm,v 1.35 1999/05/13 03:06:45 cph Exp $
;;;
;;; Copyright (c) 1991-1999 Massachusetts Institute of Technology
;;;
\f
(define-variable rmailsum-rcs-header
"The RCS header of the rmailsum.scm file."
- "$Id: rmailsum.scm,v 1.34 1999/01/02 06:11:34 cph Exp $"
+ "$Id: rmailsum.scm,v 1.35 1999/05/13 03:06:45 cph Exp $"
string?)
(define-variable-per-buffer rmail-buffer
(the-from-field (fetch-first-field "from" inner-start inner-end))
(the-cc-fields (fetch-all-fields "cc" inner-start inner-end)))
(or (and the-to-field
- (re-string-search recip-regexp the-to-field))
+ (re-string-search-forward recip-regexp the-to-field))
(and the-from-field
- (re-string-search recip-regexp the-from-field))
+ (re-string-search-forward recip-regexp the-from-field))
(and (and (not primary-only) the-cc-fields)
- (re-string-search recip-regexp the-cc-fields))))))))
+ (re-string-search-forward recip-regexp the-cc-fields))))))))
\f
(define rmail-new-summary
(lambda (description function . args)
;;; -*-Scheme-*-
;;;
-;;; $Id: strtab.scm,v 1.46 1999/01/02 06:11:34 cph Exp $
+;;; $Id: strtab.scm,v 1.47 1999/05/13 03:06:46 cph Exp $
;;;
;;; Copyright (c) 1985, 1989-1999 Massachusetts Institute of Technology
;;;
(if (= index end)
'()
(let ((entry (vector-ref (string-table-vector table) index)))
- (if (re-string-search pattern (string-table-entry-string entry))
+ (if (re-string-search-forward pattern
+ (string-table-entry-string entry))
(cons (string-table-entry-value entry) (loop (1+ index)))
(loop (1+ index))))))))
\f
;;; -*-Scheme-*-
;;;
-;;; $Id: syntax.scm,v 1.83 1999/01/02 06:11:34 cph Exp $
+;;; $Id: syntax.scm,v 1.84 1999/05/13 03:06:47 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
;;;
(declare (usual-integrations))
\f
-(define-structure (syntax-table (constructor %make-syntax-table)
- (conc-name syntax-table/))
- (entries false read-only #t))
-
-(define (modify-syntax-entry! syntax-table char string)
- (if (not (syntax-table? syntax-table))
- (error:wrong-type-argument syntax-table
- "syntax table"
- 'MODIFY-SYNTAX-ENTRY!))
- (vector-set! (syntax-table/entries syntax-table)
- (char->ascii char)
- ((ucode-primitive string->syntax-entry) string)))
+(define make-syntax-table make-char-syntax-table)
+(define modify-syntax-entry! set-char-syntax!)
(define (modify-syntax-entries! syntax-table cl ch string)
- (if (not (syntax-table? syntax-table))
- (error:wrong-type-argument syntax-table
- "syntax table"
- 'MODIFY-SYNTAX-ENTRIES!))
- (let ((entries (syntax-table/entries syntax-table))
- (ah (char->ascii ch))
- (entry ((ucode-primitive string->syntax-entry) string)))
- (do ((a (char->ascii cl) (+ a 1)))
- ((> a ah) unspecific)
- (vector-set! entries a entry))))
-
-(define standard-syntax-table
- (let ((table
- (%make-syntax-table
- (make-vector 256 ((ucode-primitive string->syntax-entry) "")))))
- (modify-syntax-entries! table #\0 #\9 "w")
- (modify-syntax-entries! table #\A #\Z "w")
- (modify-syntax-entries! table #\a #\z "w")
- (modify-syntax-entry! table #\$ "w")
- (modify-syntax-entry! table #\% "w")
- (modify-syntax-entry! table #\( "()")
- (modify-syntax-entry! table #\) ")(")
- (modify-syntax-entry! table #\[ "(]")
- (modify-syntax-entry! table #\] ")[")
- (modify-syntax-entry! table #\{ "(}")
- (modify-syntax-entry! table #\} "){")
- (modify-syntax-entry! table #\" "\"")
- (modify-syntax-entry! table #\\ "\\")
- (for-each (lambda (char)
- (modify-syntax-entry! table char "_"))
- (string->list "_-+*/&|<>="))
- (for-each (lambda (char)
- (modify-syntax-entry! table char "."))
- (string->list ".,;:?!#@~^'`"))
- table))
-
-(define (make-syntax-table #!optional table)
- (let ((table
- (if (or (default-object? table) (not table))
- standard-syntax-table
- table)))
- (%make-syntax-table (vector-copy (syntax-table/entries table)))))
-\f
-(define (char->syntax-code syntax-table char)
- ((ucode-primitive char->syntax-code) (syntax-table/entries syntax-table)
- char))
+ (set-char-syntax! syntax-table
+ (ascii-range->char-set (char->ascii cl) (char->ascii ch))
+ string))
+
+(define (group-syntax-table-entries group)
+ (char-syntax-table/entries (group-syntax-table group)))
-(define (syntax-entry->string entry)
- (let ((code (fix:and #xf entry)))
- (if (> code 12)
- "invalid"
- (string-append
- (vector-ref '#(" " "." "w" "_" "(" ")" "'" "\"" "$" "\\" "/" "<" ">")
- code)
- (let ((match (fix:and #xff (fix:lsh entry -4))))
- (if (zero? match)
- " "
- (emacs-key-name (ascii->char match) false)))
- (let ((cbits (fix:and #xFF (fix:lsh entry -12))))
- (string-append
- (if (fix:= 0 (fix:and #x40 cbits)) "" "1")
- (if (fix:= 0 (fix:and #x10 cbits)) "" "2")
- (if (fix:= 0 (fix:and #x04 cbits)) "" "3")
- (if (fix:= 0 (fix:and #x01 cbits)) "" "4")
- (if (or (fix:= 0 (fix:and #x80 cbits))
- (and (fix:= code 11)
- (fix:= #x80 (fix:and #xC0 cbits))))
- ""
- "5")
- (if (fix:= 0 (fix:and #x20 cbits)) "" "6")
- (if (or (fix:= 0 (fix:and #x08 cbits))
- (and (fix:= code 12)
- (fix:= #x08 (fix:and #x0C cbits))))
- ""
- "7")
- (if (fix:= 0 (fix:and #x02 cbits)) "" "8")))
- (if (fix:= 0 (fix:and #x100000 entry)) "" "p")))))
-
-(define (substring-find-next-char-of-syntax string start end
- syntax-table syntax)
- (let loop ((index start))
- (and (< index end)
- (if (char=? syntax
- (char->syntax-code syntax-table
- (string-ref string index)))
- index
- (loop (+ index 1))))))
-
-(define (substring-find-next-char-not-of-syntax string start end
- syntax-table syntax)
- (let loop ((index start))
- (and (< index end)
- (if (char=? syntax
- (char->syntax-code syntax-table
- (string-ref string index)))
- (loop (+ index 1))
- index))))
-\f
(define-command describe-syntax
"Describe the syntax specifications in the syntax table.
The descriptions are inserted in a buffer,
(with-output-to-help-display
(lambda ()
(newline)
- (let ((table (syntax-table/entries (ref-variable syntax-table))))
+ (let ((table (char-syntax-table/entries (ref-variable syntax-table))))
(let ((table-end (vector-length table))
(describe-char-range
(lambda (bottom top)
(let ((describe-char
(lambda (ascii)
- (emacs-key-name (ascii->char ascii) false)))
+ (emacs-key-name (ascii->char ascii) #f)))
(top (- top 1)))
(if (= bottom top)
(describe-char bottom)
(if (> code 12)
(write-string "invalid")
(begin
- (write-string (syntax-entry->string entry))
+ (write-string (char-syntax->string entry))
(write-string "\twhich means: ")
(write-string
(vector-ref '#("whitespace" "punctuation" "word" "symbol" "open"
(if (not (zero? match))
(begin
(write-string ", matches ")
- (write-string (emacs-key-name (ascii->char match) false)))))
+ (write-string (emacs-key-name (ascii->char match) #f)))))
(let ((decode-comment-bit
(lambda (code pos se style)
(if (not (fix:= 0 (fix:and code entry)))
(define-variable syntax-table
"The syntax-table used for word and list parsing."
- (make-syntax-table))
+ (make-char-syntax-table))
(define-variable syntax-ignore-comments-backwards
"If true, ignore comments in backwards expression parsing.
It should be #F for comments that end in Newline, as in Lisp;
this is because Newline occurs often when it doesn't indicate
a comment ending."
- false
+ #f
boolean?)
(define forward-word)
(define (%forward-word mark n limit?)
(let ((group (mark-group mark)))
(let ((end (group-end-index group))
- (entries (syntax-table/entries (group-syntax-table group))))
+ (entries (group-syntax-table-entries group)))
(let loop ((start (mark-index mark)) (n n))
(let ((m
((ucode-primitive scan-word-forward) entries group start end)))
(define (%backward-word mark n limit?)
(let ((group (mark-group mark)))
(let ((end (group-start-index group))
- (entries (syntax-table/entries (group-syntax-table group))))
+ (entries (group-syntax-table-entries group)))
(let loop ((start (mark-index mark)) (n n))
(let ((m
((ucode-primitive scan-word-backward) entries group start end)))
(group (mark-group mark)))
(let ((index
((ucode-primitive scan-forward-to-word)
- (syntax-table/entries (group-syntax-table group))
+ (group-syntax-table-entries group)
group
(mark-index mark)
(group-end-index group))))
(end (default-end/forward start end)))
(make-mark group
((ucode-primitive scan-forward-prefix-chars 4)
- (syntax-table/entries (group-syntax-table group))
+ (group-syntax-table-entries group)
group
(mark-index start)
(mark-index end)))))
(end (default-end/backward start end)))
(make-mark group
((ucode-primitive scan-backward-prefix-chars 4)
- (syntax-table/entries (group-syntax-table group))
+ (group-syntax-table-entries group)
group
(mark-index start)
(mark-index end)))))
(define (mark-right-char-quoted? mark)
(let ((group (mark-group mark)))
((ucode-primitive quoted-char?)
- (syntax-table/entries (group-syntax-table group))
+ (group-syntax-table-entries group)
group
(mark-index mark)
(group-start-index group))))
(group (mark-group start)))
(let ((state
((ucode-primitive scan-sexps-forward)
- (syntax-table/entries (group-syntax-table group))
+ (group-syntax-table-entries group)
group
(mark-index start)
(mark-index end)
(let ((group (mark-group start)))
(let ((index
((ucode-primitive scan-list-forward)
- (syntax-table/entries (group-syntax-table group))
+ (group-syntax-table-entries group)
group
(mark-index start)
(mark-index end)
(let ((group (mark-group start)))
(let ((index
((ucode-primitive scan-list-backward)
- (syntax-table/entries (group-syntax-table group))
+ (group-syntax-table-entries group)
group
(mark-index start)
(mark-index end)
#| -*- Scheme -*-
-$Id: ed-ffi.scm,v 1.20 1999/05/07 21:23:35 cph Exp $
+$Id: ed-ffi.scm,v 1.21 1999/05/13 03:04:06 cph Exp $
Copyright (c) 1988-1999 Massachusetts Institute of Technology
syntax-table/system-internal)
("chrset" (runtime character-set)
syntax-table/system-internal)
+ ("chrsyn" (runtime char-syntax)
+ syntax-table/system-internal)
("codwlk" (runtime scode-walker)
syntax-table/system-internal)
("conpar" (runtime continuation-parser)
syntax-table/system-internal)
("recslot" (runtime record-slot-access)
syntax-table/system-internal)
+ ("regexp" (runtime regular-expression)
+ syntax-table/system-internal)
("rep" (runtime rep)
syntax-table/system-internal)
+ ("rgxcmp" (runtime regular-expression-compiler)
+ syntax-table/system-internal)
("savres" (runtime save/restore)
syntax-table/system-internal)
("scan" (runtime scode-scan)
#| -*-Scheme-*-
-$Id: optiondb.scm,v 1.6 1999/01/29 22:47:08 cph Exp $
+$Id: optiondb.scm,v 1.7 1999/05/13 03:04:08 cph Exp $
Copyright (c) 1994-1999 Massachusetts Institute of Technology
(lambda (spec)
(define-load-option (car spec) (apply standard-option-loader (cdr spec))))
'((COMPRESS (RUNTIME COMPRESS) #F "cpress")
+ (DOSPROCESS () #F "dosproc")
(FORMAT (RUNTIME FORMAT) (INITIALIZE-PACKAGE!) "format")
(GDBM (RUNTIME GDBM) (INITIALIZE-PACKAGE!) "gdbm")
(HASH-TABLE (RUNTIME HASH-TABLE) (INITIALIZE-PACKAGE!) "hashtb")
(WT-TREE (RUNTIME WT-TREE) #F "wttree")
))
-(define-load-option 'DOSPROCESS
- (standard-option-loader '() #F "dosproc"))
\ No newline at end of file
+(define-load-option 'REGULAR-EXPRESSION
+ (standard-option-loader '(RUNTIME REGULAR-EXPRESSION-COMPILER)
+ #F
+ "rgxcmp")
+ (standard-option-loader '(RUNTIME CHAR-SYNTAX)
+ '(INITIALIZE-PACKAGE!)
+ "chrsyn")
+ (standard-option-loader '(RUNTIME REGULAR-EXPRESSION)
+ '(INITIALIZE-PACKAGE!)
+ "regexp"))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Id: rgxcmp.scm,v 1.109 1999/01/02 06:11:34 cph Exp $
+;;; $Id: rgxcmp.scm,v 1.110 1999/05/13 03:04:08 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
;;;
(output-tail output)
(output-length 0)
(stack '())
- (fixup-jump false)
+ (fixup-jump #f)
(register-number 1)
(begin-alternative)
- (pending-exact false)
- (last-start false))
+ (pending-exact #f)
+ (last-start #f))
(set! begin-alternative (output-pointer))
(let loop ()
(if (input-end?)
unspecific)
(define-integrable (output-re-code! code)
- (set! pending-exact false)
+ (set! pending-exact #f)
(output! code))
(define-integrable (output-start! code)
(repeater-loop zero? many?))
((input-match? (input-peek) #\+)
(input-discard!)
- (repeater-loop false many?))
+ (repeater-loop #f many?))
((input-match? (input-peek) #\?)
(input-discard!)
- (repeater-loop zero? false))
+ (repeater-loop zero? #f))
(else
(repeater-finish zero? many?))))
re-code:dummy-failure-jump
(fix:+ (pointer-position last-start) 6))))
-(define-repeater-char #\* true true)
-(define-repeater-char #\+ false true)
-(define-repeater-char #\? true false)
+(define-repeater-char #\* #t #t)
+(define-repeater-char #\+ #f #t)
+(define-repeater-char #\? #t #f)
\f
;;;; Character Sets
fixup-jump
register-number
begin-alternative)
- (set! last-start false)
- (set! fixup-jump false)
+ (set! last-start #f)
+ (set! fixup-jump #f)
(set! register-number (fix:1+ register-number))
(set! begin-alternative (output-pointer))
unspecific))
(output! re-code:unused)
(output! re-code:unused)
(output! re-code:unused)
- (set! pending-exact false)
- (set! last-start false)
+ (set! pending-exact #f)
+ (set! last-start #f)
(set! begin-alternative (output-pointer))
unspecific))
;;;; Compiled Pattern Disassembler
(define (hack-fastmap pattern)
- (let ((compiled-pattern (re-compile-pattern pattern false))
+ (let ((compiled-pattern (re-compile-pattern pattern #f))
(cs (char-set)))
((ucode-primitive re-compile-fastmap)
compiled-pattern
- (re-translation-table false)
- (syntax-table/entries (make-syntax-table))
+ (re-translation-table #f)
+ (get-char-syntax standard-char-syntax-table)
cs)
(char-set-members cs)))
#| -*-Scheme-*-
-$Id: runtime.pkg,v 14.327 1999/05/11 20:30:37 cph Exp $
+$Id: runtime.pkg,v 14.328 1999/05/13 03:04:25 cph Exp $
Copyright (c) 1988-1999 Massachusetts Institute of Technology
vector-8b-find-previous-char
vector-8b-find-previous-char-ci
vector-8b-ref
- vector-8b-set!))
+ vector-8b-set!)
+ (export (runtime char-syntax)
+ guarantee-substring))
(define-package (runtime 1d-property)
(files "prop1d")
eqht/for-each
eqht/get
eqht/put!
- make-eqht))
\ No newline at end of file
+ make-eqht))
+
+(define-package (runtime regular-expression)
+ (file-case options
+ ((load) "regexp")
+ (else))
+ (parent ())
+ (export ()
+ guarantee-re-register
+ guarantee-re-registers
+ preserving-re-registers
+ re-match-end-index
+ re-match-start-index
+ re-registers
+ re-registers?
+ re-string-match
+ re-string-search-backward
+ re-string-search-forward
+ re-substring-match
+ re-substring-search-backward
+ re-substring-search-forward
+ regexp-group
+ set-re-registers!)
+ (initialization (initialize-package!)))
+
+(define-package (runtime regular-expression-compiler)
+ (file-case options
+ ((load) "rgxcmp")
+ (else))
+ (parent ())
+ (export ()
+ compiled-regexp?
+ compiled-regexp/byte-stream
+ compiled-regexp/translation-table
+ condition-type:re-compile-pattern
+ re-compile-char
+ re-compile-char-set
+ re-compile-pattern
+ re-compile-string
+ re-disassemble-pattern
+ re-quote-string
+ re-translation-table))
+
+(define-package (runtime char-syntax)
+ (file-case options
+ ((load) "chrsyn")
+ (else))
+ (parent ())
+ (export ()
+ char->syntax-code
+ char-syntax->string
+ char-syntax-table?
+ get-char-syntax
+ make-char-syntax-table
+ set-char-syntax!
+ standard-char-syntax-table
+ string->char-syntax
+ substring-find-next-char-not-of-syntax
+ substring-find-next-char-of-syntax)
+ (export (runtime regular-expression)
+ char-syntax-table/entries)
+ (initialization (initialize-package!)))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: runtime.pkg,v 14.332 1999/05/11 20:30:29 cph Exp $
+$Id: runtime.pkg,v 14.333 1999/05/13 03:04:10 cph Exp $
Copyright (c) 1988-1999 Massachusetts Institute of Technology
vector-8b-find-previous-char
vector-8b-find-previous-char-ci
vector-8b-ref
- vector-8b-set!))
+ vector-8b-set!)
+ (export (runtime char-syntax)
+ guarantee-substring))
(define-package (runtime 1d-property)
(files "prop1d")
%compiled-code-support:nonrestartable-continuation
%compiled-code-support:signal-error-in-primitive
;;coerce-to-compiled-procedure
- ))
\ No newline at end of file
+ ))
+
+(define-package (runtime regular-expression)
+ (file-case options
+ ((load) "regexp")
+ (else))
+ (parent ())
+ (export ()
+ guarantee-re-register
+ guarantee-re-registers
+ preserving-re-registers
+ re-match-end-index
+ re-match-start-index
+ re-registers
+ re-registers?
+ re-string-match
+ re-string-search-backward
+ re-string-search-forward
+ re-substring-match
+ re-substring-search-backward
+ re-substring-search-forward
+ regexp-group
+ set-re-registers!)
+ (initialization (initialize-package!)))
+
+(define-package (runtime regular-expression-compiler)
+ (file-case options
+ ((load) "rgxcmp")
+ (else))
+ (parent ())
+ (export ()
+ compiled-regexp?
+ compiled-regexp/byte-stream
+ compiled-regexp/translation-table
+ condition-type:re-compile-pattern
+ re-compile-char
+ re-compile-char-set
+ re-compile-pattern
+ re-compile-string
+ re-disassemble-pattern
+ re-quote-string
+ re-translation-table))
+
+(define-package (runtime char-syntax)
+ (file-case options
+ ((load) "chrsyn")
+ (else))
+ (parent ())
+ (export ()
+ char->syntax-code
+ char-syntax->string
+ char-syntax-table?
+ get-char-syntax
+ make-char-syntax-table
+ set-char-syntax!
+ standard-char-syntax-table
+ string->char-syntax
+ substring-find-next-char-not-of-syntax
+ substring-find-next-char-of-syntax)
+ (export (runtime regular-expression)
+ char-syntax-table/entries)
+ (initialization (initialize-package!)))
\ No newline at end of file
projects / mit-scheme.git / commitdiff