;;AUTOLOAD: re-nocase
;;AUTODOC: re-nocase "returns a case-insensitive regexp"
;; (re-nocase string [error-expr])
;;
;; Returns a non case-sensitive regexp pattern from a normal string regexp
;; the returned string is recomp-ed, it can be directly used as a regexp.
;; Example:
;;     kl_.*\.[ch] is transformed into [kK][lL]_.*\.[cChH]
;; If the string is an invalid regexp, returns the result of the evaluation
;; of error-expr. If not specified, returns the string it has built as is,
;; which may be incomplete


(setq re-nocase:alphatab (list))
(dotimes (i 26)
  (put re-nocase:alphatab (+ #\a i) (+ #\A i))
  (put re-nocase:alphatab (+ #\A i) (+ #\a i))
)

(defun re-nocase (case-exp &optional (err :nil) &aux
    (re (copy ""))
    c
    cn
    previous-c
    (state 'main)			;can be: main, multiple, quoted, range
    multiple-negated			;is the current [] a [^]
    multiple-chars			;list of chars in current []
    range-start
  )
  (dolist (c case-exp)
;    (PF "c = \"%0\" (%1), state = %2\n" (String (list c)) c state)
    (if
      (= state 'main) (if		;main state
	(= c #\[)			;enter case
	(progn
	  (setq state 'multiple-start)
	  (setq multiple-negated ())
	  (setq multiple-chars (list))
	)
	
	(getn re-nocase:alphatab c)
	(re-nocase:any-case re c)
	
	(= c #\\)
	(setq state 'quoted)
	
	(put re -1 c)
      )
      
      (= state 'quoted)
      (progn (if
	  (getn re-nocase:alphatab c)	;quote was useless
	  (re-nocase:any-case re c)
	  
	  (progn
	    (put re -1 #\\)
	    (put re -1 c)
	))
	(setq state 'main)
      )	
      
      (= state 'multiple-start) (if	;at the start of a []
	(= c #\^)
	(setq multiple-negated t)
	
	(progn
	  (if (setq cn (getn re-nocase:alphatab c))
	    (put multiple-chars cn cn)
	  )
	  (put multiple-chars c c)
	  (setq state 'multiple)
	)
      )	
      
      (= state 'multiple) (if		;inside [] state
	(= c #\]) (progn
	  (re-nocase:close-multiple re multiple-chars)
	  (setq state 'main)
	)
	
	(= c #\-) (progn
	  (setq range-start previous-c)
	  (setq state 'range)
	)
	
	(progn
	  (if (setq cn (getn re-nocase:alphatab c))
	    (put multiple-chars cn cn)
	  )
	  (put multiple-chars c c)
	)
      )
      
      (= state 'range) (if		;inside a range inside a -
	(= c #\]) (progn		;- was last char, quoted
	  (put multiple-chars #\- #\-)
	  (re-nocase:close-multiple re multiple-chars)
	  (setq state 'main)
	)
	
	(progn
	  (re-nocase:close-range multiple-chars range-start c)
	  (setq state 'multiple)
	)	
      )
    )					;end main state-if
    (setq previous-c c)
  )					;end dolist
  
  ;; if we do not end at toplevel state, expression was badly formed
  (if (/= state 'main)
    (if (/= :nil err)
      (setq re (eval err))
      (if				;default is try to output something
	(= state 'quoted)
	(put re -1 #\\)
	
	(re-nocase:close-multiple re multiple-chars)
    ))

					;ok ==> compile re
    (setq re (regcomp re))
  )
  re
)

(defun re-nocase:any-case (re c)
  (put re -1 #\[)
  (put re -1 c)
  (put re -1 (getn re-nocase:alphatab c))
  (put re -1 #\])
)

(defun re-nocase:close-range (chars start end &aux c cn)
  (if (> start end)
    (with (swap end)
      (setq end start)
      (setq start swap)
  ))
  (dotimes (i (+ (- end start) 1))
    (setq c (+ start i))
    (if (setq cn (getn re-nocase:alphatab c))
      (put chars cn cn)
    )
    (put chars c c)
))

(defun re-nocase:close-multiple (re chars &aux
    (range (list))(i 0) c minus-at-end bra
  )
  (put re -1 #\[)
  (if multiple-negated (put re -1 #\^))

  ;;special cases for ] and -
  (when (getn chars #\])
    (setq bra t)
    (put re -1 #\])
    (put chars  #\] ())
  )
  (when (getn chars #\-)
    (if bra
      (setq minus-at-end t)
      (put re -1 #\-)
    )
    (put chars  #\- ())
  )
  
  (put chars -1 ())			;for proper ending
;  (PF "chars: %0\n" chars)
  
  (dolist (c chars)
    (if c
      (put range -1 c)
      (if range (progn
;	  (PF "range: %0\n" range)
	  (if (> (length range) 3)
	    (progn
	      (put re -1 (get range 0))
	      (put re -1 #\-)
	      (put re -1 (get range -1))
	    )
	    (dolist (j range) (put re -1 j))
	  )
	  (setq range (list))
      ))
    )
  )
  (if minus-at-end (put re -1 #\-))
  (put re -1 #\])
)
