(require 'latexinfo)

(defun scheme-fmt-hook ()
  (message "Running Scheme formatting hooks...") (sit-for 1)
  (let ((case-fold-search nil)
	(alist scheme-alist))
    (strip-percents)
    (setq alist scheme-delete-list)
    (while alist
      (goto-char (point-min))
      (delete-matching-lines (car alist))
      (setq alist (cdr alist)))

    (setq alist scheme-alist)
    (while alist
      (goto-char (point-min))
      (replace-regexp (car (car alist)) (cdr (car alist)) nil)
      (setq alist (cdr alist))))
  (message "Running Scheme formatting hooks... done.") (sit-for 1)
  )

(setq scheme-alist
      '(
	("{ }" . "{}")
	("{\\\\it " . "\\\\i{")
	("{\\\\tt " . "\\\\code{")
	("{\\\\tt(" . "\\\\code{(")
	("\\\\item \\[" . "\\\\item[")
	("\\\\vest " . "")
	("{\\\\cf " . "\\\\code{")
	("{\\\\em " . "\\\\b{")
	("{\\\\em{}" . "\\\\b{")
	("\\\\verb|#|" . "#")
	("\\\\#{}" . "#")
	("\\\\#" . "#")

	("\\\\nopagebreak{}" . "")
	("\\\\nopagebreak" . "")
	("\\\\unsection{}" . "")
	("\\\\unsection" . "")
	("\\\\unpenalty{}" . "")
	("\\\\unpenalty" . "")
	("\\\\nobreak{}" . "")
	("\\\\nobreak" . "")
	("\\\\rm." . ".")
	
	("\\\\lambdaexp{}" . "lambda expression")
	("\\\\lambdaexp" . "lambda expression")
	("\\\\Lambdaexp{}" . "Lambda expression")
	("\\\\Lambdaexp" . "Lambda expression")
	("\\\\exprtype" . "syntax")
	
	("^\\\\proto{\\(.*\\)}{\\(.*\\)}{\\([^}]*\\)}" .
	 "\\\\head{\\1}{}{\\3}
{(\\\\fb{\\1}\\2)}")

	("^\\\\vproto{\\(.*\\)}{\\([^}]*\\)}" .
	 "\\\\head{\\1}{}{\\2}
{\\\\vb{\\1}}")

	("^\\\\pproto{\\(.*\\)}{\\([^}]*\\)}" .
	 "\\\\head{}{}{\\2}
{\\1}")

	("^\\\\rproto{\\(.*\\)}{\\(.*\\)}{\\(.*\\)}$" .
	 "\\\\head{\\1}{}{\\3}
{(\\\\code{\\1}\\2)}")
	
	("\\\\dotsfoo{}" . "\\\\dots{}")
	("\\\\dotsfoo" . "\\\\dots")

	("\\\\schfalse{}" . "\\\\code{#f}")
	("\\\\schfalse" . "\\\\code{#f}")
	("\\\\schtrue{}" . "\\\\code{#t}")
	("\\\\schtrue" . "\\\\code{#t}")
	("\\\\backquote{}" . "`")
	("\\\\backquote" . "`")
	("\\\\sharpsign" . "#")
	("\\\\verticalbar" . "|")
	))

(setq scheme-delete-list
      '())

(defun strip-percents ()
  (while (search-forward "%" nil t)
    (forward-char -1)
    (if (bobp)
	(kill-line nil)
	(if (save-excursion
	      (forward-char -1)
	      (looking-at "\\\\"))
	    (forward-char 1)
	  (kill-line nil)))))

(put 'meta 'latexinfo-format 'latexinfo-hyper)
(put 'hyper 'latexinfo-format 'latexinfo-hyper)
(defun latexinfo-hyper ()
  (insert "\\var{<" (latexinfo-parse-arg-discard) ">}")
  (goto-char latexinfo-command-start))

(put 'hyperi 'latexinfo-format 'latexinfo-hyperi)
(defun latexinfo-hyperi ()
  (insert "\\var{<" (latexinfo-parse-arg-discard) "-1>}")
  (goto-char latexinfo-command-start))

(put 'hyperii 'latexinfo-format 'latexinfo-hyperii)
(defun latexinfo-hyperii ()
  (insert "\\var{<" (latexinfo-parse-arg-discard) "-2>}")
  (goto-char latexinfo-command-start))

(put 'hyperj 'latexinfo-format 'latexinfo-hyperj)
(defun latexinfo-hyperj ()
  (insert "\\var{<" (latexinfo-parse-arg-discard) "-i>}")
  (goto-char latexinfo-command-start))

(put 'hypern 'latexinfo-format 'latexinfo-hypern)
(defun latexinfo-hypern ()
  (insert "\\var{<" (latexinfo-parse-arg-discard) "-n>}")
  (goto-char latexinfo-command-start))

(put 'vari 'latexinfo-format 'latexinfo-vari)
(defun latexinfo-vari ()
  (insert "\\var{" (latexinfo-parse-arg-discard) "-1}")
  (goto-char latexinfo-command-start))

(put 'varii 'latexinfo-format 'latexinfo-varii)
(defun latexinfo-varii ()
  (insert "\\var{" (latexinfo-parse-arg-discard) "-2}")
  (goto-char latexinfo-command-start))

(put 'variii 'latexinfo-format 'latexinfo-variii)
(defun latexinfo-variii ()
  (insert "\\var{" (latexinfo-parse-arg-discard) "-3}")
  (goto-char latexinfo-command-start))

(put 'variv 'latexinfo-format 'latexinfo-variv)
(defun latexinfo-variv ()
  (insert "\\var{" (latexinfo-parse-arg-discard) "-4}")
  (goto-char latexinfo-command-start))

(put 'varj 'latexinfo-format 'latexinfo-varj)
(defun latexinfo-varj ()
  (insert "\\var{" (latexinfo-parse-arg-discard) "-i}")
  (goto-char latexinfo-command-start))

(put 'varn 'latexinfo-format 'latexinfo-var-n)
(defun latexinfo-var-n ()
  (insert "\\var{" (latexinfo-parse-arg-discard) "-n}")
  (goto-char latexinfo-command-start))

(put 'vr 'latexinfo-format 'latexinfo-vr)
(defun latexinfo-vr ()
  (insert "\\var{" (latexinfo-parse-arg-discard) "}")
  (goto-char latexinfo-command-start))

(put 'vri 'latexinfo-format 'latexinfo-vri)
(defun latexinfo-vri ()
  (insert "\\var{" (latexinfo-parse-arg-discard) "-1}")
  (goto-char latexinfo-command-start))

(put 'vrii 'latexinfo-format 'latexinfo-vrii)
(defun latexinfo-vrii ()
  (insert "\\var{" (latexinfo-parse-arg-discard) "-2}")
  (goto-char latexinfo-command-start))

(put 'vriii 'latexinfo-format 'latexinfo-vriii)
(defun latexinfo-vriii ()
  (insert "\\var{" (latexinfo-parse-arg-discard) "-3}")
  (goto-char latexinfo-command-start))

(put 'vriv 'latexinfo-format 'latexinfo-vriv)
(defun latexinfo-vriv ()
  (insert "\\var{" (latexinfo-parse-arg-discard) "-4}")
  (goto-char latexinfo-command-start))

(put 'vrj 'latexinfo-format 'latexinfo-vrj)
(defun latexinfo-vrj ()
  (insert "\\var{" (latexinfo-parse-arg-discard) "-i}")
  (goto-char latexinfo-command-start))

(put 'vrn 'latexinfo-format 'latexinfo-vr-n)
(defun latexinfo-vr-n ()
  (insert "\\var{" (latexinfo-parse-arg-discard) "-n}")
  (goto-char latexinfo-command-start))

(put 'defining 'latexinfo-format 'latexinfo-defining)
(defun latexinfo-defining ()
  (insert "\\emph{" (latexinfo-parse-arg-discard) "}")
  (goto-char latexinfo-command-start))

(put 'ide 'latexinfo-format 'latexinfo-format-noop)

(put 'mainschindex 'latexinfo-format 'latexinfo-parse-arg-discard)
(put 'mainindex 'latexinfo-format 'latexinfo-parse-arg-discard)
(put 'schindex 'latexinfo-format 'latexinfo-parse-arg-discard)
(put 'sharpindex 'latexinfo-format 'latexinfo-parse-arg-discard)
(put 'index 'latexinfo-format 'latexinfo-parse-arg-discard)

(put 'domain 'latexinfo-format 'latexinfo-format-noop)
(put 'nodomain 'latexinfo-format 'latexinfo-parse-arg-discard)
(put 'todo 'latexinfo-format 'latexinfo-parse-arg-discard)

(put 'ev 'latexinfo-format 'latexinfo-format-ev)

(defun latexinfo-format-ev ()
  (latexinfo-parse-noarg)
  (insert "        => "))

(put 'lev 'latexinfo-format 'latexinfo-format-lev)
(defun latexinfo-format-lev ()
  (latexinfo-parse-noarg)
  (insert "\n    => "))

(put 'unspecified 'latexinfo-format 'latexinfo-format-unspecified)
(defun latexinfo-format-unspecified ()
  (latexinfo-parse-noarg)
  (insert "\\emph{unspecified}")
  (goto-char latexinfo-command-start))

(put 'error 'latexinfo-format 'latexinfo-format-error)
(defun latexinfo-format-error ()
  (latexinfo-parse-noarg)
  (insert "\\emph{error}"))

(put 'schemenoindent 'latexinfo-format 'latexinfo-format-schemenoindent)
(defun latexinfo-format-schemenoindent ()
  (latexinfo-push-stack 'example nil)
  (latexinfo-discard-line))

(put 'schemenoindent 'latexinfo-end 'latexinfo-end-schemenoindent)
(defun latexinfo-end-schemenoindent ()
  (latexinfo-discard-command)
  (let ((stacktop
	 (latexinfo-pop-stack 'example)))
    (latexinfo-do-itemize (nth 1 stacktop))))

(put 'scheme 'latexinfo-format 'latexinfo-format-example)
(put 'scheme 'latexinfo-end 'latexinfo-end-example)

(put 'rationale 'latexinfo-format 'latexinfo-format-rationale)
(put 'rationale 'latexinfo-end 'latexinfo-discard-command)
(defun latexinfo-format-rationale ()
  (latexinfo-discard-line)
  (insert "Rationale: "))

(put 'note 'latexinfo-format 'latexinfo-format-note)
(put 'note 'latexinfo-end 'latexinfo-discard-command)
(defun latexinfo-format-note ()
  (latexinfo-discard-line)
  (insert "Note: "))

(put 'header 'latexinfo-format 'latexinfo-format-header)
(put 'header 'latexinfo-end 'latexinfo-discard-command)
(defun latexinfo-format-header ()
  (save-excursion
    (forward-char 1)
    (forward-sexp 1)
    (delete-char -1))
  (goto-char latexinfo-command-start)
  (delete-region (point) (progn (forward-line 1) (point))))


(put 'evalsto 'latexinfo-format 'latexinfo-format-arrow)
(put 'unsection 'latexinfo-format 'latexinfo-parse-noarg)

(defun latexinfo-format-syntax ()
(put 'syntax 'latexinfo-format 'latexinfo-format-syntax)  
  (latexinfo-parse-noarg)
  (insert "\\b{Syntax:} ")
  (goto-char latexinfo-command-start))

(defun latexinfo-format-semantics ()
(put 'semantics 'latexinfo-format 'latexinfo-format-semantics)  
  (latexinfo-parse-noarg)
  (insert "\\b{Semantics:} ")
  (goto-char latexinfo-command-start))


(defun find-entry (byte)
  (goto-char byte)
  (if (looking-at "(")
      (setq byte (1+ byte)))
  (buffer-substring byte
		    (progn
		      (skip-chars-forward "^\n\b)")
		      (point))))

(put 'modeline 'latexinfo-format 'latexinfo-format-code)

(put 'f 'latexinfo-format 'latexinfo-format-noop)
(put 'v 'latexinfo-format 'latexinfo-format-noop)
(put 'fb 'latexinfo-format 'latexinfo-format-noop)
(put 'vb 'latexinfo-format 'latexinfo-format-noop)
(put 'ide 'latexinfo-format 'latexinfo-format-noop)

