view release on metacpan or  search on metacpan

lib/Devel/PerlySense/external/emacs/regex-tool.el  view on Meta::CPAN

  :type '(choice
	  (const :tag "Emacs" emacs)
	  (const :tag "Perl" perl))
  :group 'regex-tool)

(defun regex-render-perl (regex sample)
  (with-temp-buffer
    (insert (format "@lines = <DATA>;
$line = join(\" \", @lines);
print \"(\";
while ($line =~ m/%s/mg) {
  print \"(\", length($`), \" \", length($&), \" \";
  for $i (1 .. 20) {
    if ($$i) {
      print \"(\", $i, \" . \\\"\", $$i, \"\\\") \";
    }
  }
  print \")\";
}
print \")\";
__DATA__
%s" regex sample))
   (call-process-region (point-min) (point-max) "perl" t t)
   (goto-char (point-min))
   (read (current-buffer))))

(defvar regex-expr-buffer nil)
(defvar regex-text-buffer nil)
(defvar regex-group-buffer nil)

(defun regex-tool ()
  (interactive)
  (select-frame (make-frame-command))
  (split-window-vertically)
  (split-window-vertically)
  (balance-windows)
  (setq regex-expr-buffer (get-buffer-create "*Regex*"))
  (switch-to-buffer regex-expr-buffer)
  (regex-tool-mode)
  (other-window 1)
  (setq regex-text-buffer (get-buffer-create "*Text*"))
  (switch-to-buffer regex-text-buffer)
  (goto-char (point-min))
  (if (eolp)
      (insert "Hello, this is text your regular expression will match against."))
  (regex-tool-mode)
  (other-window 1)
  (setq regex-group-buffer (get-buffer-create "*Groups*"))
  (switch-to-buffer regex-group-buffer)
  (other-window 1))

(defun regex-tool-markup-text (&optional beg end len)
  (interactive)
  (let ((regex (with-current-buffer regex-expr-buffer
		 (buffer-string)))
	previous-point)
    (when (> (length regex) 0)
      (with-current-buffer regex-group-buffer
	(erase-buffer))
      (with-current-buffer regex-text-buffer
	(remove-overlays)
	(save-excursion
	  (ignore-errors
	    (goto-char (point-min))
	    (if (eq regex-tool-backend 'emacs)
		(while (and (setq previous-point (point))
			    (re-search-forward regex nil t))
		  (if (= (point) previous-point)
		      (forward-char 1)
		    (overlay-put (make-overlay (match-beginning 0)
					       (match-end 0))
				 'face 'regex-tool-matched-face)
		    (dotimes (i 10)
		      (let ((text (match-string i)))
			(if text
			    (save-match-data
			      (with-current-buffer regex-group-buffer
				(goto-char (point-max))
				(insert (format "Group %d: '%s'\n" i text)))))))
		    (with-current-buffer regex-group-buffer
		      (insert ?\n))))
	      (let ((results (regex-render-perl regex (buffer-string))))
		(dolist (result results)
		  (let ((offset (nth 0 result))
			(length (nth 1 result))
			(matches (nthcdr 2 result)))
		    (overlay-put (make-overlay (1+ offset) (+ offset length 1))
				 'face 'regex-tool-matched-face)
		    (let ((match-zero (buffer-substring (1+ offset)
							(+ offset length 1))))
		      (with-current-buffer regex-group-buffer
			(insert (format "Group 0: '%s'\n" match-zero))))
		    (dolist (match matches)
		      (with-current-buffer regex-group-buffer
			(goto-char (point-max))
			(insert (format "Group %d: '%s'\n" (car match)
					(cdr match)))))
		    (with-current-buffer regex-group-buffer
		      (insert ?\n)))))))))
      (with-current-buffer regex-group-buffer
	(goto-char (point-min))))))

(defun regex-tool-quit ()
  (interactive)
  (kill-buffer regex-expr-buffer)
  (kill-buffer regex-text-buffer)
  (kill-buffer regex-group-buffer)
  (delete-frame))

(provide 'regex-tool)

;; regex-tool.el ends here