#!/bin/sh
: ; exec klone $0 "$@"
; The above line finds the klone executable in the $PATH

;;(kdb t)
;;(setq kdb:stream-in (open "/dev/tty"))

(setq files (getopts
    "ifdef-expand [options] files...
physically solves ifdefs given in options in place in files or as an unix
filter if none are given, but only the ones given, leaves the other untouched.
ifdefs are found:
 [1] C-style as ^#[ \t]*ifdef <symbol>
 [2] in comments or else as #*#ifdef
"
    ("-d" symbol defined-symbols "keeps only the text conditioned by this symbol being defined" :multiple t)
    ("-u" symbol undefined-symbols "keeps only the text conditioned by this symbol being undefined" :multiple t)
    ("-e" filename excluded-filenames "excludes (removes) filename from a fshar collection" :multiple t)
    ("-i" filename included-filenames "includes filename into a fshar collection" :multiple t)
))

(defun main (&aux
    (re-interesting (regcomp
	"END_OF_SHAR_FOR_| 2>[/]dev[/]null|chmod a[+]x |^[#]|[#][*][#]"))
    (re-ifdef (regcomp
	"(^[#][ \t]*|[#][*][#])if(def)?[ \t|&!()]+([a-zA-Z_0-9]+)"))
    (re-ifdef:ident 3)
    (re-ifndef (regcomp "(^[#][ \t]*|[#][*][#])ifndef[ \t]+([a-zA-Z_0-9]+)"))
    (re-ifndef:ident 2)
    (re-else (regcomp "(^[#][ \t]*|[#][*][#])else"))
    (re-endif (regcomp "(^[#][ \t]*|[#][*][#])endif"))
    (re-elif (regcomp
	"(^[#][ \t]*|[#][*][#])elif[ \t(]+(defined[(]([a-zA-Z_0-9]+)[)]|([a-zA-Z_0-9]+))"))
    (re-elif:ident 2)
    (re-ifline (regcomp "[#][*][#]if(n?)line[ \t]+([a-zA-Z_0-9]+)"))
    (re-ifline:no 1)
    (re-ifline:ident 2)
    (re-eos-start (regcomp 
	"^cat ([|] funshar -d )?> ([^ ]+) << [\\]END_OF_SHAR_FOR_"))
    (re-eos-start:ident 2)
    (re-eos-end (regcomp "^END_OF_SHAR_FOR_"))
    (re-mkdir (regcomp "^mkdir ([^ ]+) 2>/dev/null$"))
    (re-mkdir:ident 1)
    (re-chmod (regcomp "^chmod a[+]x ([^ ]+)$"))
    (re-chmod:ident 1)
  )
  
  (if files
    (dolist (file files)
      (setq file-new (+ file ".NEW"))
      (if (process-file (open file) 
	  (open file-new :direction :output :if-exists :supersede)
	) 
	(wait (system (list "mv" file-new file))) ;ok, replace
	(wait (system (list "rm" "-f" file-new))) ;no changes, remove
      )
    )
    ;; filter
    (process-file *standard-input* *standard-output*)
  )   
)

;; states is a stack of lists with elements:
;; 0 - current symbol being #if[n]defined
;; 1 - is the current code to be included if symbol (t) or excluded (nil)
;; 2 - before else (t) or after (nil)
;; 3 - current state of printing (stacked)
;; 4 - plist of (lines, what) at which the define started or was else-ed
(setqn state-ident 0 state-yes 1 state-first 2 state-printing 3 state-lines 4)

(defun process-file (fd fdo &aux
    (states (list))
    (printing t)
    print-this-line
    ident
    (lineno 0)
  )
  (while (setq line (read-line fd ()))
    (incf lineno)
    (setq print-this-line t)
    (if (regexec re-interesting line)
      (if
	(regexec re-ifdef line) (progn
	  (setq ident (regsub re-ifdef re-ifdef:ident))
	  (if (= "defined" ident) (progn
	      (setq ident (match "defined[(]([a-zA-Z0-9_]+)[)]" line 1))
	      (if (not ident) (setq ident ""))
	  ))
	  (lappend states (list ident t t printing (list lineno line)))
	  (if (seek defined-symbols ident)
	    (setq print-this-line ())
	    (seek undefined-symbols ident)
	    (setq printing ())
	  )
	)
	(regexec re-elif line) (progn
	  (setq ident (regsub re-elif re-elif:ident))
	  (if (not states) (desynchronization-error "elif at toplevel" ()))
	  (setq state (get states -1))
	  (if (not (get state state-first)) 
	    (desynchronization-error "elif in an else" state))
	  (put state state-ident "")
	  (put state state-yes t)
	  (nconc (get state state-lines) (list lineno line))
	  (if (seek defined-symbols ident)
	    (setqn print-this-line () printing (stacked-printing states))
	    (seek undefined-symbols ident)
	    (setq printing ())
	  )
	)
	(regexec re-ifndef line) (progn
	  (setq ident (regsub re-ifndef re-ifndef:ident))
	  (lappend states (list ident () t printing (list lineno line)))
	  (if (seek undefined-symbols ident)
	    (setq print-this-line ())
	    (seek defined-symbols ident)
	    (setq printing ())
	  )
	)
	(regexec re-else line) (progn
	  (if (not states) (desynchronization-error "else at toplevel" ()))
	  (setq state (get states -1))
	  (setq ident (get state state-ident))
	  (if (not (get state state-first)) 
	    (desynchronization-error "else in an else" state))
	  (put state state-yes (not (get state state-yes)))
	  (nconc (get state state-lines) (list lineno line))
	  (if (get state state-yes)
	    (if (seek defined-symbols ident)
	      (setqn print-this-line () printing (stacked-printing states))
	      (seek undefined-symbols ident)
	      (setq printing ())
	    )
	    (if (seek undefined-symbols ident)
	      (setqn print-this-line () printing (stacked-printing states))
	      (seek defined-symbols ident)
	      (setq printing ())
	    )
	  )
	)
	(regexec re-endif line) (progn
	  (if (not states) (desynchronization-error "endif at toplevel" ()))
	  (setq state (get states -1))
	  (setq ident (get state state-ident))
	  (if (or (seek defined-symbols ident) (seek undefined-symbols ident))
	    (setqn print-this-line () printing (stacked-printing states))
	  )
	  (delete states -1)
	)
	(regexec re-eos-start line) (progn
	  (setq ident (regsub re-eos-start re-eos-start:ident))
	  (if (seek excluded-filenames ident) (progn
	      (setq print-this-line ())
	      (catch 'Done
		(while (setq line (read-line fd ()))
		  (if (regexec re-eos-end line)
		    (throw 'Done)
		))
		(desynchronization-error
		  (+ "EOF inside fshar hunk for " ident) ())
	  )))
	)
	(regexec re-mkdir line) (progn
	  (setq ident (regsub re-mkdir re-mkdir:ident))
	  (if (seek excluded-filenames ident) (progn
	      (setq print-this-line ())
	  ))
	)
	(regexec re-chmod line) (progn
	  (setq ident (regsub re-chmod re-chmod:ident))
	  (if (seek excluded-filenames ident) (progn
	      (setq print-this-line ())
	)))
	(regexec re-ifline line) (progn
	  (setq ident (regsub re-ifline re-ifline:ident))
	  (if (= "" (regsub re-ifline re-ifline:no))
	    (if (seek undefined-symbols ident)
	      (setq print-this-line ())
	    )
	    (if (seek defined-symbols ident)
	      (setq print-this-line ())
	  ))
	  (if print-this-line 
	    (setq line (apply +
		(match "^(.*)[#][*][#]ifn?line[ \t]+[a-zA-Z_0-9]+(.*$)" line
		  1 2)
	  )))
	)
      )
    )
    (if (and printing print-this-line) (write-line line fdo))
  )					;end while
  (if states (desynchronization-error "EOF inside an #ifdef" (get states -1)))
  (add-included-files fdo)
)

(defun add-included-files (fdo &aux
    (temp-file (if (= *machine* 'amiga) "t:ifdef-expand.fshar-in"
	"/tmp/ifdef-expand.fshar-in"
    ))
    (fd (open temp-file :direction :output :if-exists :supersede))
    s
  )
  (dolist (file included-filenames)
    (write-line file fd)
  )
  (close fd)
  (system (+ "fshar < " temp-file) :output 'fd-shar)
  (read-line fd-shar)			;skip first comments
  (read-line fd-shar)
  (setq s (String fd-shar))
  (write-string s fdo)
  (wait (system (list "rm" temp-file)))
)

(defun stacked-printing (states &aux (res t))
  (dolist (state states)
    (if (not (get state state-printing))
      (setq res ())
  ))
  res
)

(defun desynchronization-error (text state)
  (print-format *standard-error*
    "ERROR: #ifdef desynchronized in %0, line %2: %r1\n"
    (if files file "stdin") text lineno
  )
  (if state (progn
      (print-format *standard-error* "Frame defined at lines: \n")
      (dohash (lno l (get state state-lines))
	(print-format *standard-error* "    %0 : %1\n" lno l)
  )))
  (exit 1)
)

(main)

;;; EMACS MODES
;;; Local Variables: ***
;;; mode:lisp ***
;;; End: ***
