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

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