lisp/emacs-lisp/re-builder.el

   1 ;;; re-builder.el --- Building Regexps with visual feedback
   2
   3 ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
   4
   5 ;; Author: Detlev Zundel <dzu@gnu.org>
   6 ;; Keywords: matching, lisp, tools
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; When I have to come up with regular expressions that are more
  28 ;; complex than simple string matchers, especially if they contain sub
  29 ;; expressions, I find myself spending quite some time in the
  30 ;; `development cycle'.  `re-builder' aims to shorten this time span
  31 ;; so I can get on with the more interesting bits.
  32
  33 ;; With it you can have immediate visual feedback about how well the
  34 ;; regexp behaves to your expectations on the intended data.
  35
  36 ;; When called up `re-builder' attaches itself to the current buffer
  37 ;; which becomes its target buffer, where all the matching is done.
  38 ;; The active window is split so you have a view on the data while
  39 ;; authoring the RE.  If the edited expression is valid the matches in
  40 ;; the target buffer are marked automatically with colored overlays
  41 ;; (for non-color displays see below) giving you feedback over the
  42 ;; extents of the matched (sub) expressions.  The (non-)validity is
  43 ;; shown only in the modeline without throwing the errors at you.  If
  44 ;; you want to know the reason why RE Builder considers it as invalid
  45 ;; call `reb-force-update' ("\C-c\C-u") which should reveal the error.
  46
  47 ;; The `re-builder' keeps the focus while updating the matches in the
  48 ;; target buffer so corrections are easy to incorporate.  If you are
  49 ;; satisfied with the result you can paste the RE to the kill-ring
  50 ;; with `reb-copy' ("\C-c\C-w"), quit the `re-builder' ("\C-c\C-q")
  51 ;; and use it wherever you need it.
  52
  53 ;; As the automatic updates can take some time on large buffers, they
  54 ;; can be limited by `reb-auto-match-limit' so that they should not
  55 ;; have a negative impact on the editing.  Setting it to nil makes
  56 ;; even the auto updates go all the way.  Forcing an update overrides
  57 ;; this limit allowing an easy way to see all matches.
  58
  59 ;; Currently `re-builder' understands four different forms of input,
  60 ;; namely `read', `string', `sregex' and `lisp-re' syntax.  Read
  61 ;; syntax and string syntax are both delimited by `"'s and behave
  62 ;; according to their name.  With the `string' syntax there's no need
  63 ;; to escape the backslashes and double quotes simplifying the editing
  64 ;; somewhat.  The other two allow editing of symbolic regular
  65 ;; expressions supported by the packages of the same name.  (`lisp-re'
  66 ;; is a package by me and its support may go away as it is nearly the
  67 ;; same as the `sregex' package in Emacs)
  68
  69 ;; Editing symbolic expressions is done through a major mode derived
  70 ;; from `emacs-lisp-mode' so you'll get all the good stuff like
  71 ;; automatic indentation and font-locking etc.
  72
  73 ;; When editing a symbolic regular expression, only the first
  74 ;; expression in the RE Builder buffer is considered, which helps
  75 ;; limiting the extent of the expression like the `"'s do for the text
  76 ;; modes.  For the `sregex' syntax the function `sregex' is applied to
  77 ;; the evaluated expression read.  So you can use quoted arguments
  78 ;; with something like '("findme") or you can construct arguments to
  79 ;; your hearts delight with a valid ELisp expression.  (The compiled
  80 ;; string form will be copied by `reb-copy')  If you want to take
  81 ;; a glance at the corresponding string you can temporarily change the
  82 ;; input syntax.
  83
  84 ;; Changing the input syntax is transparent (for the obvious exception
  85 ;; non-symbolic -> symbolic) so you can change your mind as often as
  86 ;; you like.
  87
  88 ;; There is also a shortcut function for toggling the
  89 ;; `case-fold-search' variable in the target buffer with an immediate
  90 ;; update.
  91
  92
  93 ;; Q: But what if my display cannot show colored overlays?
  94 ;; A: Then the cursor will flash around the matched text making it stand
  95 ;;    out.
  96
  97 ;; Q: But how can I then make out the sub-expressions?
  98 ;; A: Thats where the `sub-expression mode' comes in.  In it only the
  99 ;;    digit keys are assigned to perform an update that will flash the
 100 ;;    corresponding subexp only.
 101
 102
 103 ;;; Code:
 104
 105 ;; On XEmacs, load the overlay compatibility library
 106 (if (not (fboundp 'make-overlay))
 107     (require 'overlay))
 108
 109 ;; User costomizable variables
 110 (defgroup re-builder nil
 111   "Options for the RE Builder."
 112   :group 'lisp
 113   :prefix "reb-")
 114
 115 (defcustom reb-blink-delay 0.5
 116   "*Seconds to blink cursor for next/previous match in RE Builder."
 117   :group 're-builder
 118   :type 'number)
 119
 120 (defcustom reb-mode-hook nil
 121   "*Hooks to run on entering RE Builder mode."
 122   :group 're-builder
 123   :type 'hook)
 124
 125 (defcustom reb-re-syntax 'read
 126   "*Syntax for the REs in the RE Builder.
 127 Can either be `read', `string', `sregex' or `lisp-re'."
 128   :group 're-builder
 129   :type '(choice (const :tag "Read syntax" read)
 130                  (const :tag "String syntax" string)
 131                  (const :tag "`sregex' syntax" sregex)
 132                  (const :tag "`lisp-re' syntax" lisp-re)
 133                  (value: string)))
 134
 135 (defcustom reb-auto-match-limit 200
 136   "*Positive integer limiting the matches for RE Builder auto updates.
 137 Set it to nil if you don't want limits here."
 138   :group 're-builder
 139   :type '(restricted-sexp :match-alternatives
 140                           (integerp 'nil)))
 141
 142
 143 (defface reb-match-0
 144   '((((class color))
 145      (:background "lightblue"))
 146     (t (:inverse-video t)))
 147   "Used for displaying the whole match."
 148   :group 're-builder)
 149
 150 (defface reb-match-1
 151   '((((class color))
 152      (:background "aquamarine"))
 153     (t (:inverse-video t)))
 154   "Used for displaying the first matching subexpression."
 155   :group 're-builder)
 156
 157 (defface reb-match-2
 158   '((((class color))
 159      (:background "springgreen"))
 160     (t (:inverse-video t)))
 161   "Used for displaying the second matching subexpression."
 162   :group 're-builder)
 163
 164 (defface reb-match-3
 165   '((((class color))
 166      (:background "yellow"))
 167     (t (:inverse-video t)))
 168   "Used for displaying the third matching subexpression."
 169   :group 're-builder)
 170
 171 ;; Internal variables below
 172 (defvar reb-mode nil
 173   "Enables the RE Builder minor mode.")
 174
 175 (defvar reb-target-buffer nil
 176   "Buffer to which the RE is applied to.")
 177
 178 (defvar reb-target-window nil
 179   "Window to which the RE is applied to.")
 180
 181 (defvar reb-regexp nil
 182   "Last regexp used by RE Builder.")
 183
 184 (defvar reb-regexp-src nil
 185   "Last regexp used by RE Builder before processing it.
 186 Except for Lisp syntax this is the same as `reb-regexp'.")
 187
 188 (defvar reb-overlays nil
 189   "List of overlays of the RE Builder.")
 190
 191 (defvar reb-window-config nil
 192   "Old window configuration.")
 193
 194 (defvar reb-subexp-mode nil
 195   "Indicates whether sub-exp mode is active.")
 196
 197 (defvar reb-subexp-displayed nil
 198   "Indicates which sub-exp is active.")
 199
 200 (defvar reb-mode-string ""
 201   "String in mode line for additional info.")
 202
 203 (defvar reb-valid-string ""
 204   "String in mode line showing validity of RE.")
 205
 206 (make-variable-buffer-local 'reb-overlays)
 207 (make-variable-buffer-local 'reb-regexp)
 208 (make-variable-buffer-local 'reb-regexp-src)
 209
 210 (defconst reb-buffer "*RE-Builder*"
 211   "Buffer to use for the RE Builder.")
 212
 213 ;; Define the local "\C-c" keymap
 214 (defvar reb-mode-map nil
 215   "Keymap used by the RE Builder.")
 216
 217 (if (not reb-mode-map)
 218     (progn
 219       (setq reb-mode-map (make-sparse-keymap))
 220       (define-key reb-mode-map "\C-c\C-c" 'reb-toggle-case)
 221       (define-key reb-mode-map "\C-c\C-q" 'reb-quit)
 222       (define-key reb-mode-map "\C-c\C-w" 'reb-copy)
 223       (define-key reb-mode-map "\C-c\C-s" 'reb-next-match)
 224       (define-key reb-mode-map "\C-c\C-r" 'reb-prev-match)
 225       (define-key reb-mode-map "\C-c\C-i" 'reb-change-syntax)
 226       (define-key reb-mode-map "\C-c\C-e" 'reb-enter-subexp-mode)
 227       (define-key reb-mode-map "\C-c\C-u" 'reb-force-update)))
 228
 229 (defun reb-mode ()
 230   "Major mode for interactively building Regular Expressions.
 231 \\{reb-mode-map}"
 232   (interactive)
 233
 234   (setq major-mode       'reb-mode
 235         mode-name        "RE Builder")
 236   (use-local-map reb-mode-map)
 237   (reb-mode-common)
 238   (run-hooks reb-mode-hook))
 239
 240 (define-derived-mode reb-lisp-mode
 241   emacs-lisp-mode "RE Builder Lisp"
 242   "Major mode for interactively building symbolic Regular Expressions.
 243 \\{reb-lisp-mode-map}"
 244   (cond ((eq reb-re-syntax 'lisp-re)    ; Pull in packages
 245          (require 'lisp-re))            ; as needed
 246         ((eq reb-re-syntax 'sregex)     ; sregex is not autoloaded
 247          (require 'sregex)))            ; right now..
 248   (reb-mode-common))
 249
 250 ;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from
 251 ;; `emacs-lisp-mode'
 252 (define-key reb-lisp-mode-map "\C-c"
 253   (lookup-key reb-mode-map "\C-c"))
 254
 255 (if (boundp 'font-lock-defaults-alist)
 256     (setq font-lock-defaults-alist
 257           (cons (cons 'reb-lisp-mode
 258                       (cdr (assoc 'emacs-lisp-mode
 259                                   font-lock-defaults-alist)))
 260                 font-lock-defaults-alist)))
 261
 262 (defvar reb-subexp-mode-map nil
 263   "Keymap used by the RE Builder for the subexpression mode.")
 264
 265 (if (not reb-subexp-mode-map)
 266     (progn
 267       (setq reb-subexp-mode-map (make-sparse-keymap))
 268       (suppress-keymap reb-subexp-mode-map)
 269       ;; Again share the "\C-c" keymap for the commands
 270       (define-key reb-subexp-mode-map "\C-c"
 271         (lookup-key reb-mode-map "\C-c"))
 272       (define-key reb-subexp-mode-map "q" 'reb-quit-subexp-mode)
 273       (mapcar (lambda (digit)
 274                 (define-key reb-subexp-mode-map (int-to-string digit)
 275                   'reb-display-subexp))
 276               '(0 1 2 3 4 5 6 7 8 9))))
 277
 278 (defun reb-mode-common ()
 279   "Setup functions common to functions `reb-mode' and `reb-mode-lisp'."
 280
 281   (setq reb-mode-string  ""
 282         reb-valid-string ""
 283         mode-line-buffer-identification
 284                          '(25 . ("%b" reb-mode-string reb-valid-string)))
 285   (reb-update-modestring)
 286   (make-local-variable 'after-change-functions)
 287   (add-hook 'after-change-functions
 288             'reb-auto-update)
 289   ;; At least make the overlays go away if the buffer is killed
 290   (make-local-variable 'reb-kill-buffer)
 291   (add-hook 'kill-buffer-hook 'reb-kill-buffer)
 292   (reb-auto-update nil nil nil))
 293
 294
 295 ;; Handy macro for doing things in other windows
 296 (defmacro reb-with-current-window (window &rest body)
 297   "With WINDOW selected evaluate BODY forms and reselect previous window."
 298
 299   (let ((oldwindow (make-symbol "*oldwindow*")))
 300     `(let ((,oldwindow (selected-window)))
 301        (select-window ,window)
 302        (unwind-protect
 303            (progn
 304              ,@body)
 305          (select-window ,oldwindow)))))
 306 (put 'reb-with-current-window 'lisp-indent-function 0)
 307
 308 (defun reb-color-display-p ()
 309   "Return t if display is capable of displaying colors."
 310   (eq 'color
 311       ;; emacs/xemacs compatibility
 312       (if (fboundp 'frame-parameter)
 313           (frame-parameter (selected-frame) 'display-type)
 314         (frame-property (selected-frame) 'display-type))))
 315
 316 (defsubst reb-lisp-syntax-p ()
 317   "Return non-nil if RE Builder uses a Lisp syntax."
 318   (memq reb-re-syntax '(lisp-re sregex)))
 319
 320 (defmacro reb-target-binding (symbol)
 321   "Return binding for SYMBOL in the RE Builder target buffer."
 322   `(with-current-buffer reb-target-buffer ,symbol))
 323
 324
 325 ;;;###autoload
 326 (defun re-builder ()
 327   "Call up the RE Builder for the current window."
 328   (interactive)
 329
 330   (if reb-target-buffer
 331       (reb-delete-overlays))
 332   (setq reb-target-buffer (current-buffer)
 333         reb-target-window (selected-window)
 334         reb-window-config (current-window-configuration))
 335   (select-window (split-window (selected-window) (- (window-height) 4)))
 336   (switch-to-buffer (get-buffer-create reb-buffer))
 337   (erase-buffer)
 338   (reb-insert-regexp)
 339   (goto-char (+ 2 (point-min)))
 340   (cond
 341    ((reb-lisp-syntax-p)
 342     (reb-lisp-mode))
 343    (t (reb-mode))))
 344
 345
 346 (defun reb-force-update ()
 347   "Forces an update in the RE Builder target window without a match limit."
 348   (interactive)
 349
 350   (let ((reb-auto-match-limit nil))
 351     (reb-update-overlays
 352      (if reb-subexp-mode reb-subexp-displayed nil))))
 353
 354 (defun reb-quit ()
 355   "Quit the RE Builder mode."
 356   (interactive)
 357
 358   (setq reb-subexp-mode nil
 359         reb-subexp-displayed nil)
 360   (reb-delete-overlays)
 361   (bury-buffer)
 362   (set-window-configuration reb-window-config))
 363
 364 (defun reb-next-match ()
 365   "Go to next match in the RE Builder target window."
 366   (interactive)
 367
 368   (reb-assert-buffer-in-window)
 369   (reb-with-current-window
 370     reb-target-window
 371     (if (not (re-search-forward reb-regexp (point-max) t))
 372         (message "No more matches.")
 373       (reb-show-subexp
 374        (or (and reb-subexp-mode reb-subexp-displayed) 0)
 375        t))))
 376
 377 (defun reb-prev-match ()
 378   "Go to previous match in the RE Builder target window."
 379   (interactive)
 380
 381   (reb-assert-buffer-in-window)
 382   (reb-with-current-window reb-target-window
 383     (goto-char (1- (point)))
 384     (if (not (re-search-backward reb-regexp (point-min) t))
 385         (message "No more matches.")
 386       (reb-show-subexp
 387        (or (and reb-subexp-mode reb-subexp-displayed) 0)
 388        t))))
 389
 390 (defun reb-toggle-case ()
 391   "Toggle case sensitivity of searches for RE Builder target buffer."
 392   (interactive)
 393
 394   (with-current-buffer reb-target-buffer
 395     (setq case-fold-search (not case-fold-search)))
 396   (reb-update-modestring)
 397   (reb-auto-update nil nil nil t))
 398
 399 (defun reb-copy ()
 400   "Copy current RE into the kill ring for later insertion."
 401   (interactive)
 402
 403   (reb-update-regexp)
 404   (let ((re (with-output-to-string
 405               (print (reb-target-binding reb-regexp)))))
 406     (kill-new (substring re 1 (1- (length re))))
 407     (message "Regexp copied to kill-ring")))
 408
 409 ;; The subexpression mode is not electric because the number of
 410 ;; matches should be seen rather than a prompt.
 411 (defun reb-enter-subexp-mode ()
 412   "Enter the subexpression mode in the RE Builder."
 413   (interactive)
 414
 415   (setq reb-subexp-mode t)
 416   (reb-update-modestring)
 417   (use-local-map reb-subexp-mode-map)
 418   (message "`0'-`9' to display subexpressions  `q' to quit subexp mode."))
 419
 420 (defun reb-show-subexp (subexp &optional pause)
 421   "Visually show limit of subexpression SUBEXP of recent search.
 422 On color displays this just puts point to the end of the expression as
 423 the match should already be marked by an overlay.
 424 On other displays jump to the beginning and the end of it.
 425 If the optional PAUSE is non-nil then pause at the end in any case."
 426   (reb-with-current-window reb-target-window
 427     (if (not (reb-color-display-p))
 428         (progn (goto-char (match-beginning subexp))
 429                (sit-for reb-blink-delay)))
 430     (goto-char (match-end subexp))
 431     (if (or (not (reb-color-display-p)) pause)
 432         (sit-for reb-blink-delay))))
 433
 434 (defun reb-quit-subexp-mode ()
 435   "Quit the subexpression mode in the RE Builder."
 436   (interactive)
 437
 438   (setq reb-subexp-mode nil
 439         reb-subexp-displayed nil)
 440   (reb-update-modestring)
 441   (use-local-map reb-mode-map)
 442   (reb-do-update))
 443
 444 (defun reb-change-syntax (&optional syntax)
 445   "Change the syntax used by the RE Builder.
 446 Optional argument SYNTAX must be specified if called non-interactively."
 447   (interactive
 448    (list (intern
 449           (completing-read "Select syntax: "
 450                            (mapcar (lambda (el) (cons (symbol-name el) 1))
 451                                    '(read string lisp-re sregex))
 452                            nil t (symbol-name reb-re-syntax)))))
 453
 454   (if (memq syntax '(read string lisp-re sregex))
 455       (let ((buffer (get-buffer reb-buffer)))
 456         (setq reb-re-syntax syntax)
 457         (if buffer
 458             (with-current-buffer buffer
 459               (erase-buffer)
 460               (reb-insert-regexp)
 461               (goto-char (+ 2 (point-min)))
 462               (cond ((reb-lisp-syntax-p)
 463                      (reb-lisp-mode))
 464                     (t (reb-mode))))))
 465     (error "Invalid syntax: %s" syntax)))
 466
 467
 468 ;; Non-interactive functions below
 469 (defun reb-do-update (&optional subexp)
 470   "Update matches in the RE Builder target window.
 471 If SUBEXP is non-nil mark only the corresponding sub-expressions."
 472
 473   (reb-assert-buffer-in-window)
 474   (reb-update-regexp)
 475   (reb-update-overlays subexp))
 476
 477 (defun reb-auto-update (beg end lenold &optional force)
 478   "Called from `after-update-functions' to update the display.
 479 BEG END and LENOLD are passed in from the hook.
 480 An actual update is only done if the regexp has changed or if the
 481 optional fourth argument FORCE is non-nil."
 482   (let ((prev-valid reb-valid-string)
 483         (new-valid
 484          (condition-case nil
 485              (progn
 486                (if (or (reb-update-regexp) force)
 487                    (progn
 488                      (reb-assert-buffer-in-window)
 489                      (reb-do-update)))
 490                "")
 491            (error " *invalid*"))))
 492     (setq reb-valid-string new-valid)
 493     (force-mode-line-update)
 494
 495     ;; Through the caching of the re a change invalidating the syntax
 496     ;; for symbolic expressions will not delete the overlays so we
 497     ;; catch it here
 498     (if (and (reb-lisp-syntax-p)
 499              (not (string= prev-valid new-valid))
 500              (string= prev-valid ""))
 501         (reb-delete-overlays))))
 502
 503 (defun reb-delete-overlays ()
 504   "Delete all RE Builder overlays in the `reb-target-buffer' buffer."
 505   (if (buffer-live-p reb-target-buffer)
 506     (with-current-buffer reb-target-buffer
 507       (mapcar 'delete-overlay reb-overlays)
 508       (setq reb-overlays nil))))
 509
 510 (defun reb-assert-buffer-in-window ()
 511   "Assert that `reb-target-buffer' is displayed in `reb-target-window'."
 512
 513   (if (not (eq reb-target-buffer (window-buffer reb-target-window)))
 514       (set-window-buffer reb-target-window reb-target-buffer)))
 515
 516 (defun reb-update-modestring ()
 517   "Update the variable `reb-mode-string' displayed in the mode line."
 518   (setq reb-mode-string
 519         (concat
 520          (if reb-subexp-mode
 521              (format " (subexp %s)" (or reb-subexp-displayed "-"))
 522            "")
 523          (if (not (reb-target-binding case-fold-search))
 524              " Case"
 525            "")))
 526   (force-mode-line-update))
 527
 528 (defun reb-display-subexp (&optional subexp)
 529   "Highlight only subexpression SUBEXP in the RE Builder."
 530   (interactive)
 531
 532   (setq reb-subexp-displayed
 533         (or subexp (string-to-int (format "%c" last-command-char))))
 534   (reb-update-modestring)
 535   (reb-do-update reb-subexp-displayed))
 536
 537 (defun reb-kill-buffer ()
 538   "When the RE Builder buffer is killed make sure no overlays stay around."
 539
 540   (if (member major-mode '(reb-mode reb-lisp-mode))
 541       (reb-delete-overlays)))
 542
 543
 544 ;; The next functions are the interface between the regexp and
 545 ;; its textual representation in the RE Builder buffer.
 546 ;; They are the only functions concerned with the actual syntax
 547 ;; being used.
 548 (defun reb-read-regexp ()
 549   "Read current RE."
 550   (save-excursion
 551     (cond ((eq reb-re-syntax 'read)
 552            (goto-char (point-min))
 553            (read (current-buffer)))
 554           ((eq reb-re-syntax 'string)
 555            (goto-char (point-min))
 556            (re-search-forward "\"")
 557            (let ((beg (point)))
 558              (goto-char (point-max))
 559              (re-search-backward "\"")
 560              (buffer-substring-no-properties beg (point))))
 561           ((reb-lisp-syntax-p)
 562            (buffer-string)))))
 563
 564 (defun reb-empty-regexp ()
 565   "Return empty RE for current syntax."
 566   (cond ((reb-lisp-syntax-p) "'()")
 567         (t "")))
 568
 569 (defun reb-insert-regexp ()
 570   "Insert current RE."
 571
 572   (let ((re (or (reb-target-binding reb-regexp)
 573                 (reb-empty-regexp))))
 574   (cond ((eq reb-re-syntax 'read)
 575          (print re (current-buffer)))
 576         ((eq reb-re-syntax 'string)
 577          (insert "\n\"" re "\""))
 578         ;; For the Lisp syntax we need the "source" of the regexp
 579         ((reb-lisp-syntax-p)
 580          (insert (or (reb-target-binding reb-regexp-src)
 581                      (reb-empty-regexp)))))))
 582
 583 (defun reb-cook-regexp (re)
 584   "Return RE after processing it according to `reb-re-syntax'."
 585   (cond ((eq reb-re-syntax 'lisp-re)
 586          (lre-compile-string (eval (car (read-from-string re)))))
 587         ((eq reb-re-syntax 'sregex)
 588          (apply 'sregex (eval (car (read-from-string re)))))
 589         (t re)))
 590
 591 (defun reb-update-regexp ()
 592   "Update the regexp for the target buffer.
 593 Return t if the (cooked) expression changed."
 594   (let* ((re-src (reb-read-regexp))
 595          (re (reb-cook-regexp re-src)))
 596     (with-current-buffer reb-target-buffer
 597       (let ((oldre reb-regexp))
 598         (prog1
 599             (not (string= oldre re))
 600           (setq reb-regexp re)
 601           ;; Only update the source re for the lisp formats
 602           (if (reb-lisp-syntax-p)
 603               (setq reb-regexp-src re-src)))))))
 604
 605
 606 ;; And now the real core of the whole thing
 607 (defun reb-count-subexps (re)
 608   "Return number of sub-expressions in the regexp RE."
 609
 610   (let ((i 0) (beg 0))
 611     (while (string-match "\\\\(" re beg)
 612       (setq i (1+ i)
 613             beg (match-end 0)))
 614     i))
 615
 616
 617 (defun reb-update-overlays (&optional subexp)
 618   "Switch to `reb-target-buffer' and mark all matches of `reb-regexp'.
 619 If SUBEXP is non-nil mark only the corresponding sub-expressions."
 620
 621   (let* ((re (reb-target-binding reb-regexp))
 622          (subexps (reb-count-subexps re))
 623          (matches 0)
 624          (submatches 0)
 625          firstmatch)
 626     (save-excursion
 627       (set-buffer reb-target-buffer)
 628       (reb-delete-overlays)
 629       (goto-char (point-min))
 630       (while (and (re-search-forward re (point-max) t)
 631                   (or (not reb-auto-match-limit)
 632                       (< matches reb-auto-match-limit)))
 633         (if (= 0 (length (match-string 0)))
 634           (error "Empty regular expression!"))
 635         (let ((i 0))
 636           (setq matches (1+ matches))
 637           (while (<= i subexps)
 638             (if (and (or (not subexp) (= subexp i))
 639                      (match-beginning i))
 640                 (let ((overlay (make-overlay (match-beginning i)
 641                                              (match-end i)))
 642                       (face-name (format "reb-match-%d" i)))
 643                   (if (not firstmatch)
 644                       (setq firstmatch (match-data)))
 645                   (setq reb-overlays (cons overlay reb-overlays)
 646                         submatches (1+ submatches))
 647                   (overlay-put
 648                    overlay 'face
 649                    (or (intern-soft face-name)
 650                        (error "Too many subexpressions - face `%s' not defined"
 651                               face-name )))
 652                   (overlay-put overlay 'priority i)))
 653             (setq i (1+ i))))))
 654     (let ((count (if subexp submatches matches)))
 655       (message"%s %smatch(es)%s"
 656                (if (= 0 count) "No" (int-to-string count))
 657                (if subexp "subexpression " "")
 658                (if (and reb-auto-match-limit
 659                         (= reb-auto-match-limit count))
 660                    " (limit reached)" "")))
 661     (if firstmatch
 662         (progn (store-match-data firstmatch)
 663                (reb-show-subexp (or subexp 0))))))
 664
 665 ;;; re-builder.el ends here