view release on metacpan or  search on metacpan

lisp/re-builder-x.el  view on Meta::CPAN

  (re-search-forward "\"")
  (let ((beg (point)))
    (goto-char (point-max))
    (re-search-backward "\"")
    (buffer-substring-no-properties beg (point))))

(defun reb-string-insert-regexp (default)
  (insert "\n\"" default "\""))

(defun reb-lisp-build-matches (subexp)
  (let ((re reb-regexp)
        (len 0)
        matches)
    (goto-char (point-min))
    (while (and (not (eobp))
                (re-search-forward re (point-max) t)
                (or (not reb-auto-match-limit)
                    (< len reb-auto-match-limit)))
      (if (= 0 (length (match-string 0)))
          (unless (eobp)
            (forward-char 1)))
      (setq len (1+ len))
      (push (nbutlast (match-data t)) matches))
    (nreverse matches)))

;;; Changed function in re-builder

;; FIX FOR: not use hard coded data in function
(defsubst reb-lisp-syntax-p ()
  (eq (car reb-re-builder) 'emacs-lisp))

;; FIX FOR: not use hard coded data in function
(defun reb-change-syntax (&optional syntax)
  "Change the syntax used by the RE Builder.
Optional argument SYNTAX must be specified if called non-interactively."
  (interactive
   (list (intern
          (completing-read "Select syntax: "
                           (mapcar (lambda (el) (cons (symbol-name el) 1))
                                   (apply 'append (reb-all-in-builder :syntax)))
                           nil t (symbol-name reb-re-syntax)))))
  (if (memq syntax (apply 'append (reb-all-in-builder :syntax)))
      (let ((buffer (get-buffer reb-buffer)))
        (setq reb-re-syntax syntax)
        (when buffer
          (with-current-buffer buffer
            (reb-initialize-buffer))))
    (error "Invalid syntax: %s" syntax)))

;; FIX FOR: make kill-buffer-hook local for re-builder buffer
(defun reb-mode-common ()
  "Setup functions common to functions `reb-mode' and `reb-mode-lisp'."
  (setq	reb-mode-string  ""
	reb-valid-string ""
	mode-line-buffer-identification
	                 '(25 . ("%b" reb-mode-string reb-valid-string)))
  (reb-update-modestring)
  (make-local-variable 'after-change-functions)
  (add-hook 'after-change-functions
	    'reb-auto-update)
  ;; At least make the overlays go away if the buffer is killed
  (add-hook 'kill-buffer-hook 'reb-kill-buffer nil t)
  (reb-auto-update nil nil nil))

;; FIX FOR: call :cleaner function
(defun reb-kill-buffer ()
  "When the RE Builder buffer is killed make sure no overlays stay around."
  (when (memq major-mode (reb-all-in-builder :mode))
    (reb-delete-overlays)
    (funcall (or (reb-builder-get reb-re-builder :cleaner) 'ignore))))

;; FIX FOR: call :cleaner function
(defun reb-quit ()
  "Quit the RE Builder mode."
  (interactive)
  (setq reb-subexp-mode nil
        reb-subexp-displayed nil)
  (reb-delete-overlays)
  (funcall (or (reb-builder-get reb-re-builder :cleaner) 'ignore))
  (bury-buffer)
  (set-window-configuration reb-window-config))

;; FIX FOR: call :reader function
(defun reb-read-regexp ()
  "Read current RE."
  (save-excursion
    (cond ((eq reb-re-syntax 'read)
           (progn
             (goto-char (point-min))
             (read (current-buffer))))
          ((reb-lisp-syntax-p)
           (buffer-string))
          (t (funcall (or (reb-builder-get reb-re-builder :reader)
                          'reb-string-read-regexp))))))

;; FIX FOR: call :cooker function
(defun reb-cook-regexp (re)
  "Return RE after processing it according to `reb-re-syntax'."
  (cond ((eq reb-re-syntax 'lisp-re)
         (if (fboundp 'lre-compile-string)
             (lre-compile-string (eval (car (read-from-string re))))))
        ((eq reb-re-syntax 'sregex)
         (apply 'sregex (eval (car (read-from-string re)))))
        ((eq reb-re-syntax 'rx)
         (rx-to-string (eval (car (read-from-string re)))))
        (t (funcall (or (reb-builder-get reb-re-builder :cooker)
                        'identity) re))))

;; FIX FOR: call :inserter function
(defun reb-insert-regexp ()
  "Insert current RE."
  (let ((re (or (reb-target-binding reb-regexp)
                (reb-empty-regexp))))
    (cond ((eq reb-re-syntax 'read)
           (print re (current-buffer)))
          ;; For the Lisp syntax we need the "source" of the regexp
          ((reb-lisp-syntax-p)
           (insert (or (reb-target-binding reb-regexp-src)
                       (reb-empty-regexp))))
          (t (funcall (or (reb-builder-get reb-re-builder :inserter)
                          'reb-string-insert-regexp) re)))))

;;; FIX FOR: call :switcher function
(defun reb-toggle-case ()
  "Toggle case sensitivity of searches for RE Builder target buffer."
  (interactive)
  (with-current-buffer reb-target-buffer
    (setq case-fold-search (not case-fold-search))
    (funcall (or (reb-builder-get reb-re-builder :switcher) 'ignore)))
  (reb-update-modestring)
  (reb-auto-update nil nil nil t))

;; FIX FOR: call :mode function
(defun reb-initialize-buffer ()
  "Initialize the current buffer as a RE Builder buffer."
  (erase-buffer)
  (reb-insert-regexp)
  (setq reb-re-builder (reb-re-builder))
  (goto-char (+ 2 (point-min)))
  (funcall (or (reb-builder-get reb-re-builder :mode) 'reb-mode)))

;; FIX FOR: call :changer function
(defun reb-change-target-buffer (buf)
  "Change the target buffer and display it in the target window."
  (interactive "bSet target buffer to: ")
  (let ((buffer (get-buffer buf)))
    (if (not buffer)
        (error "No such buffer")
      (reb-delete-overlays)
      (setq reb-target-buffer buffer)
      (funcall (or (reb-builder-get reb-re-builder :changer) 'ignore))
      (reb-do-update
       (if reb-subexp-mode reb-subexp-displayed nil))
      (reb-update-modestring))))

;; FIX FOR: call :matcher function
;; Note that `reb-count-subexps' is not needed in this function
(defun reb-update-overlays (&optional subexp)
  "Switch to `reb-target-buffer' and mark all matches of `reb-regexp'.
If SUBEXP is non-nil mark only the corresponding sub-expressions."
  (let ((submatches 0)
        matches firstmatch i max-suffix suffix )
    (save-excursion
      (set-buffer reb-target-buffer)
      (goto-char (point-min))
      (setq matches (funcall (or (reb-builder-get reb-re-builder :matcher)
                                 'reb-lisp-build-matches) subexp))
      (reb-delete-overlays)
      (dolist (match matches)
        (setq i (or subexp 0))
        (while match
          (let ((overlay (make-overlay (car match) (cadr match)))
                ;; When we have exceeded the number of provided faces,
                ;; cycle thru them where `max-suffix' denotes the maximum
                ;; suffix for `reb-match-*' that has been defined and
                ;; `suffix' the suffix calculated for the current match.
                (face
                 (cond
                  (max-suffix
                   (if (= suffix max-suffix)
                       (setq suffix 1)
                     (setq suffix (1+ suffix)))
                   (intern-soft (format "reb-match-%d" suffix)))
                  ((intern-soft (format "reb-match-%d" i)))
                  ((setq max-suffix (1- i))
                   (setq suffix 1)
                   ;; `reb-match-1' must exist.
                   'reb-match-1))))
            (setq reb-overlays (cons overlay reb-overlays)
                  submatches (1+ submatches))
            (overlay-put overlay 'face face)
            (overlay-put overlay 'priority i))
          (setq i (1+ i)
                match (cddr match)))))
    (let ((count (if subexp submatches (length matches))))
      (message "%s %smatch%s%s"
               (if (= 0 count) "No" (int-to-string count))
               (if subexp "subexpression " "")
               (if (= 1 count) "" "es")
               (if (and reb-auto-match-limit
                        (= reb-auto-match-limit count))
                   " (limit reached)" "")))
    (if matches
        (progn (store-match-data
                (append (car matches) (list reb-target-buffer)))
               (reb-show-subexp (or subexp 0))))))

;; FIX FOR: make this command generic
(defun reb-next-match ()
  "Go to next match in the RE Builder target window."
  (interactive)
  (reb-assert-buffer-in-window)
  (with-selected-window reb-target-window
    (let ((face-re (if reb-subexp-mode
                       "^reb-match-[0-9]+$"
                     "^reb-match-0$"))
          (oldpos (point))
          face found)
      (while (and (not found) (not (eobp)))
        (goto-char (next-overlay-change (point)))
        (mapc (lambda (ov)
                (and (not found)
                     (setq face (overlay-get ov 'face))
                     (string-match face-re (symbol-name face))
                     (setq found ov)))
              (overlays-at (point))))
      (if (not found)
          (progn
            (goto-char oldpos)
            (message "No more matches."))
        ;; FIXME: save match data in overlay or just a little hack
        (store-match-data (list (overlay-start found)
                                (overlay-end found)
                                (current-buffer)))
        (reb-show-subexp 0 t)))))

(defun reb-prev-match ()
  "Go to previous match in the RE Builder target window."
  (interactive)
  (reb-assert-buffer-in-window)
  (with-selected-window reb-target-window
    (let ((face-re (if reb-subexp-mode
                       "^reb-match-[0-9]+$"
                     "^reb-match-0$"))
          (oldpos (point))
          face found)
      (while (and (not found) (not (bobp)))
        (goto-char (previous-overlay-change (point)))
        (mapc (lambda (ov)
                (and (not found)
                     (setq face (overlay-get ov 'face))
                     (string-match face-re (symbol-name face))
                     (< (overlay-end ov) oldpos)
                     (setq found ov)))
              (overlays-at (point))))
      (if (not found)
          (progn
            (goto-char oldpos)
            (message "No more matches."))
        ;; FIXME: save match data in overlay or just a little hack
        (store-match-data (list (overlay-start found)
                                (overlay-end found)
                                (current-buffer)))
        (reb-show-subexp 0 t)))))

;;; Regexp Builder for Perl
(defvar reb-perl-coding-system-alist
  '((utf-8 . "utf8")
    (chinese-gbk . "gbk"))
  "Coding system conversion between emacs and perl")
(defvar reb-perl-process nil
  "Process of perl re-builder")
(defvar reb-perl-buffer " reb-perl"
  "Name of the buffer store output of `reb-perl-process'.")
(defvar reb-perl-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map reb-mode-map)
    (define-key map "\C-c\C-a" 'reb-perl-send-buffer)
    map)
  "Keymap used for reb-perl-mode.")
(defvar reb-perl-script
"use Encode qw/decode/;
our ( $buffer, $pattern, $str, %config );
while (<>) {
    chomp( my $cmd = $_ );
    if ( $cmd =~ '^[.] ' ) {
        $str .= substr( $_, 2 );
    }
    elsif ( $cmd eq \"output\" ) {
        display_matches();
    }
    elsif ( $cmd =~ /set\\s+(buffer|pattern)/ ) {
        chomp($str);
        if ( $1 eq \"buffer\" ) {
            $buffer = decode($config{encoding}, $str);
        }
        else {
            $pattern = decode($config{encoding}, $str);
        }
        $str = \"\";
    }
    elsif ( $cmd =~ /set\\s+(limit|subexp|case|encoding)\\s+(\\w+)/ ) {
        if ( $2 eq \"undef\" ) {
            delete $config{$1};
        }
        else {
            $config{$1} = $2;
        }
    }
    elsif ( $cmd eq 'debug' ) {
        print \"String:\\n\", $buffer, \"\\n\",
              \"Pattern: \", $pattern, \"\\n\",
              \"Limit: \", $config{limit} || \"no limit\", \"\\n\",
              \"Subexp: \", (exists $config{limit} ? $config{limit} : \"All\" ), \"\\n\";
    }
}

sub read_until_eof {
    my $s;
    while (<>) {
        $s .= $_;
    }