;;; extre.el --- extended regular expression syntax support
;; Copyright (C) 1997 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <lmi@gnus.org>
;; Keywords: util

;; This file is not part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This package adds support for regexps like "foo{0,3}" and stuff.
;; To use it, say (re-search-forward (extended-regexp "foo{0,3}") ...))

;;; Code:

(defvar extended-regexp-syntax-table
  (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
    (modify-syntax-entry ?\\ "w" table)
    table)
  "Syntax table used in article mode buffers.")

(eval-and-compile
  (autoload 'hexl-hex-string-to-integer "hexl")
  (autoload 'hexl-octal-string-to-integer "hexl"))

;;;###autoload
(defmacro extended-regexp (regexp)
  "Translate extended REGEXP into an Emacs Lisp regular expression."
  (if (stringp regexp)
      (extended-regexp-1 regexp)
    `(extended-regexp-1 ,regexp)))

(defun extended-regexp-1 (regexp)
  "Translate extended REGEXP into an Emacs Lisp regular expression."
  (save-excursion
    (set-buffer (get-buffer-create " *extended regexp*"))
    (set-syntax-table extended-regexp-syntax-table)
    (erase-buffer)
    (insert regexp)
    (goto-char (point-min))
    (condition-case ()
	(extended-regexp-parse)
      (quit "Illegal extended regular expression"))))

(defun extended-regexp-parse ()
  "Parse the current (narrowed) buffer."
  (let (re char result subre prev val)
    (while (not (eobp))
      (setq char (following-char))
      (setq
       subre
       (cond
	((= char ?|)
	 (forward-char 1)
	 "\\|")
	((= char ?\[)
	 (prog1
	     (save-restriction
	       (narrow-to-region
		(1+ (point))
		(progn (forward-sexp) (1- (point))))
	       (goto-char (point-min))
	       (prog1
		   (extended-regexp-set-parse)
		 (goto-char (point-max))))
	   (forward-char 1)))
	((= char ?\\)
	 (forward-char 1)
	 (setq char (following-char))
	 (forward-char 1)
	 (cond
	  ;; Special characters that are to have non-special meanings.
	  ((memq char '(?( ?) ?| ?{ ?}))
	   (char-to-string char))
	  ;; Common control characters.
	  ((setq val (assq char '((?n . "\n") (?t . "\t") (?r . "\r")
				  (?a . "\a") (?e . "\e"))))
	   (cdr val))
	  ;; \xAB hex character.
	  ((eq char ?x)
	   (prog1
	       (char-to-string (hexl-hex-string-to-integer
				(buffer-substring (point) (+ (point) 2))))
	     (forward-char 2)))
	  ;; \033 octal character.
	  ((memq char '(?0 ?1 ?2))
	   (prog1
	       (char-to-string (hexl-octal-string-to-integer
				(buffer-substring (1- (point)) (+ (point) 2))))
	     (forward-char 2)))
	  ;; \c[ control character.
	  ((eq char ?c)
	   (prog1
	       (char-to-string (- (following-char) ?@))
	     (forward-char 1)))
	  ;; \d
	  ((eq char ?d)
	   "[0-9]")
	  ;; \D
	  ((eq char ?D)
	   "[^0-9]")
	  ;; Return the quoted character.
	  (t
	   (concat "\\" (char-to-string char)))))
	;; Group open.
	((= char ?\()
	 ;; (?#comment)
	 (if (looking-at "(\\?#")
	     (progn
	       (forward-sexp)
	       "")
	   ;; Ordinary group.
	   (prog1
	       (save-restriction
		 (narrow-to-region (1+ (point))
				   (progn (forward-sexp) (1- (point))))
		 (goto-char (point-min))
		 (concat "\\(" (extended-regexp-parse) "\\)"))
	     (forward-char 1))))
	((= char ?{)
	 (looking-at "{\\([0-9]+\\)?\\(,\\([0-9]+\\)?\\)?}")
	 (goto-char (match-end 0))
	 (cons (if (match-beginning 1) (string-to-number (match-string 1)))
	       (if (match-beginning 2)
		   (if (match-beginning 3) (string-to-number (match-string 3)))
		 (string-to-number (match-string 1)))))
	(t
	 (prog1
	     (char-to-string char)
	   (forward-char 1)))))
      (if (stringp subre)
	  (if prev
	      (push prev result))
	(push (extended-regexp-repeat prev (car subre) (cdr subre)) result)
	(setq subre nil))
      (setq prev subre))
    (when prev
      (push prev result))
    (mapconcat 'identity (nreverse result) "")))

(defun extended-regexp-repeat (regexp min max)
  (let (result)
    (concat
     "\\("
     (cond
      ((null max)
       (concat (extended-regexp-string regexp min) "+"))
      ((or (= min max) (zerop max))
       (extended-regexp-string regexp min))
      (t
       (while (<= min max)
	 (push (extended-regexp-string regexp min) result)
	 (incf min))
       (mapconcat 'identity (nreverse result) "\\|")))
     "\\)")))

(defun extended-regexp-string (string num)
  (mapconcat (lambda (n) string) (make-vector num 0) ""))

(defun extended-regexp-set-parse ()
  "Parse the extended regexp."
  (let (results char)
    (while (not (eobp))
      (setq char (following-char))
      (forward-char 1)
      (push
       (cond
	((eq char ?\\)
	 (setq char (following-char))
	 (forward-char 1)
	 (cond
	  ((eq char ?d)
	   "0-9")
	  ((eq char ?D)
	   "\x00-\x2f\x3a-\xff")
	  (t
	   (concat "\\" (char-to-string char)))))
	(t
	 (char-to-string char)))
       results))
    (concat "[" (mapconcat 'identity (nreverse results) "") "]")))

(provide 'extre)

;;; extre.el ends here