archive/src/clisp-regex.lisp

   1 (eval-when (:compile-toplevel :load-toplevel :execute)
   2 (defpackage "SI"
   3   (:use "COMMON-LISP")
   4   (:export
   5    "STRING-MATCH"
   6    "MATCH-END"
   7    "MATCH-BEGINNING"
   8    "*MATCH-DATA*"
   9    "*CASE-FOLD-SEARCH*"))
  10 )
  11
  12 (in-package "SI")
  13 (defvar *match-data*)
  14 (defvar *case-fold-search* nil)
  15
  16 #+nil
  17 (defun string-match (pattern string
  18                              &optional (start 0) end)
  19   "Search the string STRING for the first pattern that matches the
  20 regexp PATTERN.  The syntax used for the pattern is specified by
  21 SYNTAX.  The search may start in the string at START and ends at END,
  22 which default to 0 and the end of the string.
  23
  24 If there is a match, returns the index of the start of the match and
  25 an array of match-data.  If there is no match, -1 is returned and
  26 nil."
  27
  28   (let ((result
  29          (multiple-value-list
  30            #+case-fold-search
  31            (regexp:match pattern string :start start :end end
  32                :case-insensitive *case-fold-search*)
  33            #+case-fold-search-not
  34            (regexp:match pattern string :start start :end end
  35                :case-sensitive (not *case-fold-search*))
  36                )))
  37     (setf *match-data* result)
  38     (if (first result)
  39         (regexp:match-start (first result))
  40         -1)))
  41
  42 (defun string-match (pattern string
  43                              &optional (start 0) end)
  44   "Search the string STRING for the first pattern that matches the
  45 regexp PATTERN.  The syntax used for the pattern is specified by
  46 SYNTAX.  The search may start in the string at START and ends at END,
  47 which default to 0 and the end of the string.
  48
  49 If there is a match, returns the index of the start of the match and
  50 an array of match-data.  If there is no match, -1 is returned and
  51 nil."
  52
  53   (let* ((compiled-pattern (regexp:regexp-compile pattern
  54                               #+case-fold-search  *case-fold-search*
  55                               #+case-fold-search-not (not  *case-fold-search*)
  56                               ))
  57          (result
  58           (multiple-value-list
  59               (regexp:regexp-exec compiled-pattern string
  60                                   :start start :end end))))
  61     (setf *match-data* result)
  62     (if (first result)
  63         (regexp:match-start (first result))
  64         -1)))
  65
  66 (defun match-beginning (index &optional (match-data *match-data*))
  67   (if (and match-data (< index (length match-data)))
  68       (regexp:match-start (elt match-data index))
  69       -1))
  70
  71 (defun match-end (index &optional (match-data *match-data*))
  72   (if (and match-data (< index (length match-data)))
  73       (regexp:match-end (elt match-data index))
  74       -1))
  75