code.delx.au - gnu-emacs/blob - lisp/emacs-lisp/rx.el

   1 ;;; rx.el --- sexp notation for regular expressions
   2
   3 ;; Copyright (C) 2001, 03, 2004  Free Software Foundation, Inc.
   4
   5 ;; Author: Gerd Moellmann <gerd@gnu.org>
   6 ;; Maintainer: FSF
   7 ;; Keywords: strings, regexps, extensions
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This is another implementation of sexp-form regular expressions.
  29 ;; It was unfortunately written without being aware of the Sregex
  30 ;; package coming with Emacs, but as things stand, Rx completely
  31 ;; covers all regexp features, which Sregex doesn't, doesn't suffer
  32 ;; from the bugs mentioned in the commentary section of Sregex, and
  33 ;; uses a nicer syntax (IMHO, of course :-).
  34
  35 ;; This significantly extended version of the original, is almost
  36 ;; compatible with Sregex.  The only incompatibility I (fx) know of is
  37 ;; that the `repeat' form can't have multiple regexp args.
  38
  39 ;; Now alternative forms are provided for a degree of compatibility
  40 ;; with Shivers' attempted definitive SRE notation
  41 ;; <URL:http://www.ai.mit.edu/~/shivers/sre.txt>.  SRE forms not
  42 ;; catered for include: dsm, uncase, w/case, w/nocase, ,@<exp>,
  43 ;; ,<exp>, (word ...), word+, posix-string, and character class forms.
  44 ;; Some forms are inconsistent with SRE, either for historical reasons
  45 ;; or because of the implementation -- simple translation into Emacs
  46 ;; regexp strings.  These include: any, word.  Also, case-sensitivity
  47 ;; and greediness are controlled by variables external to the regexp,
  48 ;; and you need to feed the forms to the `posix-' functions to get
  49 ;; SRE's POSIX semantics.  There are probably more difficulties.
  50
  51 ;; Rx translates a sexp notation for regular expressions into the
  52 ;; usual string notation.  The translation can be done at compile-time
  53 ;; by using the `rx' macro.  It can be done at run-time by calling
  54 ;; function `rx-to-string'.  See the documentation of `rx' for a
  55 ;; complete description of the sexp notation.
  56 ;;
  57 ;; Some examples of string regexps and their sexp counterparts:
  58 ;;
  59 ;; "^[a-z]*"
  60 ;; (rx (and line-start (0+ (in "a-z"))))
  61 ;;
  62 ;; "\n[^ \t]"
  63 ;; (rx (and "\n" (not blank))), or
  64 ;; (rx (and "\n" (not (any " \t"))))
  65 ;;
  66 ;; "\\*\\*\\* EOOH \\*\\*\\*\n"
  67 ;; (rx "*** EOOH ***\n")
  68 ;;
  69 ;; "\\<\\(catch\\|finally\\)\\>[^_]"
  70 ;; (rx (and word-start (submatch (or "catch" "finally")) word-end
  71 ;;          (not (any ?_))))
  72 ;;
  73 ;; "[ \t\n]*:\\([^:]+\\|$\\)"
  74 ;; (rx (and (zero-or-more (in " \t\n")) ":"
  75 ;;          (submatch (or line-end (one-or-more (not (any ?:)))))))
  76 ;;
  77 ;; "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*"
  78 ;; (rx (and line-start
  79 ;;          "content-transfer-encoding:"
  80 ;;          (+ (? ?\n)) blank
  81 ;;          "quoted-printable"
  82 ;;          (+ (? ?\n)) blank))
  83 ;;
  84 ;; (concat "^\\(?:" something-else "\\)")
  85 ;; (rx (and line-start (eval something-else))), statically or
  86 ;; (rx-to-string '(and line-start ,something-else)), dynamically.
  87 ;;
  88 ;; (regexp-opt '(STRING1 STRING2 ...))
  89 ;; (rx (or STRING1 STRING2 ...)), or in other words, `or' automatically
  90 ;; calls `regexp-opt' as needed.
  91 ;;
  92 ;; "^;;\\s-*\n\\|^\n"
  93 ;; (rx (or (and line-start ";;" (0+ space) ?\n)
  94 ;;         (and line-start ?\n)))
  95 ;;
  96 ;; "\\$[I]d: [^ ]+ \\([^ ]+\\) "
  97 ;; (rx (and "$Id: "
  98 ;;          (1+ (not (in " ")))
  99 ;;          " "
 100 ;;          (submatch (1+ (not (in " "))))
 101 ;;          " "))
 102 ;;
 103 ;; "\\\\\\\\\\[\\w+"
 104 ;; (rx (and ?\\ ?\\ ?\[ (1+ word)))
 105 ;;
 106 ;; etc.
 107
 108 ;;; History:
 109 ;;
 110
 111 ;;; Code:
 112
 113 (defconst rx-constituents
 114   '((and                . (rx-and 1 nil))
 115     (seq                . and)          ; SRE
 116     (:                  . and)          ; SRE
 117     (sequence           . and)          ; sregex
 118     (or                 . (rx-or 1 nil))
 119     (|                  . or)           ; SRE
 120     (not-newline        . ".")
 121     (nonl               . not-newline)  ; SRE
 122     (anything           . ".\\|\n")
 123     (any                . (rx-any 1 nil rx-check-any)) ; inconsistent with SRE
 124     (in                 . any)
 125     (char               . any)          ; sregex
 126     (not-char           . (rx-not-char 1 nil rx-check-any)) ; sregex
 127     (not                . (rx-not 1 1 rx-check-not))
 128     ;; Partially consistent with sregex, whose `repeat' is like our
 129     ;; `**'.  (`repeat' with optional max arg and multiple sexp forms
 130     ;; is ambiguous.)
 131     (repeat             . (rx-repeat 2 3))
 132     (=                  . (rx-= 2 nil))    ; SRE
 133     (>=                 . (rx->= 2 nil))   ; SRE
 134     (**                 . (rx-** 2 nil))   ; SRE
 135     (submatch           . (rx-submatch 1 nil)) ; SRE
 136     (group              . submatch)
 137     (zero-or-more       . (rx-kleene 1 nil))
 138     (one-or-more        . (rx-kleene 1 nil))
 139     (zero-or-one        . (rx-kleene 1 nil))
 140     (\?                 . zero-or-one)  ; SRE
 141     (\??                . zero-or-one)
 142     (*                  . zero-or-more) ; SRE
 143     (*?                 . zero-or-more)
 144     (0+                 . zero-or-more)
 145     (+                  . one-or-more)  ; SRE
 146     (+?                 . one-or-more)
 147     (1+                 . one-or-more)
 148     (optional           . zero-or-one)
 149     (opt                . zero-or-one)  ; sregex
 150     (minimal-match      . (rx-greedy 1 1))
 151     (maximal-match      . (rx-greedy 1 1))
 152     (backref            . (rx-backref 1 1 rx-check-backref))
 153     (line-start         . "^")
 154     (bol                . line-start)   ; SRE
 155     (line-end           . "$")
 156     (eol                . line-end)     ; SRE
 157     (string-start       . "\\`")
 158     (bos                . string-start) ; SRE
 159     (bot                . string-start) ; sregex
 160     (string-end         . "\\'")
 161     (eos                . string-end)   ; SRE
 162     (eot                . string-end)   ; sregex
 163     (buffer-start       . "\\`")
 164     (buffer-end         . "\\'")
 165     (point              . "\\=")
 166     (word-start         . "\\<")
 167     (bow                . word-start)   ; SRE
 168     (word-end           . "\\>")
 169     (eow                . word-end)     ; SRE
 170     (word-boundary      . "\\b")
 171     (not-word-boundary  . "\\B")        ; sregex
 172     (syntax             . (rx-syntax 1 1))
 173     (not-syntax         . (rx-not-syntax 1 1)) ; sregex
 174     (category           . (rx-category 1 1 rx-check-category))
 175     (eval               . (rx-eval 1 1))
 176     (regexp             . (rx-regexp 1 1 stringp))
 177     (digit              . "[[:digit:]]")
 178     (numeric            . digit)        ; SRE
 179     (num                . digit)        ; SRE
 180     (control            . "[[:cntrl:]]") ; SRE
 181     (cntrl              . control)       ; SRE
 182     (hex-digit          . "[[:xdigit:]]") ; SRE
 183     (hex                . hex-digit)      ; SRE
 184     (xdigit             . hex-digit)      ; SRE
 185     (blank              . "[[:blank:]]")  ; SRE
 186     (graphic            . "[[:graph:]]")  ; SRE
 187     (graph              . graphic)        ; SRE
 188     (printing           . "[[:print:]]")  ; SRE
 189     (print              . printing)       ; SRE
 190     (alphanumeric       . "[[:alnum:]]")  ; SRE
 191     (alnum              . alphanumeric)   ; SRE
 192     (letter             . "[[:alpha:]]")
 193     (alphabetic         . letter)       ; SRE
 194     (alpha              . letter)       ; SRE
 195     (ascii              . "[[:ascii:]]") ; SRE
 196     (nonascii           . "[[:nonascii:]]")
 197     (lower              . "[[:lower:]]") ; SRE
 198     (lower-case         . lower)         ; SRE
 199     (punctuation        . "[[:punct:]]") ; SRE
 200     (punct              . punctuation)   ; SRE
 201     (space              . "[[:space:]]") ; SRE
 202     (whitespace         . space)         ; SRE
 203     (white              . space)         ; SRE
 204     (upper              . "[[:upper:]]") ; SRE
 205     (upper-case         . upper)         ; SRE
 206     (word               . "[[:word:]]")  ; inconsistent with SRE
 207     (wordchar           . word)          ; sregex
 208     (not-wordchar       . "[^[:word:]]") ; sregex (use \\W?)
 209     )
 210   "Alist of sexp form regexp constituents.
 211 Each element of the alist has the form (SYMBOL . DEFN).
 212 SYMBOL is a valid constituent of sexp regular expressions.
 213 If DEFN is a string, SYMBOL is translated into DEFN.
 214 If DEFN is a symbol, use the definition of DEFN, recursively.
 215 Otherwise, DEFN must be a list (FUNCTION MIN-ARGS MAX-ARGS PREDICATE).
 216 FUNCTION is used to produce code for SYMBOL.  MIN-ARGS and MAX-ARGS
 217 are the minimum and maximum number of arguments the function-form
 218 sexp constituent SYMBOL may have in sexp regular expressions.
 219 MAX-ARGS nil means no limit.  PREDICATE, if specified, means that
 220 all arguments must satisfy PREDICATE.")
 221
 222
 223 (defconst rx-syntax
 224   '((whitespace         . ?-)
 225     (punctuation        . ?.)
 226     (word               . ?w)
 227     (symbol             . ?_)
 228     (open-parenthesis   . ?\()
 229     (close-parenthesis  . ?\))
 230     (expression-prefix  . ?\')
 231     (string-quote       . ?\")
 232     (paired-delimiter   . ?$)
 233     (escape             . ?\\)
 234     (character-quote    . ?/)
 235     (comment-start      . ?<)
 236     (comment-end        . ?>)
 237     (string-delimiter   . ?|)
 238     (comment-delimiter  . ?!))
 239   "Alist mapping Rx syntax symbols to syntax characters.
 240 Each entry has the form (SYMBOL . CHAR), where SYMBOL is a valid
 241 symbol in `(syntax SYMBOL)', and CHAR is the syntax character
 242 corresponding to SYMBOL, as it would be used with \\s or \\S in
 243 regular expressions.")
 244
 245
 246 (defconst rx-categories
 247   '((consonant                  . ?0)
 248     (base-vowel                 . ?1)
 249     (upper-diacritical-mark     . ?2)
 250     (lower-diacritical-mark     . ?3)
 251     (tone-mark                  . ?4)
 252     (symbol                     . ?5)
 253     (digit                      . ?6)
 254     (vowel-modifying-diacritical-mark . ?7)
 255     (vowel-sign                 . ?8)
 256     (semivowel-lower            . ?9)
 257     (not-at-end-of-line         . ?<)
 258     (not-at-beginning-of-line   . ?>)
 259     (alpha-numeric-two-byte     . ?A)
 260     (chinse-two-byte            . ?C)
 261     (greek-two-byte             . ?G)
 262     (japanese-hiragana-two-byte . ?H)
 263     (indian-two-byte            . ?I)
 264     (japanese-katakana-two-byte . ?K)
 265     (korean-hangul-two-byte     . ?N)
 266     (cyrillic-two-byte          . ?Y)
 267     (combining-diacritic        . ?^)
 268     (ascii                      . ?a)
 269     (arabic                     . ?b)
 270     (chinese                    . ?c)
 271     (ethiopic                   . ?e)
 272     (greek                      . ?g)
 273     (korean                     . ?h)
 274     (indian                     . ?i)
 275     (japanese                   . ?j)
 276     (japanese-katakana          . ?k)
 277     (latin                      . ?l)
 278     (lao                        . ?o)
 279     (tibetan                    . ?q)
 280     (japanese-roman             . ?r)
 281     (thai                       . ?t)
 282     (vietnamese                 . ?v)
 283     (hebrew                     . ?w)
 284     (cyrillic                   . ?y)
 285     (can-break                  . ?|))
 286   "Alist mapping symbols to category characters.
 287 Each entry has the form (SYMBOL . CHAR), where SYMBOL is a valid
 288 symbol in `(category SYMBOL)', and CHAR is the category character
 289 corresponding to SYMBOL, as it would be used with `\\c' or `\\C' in
 290 regular expression strings.")
 291
 292
 293 (defvar rx-greedy-flag t
 294   "Non-nil means produce greedy regular expressions for `zero-or-one',
 295 `zero-or-more', and `one-or-more'.  Dynamically bound.")
 296
 297
 298 (defun rx-info (op)
 299   "Return parsing/code generation info for OP.
 300 If OP is the space character ASCII 32, return info for the symbol `?'.
 301 If OP is the character `?', return info for the symbol `??'.
 302 See also `rx-constituents'."
 303   (cond ((eq op ? ) (setq op '\?))
 304         ((eq op ??) (setq op '\??)))
 305   (while (and (not (null op)) (symbolp op))
 306     (setq op (cdr (assq op rx-constituents))))
 307   op)
 308
 309
 310 (defun rx-check (form)
 311   "Check FORM according to its car's parsing info."
 312   (unless (listp form)
 313     (error "rx `%s' needs argument(s)" form))
 314   (let* ((rx (rx-info (car form)))
 315          (nargs (1- (length form)))
 316          (min-args (nth 1 rx))
 317          (max-args (nth 2 rx))
 318          (type-pred (nth 3 rx)))
 319     (when (and (not (null min-args))
 320                (< nargs min-args))
 321       (error "rx form `%s' requires at least %d args"
 322              (car form) min-args))
 323     (when (and (not (null max-args))
 324                (> nargs max-args))
 325       (error "rx form `%s' accepts at most %d args"
 326              (car form) max-args))
 327     (when (not (null type-pred))
 328       (dolist (sub-form (cdr form))
 329         (unless (funcall type-pred sub-form)
 330           (error "rx form `%s' requires args satisfying `%s'"
 331                  (car form) type-pred))))))
 332
 333
 334 (defun rx-and (form)
 335   "Parse and produce code from FORM.
 336 FORM is of the form `(and FORM1 ...)'."
 337   (rx-check form)
 338   (concat "\\(?:"
 339           (mapconcat
 340            (function (lambda (x) (rx-to-string x 'no-group)))
 341            (cdr form) nil)
 342           "\\)"))
 343
 344
 345 (defun rx-or (form)
 346   "Parse and produce code from FORM, which is `(or FORM1 ...)'."
 347   (rx-check form)
 348   (let ((all-args-strings t))
 349     (dolist (arg (cdr form))
 350       (unless (stringp arg)
 351         (setq all-args-strings nil)))
 352     (concat "\\(?:"
 353             (if all-args-strings
 354                 (regexp-opt (cdr form))
 355               (mapconcat #'rx-to-string (cdr form) "\\|"))
 356             "\\)")))
 357
 358
 359 (defvar rx-bracket)                    ; dynamically bound in `rx-any'
 360
 361 (defun rx-check-any (arg)
 362    "Check arg ARG for Rx `any'."
 363    (if (integerp arg)
 364        (setq arg (string arg)))
 365    (when (stringp arg)
 366      (if (zerop (length arg))
 367          (error "String arg for Rx `any' must not be empty"))
 368      ;; Quote ^ at start; don't bother to check whether this is first arg.
 369      (if (eq ?^ (aref arg 0))
 370          (setq arg (concat "\\" arg)))
 371      ;; Remove ] and set flag for adding it to start of overall result.
 372      (when (string-match "]" arg)
 373        (setq arg (replace-regexp-in-string "]" "" arg)
 374              rx-bracket "]")))
 375    (when (symbolp arg)
 376      (let ((translation (condition-case nil
 377                             (rx-to-string arg 'no-group)
 378                           (error nil))))
 379        (unless translation (error "Invalid char class `%s' in Rx `any'" arg))
 380        (setq arg (substring translation 1 -1)))) ; strip outer brackets
 381    ;; sregex compatibility
 382    (when (and (integerp (car-safe arg))
 383               (integerp (cdr-safe arg)))
 384      (setq arg (string (car arg) ?- (cdr arg))))
 385    (unless (stringp arg)
 386      (error "rx `any' requires string, character, char pair or char class args"))
 387    arg)
 388
 389 (defun rx-any (form)
 390   "Parse and produce code from FORM, which is `(any ARG ...)'.
 391 ARG is optional."
 392   (rx-check form)
 393   (let* ((rx-bracket nil)
 394          (args (mapcar #'rx-check-any (cdr form)))) ; side-effects `rx-bracket'
 395     ;; If there was a ?- in the form, move it to the front to avoid
 396     ;; accidental range.
 397     (if (member "-" args)
 398         (setq args (cons "-" (delete "-" args))))
 399     (apply #'concat "[" rx-bracket (append args '("]")))))
 400
 401
 402 (defun rx-check-not (arg)
 403   "Check arg ARG for Rx `not'."
 404   (unless (or (and (symbolp arg)
 405                    (string-match "\\`\\[\\[:[-a-z]:]]\\'"
 406                                  (condition-case nil
 407                                      (rx-to-string arg 'no-group)
 408                                    (error ""))))
 409               (eq arg 'word-boundary)
 410               (and (consp arg)
 411                    (memq (car arg) '(not any in syntax category))))
 412     (error "rx `not' syntax error: %s" arg))
 413   t)
 414
 415
 416 (defun rx-not (form)
 417   "Parse and produce code from FORM.  FORM is `(not ...)'."
 418   (rx-check form)
 419   (let ((result (rx-to-string (cadr form) 'no-group))
 420         case-fold-search)
 421     (cond ((string-match "\\`\\[^" result)
 422            (if (= (length result) 4)
 423                (substring result 2 3)
 424              (concat "[" (substring result 2))))
 425           ((eq ?\[ (aref result 0))
 426            (concat "[^" (substring result 1)))
 427           ((string-match "\\`\\\\[scb]" result)
 428            (concat (capitalize (substring result 0 2)) (substring result 2)))
 429           (t
 430            (concat "[^" result "]")))))
 431
 432
 433 (defun rx-not-char (form)
 434   "Parse and produce code from FORM.  FORM is `(not-char ...)'."
 435   (rx-check form)
 436   (rx-not `(not (in ,@(cdr form)))))
 437
 438
 439 (defun rx-not-syntax (form)
 440   "Parse and produce code from FORM.  FORM is `(not-syntax SYNTAX)'."
 441   (rx-check form)
 442   (rx-not `(not (syntax ,@(cdr form)))))
 443
 444
 445 (defun rx-trans-forms (form &optional skip)
 446   "If FORM's length is greater than two, transform it to length two.
 447 A form (HEAD REST ...) becomes (HEAD (and REST ...)).
 448 If SKIP is non-nil, allow that number of items after the head, i.e.
 449 `(= N REST ...)' becomes `(= N (and REST ...))' if SKIP is 1."
 450   (unless skip (setq skip 0))
 451   (let ((tail (nthcdr (1+ skip) form)))
 452     (if (= (length tail) 1)
 453         form
 454       (let ((form (copy-sequence form)))
 455         (setcdr (nthcdr skip form) (list (cons 'and tail)))
 456         form))))
 457
 458
 459 (defun rx-= (form)
 460   "Parse and produce code from FORM `(= N ...)'."
 461   (rx-check form)
 462   (setq form (rx-trans-forms form 1))
 463   (unless (and (integerp (nth 1 form))
 464                (> (nth 1 form) 0))
 465     (error "rx `=' requires positive integer first arg"))
 466   (format "%s\\{%d\\}" (rx-to-string (nth 2 form)) (nth 1 form)))
 467
 468
 469 (defun rx->= (form)
 470   "Parse and produce code from FORM `(>= N ...)'."
 471   (rx-check form)
 472   (setq form (rx-trans-forms form 1))
 473   (unless (and (integerp (nth 1 form))
 474                (> (nth 1 form) 0))
 475     (error "rx `>=' requires positive integer first arg"))
 476   (format "%s\\{%d,\\}" (rx-to-string (nth 2 form)) (nth 1 form)))
 477
 478
 479 (defun rx-** (form)
 480   "Parse and produce code from FORM `(** N M ...)'."
 481   (rx-check form)
 482   (setq form (cons 'repeat (cdr (rx-trans-forms form 2))))
 483   (rx-to-string form))
 484
 485
 486 (defun rx-repeat (form)
 487   "Parse and produce code from FORM.
 488 FORM is either `(repeat N FORM1)' or `(repeat N M FORM1)'."
 489   (rx-check form)
 490   (cond ((= (length form) 3)
 491          (unless (and (integerp (nth 1 form))
 492                       (> (nth 1 form) 0))
 493            (error "rx `repeat' requires positive integer first arg"))
 494          (format "%s\\{%d\\}" (rx-to-string (nth 2 form)) (nth 1 form)))
 495         ((or (not (integerp (nth 2 form)))
 496              (< (nth 2 form) 0)
 497              (not (integerp (nth 1 form)))
 498              (< (nth 1 form) 0)
 499              (< (nth 2 form) (nth 1 form)))
 500          (error "rx `repeat' range error"))
 501         (t
 502          (format "%s\\{%d,%d\\}" (rx-to-string (nth 3 form))
 503                  (nth 1 form) (nth 2 form)))))
 504
 505
 506 (defun rx-submatch (form)
 507   "Parse and produce code from FORM, which is `(submatch ...)'."
 508   (concat "\\("
 509           (mapconcat (function (lambda (x) (rx-to-string x 'no-group)))
 510                      (cdr form) nil)
 511           "\\)"))
 512
 513 (defun rx-backref (form)
 514   "Parse and produce code from FORM, which is `(backref N)'."
 515   (rx-check form)
 516   (format "\\%d" (nth 1 form)))
 517
 518 (defun rx-check-backref (arg)
 519   "Check arg ARG for Rx `backref'."
 520   (or (and (integerp arg) (>= arg 1) (<= arg 9))
 521       (error "rx `backref' requires numeric 1<=arg<=9: %s" arg)))
 522
 523 (defun rx-kleene (form)
 524   "Parse and produce code from FORM.
 525 FORM is `(OP FORM1)', where OP is one of the `zero-or-one',
 526 `zero-or-more' etc.  operators.
 527 If OP is one of `*', `+', `?', produce a greedy regexp.
 528 If OP is one of `*?', `+?', `??', produce a non-greedy regexp.
 529 If OP is anything else, produce a greedy regexp if `rx-greedy-flag'
 530 is non-nil."
 531   (rx-check form)
 532   (setq form (rx-trans-forms form))
 533   (let ((suffix (cond ((memq (car form) '(* + ? )) "")
 534                       ((memq (car form) '(*? +? ??)) "?")
 535                       (rx-greedy-flag "")
 536                       (t "?")))
 537         (op (cond ((memq (car form) '(* *? 0+ zero-or-more)) "*")
 538                   ((memq (car form) '(+ +? 1+ one-or-more))  "+")
 539                   (t "?")))
 540         (result (rx-to-string (cadr form) 'no-group)))
 541     (if (not (rx-atomic-p result))
 542         (setq result (concat "\\(?:" result "\\)")))
 543     (concat result op suffix)))
 544
 545 (defun rx-atomic-p (r)
 546   "Return non-nil if regexp string R is atomic.
 547 An atomic regexp R is one such that a suffix operator
 548 appended to R will apply to all of R.  For example, \"a\"
 549 \"[abc]\" and \"\\(ab\\|ab*c\\)\" are atomic and \"ab\",
 550 \"[ab]c\", and \"ab\\|ab*c\" are not atomic.
 551
 552 This function may return false negatives, but it will not
 553 return false positives.  It is nevertheless useful in
 554 situations where an efficiency shortcut can be taken iff a
 555 regexp is atomic.  The function can be improved to detect
 556 more cases of atomic regexps.  Presently, this function
 557 detects the following categories of atomic regexp;
 558
 559   a group or shy group:  \\(...\\)
 560   a character class:     [...]
 561   a single character:    a
 562
 563 On the other hand, false negatives will be returned for
 564 regexps that are atomic but end in operators, such as
 565 \"a+\".  I think these are rare.  Probably such cases could
 566 be detected without much effort.  A guarantee of no false
 567 negatives would require a theoretic specification of the set
 568 of all atomic regexps."
 569   (let ((l (length r)))
 570     (or (equal l 1)
 571         (and (>= l 6)
 572              (equal (substring r 0 2) "\\(")
 573              (equal (substring r -2) "\\)"))
 574         (and (>= l 2)
 575              (equal (substring r 0 1) "[")
 576              (equal (substring r -1) "]")))))
 577
 578
 579 (defun rx-syntax (form)
 580   "Parse and produce code from FORM, which is `(syntax SYMBOL)'."
 581   (rx-check form)
 582   (let* ((sym (cadr form))
 583          (syntax (assq sym rx-syntax)))
 584     (unless syntax
 585       ;; Try sregex compatibility.
 586       (let ((name (symbol-name sym)))
 587         (if (= 1 (length name))
 588             (setq syntax (rassq (aref name 0) rx-syntax))))
 589       (unless syntax
 590         (error "Unknown rx syntax `%s'" (cadr form))))
 591     (format "\\s%c" (cdr syntax))))
 592
 593
 594 (defun rx-check-category (form)
 595   "Check the argument FORM of a `(category FORM)'."
 596   (unless (or (integerp form)
 597               (cdr (assq form rx-categories)))
 598     (error "Unknown category `%s'" form))
 599   t)
 600
 601
 602 (defun rx-category (form)
 603   "Parse and produce code from FORM, which is `(category SYMBOL)'."
 604   (rx-check form)
 605   (let ((char (if (integerp (cadr form))
 606                   (cadr form)
 607                 (cdr (assq (cadr form) rx-categories)))))
 608     (format "\\c%c" char)))
 609
 610
 611 (defun rx-eval (form)
 612   "Parse and produce code from FORM, which is `(eval FORM)'."
 613   (rx-check form)
 614   (rx-to-string (eval (cadr form))))
 615
 616
 617 (defun rx-greedy (form)
 618   "Parse and produce code from FORM.
 619 If FORM is '(minimal-match FORM1)', non-greedy versions of `*',
 620 `+', and `?' operators will be used in FORM1.  If FORM is
 621 '(maximal-match FORM1)', greedy operators will be used."
 622   (rx-check form)
 623   (let ((rx-greedy-flag (eq (car form) 'maximal-match)))
 624     (rx-to-string (cadr form))))
 625
 626
 627 (defun rx-regexp (form)
 628   "Parse and produce code from FORM, which is `(regexp STRING)'."
 629   (rx-check form)
 630   (concat "\\(?:" (cadr form) "\\)"))
 631
 632
 633 ;;;###autoload
 634 (defun rx-to-string (form &optional no-group)
 635   "Parse and produce code for regular expression FORM.
 636 FORM is a regular expression in sexp form.
 637 NO-GROUP non-nil means don't put shy groups around the result."
 638   (cond ((stringp form)
 639          (regexp-quote form))
 640         ((integerp form)
 641          (regexp-quote (char-to-string form)))
 642         ((symbolp form)
 643          (let ((info (rx-info form)))
 644            (cond ((stringp info)
 645                   info)
 646                  ((null info)
 647                   (error "Unknown rx form `%s'" form))
 648                  (t
 649                   (funcall (nth 0 info) form)))))
 650         ((consp form)
 651          (let ((info (rx-info (car form))))
 652            (unless (consp info)
 653              (error "Unknown rx form `%s'" (car form)))
 654            (let ((result (funcall (nth 0 info) form)))
 655              (if (or no-group (string-match "\\`\\\\[(]" result))
 656                  result
 657                (concat "\\(?:" result "\\)")))))
 658         (t
 659          (error "rx syntax error at `%s'" form))))
 660
 661
 662 ;;;###autoload
 663 (defmacro rx (&rest regexps)
 664   "Translate regular expressions REGEXPS in sexp form to a regexp string.
 665 REGEXPS is a non-empty sequence of forms of the sort listed below.
 666 See also `rx-to-string' for how to do such a translation at run-time.
 667
 668 The following are valid subforms of regular expressions in sexp
 669 notation.
 670
 671 STRING
 672      matches string STRING literally.
 673
 674 CHAR
 675      matches character CHAR literally.
 676
 677 `not-newline', `nonl'
 678      matches any character except a newline.
 679                         .
 680 `anything'
 681      matches any character
 682
 683 `(any SET ...)'
 684 `(in SET ...)'
 685 `(char SET ...)'
 686      matches any character in SET ....  SET may be a character or string.
 687      Ranges of characters can be specified as `A-Z' in strings.
 688      Ranges may also be specified as conses like `(?A . ?Z)'.
 689
 690      SET may also be the name of a character class: `digit',
 691      `control', `hex-digit', `blank', `graph', `print', `alnum',
 692      `alpha', `ascii', `nonascii', `lower', `punct', `space', `upper',
 693      `word', or one of their synonyms.
 694
 695 `(not (any SET ...))'
 696      matches any character not in SET ...
 697
 698 `line-start', `bol'
 699      matches the empty string, but only at the beginning of a line
 700      in the text being matched
 701
 702 `line-end', `eol'
 703      is similar to `line-start' but matches only at the end of a line
 704
 705 `string-start', `bos', `bot'
 706      matches the empty string, but only at the beginning of the
 707      string being matched against.
 708
 709 `string-end', `eos', `eot'
 710      matches the empty string, but only at the end of the
 711      string being matched against.
 712
 713 `buffer-start'
 714      matches the empty string, but only at the beginning of the
 715      buffer being matched against.  Actually equivalent to `string-start'.
 716
 717 `buffer-end'
 718      matches the empty string, but only at the end of the
 719      buffer being matched against.  Actually equivalent to `string-end'.
 720
 721 `point'
 722      matches the empty string, but only at point.
 723
 724 `word-start', `bow'
 725      matches the empty string, but only at the beginning or end of a
 726      word.
 727
 728 `word-end', `eow'
 729      matches the empty string, but only at the end of a word.
 730
 731 `word-boundary'
 732      matches the empty string, but only at the beginning or end of a
 733      word.
 734
 735 `(not word-boundary)'
 736 `not-word-boundary'
 737      matches the empty string, but not at the beginning or end of a
 738      word.
 739
 740 `digit', `numeric', `num'
 741      matches 0 through 9.
 742
 743 `control', `cntrl'
 744      matches ASCII control characters.
 745
 746 `hex-digit', `hex', `xdigit'
 747      matches 0 through 9, a through f and A through F.
 748
 749 `blank'
 750      matches space and tab only.
 751
 752 `graphic', `graph'
 753      matches graphic characters--everything except ASCII control chars,
 754      space, and DEL.
 755
 756 `printing', `print'
 757      matches printing characters--everything except ASCII control chars
 758      and DEL.
 759
 760 `alphanumeric', `alnum'
 761      matches letters and digits.  (But at present, for multibyte characters,
 762      it matches anything that has word syntax.)
 763
 764 `letter', `alphabetic', `alpha'
 765      matches letters.  (But at present, for multibyte characters,
 766      it matches anything that has word syntax.)
 767
 768 `ascii'
 769      matches ASCII (unibyte) characters.
 770
 771 `nonascii'
 772      matches non-ASCII (multibyte) characters.
 773
 774 `lower', `lower-case'
 775      matches anything lower-case.
 776
 777 `upper', `upper-case'
 778      matches anything upper-case.
 779
 780 `punctuation', `punct'
 781      matches punctuation.  (But at present, for multibyte characters,
 782      it matches anything that has non-word syntax.)
 783
 784 `space', `whitespace', `white'
 785      matches anything that has whitespace syntax.
 786
 787 `word', `wordchar'
 788      matches anything that has word syntax.
 789
 790 `not-wordchar'
 791      matches anything that has non-word syntax.
 792
 793 `(syntax SYNTAX)'
 794      matches a character with syntax SYNTAX.  SYNTAX must be one
 795      of the following symbols, or a symbol corresponding to the syntax
 796      character, e.g. `\\.' for `\\s.'.
 797
 798      `whitespace'               (\\s- in string notation)
 799      `punctuation'              (\\s.)
 800      `word'                     (\\sw)
 801      `symbol'                   (\\s_)
 802      `open-parenthesis'         (\\s()
 803      `close-parenthesis'        (\\s))
 804      `expression-prefix'        (\\s')
 805      `string-quote'             (\\s\")
 806      `paired-delimiter'         (\\s$)
 807      `escape'                   (\\s\\)
 808      `character-quote'          (\\s/)
 809      `comment-start'            (\\s<)
 810      `comment-end'              (\\s>)
 811      `string-delimiter'         (\\s|)
 812      `comment-delimiter'        (\\s!)
 813
 814 `(not (syntax SYNTAX))'
 815      matches a character that doesn't have syntax SYNTAX.
 816
 817 `(category CATEGORY)'
 818      matches a character with category CATEGORY.  CATEGORY must be
 819      either a character to use for C, or one of the following symbols.
 820
 821      `consonant'                        (\\c0 in string notation)
 822      `base-vowel'                       (\\c1)
 823      `upper-diacritical-mark'           (\\c2)
 824      `lower-diacritical-mark'           (\\c3)
 825      `tone-mark'                        (\\c4)
 826      `symbol'                           (\\c5)
 827      `digit'                            (\\c6)
 828      `vowel-modifying-diacritical-mark' (\\c7)
 829      `vowel-sign'                       (\\c8)
 830      `semivowel-lower'                  (\\c9)
 831      `not-at-end-of-line'               (\\c<)
 832      `not-at-beginning-of-line'         (\\c>)
 833      `alpha-numeric-two-byte'           (\\cA)
 834      `chinse-two-byte'                  (\\cC)
 835      `greek-two-byte'                   (\\cG)
 836      `japanese-hiragana-two-byte'       (\\cH)
 837      `indian-tow-byte'                  (\\cI)
 838      `japanese-katakana-two-byte'       (\\cK)
 839      `korean-hangul-two-byte'           (\\cN)
 840      `cyrillic-two-byte'                (\\cY)
 841      `combining-diacritic'              (\\c^)
 842      `ascii'                            (\\ca)
 843      `arabic'                           (\\cb)
 844      `chinese'                          (\\cc)
 845      `ethiopic'                         (\\ce)
 846      `greek'                            (\\cg)
 847      `korean'                           (\\ch)
 848      `indian'                           (\\ci)
 849      `japanese'                         (\\cj)
 850      `japanese-katakana'                (\\ck)
 851      `latin'                            (\\cl)
 852      `lao'                              (\\co)
 853      `tibetan'                          (\\cq)
 854      `japanese-roman'                   (\\cr)
 855      `thai'                             (\\ct)
 856      `vietnamese'                       (\\cv)
 857      `hebrew'                           (\\cw)
 858      `cyrillic'                         (\\cy)
 859      `can-break'                        (\\c|)
 860
 861 `(not (category CATEGORY))'
 862      matches a character that doesn't have category CATEGORY.
 863
 864 `(and SEXP1 SEXP2 ...)'
 865 `(: SEXP1 SEXP2 ...)'
 866 `(seq SEXP1 SEXP2 ...)'
 867 `(sequence SEXP1 SEXP2 ...)'
 868      matches what SEXP1 matches, followed by what SEXP2 matches, etc.
 869
 870 `(submatch SEXP1 SEXP2 ...)'
 871 `(group SEXP1 SEXP2 ...)'
 872      like `and', but makes the match accessible with `match-end',
 873      `match-beginning', and `match-string'.
 874
 875 `(group SEXP1 SEXP2 ...)'
 876      another name for `submatch'.
 877
 878 `(or SEXP1 SEXP2 ...)'
 879 `(| SEXP1 SEXP2 ...)'
 880      matches anything that matches SEXP1 or SEXP2, etc.  If all
 881      args are strings, use `regexp-opt' to optimize the resulting
 882      regular expression.
 883
 884 `(minimal-match SEXP)'
 885      produce a non-greedy regexp for SEXP.  Normally, regexps matching
 886      zero or more occurrences of something are \"greedy\" in that they
 887      match as much as they can, as long as the overall regexp can
 888      still match.  A non-greedy regexp matches as little as possible.
 889
 890 `(maximal-match SEXP)'
 891      produce a greedy regexp for SEXP.  This is the default.
 892
 893 Below, `SEXP ...' represents a sequence of regexp forms, treated as if
 894 enclosed in `(and ...)'.
 895
 896 `(zero-or-more SEXP ...)'
 897 `(0+ SEXP ...)'
 898      matches zero or more occurrences of what SEXP ... matches.
 899
 900 `(* SEXP ...)'
 901      like `zero-or-more', but always produces a greedy regexp, independent
 902      of `rx-greedy-flag'.
 903
 904 `(*? SEXP ...)'
 905      like `zero-or-more', but always produces a non-greedy regexp,
 906      independent of `rx-greedy-flag'.
 907
 908 `(one-or-more SEXP ...)'
 909 `(1+ SEXP ...)'
 910      matches one or more occurrences of SEXP ...
 911
 912 `(+ SEXP ...)'
 913      like `one-or-more', but always produces a greedy regexp.
 914
 915 `(+? SEXP ...)'
 916      like `one-or-more', but always produces a non-greedy regexp.
 917
 918 `(zero-or-one SEXP ...)'
 919 `(optional SEXP ...)'
 920 `(opt SEXP ...)'
 921      matches zero or one occurrences of A.
 922
 923 `(? SEXP ...)'
 924      like `zero-or-one', but always produces a greedy regexp.
 925
 926 `(?? SEXP ...)'
 927      like `zero-or-one', but always produces a non-greedy regexp.
 928
 929 `(repeat N SEXP)'
 930 `(= N SEXP ...)'
 931      matches N occurrences.
 932
 933 `(>= N SEXP ...)'
 934      matches N or more occurrences.
 935
 936 `(repeat N M SEXP)'
 937 `(** N M SEXP ...)'
 938      matches N to M occurrences.
 939
 940 `(backref N)'
 941     matches what was matched previously by submatch N.
 942
 943 `(backref N)'
 944      matches what was matched previously by submatch N.
 945
 946 `(backref N)'
 947     matches what was matched previously by submatch N.
 948
 949 `(eval FORM)'
 950      evaluate FORM and insert result.  If result is a string,
 951      `regexp-quote' it.
 952
 953 `(regexp REGEXP)'
 954      include REGEXP in string notation in the result."
 955   (cond ((null regexps)
 956          (error "No regexp"))
 957         ((cdr regexps)
 958          (rx-to-string `(and ,@regexps) t))
 959         (t
 960          (rx-to-string (car regexps) t))))
 961 \f
 962 ;; ;; sregex.el replacement
 963
 964 ;; ;;;###autoload (provide 'sregex)
 965 ;; ;;;###autoload (autoload 'sregex "rx")
 966 ;; (defalias 'sregex 'rx-to-string)
 967 ;; ;;;###autoload (autoload 'sregexq "rx" nil nil 'macro)
 968 ;; (defalias 'sregexq 'rx)
 969 \f
 970 (provide 'rx)
 971
 972 ;;; arch-tag: 12d01a63-0008-42bb-ab8c-1c7d63be370b
 973 ;;; rx.el ends here