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