;;convert-one-def
;; do-var

(defvar *subs*  '((?A . ?*)(?_ . ?-)(?P . ?+))) 
(defun mysub (x)
  (let ((i (length x))tem)
    (while (>= (setq i (- i 1)) 0)
      (setq tem (cdr (assoc (aref x i) *subs*)))
      (if tem (aset x i tem)))
    x))
      
(defun defu (x)
  (interactive "sc function name: ")
  (insert "DEFUN(\"")
  (let (pack name beg)
  (cond ((eql (aref  x 1) ?L)
	 (setq pack "LISP"))
	((eql (aref x 1 ) ?S)
	 (setq pack "SI"))
	(t (barf)))
  (setq name (upcase (mysub (substring x 2 nil))))
  (insert name "\",object," x "," pack ",0,0,NONE,OO,OO,OO,OO,\"\")")
  ))

(defun insert-vararg-preamble ()
  (interactive)
  (let (min beg)
  (beginning-of-line)
  (looking-at "DEFUN")
  (save-excursion
    (search-forward "(")
    (forward-sexp 5)(forward-sexp -1)
    (setq min (string-to-int (buffer-substring (point) (+ (point) 3)))) 
    (forward-sexp 1)(forward-sexp -1)
    (setq max (string-to-int (buffer-substring (point) (+ (point) 3)))) 
    )
  (forward-sexp 3)
  (forward-char -1)
  (insert
   (if (eql (char-after (- (point) 1)) ?\( ) "" ",")
   "va_alist")
  (search-forward "\n{" )
  (forward-char -1)
  (open-line 1)
  (insert "va_dcl")
  (search-forward "\n{" )
  (let ((n (read-string "name for n : " "n"))
	(vars (read-minibuffer "names for args: "))
	defaults
	(beg (point))
	)
    (insert "\tint " n "=VFUN_NARGS;")
    (setq vars (mapcar 'symbol-name vars))
    (let ((tem vars))
      (while tem
	(insert "\nobject " (car tem) ";")
	(setq tem (cdr tem)))
      (setq tem vars)
      (insert "\nva_list ap;\n{ va_start(ap);\n")
      (let ((i (+ min 1)))
      (while tem
	(setq defaults (cons (format "LDEFAULT%d" i) defaults))
	(insert " if (" n
		(format ">=%d) " i)
		(car tem) "=va_arg(ap,object);else goto "
		(car defaults)";\n")
	(setq i (+ i 1))
	(setq tem (cdr tem)))
      (insert " goto LEND_VARARG;\n")
      (setq tem vars)
      (setq defaults (nreverse defaults))
      (while tem
	(insert " "(car defaults) ": " (car tem) " = Cnil;\n")
	(setq tem (cdr tem)) (setq defaults (cdr defaults)))
      (insert " LEND_VARARG: va_end(ap);}\n"))
      (c-indent-region beg (point))
      vars))))
  
  
      

(defun get-name-from-point ()
  (beginning-of-line)
  (let (name)
  (save-excursion
    (cond ((looking-at "\\(siL\\|L\\)\\([a-zA-Z0-9_]*\\)")
	   (setq name (buffer-substring (match-beginning 2)
					(match-end 2)))

	   (concat (if (looking-at "si") "fS"
		     "fL")
		   name))))))

;(grep "grep -n '^siL[a-zA-Z_]*()' *.c *.d")
;(grep "grep -n '^L[a-zA-Z_]*()' *.c *.d")
;(grep "grep -n 'make_keywo' *.c *.d")
;(setq-default case-fold-search nil)
;(let (case-fold-search case-replace)(tags-query-replace "\\b[K]\\([a-z]\\)" "sK\\1"))
;(let (case-fold-search case-replace)  (tags-query-replace "\\([^a-zA-Z_]\\)[S]\\([a-z]\\)" "\\1sL\\2"))
;(query-replace-regexp "\\([^a-zA-Z_]\\)[S]\\([a-z]\\)" "\\1sL\\2" nil)
;(setq-default case-fold-search nil)

(defun defo (&optional x n max)
  (interactive)
  (beginning-of-line)
  (let ((old-name (buffer-substring (point)
			      (save-excursion
				(forward-sexp 1)(point)))))
  (or x (setq x (read-string "C function name: "
			     (get-name-from-point))))
  (insert "DEFUNO(\"")
  (let (pack name)
  (cond ((eql (aref  x 1) ?L)
	 (setq pack "LISP"))
	((eql (aref x 1 ) ?S)
	 (setq pack "SI"))
	(t (barf)))
  (setq name (upcase (mysub (substring x 2 nil))))
  (insert name "\",object," x "," pack
	  (format "\n   ,%d,%d" (or n 0) (or max n 0))
	  ",NONE,OO,OO,OO,OO," old-name
	  ",\"\")")
  )
  old-name))

(defvar end-def (make-marker))
(setq standard-args '(x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12))

(defun convert-one-def ()
  (interactive)
  (make-local-variable 'version-control)
  (setq version-control t)
  (let ((here (point)) old-name)
    (mark-c-function)
    (let ((end (region-end)) n max)
      (set-marker end-def end)
      (save-restriction
	(narrow-to-region (region-beginning) (region-end))
	(save-excursion
	  (cond ((re-search-forward "check_arg(\\([0-9]+\\));" end t)
		 (setq n (string-to-int
			  (buffer-substring (match-beginning 1)
					    (match-end 1))))
		 (delete-region (match-beginning 0)
				(match-end 0))
		 (insert (format "/* %d args */" n)))
		((or (re-search-forward
	  	"if (vs_top - vs_base < \\([0-9]+\\))[ \t\n]+too_few_arguments();[ \t\n]+if (vs_top - vs_base > \\([0-9]+\\))[ \t\n]+too_many_arguments();" nil t)
		     (re-search-forward "CHECK_ARG_RANGE(\\([0-9]+\\),\\([0-9]+\\));" nil t))
		 (setq n (string-to-int
			  (buffer-substring (match-beginning 1)
					    (match-end 1))))
		 (setq max (string-to-int
			  (buffer-substring (match-beginning 2)
					    (match-end 2))))
		 
		 (delete-region (match-beginning 0)
				(match-end 0))
		 (insert (format "CHECK_ARG_RANGE(%s,%s);" n max))
		))
	(goto-char here)
	(setq old-name (defo nil n max))
	(kill-sexp 1)
	(search-forward "(")
	(or n (setq n 0))
	(let ((i 0) (args "") ok
	      (standard-args standard-args)
	      new)
	  (while (< i  n)
	    (setq new (cons (car standard-args) new))
	    (setq standard-args (cdr standard-args))
	    (setq i (+ i 1)))
	  (setq new (reverse new))
	  (save-excursion
	    (while (not ok)
	      (setq standard-args
		    (read-minibuffer "New args: " (format "%s" new)))
	      (setq ok t)
	      (setq standard-args (mapcar 'symbol-name standard-args))
	      (setq i 0)
	      (while (and ok (< i n))
		(setq args (format "%s%s" args (nth i standard-args)))
		(while (search-forward (nth i standard-args) nil t)
		  (message "conflict %s? space for ok" (nth i standard-args))
		  (cond ((member (read-char) '(?y ?\  )))
			(t (setq ok nil))))
		(setq i (+ i 1))
		(if (< i n) (setq args (concat args ","))))
	      ))
	  
	  (insert args)
	  (forward-line 1)
	  (beginning-of-line)
	  (and standard-args (insert "object " args ";\n"))
	  (cond (max
		 (save-excursion
		   (search-backward "\nDEFUN")
		   (forward-char 1)
		   (setq standard-args
			 (append standard-args
				 (insert-vararg-preamble))))))
	  (goto-char (point-min))
	  (while (re-search-forward 
		  "\\(vs_base\\|base\\)[[]\\([0-9]+\\)[]]" nil t)
	    (let ((m (string-to-int (buffer-substring (match-beginning 2)
						      (match-end 2)))))
	      (cond ((and (nth m standard-args)
			  (my-y-or-n-p (format "replace-> %s" (nth m standard-args))))
		     (delete-region (match-beginning 0)
				    (match-end 0))
		     (insert (nth m standard-args))))))
	  (goto-char (point-max))
	  (search-backward "}")
	  (open-line 1)
	  (insert "RETURN1(" (or (nth 0 standard-args) "vs_base[0]") ");")
	  (c-indent-command)
	  (goto-char here)
	  (widen)
	  (save-excursion
	    (goto-char (point-max))
	    (cond ((search-backward old-name nil t)
		  (cond ((my-y-or-n-p "Delete line?")
			 (beginning-of-line)
			 (delete-region (point)
					(progn (forward-line 1)  (point)))
			 (sit-for 1)
			 )
			
			))))
	  ))))))

(defun next-sexp ()
  (let (beg)
    (forward-sexp 1)
    (forward-sexp -1)
    (setq beg (point))
    (forward-sexp 1)
    (buffer-substring beg (point))))

(defun mangle-string (v)
  (let ((beg (point)) end ans)
    (insert v)
    (setq end (point))
    (downcase-region beg end)
    (do-replace '(("[*]" "A")
		  ("[---]" "_")
		  ("[+]" "Q")
		  ("[*]" "A")
		  ("[%]" "P")
		  ("[;]" "X")
		  ("[.]" "Z")
		  ("[,]" "Y")
		  ("[]" "E")
		  ("[@]" "B")
		  
		  ) beg end)
    (setq ans (buffer-substring beg end))
    (delete-region beg end)
    ans
    ))

(defun do-replace (lis &optional beg end)
  (save-excursion
    (let ((ma (make-marker)))
      (set-marker ma (or end (point-max)))
      (setq beg (or beg (point-min)))
      (while lis
	(goto-char beg)
	(setq x (car lis) ) (setq lis (cdr lis))
	(while (re-search-forward (car x) ma t)
	  (replace-match (nth 1 x)   t)))
      (set-marker ma nil))))

(defun do-var ()
  (interactive)
  (let (na beg old (m (make-marker)))
    (save-excursion
      (setq beg (point))
      (setq old (next-sexp))
      (cond ((search-forward "(\"" nil t)
	     (setq pt (point))
	     (forward-char -1)
	     (setq na (next-sexp))
	     (cond ((looking-at ")"))
		   (t
		    (forward-sexp 1)
		    (forward-sexp -1)
		    (setq val (buffer-substring (point)
						(progn (search-forward ");")
						       (- (point) 2))))
		    ;(setq val (next-sexp))
		    ))))
      (let ((pack "L"))
	(goto-char beg)
	(cond ((search-forward "make_si" pt t)
	       (setq pack "S"))
	      ((search-forward "make_keyw" pt t)
	       (setq pack "K")
	      ))
	(setq na  (concat "s" pack
			  (mangle-string (substring na 1 (- (length na) 1)))))
	(goto-char beg)
	(open-line 1)
	(defva na val)
	)
      
      )
  (set-marker m (point))
  (save-excursion
    (search-forward ");" nil t)
    (delete-region m (point)))
  (let ((buf (current-buffer)))
    (unwind-protect
	(cond ((and (not (equal old na))
		(y-or-n-p (format "Replace %s--> %s :" old na)))
	       (goto-char (point-min))
	       (tags-query-replace old na nil)))
    (switch-to-buffer buf)
    (goto-char m)
    (set-marker m nil)
))))
 

	

(defun my-y-or-n-p (string)
  (message (format "%s (Y or Space for yes): " string))
  (member (read-char)  '(?y ?\ )))
  

(defun defva (x &optional val)
  (interactive "sc Variable name: ")
  (let (pack name special)
  (cond ((eql (aref  x 1) ?L)
	 (setq pack "LISP"))
	((eql (aref x 1 ) ?S)
	 (setq pack "SI"))
	((eql (aref x 1 ) ?K)
	 (setq pack "KEYWORD"))
	(t (barf)))
  (cond ((eql (aref x 2) ?A)
	 (setq special t)))
  (insert (if special "DEFVAR(\"" "DEF_ORDINARY(\""))
  (setq name (upcase (mysub (substring x 2 nil))))
  (insert name "\"," x "," pack)
  (if special (insert "," (or val  "sLnil")))
  (insert ",\"\");")
;  (insert "\n#define " x " S" (substring x 2 nil)) 

  ))

;(tags-search "BEGIN_NO_INTERRUPT")
(global-set-key "\C-x'" 'check-interrupt)
(global-set-key "\C-xp" '(lambda()(interactive) (insert "END_NO_INTERRUPT;")))
(global-set-key "\C-xa"
		'(lambda()(interactive) (insert "{BEGIN_NO_INTERRUPT;")
		   (save-excursion (beginning-of-line) (forward-sexp 1) (insert "}"))))
		   
(defun check-interrupt ( )
  (interactive)
  (let (found at (bil (make-marker)) (ok t))
  (forward-sexp -1)
  (setq at (point))
  (mark-c-function)
  (goto-char at)
  (set-marker bil (region-end))
  (while (and ok (re-search-forward "\\(return\\)\\|\\(END_NO_INTERRUPT\\)"
			    bil t))
    (cond ((match-beginning 1)
	   (setq found t)
	   (if (my-y-or-n-p "replace?")
	       (replace-match "goto END_INTER " t)))
	  ((match-beginning 2)
	   (setq ok nil)
	   (if (and found (my-y-or-n-p "replace?"))
	       (replace-match "END_INTER: END_NO_INTERRUPT;\n  return " t)))
	  ))
  (set-marker bil nil)
  (or found (message "was ok"))
  (if ok (message "problem"))
  ))
		
  

(defun foo()
  (interactive)
  (let (p tem)
    (end-of-line)
    (setq p (point))
    (forward-sexp -1)
    (forward-char 1)
    (setq tem (buffer-substring (point) p))
    (save-excursion
      (set-buffer (get-buffer "usig2.c<2>"))
      (insert "\t&" tem ",\n"))
    (forward-line 1)))
  
(defun fa ()
  (interactive)
  (let (p tem)
    (end-of-line)
    (setq p (point))
    (forward-sexp -1)
    (forward-char 1)
    (setq tem (buffer-substring (point) p))
    (grep (concat  "grep -n " tem " o/*.c o/*.d mp/*.c h/*.h "))))

;(let ((case-fold-search nil)) (tags-query-replace "NONE" "VARARG"))

(defun fa ()
  (interactive)
  (re-search-forward "&\\([a-zA-Z0-9_]+\\)," nil t)
  (grep (concat "grep -n " (buffer-substring (match-beginning 1)
					     (match-end 1))
		" ../o/*c ../o/*.d ../h/*.h ../mp/*.c")))

(defun my-grep ()
  (interactive)
  (let (end )
  (save-excursion
    (forward-sexp 1) (setq end (point))
    (forward-sexp -1)
    (let ((tem (buffer-substring (point) end)))
      (setq tem (read-string "Grep: " (concat "grep -n " tem " ../o/*.c ../o/*.d  ../h/*.h ../mp/*.c")))
    (grep tem)))))