=== modified file 'lisp/emacs-lisp/re-builder.el' --- trunk/lisp/emacs-lisp/re-builder.el 2010-01-13 08:35:10 +0000 +++ patched/lisp/emacs-lisp/re-builder.el 2010-06-04 02:17:08 +0000 @@ -245,6 +245,7 @@ (define-key menu-map [rq] '(menu-item "Quit" reb-quit :help "Quit the RE Builder mode")) + (define-key menu-map [div1] '(menu-item "--")) (define-key menu-map [rt] '(menu-item "Case sensitive" reb-toggle-case :button (:toggle . case-fold-search) @@ -255,6 +256,7 @@ (define-key menu-map [rs] '(menu-item "Change syntax..." reb-change-syntax :help "Change the syntax used by the RE Builder")) + (define-key menu-map [div2] '(menu-item "--")) (define-key menu-map [re] '(menu-item "Enter subexpression mode" reb-enter-subexp-mode :help "Enter the subexpression mode in the RE Builder")) @@ -267,6 +269,7 @@ (define-key menu-map [rp] '(menu-item "Go to previous match" reb-prev-match :help "Go to previous match in the RE Builder target window")) + (define-key menu-map [div3] '(menu-item "--")) (define-key menu-map [rc] '(menu-item "Copy current RE" reb-copy :help "Copy current RE into the kill ring for later insertion")) @@ -343,6 +346,7 @@ (cond ((reb-lisp-syntax-p) (reb-lisp-mode)) (t (reb-mode))) + (reb-restart-font-lock) (reb-do-update)) (defun reb-mode-buffer-p () @@ -370,6 +374,7 @@ (setq reb-window-config (current-window-configuration)) (split-window (selected-window) (- (window-height) 4))))) (switch-to-buffer (get-buffer-create reb-buffer)) + (font-lock-mode 1) (reb-initialize-buffer))) (defun reb-change-target-buffer (buf) @@ -446,7 +451,9 @@ (reb-update-regexp) (let ((re (with-output-to-string (print (reb-target-binding reb-regexp))))) - (kill-new (substring re 1 (1- (length re)))) + (setq re (substring re 1 (1- (length re)))) + (setq re (replace-regexp-in-string "\n" "\\n" re nil t)) + (kill-new re) (message "Regexp copied to kill-ring"))) ;; The subexpression mode is not electric because the number of @@ -482,6 +489,8 @@ (use-local-map reb-mode-map) (reb-do-update)) +(defvar reb-change-syntax-hist nil) + (defun reb-change-syntax (&optional syntax) "Change the syntax used by the RE Builder. Optional argument SYNTAX must be specified if called non-interactively." @@ -490,7 +499,8 @@ (completing-read "Select syntax: " (mapcar (lambda (el) (cons (symbol-name el) 1)) '(read string lisp-re sregex rx)) - nil t (symbol-name reb-re-syntax))))) + nil t (symbol-name reb-re-syntax) + 'reb-change-syntax-hist)))) (if (memq syntax '(read string lisp-re sregex rx)) (let ((buffer (get-buffer reb-buffer))) @@ -657,8 +667,14 @@ (subexps (reb-count-subexps re)) (matches 0) (submatches 0) - firstmatch) + firstmatch + here + firstmatch-after-here) (with-current-buffer reb-target-buffer + (setq here + (if reb-target-window + (with-selected-window reb-target-window (window-point)) + (point))) (reb-delete-overlays) (goto-char (point-min)) (while (and (not (eobp)) @@ -693,6 +709,9 @@ ;; `reb-match-1' must exist. 'reb-match-1)))) (unless firstmatch (setq firstmatch (match-data))) + (unless firstmatch-after-here + (when (> (point) here) + (setq firstmatch-after-here (match-data)))) (setq reb-overlays (cons overlay reb-overlays) submatches (1+ submatches)) (overlay-put overlay 'face face) @@ -707,7 +726,7 @@ (= reb-auto-match-limit count)) " (limit reached)" ""))) (when firstmatch - (store-match-data firstmatch) + (store-match-data (or firstmatch-after-here firstmatch)) (reb-show-subexp (or subexp 0))))) ;; The End @@ -723,6 +742,124 @@ ;; continue standard unloading nil) +(defun reb-fontify-string-re (bound) + (catch 'found + ;; The following loop is needed to continue searching after matches + ;; that do not occur in strings. The associated regexp matches one + ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'. `\\\\' has been included to + ;; avoid highlighting, for example, `\\(' in `\\\\('. + (when (memq reb-re-syntax '(read string)) + (while (re-search-forward + (if (eq reb-re-syntax 'read) + ;; Copied from font-lock.el + "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)" + "\\(\\\\\\)\\(?:\\(\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)") + bound t) + (unless (match-beginning 2) + (let ((face (get-text-property (1- (point)) 'face))) + (when (or (and (listp face) + (memq 'font-lock-string-face face)) + (eq 'font-lock-string-face face) + t) + (throw 'found t)))))))) + +(defface reb-regexp-grouping-backslash + '((t :inherit font-lock-keyword-face :weight bold :underline t)) + "Font Lock mode face for backslashes in Lisp regexp grouping constructs." + :group 're-builder) + +(defface reb-regexp-grouping-construct + '((t :inherit font-lock-keyword-face :weight bold :underline t)) + "Font Lock mode face used to highlight grouping constructs in Lisp regexps." + :group 're-builder) + +(defconst reb-string-font-lock-keywords + (eval-when-compile + '(((reb-fontify-string-re + (1 'reb-regexp-grouping-backslash prepend) + (3 'reb-regexp-grouping-construct prepend)) + (reb-mark-non-matching-parenthesis)) + nil))) + +(defsubst reb-while (limit counter where) + (let ((count (symbol-value counter))) + (if (= count limit) + (progn + (msgtrc "Reached (while limit=%s, where=%s)" limit where) + nil) + (set counter (1+ count))))) + +(defun reb-mark-non-matching-parenthesis (bound) + ;; We have a small string, check the whole of it, but wait until + ;; everything else is fontified. + (when (>= bound (point-max)) + (let ((here (point)) + left-pars + (n-reb 0) + faces-here + ) + (goto-char (point-min)) + (while (and (reb-while 100 'n-reb "mark-par") + (not (eobp))) + (skip-chars-forward "^()") + (unless (eobp) + (setq faces-here (get-text-property (point) 'face)) + ;; It is already fontified, use that info: + (when (or (eq 'reb-regexp-grouping-construct faces-here) + (and (listp faces-here) + (memq 'reb-regexp-grouping-construct faces-here))) + (cond ((eq (char-after) ?\() + (setq left-pars (cons (point) left-pars))) + ((eq (char-after) ?\)) + (if left-pars + (setq left-pars (cdr left-pars)) + (put-text-property (point) (1+ (point)) + 'face 'font-lock-warning-face))) + (t (message "markpar: char-after=%s" (char-to-string (char-after)))))) + (forward-char))) + (dolist (lp left-pars) + (put-text-property lp (1+ lp) + 'face 'font-lock-warning-face))))) + +(require 'rx) +(defconst reb-rx-font-lock-keywords + (let ((constituents (mapcar (lambda (rec) (symbol-name (car rec))) rx-constituents)) + (syntax (mapcar (lambda (rec) (symbol-name (car rec))) rx-syntax)) + (categories (mapcar (lambda (rec) (symbol-name (car rec))) rx-categories))) + `( + (,(concat "(" (regexp-opt (list "rx-to-string") t) "[[:space:]]") + (1 font-lock-function-name-face)) + (,(concat "(" (regexp-opt (list "rx") t) "[[:space:]]") + (1 font-lock-preprocessor-face)) + (,(concat "(category[[:space:]]+" (regexp-opt categories t) ")") + (1 font-lock-variable-name-face)) + (,(concat "(syntax[[:space:]]+" (regexp-opt syntax t) ")") + (1 font-lock-type-face)) + (,(concat "(" (regexp-opt constituents t)) + (1 font-lock-keyword-face)) + ))) + +(defun reb-restart-font-lock () + "Restart `font-lock-mode' to fit current regexp format." + ;;(set-default 'font-lock-keywords nil) + ;;(set-default 'font-lock-set-defaults nil) + (message "reb-restart-font-lock re-re-syntax=%s" reb-re-syntax) + (with-current-buffer (get-buffer reb-buffer) + (let ((font-lock-is-on font-lock-mode)) + (font-lock-mode -1) + (kill-local-variable 'font-lock-set-defaults) + ;;(set (make-local-variable 'reb-re-syntax) 'string) + ;;(set (make-local-variable 'reb-re-syntax) 'rx) + (setq font-lock-defaults + (cond + ((memq reb-re-syntax '(read string)) + reb-string-font-lock-keywords) + ((eq reb-re-syntax 'rx) + '(reb-rx-font-lock-keywords + nil)) + (t nil))) + (when font-lock-is-on (font-lock-mode 1))))) + (provide 're-builder) ;; arch-tag: 5c5515ac-4085-4524-a421-033f44f032e7