;;AUTOLOAD: domatch
;;AUTODOC: domatch "scans all lines in a file one by one for regexps"
;; (domatch (variable stream) case-statements...)
;;
;; domatch is a convenience macro that will read the whole stream, line per 
;; line, and match the line against the given regular expression in the given 
;; order, and execute the forms after the matching regexp. The forms can refer
;; to the matching regular expression by the name given by variable, and the 
;; whole line matched against by domatch:line.
;; The default case can be specified by the string ".*" that will be recognized
;; and handled optimally, but be careful, the variable will be set to () in this
;; case
;; Atoms in forms are supressed so that you can add symbols such as case, :, 
;; etc... for better legibility
;;
;; case-statements can be of the following forms:
;;    regexp-string forms...
;;    regexp-string (forms...)
;; The second form giving better results under indenting editors
;; e.g:
;;    (domatch (re)
;;        "^From: *(.*)$" (
;;            (setq header-name "From")
;;            (setq sender (regsub re 1))
;;        )
;;        "^To: *(.*)$"
;;            (setq sendee (regsub re 1))
;;        ".*"
;;            (store-line domatch:line)
;;    )
;; 
;; () is returned at the end
;; stream can be:
;;    a stream
;;    () or omitted:    *standard-input* is used
;;    a string:         the systems opens the file named by the string and uses
;;                      it as input
;; The form (domatch () forms...) is also accepted, in which case variable is
;; set to the symbol `re'
;;
;; SEE ALSO: doline

(defvar Errors:DoMatch "Bad domatch syntax: %0")

(defmacrod domatch (varlist &rest forms &aux 
    stream
    var 
    (with-decls (list 'domatch:line ())) ;the collected local regexps
    (collected-forms (list))		;the previous forms
    (if-clause (list 'if))		;the main if body
    (varnum 0)				;current N for domatch:N
    (varname (lambda (n) (intern (+ "domatch:" (String n)))))
    (terminator "(")			;an invalid regexp as terminator
  )
  (if (not (and
	(typep varlist List)
	(< (length varlist) 3)
	(or (not varlist) (typep (0 varlist) Symbol))
    ))
    (error 'Errors:BadDoSyntax)
  )
  (setq stream (1 varlist))
  (setq var (0 varlist))
  (if (not var) (setq var 're))
  (if (not stream) (setq stream '*standard-input*)
    (and (typep stream String) (not (typep stream Symbol)))
    (setq stream (open stream))
  )
  
  ;;the expanded forms are :
  ;;(with (domatch:line () domatch:1 (regcomp string1)...)
  ;;  (catch 'EOF
  ;;    (while t (setq domatch:line (read-line stream))
  ;;      (if
  ;;        (regexec domatch:1 domatch:line)(with (variable domatch:1) forms...) 
  ;;        (regexec domatch:2 domatch:line)(with (variable domatch:2) forms...) 
  ;;))
  (setq forms (+ forms (list terminator))) ;to force last iteration
  (dolist (form forms)
    (if (typep form Symbol) ()		;supress toplevel atoms: case, :, ...
      (if (typep form String)		;regexp
	(progn
	  (when (and (/= form ".*") (not (eq form terminator)))
	    (lappend with-decls (varname (+ 1 varnum)))
	    (lappend with-decls `(regcomp ,form))
	  )
	  ;; wrap all previous collected forms
	  (if (= varnum 0)		;first one
	    (if collected-forms
	      (error 'Errors:DoMatch (print-format String 
		  "first form must be a regexp-string, not: %0"
		  (getn collected-forms 0)))
	    )				;rest
	    (with (non-default? (getn with-decls (varname varnum))) ;was not ".*"
	      (if non-default?
		(lappend if-clause 
		  `(regexec ,(varname varnum) domatch:line)
		)
		(lappend if-clause t)	;match all
	      )
	      (if (and			;second form: ( forms ... )
		  (= 1 (length collected-forms))
		  (typep (0 collected-forms) List)
		  (typep (0 (0 collected-forms)) List)
		) 
		(if non-default?
		  (lappend if-clause
		    `(with (,var ,(varname varnum)) ,@(getn collected-forms 0))
		  )
		  (lappend if-clause (if (> (length (getn collected-forms 0)) 1)
		      `(progn ,@(getn collected-forms 0))
		      (getn collected-forms 0)
		  ))
		)
		(if collected-forms	;first form: forms...
		  (if non-default?
		    (lappend if-clause	;some forms given
		      `(with (,var ,(varname varnum)) ,@collected-forms)
		    )
		    (lappend if-clause (if (> (length collected-forms) 1)
			`(progn ,@collected-forms)
			collected-forms)
		    )
		  )
		  (lappend if-clause ()) ;none given
		)
	      )
	    )
	  )
	  (incf varnum)
	  (setq collected-forms (list))
	)
					;form: collect
	(lappend collected-forms form)
    ))
  )					;end dolist
  ;; optims
  (with (l (length if-clause))		;remove t if last clause
    (if (and (> l 3) (eq t (getn if-clause (- l 2))))
      (delete if-clause (- l 2))
  ))
  ;; return expansion
  `(with ,with-decls 
    (catch 'EOF
      (while t 
	(setq domatch:line 
	  ,(if (= stream '*standard-input*) '(read-line) 
	    (list 'read-line stream))
	)
	,if-clause
  )))
)

