;; Convert scribe files to latexinfo.
;; This is an absolutely shameful and indecypherable hack, but it works.
;; Please pretend you never looked in this file.
;; If you have any questions, I'll deny all knowledge of it.

(require 'latexinfo)
(require 'latexnfo-upd)

(defvar scribe-format-syntax-table nil)

(defvar   scribe-to-latex-head
"\\documentstyle[latexinfo,fvpindex,cmulisp,format]{book} % -*-latexinfo-*-
\\pagestyle{headings}

\\begin{document}
\\alwaysrefill

\\comment Delete any of these if you don't want that particular index.
\\newindex{cp}
\\newindex{ky}

")

(defvar scribe-to-latex-tail "\\twocolumn
\\node Function Index, Variable Index, , top
\\unnumbered{Function Index}
\\cindex{Function Index}

\\printindex{fn}

\\twocolumn
\\node Variable Index, Package Index, Function Index, top
\\unnumbered{Variable Index}
\\cindex{Variable Index}

\\printindex{vr}

\\twocolumn
\\node Package Index, Condition Index, Variable Index, top
\\unnumbered{Package Index}
\\cindex{Package Index}

\\printindex{pg}

\\twocolumn
\\node Condition Index, Concept Index, Package Index, top
\\unnumbered{Condition Index}
\\cindex{Condition Index}

\\printindex{ky}

\\onecolumn
\\node Concept Index,  , Variable Index, top
\\unnumbered{Concept Index}
\\cindex{Concept Index}

\\printindex{cp}
\\end{document}
")

(defun scribe-to-latexinfo (arg)
  (interactive "FNew File Name: ")
  (let ((case-fold-search nil)
	(input-buffer (current-buffer)))
    (find-file arg)
    (auto-save-mode -1)
    (erase-buffer)
    (insert-buffer-substring input-buffer)
    (goto-char (point-min))
    (let ((alist scribe-alist))
      (set-syntax-table scribe-format-syntax-table)
      ;; Input the @input files
      (s2l-input-files)
      (s2l-do-alist '(
		      ;; will trash backslashes in verbatim environments
		      ("\\\\" . "\\\\back ") 
		      ("\n\n@\\\\back " . "\n@\\\\")
		      ("@\\\\back " . "@\\\\")))
      ;; Fix the header for LaTeX
      (goto-char (point-min))
      (insert    scribe-to-latex-head)
      (insert "\\setfilename{" (file-name-nondirectory arg) ".info}\n")
      ;; Delete commands you don't want to handle.
      (setq alist scribe-delete-list)
      (while alist
	(goto-char (point-min))
	(delete-matching-lines (car alist))
	(setq alist (cdr alist)))
      ;; get rid of the f cking spaces
      (s2l-do-alist '(
		      ("^@\\([a-zA-Z0-9]+\\) +\\[" . "@\\1[")
		      ("^@\\([a-zA-Z0-9]+\\) +<" . "@\\1<")
		      ("^@\\([a-zA-Z0-9]+\\) +(" . "@\\1(")
		      ))
      (goto-char (point-min))
      (s2l-handle-comments)
      (s2l-handle-environments)
      (s2l-handle-defuns)
      (s2l-do-titlepage)
      (s2l-do-environments)
      (s2l-do-defuns)
      (s2l-do-alist scribe-alist)
      (s2l-do-constants)
      ;; Convert package to LaTeX optional argument format
      (s2l-do-alist '(
		      ("{[ \t\n]*\\\\[pP]ackage{\\([^}]+\\)}[ \t,]*" . 
		       "[\\1]{")
		      ;; Junk the extra argument to defvar .
		      ;; Had thought of using it for default.
		      ("^\\\\defconst\\(.+\\){}" . "\\\\defconst\\1")
		      ("^\\\\defconstx\\(.+\\){}" . "\\\\defconstx\\1")
		      ("^\\\\defvar\\(.+\\){}" . "\\\\defvar\\1")
		      ("^\\\\defvarx\\(.+\\){}" . "\\\\defvarx\\1")))
      ;; Ask about @@ -> @
      (goto-char (point-min))
      (if  (yes-or-no-p
	    "Would you like all occurences of `@@' replaced by `@'? ")
	  (query-replace "@@" "@" nil))
      (goto-char (point-max))
      (insert scribe-to-latex-tail)
      (s2l-format-scan)
      )
    )
  )

(defun s2l-format-scan ()
  (goto-char (point-min))
  (latexinfo-insert-node-lines (point-min) (point-max) t)
  (mark-whole-buffer)
  (latexinfo-sequential-node-update t)
  (latexinfo-all-menus-update)
;;  (latexinfo-master-menu nil)
  )

(setq scribe-alist
      '(
	;;
	("@kwd\\s(:\\([a-z---]+\\)\\s)" . "\\\\kwd{\\1}")
	("@kwd\\s(\\([A-Za-z---]+\\)\\s)" . "\\\\kwd{\\1}")
	("@ux\\s(\\([@a-z--- ]+\\)\\s)" . "\\\\ux{\\1}")
	("@var\\s(\\([*a-z---]+\\)\\s)" . "\\\\v{\\1}")
	("@blankspace\\s(\\([0-9]+\\)[ \t]*lines\\s)" . "\\\\sp{\\1}")
	("@blankspace\\s(\\([0-9.]+\\)[ \t]*inches\\s)" . "\\\\vspace{\\1in}")
	("@blankspace\\s(\\([a-z\t 0-9.]+\\)\\s)" . "\\\\vspace{\\1}")
	("@newpage\\s(\\([0-9]+\\)\\s)" . "\\\\clearpage")

	;; \var
	("@i\\s(\\([a-z---]+\\)\\s)" . "\\\\var{\\1}")
	("@i\"\\([a-z---]+\\)\"" . "\\\\var{\\1}")
	("@i\\s(\\([A-Z][a-z---]+\\)\\s)" . "\\\\var{\\1}")
	("@i\"\\([A-Z][a-z---]+\\)\"" . "\\\\var{\\1}")
	("@I\\s(\\([A-Z---]+\\)\\s)" . "\\\\var{\\1}")
	("@i\\s(:\\([a-z---]+\\)\\s)" . "\\\\kwd{\\1}")
	("@I\\s(:\\([A-Z---]+\\)\\s)" . "\\\\kwd{\\1}")
	("@i\\s(\\([a-z---]+ *[---a-z ]+\\)\\s)" . "\\\\i{\\1}")

	("@f( )" . "\\\\ ")
	;; search list
	("\"@f\\s(\\([a-z][a-z---:.]+\\)\\s)\"" . "\\\\code{\\1}")
	;; Package
	("@f\\s(\"\\([A-Z]+\\)\"\\s)" . "\\\\p{\\1}")
	;; Maybe Internet address
	("@f\\s(\"\\([A-Z.]+\\)\"\\s)" . "\\\\code{\\1}")
	;; Hemlock Command
	("@f\\s(\"\\([A-Za-z--- ]+\\)\"\\s)" . "\\\\F{\\1}")
	("@F\\s(\\([A-Za-z--- ]+\\)\\s)" . "\\\\F{\\1}")
	;; files
	("@f\\s(\"\\(/[a-z---./]+\\)\"\\s)" . "\\\\file{\\1}")
	("\"@f\\s(\\(/[a-z---./]+\\)\\s)\"" . "\\\\file{\\1}")
	("@f\\s(\\(/[a-z---./]+\\)\\s)" . "\\\\file{\\1}")
	("@f\\s(\\(*[*A-Za-z---]+*\\)\\s)" . "\\\\v{\\1}")

	("@f\\s(\\([a-z][a-z---]+\\)\\s)" . "\\\\f{\\1}")
	("@f\\s(\\([A-Z][a-z---]+\\)\\s)" . "\\\\f{\\1}")
	("@f\\s(\\([A-Z][a-z---0-9]+\\)\\s)" . "\\\\f{\\1}")

	("@f\\s(\\([a-z][a-z---:]+\\)\\s)" . "\\\\code{\\1}")
	("@f\\s(\\([A-Za-z][A-Za-z---:]+\\)\\s)" . "\\\\code{\\1}")
	("@f\\s(\\([a-z][a-z---.]+\\)\\s)" . "\\\\file{\\1}")

	;;catch all
	("@f\\[\\([^]]+\\)]" . "\\\\code{\\1}")
	("@f(\\([^)]+\\))" . "\\\\code{\\1}")
	("@f<\\([^>]+\\)>" . "\\\\code{\\1}")
	("@f{\\([^}]+\\)}" . "\\\\code{\\1}")

	;;catch all
	("@i\\[\\([^]]+\\)]" . "\\\\i{\\1}")
	("@I\\[\\([^]]+\\)]" . "\\\\i{\\1}")
	("@i(\\([^)]+\\))" . "\\\\i{\\1}")
	("@i<\\([^>]+\\)>" . "\\\\i{\\1}")
	("@i{\\([^}]+\\)}" . "\\\\i{\\1}")
	("@i\"\\([^\"]+\\)\"" . "\\\\i{\\1}")

	("@b\\s(\\([a-zA-Z?]\\)\\s)" . "\\\\key{\\1}")
	("@b\\s(\\([a-z---]+\\)\\s)" . "\\\\f{\\1}") ; or \v
	("@b\\s(\\([a-z]+\\):\\([a-z---]+\\)\\s)" . "\\\\f{\\1:\\2}")
	("@b\\s(\\([a-zA-Z_. ]+\\)\\s)" . "\\\\b{\\1}")	

	("@b\\[\\([^]]+\\)]" . "\\\\b{\\1}")
	("@b(\\([^)]+\\))" . "\\\\b{\\1}")
	("@b<\\([^>]+\\)>" . "\\\\b{\\1}")
	("@b{\\([^}]+\\)}" . "\\\\b{\\1}")

	("@w\\[\\([^]]+\\)]" . "\\\\w{\\1}")
	("@w(\\([^)]+\\))" . "\\\\w{\\1}")
	("@w<\\([^>]+\\)>" . "\\\\w{\\1}")
	("@w{\\([^}]+\\)}" . "\\\\w{\\1}")

	;; BNF syntax for arguments
	("@mopt(\\([^)]+\\))" . "\\\\mopt{\\1}")
	("@mopt<\\([^>]+\\)>" . "\\\\mopt{\\1}")
	("@mplus(\\([^)]+\\))" . "\\\\mplus{\\1}")
	("@mplus<\\([^>]+\\)>" . "\\\\mplus{\\1}")
	("@mstar(\\([^)]+\\))" . "\\\\mstar{\\1}")
	("@mstar<\\([^>]+\\)>" . "\\\\mstar{\\1}")
	("@mor" . "\\\\mor")

	("@multiple\\[\\([^]]+\\)]" . "\\\\multiple{\\1}")
	("@multiple(\\([^)]+\\))" . "\\\\multiple{\\1}")
	("@multiple<\\([^>]+\\)>" . "\\\\multiple{\\1}")
	("@multiple{\\([^}]+\\)}" . "\\\\multiple{\\1}")

	;; section commands
	("^@[mM]y[cC]hapter\\s(\\([':_a-zA-Z 0-9---]+\\)\\s)" . "\\\\chapter{\\1}")
	("^@[cC]hapter\\s(\\([:'_a-zA-Z 0-9---]+\\)\\s)" . "\\\\chapter{\\1}")
	("^@[Ss]ection\\s(\\(.+\\)\\s)[ \t]*$" . "\\\\section{\\1}")
	("^@[sS]ubsection\\s(\\(.+\\)\\s)[ \t]*$" . "\\\\subsection{\\1}")
	("^@[sS]ubsubsection\\s(\\(.+\\)\\s)[ \t]*$" . "\\\\subsubsection{\\1}")
	("^@[hH]eading\\s(\\(.+\\)\\s)[ \t]*$" . "\\\\paragraph{\\1}")

	;; Indexes
	("@[iI]ndex\\s(\\([A-Za-z--- ]+\\)\\s)" . "\\\\cindex{\\1}")
	("@[iI]ndex\\[\\([\\\\A-Za-z--- (){}]+\\)]" . "\\\\cindex{\\1}")
	("@[iI]ndex\\s(\\([A-Za-z--- ]+\\),[ \t]\\([\\\\{}()A-Za-z--- ]+\\)\\s)" . "\\\\cpsubindex{\\1}{\\2}")
	("@[iI]ndex\\s(\\([A-Za-z0-9(),--- ]+\\)\\s)" . "\\\\cindex{\\1}")
	("@findex\\s(\\([a-z---]+\\)\\s)" . "\\\\findex{\\1}")

	("^@indexentry\\s(key=\\s(\\([a-z---]+\\).*,\n.*\n.*\\s)[ \t]*\n"
	 . "\\\\kindex{\\1}\n")
	("@label\\s(\\([A-Za-z---]+\\)\\s)" . "\\\\label{\\1}")

	("See[ \t\n]+section[ \t\n]@ref\\s(\\([a-z---]+\\)\\s)" . "\\\\xlref{\\1}")
	("see[ \t\n]+section[ \t\n]@ref\\s(\\([a-z---]+\\)\\s)" . "\\\\pxlref{\\1}")
	("(section[ \t\n]@ref\\s(\\([a-z---]+\\)\\s))" . "(\\\\pxlref{\\1})")
	("See[ \t\n]+also[ \t\n]+section[ \t\n]@ref\\s(\\([a-z---]+\\)\\s)" . "\\\\xlref{\\1}")
	("see[ \t\n]+also[ \t\n]+section[ \t\n]@ref\\s(\\([a-z---]+\\)\\s)" . "\\\\pxlref{\\1}")
;;	("See[ \t\n]+sections[ \t\n]@ref\\s(\\([a-z---]+\\)\\s)" . "\\\\xlref{\\1},")
;;	("see[ \t\n]+sections[ \t\n]@ref\\s(\\([a-z---]+\\)\\s)" . "\\\\pxlref{\\1},")

	("@ref\\s(\\([A-Za-z---]+\\)\\s)" . "\\\\ref{\\1}")
	;; The pageref phrase will be wrong.
	("@pageref\\s(\\([A-Za-z---]+\\)\\s)" . "\\\\pageref{\\1}")

	("@funref\\s(\\([A-Za-z---]+\\)\\s)" . "\\\\funref{\\1}")
	("@macref\\s(\\([A-Za-z---]+\\)\\s)" . "\\\\macref{\\1}")
	("@specref\\s(\\([A-Za-z---]+\\)\\s)" . "\\\\specref{\\1}")
	("@varref\\s(\\([A-Za-z---]+\\)\\s)" . "\\\\varref{\\1}")

	("@-" . "\\\\-")
	("@appendix" . "\\\\appendix")
	("{@ }" . "{\\\\ }")
	))

(setq scribe-delete-list  '(
			    "^@Make"
			    "^@commandstring"
			    "^@Pageheading"
			    "^@Pagefooting"
			    "^@Device"
			    "^@Use"
			    "^@Style"
			    "^@Libraryfile"
			    "^@Tabclear"
			    "^@Textform"
			    "^@tabdivide"))

(if scribe-format-syntax-table nil
  (progn
    (setq scribe-format-syntax-table (make-syntax-table))
    (modify-syntax-entry ?\" "\"" scribe-format-syntax-table)
    (modify-syntax-entry ?* "w" scribe-format-syntax-table)
    (modify-syntax-entry ?@ "w" scribe-format-syntax-table)
    (modify-syntax-entry ?\\ "\\" scribe-format-syntax-table)
    (modify-syntax-entry ?\^q "\\" scribe-format-syntax-table)
    (modify-syntax-entry ?\[ "(]" scribe-format-syntax-table)
    (modify-syntax-entry ?\] ")[" scribe-format-syntax-table)
    (modify-syntax-entry ?\( "()" scribe-format-syntax-table)
    (modify-syntax-entry ?\) ")(" scribe-format-syntax-table)
    (modify-syntax-entry ?{ "(}" scribe-format-syntax-table)
    (modify-syntax-entry ?} "){" scribe-format-syntax-table)
    (modify-syntax-entry ?< "(>" scribe-format-syntax-table)
    (modify-syntax-entry ?> ")<" scribe-format-syntax-table)
    (modify-syntax-entry ?\' "." scribe-format-syntax-table)))

(defun s2l-do-alist (alist)
  (let ((case-fold-search nil))
    (set-syntax-table scribe-format-syntax-table)
    (while alist
      (goto-char (point-min))
      (quietly-replace-regexp (car (car alist)) (cdr (car alist)) nil)
      (message "%s" (car (car alist)))
      (setq alist (cdr alist)))
    )
  )

(defun s2l-do-titlepage ()
  (s2l-do-alist 
   '(
     ;; They will probably have to fix the location of the \maketitle
     ("\\\\setfilename{\\(.+\\)}" . "\\\\setfilename{\\1}
\\\\pagestyle{empty}
\\\\date{\\\\today}
\\\\maketitle

\\\\clearpage
\\\\pagestyle{headings}
\\\\pagenumbering{roman}
\\\\tableofcontents

\\\\clearpage
\\\\pagenumbering{arabic}
\\\\node top, ,(dir), (dir)
")
     ("@begin\\[Text,[ \t]*indent[ \t\n]*0\\][ \t\n]*" . "\\\\noindent\n")
     ("@end\\[Text\\][\n]" . "")
     ))
  )

(defun s2l-do-environments ()
  (s2l-do-alist
   '(
     ;; Standard environments
     ("^@[lL]isp" . "\\\\begin{lisp}")
     ("^@[eE]nd[lL]isp" . "\\\\end{lisp}")
     ("^@[bB]egin\\s([eE]xample\\s)" . "\\\\begin{example}")
     ("^@[eE]nd\\s([eE]xample\\s)" . "\\\\end{example}")
     ("^@[bB]egin\\s([iI]\\s)" . "\\\\i{")
     ("^@[eE]nd\\s([iI]\\s)" . "}")
     ("^@[bB]egin\\s([vV]erbatim\\s)" . "\\\\begin{verbatim}")
     ("^@[eE]nd\\s([vV]erbatim\\s)" . "\\\\end{verbatim}")
     ("^@[bB]egin\\s([qQ]uotation\\s)" . "\\\\begin{quote}")
     ("^@[eE]nd\\s([qQ]uotation\\s)" . "\\\\end{quote}")
     ("^@[bB]egin\\s([cC]enter\\s)" . "\\\\begin{center}")
     ("^@[eE]nd\\s([cC]enter\\s)" . "\\\\end{center}")
     ("^@[bB]egin\\s([dD]isplay\\s)" . "\\\\begin{display}")
     ("^@[eE]nd\\s([dD]isplay\\s)" . "\\\\end{display}")
     ("^\\([^\\\\]+\\)@\\\\" . "\\\\item[\\1]\t")
     ("^\\([^\\\\]+\\)\n@\\\\" . "\\\\item[\\1]\t")
     ("^@[bB]egin\\s([pP]rogram[eE]xample\\s)" . "\\\\begin{verbatim}")
     ("^@[eE]nd\\s([pP]rogram[eE]xample\\s)" . "\\\\end{verbatim}")

     ;; Lower-case end catch all
     ("^@[eE]nd\\s(\\([a-z]+\\)\\s)" . "\\\\end{\\1}")
     ("@[eE]nd[dD]effun" "\\\\end{defun}")
     ))
  )

(defun s2l-do-defuns ()
  "Must come after       (s2l-handle-defuns)"
  (s2l-do-alist
   '(
     ;; @def environments
     ;; Name is required.
     ("^@defun{fun \\s(\\([*a-z0-9+---]+\\)\\s)" . "\\\\defun{\\1}{")
     ("^@defun1{fun \\s(\\([*a-z0-9+---]+\\)\\s)" . "\\\\defunx{\\1}{")

     ("^@defmac{fun \\s(\\([*a-z0-9+---]+\\)\\s)" . "\\\\defmac{\\1}{")
     ("^@defmac1{fun \\s(\\([*a-z0-9+---]+\\)\\s)" . "\\\\defmacx{\\1}{")

     ("^@defspec{fun \\s(\\([*a-z0-9+---]+\\)\\s)" . "\\\\defspec{\\1}{")
     ("^@defspec1{fun \\s(\\([*a-z0-9+---]+\\)\\s)" . "\\\\defspecx{\\1}{")

     ("^@defvar{var \\s(\\([*a-z0-9+---]+\\)\\s)" . "\\\\defvar{\\1}{")
     ("^@defvar1{var \\s(\\([*a-z0-9+---]+\\)\\s)" . "\\\\defvarx{\\1}{")

     ("^@defcon{var \\s(\\([*a-z0-9+---]+\\)\\s)" . "\\\\defconst{\\1}{")
     ("^@defcon1{var \\s(\\([*a-z0-9+---]+\\)\\s)" . "\\\\defconstx{\\1}{")
     ("@enddefcon" . "\\\\enddefconst")

     ("@enddef\\([a-z]+\\)" . "\\\\enddef\\1")

     ;; keys
     (",\\([ \t\n]+\\)morekeys[ \t]*" . "\\1\\\\morekeys")
     (",\\([ \t\n]+\\)yetmorekeys[ \t]*" . "\\1\\\\morekeys")

     ))
  )


(defun s2l-do-constants ()
  (s2l-do-alist
   '(
     ("@value\\s([dD]ate\\s)" . "\\\\today")
     ;; constants
     ;; These are totally CMU Lisp specific
     ("@hinge\\." . "\\\\hinge.")
     ("@true\\." . "\\\\true.")
     ("@false\\." . "\\\\false.")	
     ("@FALSE\\." . "\\\\FALSE.")
     ("@hemlock\\." . "\\\\hemlock.")
     ("@Hemlock\\." . "\\\\Hemlock.")
     ("@cmucl\\." . "\\\\cmucl.")
     ("@cltl\\." . "\\\\cltl.")
     ("@Python\\." . "\\\\Python.")
     ("@python\\." . "\\\\python.")
     ("@llisp\\." . "\\\\llisp.")
     ("@Llisp\\." . "\\\\Llisp.")
     ("@clisp\\." . "\\\\clisp.")
     ("@rest\\." . "\\\\&rest.")
     ("@key\\." . "\\\\&key.")
     ("@dash\\." . "\\\\dash.")
     ("@optional\\." . "\\\\&optional.")
     ("@nil\\." . "\\\\nil.")
     ("@Aliens\\." . "\\\\Aliens.")
     ("@Alien\\." . "\\\\Alien.")
     ("@alien\\." . "\\\\alien.")
     ("@hinge," . "\\\\hinge,")
     ("@true," . "\\\\true,")
     ("@false," . "\\\\false,")	
     ("@FALSE," . "\\\\FALSE,")
     ("@hemlock," . "\\\\hemlock,")
     ("@Hemlock," . "\\\\Hemlock,")
     ("@cmucl," . "\\\\cmucl,")
     ("@cltl," . "\\\\cltl,")
     ("@Python," . "\\\\Python,")
     ("@python," . "\\\\python,")
     ("@llisp," . "\\\\llisp,")
     ("@Llisp," . "\\\\Llisp,")
     ("@clisp," . "\\\\clisp,")
     ("@rest," . "\\\\&rest,")
     ("@key," . "\\\\&key,")
     ("@dash," . "\\\\dash,")
     ("@optional," . "\\\\&optional,")
     ("@nil," . "\\\\nil,")
     ("@Aliens," . "\\\\Aliens,")
     ("@Alien," . "\\\\Alien,")
     ("@alien," . "\\\\alien,")
     ("@hinge" . "\\\\hinge{}")
     ("@true" . "\\\\true{}")
     ("@false" . "\\\\false{}")	
     ("@FALSE" . "\\\\FALSE{}")
     ("@hemlock" . "\\\\hemlock{}")
     ("@Hemlock" . "\\\\Hemlock{}")
     ("@cmucl" . "\\\\cmucl{}")
     ("@cltl" . "\\\\cltl{}")
     ("@Python" . "\\\\Python{}")
     ("@python" . "\\\\python{}")
     ("@llisp" . "\\\\llisp{}")
     ("@Llisp" . "\\\\Llisp{}")
     ("@clisp" . "\\\\clisp{}")
     ("@rest" . "\\\\&rest{}")
     ("@key" . "\\\\&key{}")
     ("@dash" . "\\\\dash{}")
     ("@optional" . "\\\\&optional{}")
     ("@nil" . "\\\\nil{}")
     ("@Aliens" . "\\\\Aliens{}")
     ("@Alien" . "\\\\Alien{}")
     ("@alien" . "\\\\alien{}")
     )))


(defun s2l-input-files ()
  (if (and (save-excursion (re-search-forward "^@include" nil t))
	   (yes-or-no-p
	    "Would you like to do the @include files now, to do it all at once?"))
      (while (re-search-forward "^@include" nil t)
	(save-excursion
	  (skip-chars-forward " 	{(")
	  (let ((file-name
		 (buffer-substring 
		  (point)
		  (progn
		    (skip-chars-forward "^ 	)}\n")
		    (point)))))
	    (setq file-name
		  (expand-file-name
		   (if (file-readable-p (expand-file-name file-name))
		       file-name
		     (concat file-name ".ms"))))
	    (beginning-of-line 1)
	    (if (file-readable-p file-name)
		(progn
		  (delete-region (point) (progn (forward-line 1) (point)))
		  (message "Inserting file %s..." file-name) (sit-for 1)
		  (insert "\n@comment{File:" file-name "}\n\n")
		  (insert-file file-name) 
		  (insert "\n\n")	; important for always refill
		  (message "Inserting file %s...done" file-name))
	      (error "I can't find the file %s" file-name))
	    )))))

(defun s2l-handle-comments ()
  (let ((case-fold-search nil))
    (set-syntax-table scribe-format-syntax-table)
    (goto-char (point-min))
    (replace-regexp "@[bB]egin\\s([cC]omment\\s)"  "\\\\begin{ignore}" nil)
    (goto-char (point-min))
    (replace-regexp "@[eE]nd\\s([cC]omment\\s)"  "\\\\end{ignore}" nil)
    (goto-char (point-min))
    (while (re-search-forward "@comment" nil t)
      (replace-match "\\hide" t t)
      (let ((here (point)))
	(forward-list 1)
	(delete-char -1)
	(insert "}")
	;; sometimes after a comment is something usually found at bolp.
	(if (looking-at "@") (insert "\n"))
	(goto-char here)
	(delete-char 1)
	(insert "{")))
    (goto-char (point-min))
    (while (re-search-forward "@foot" nil t)
      (replace-match "\\footnote" t t)
      (let ((here (point)))
	(forward-list 1)
	(delete-char -1)
	(insert "}")
	(goto-char here)
	(delete-char 1)
	(insert "{")))
    ))

(defun s2l-handle-defuns ()
  (let ((case-fold-search nil))
    (set-syntax-table scribe-format-syntax-table)
    (goto-char (point-min))
    (while (re-search-forward "^@def[0-9a-z]+[ \t]*[[(<]" nil t)
      (forward-char -1)
      (let ((here (point))
	    (end (save-excursion (forward-list 1) (point))))
	(goto-char end) (delete-char -1) (insert "}")
	(goto-char here) (delete-char 1)(insert "{")
	(narrow-to-region here end)
	(goto-char (point-min))
	(if (re-search-forward "fun[ \t]+\"\\([a-z---]+\\)\"" nil t)
	    (replace-match "fun {\\1}"))
	(goto-char (point-min))
	(while (re-search-forward ",\\([ \t\n]*\\)\\([pP]ackage\\|args\\|keys\\|morekeys\\|yetmorekeys\\)[ \t]*" nil t)
	  (replace-match "\\1\\\\\\2")
	  (skip-chars-forward " \t\n")
	  (let ((here (point))
		(end (save-excursion 
		      (forward-sexp 1) (point))))
	    (goto-char end) (delete-char -1) (insert "}")
	    (goto-char here) (delete-char 1)(insert "{"))
	  )
	(goto-char (point-min))
	(quietly-replace-string "keys{[" "keys{:" nil)
	(goto-char (point-min))
	(quietly-replace-string "][" " :" nil)
	(goto-char (point-min))
	(replace-regexp "keys{:\\([^]]+\\)]}" "keys{:\\1}" nil)
	(goto-char (point-min))
	(quietly-replace-string "keys{<" "keys{:" nil)
	(goto-char (point-min))
	(quietly-replace-string "><" " :" nil)
	(goto-char (point-min))
	(replace-regexp "keys{:\\([^>]+\\)>}" "keys{:\\1}" nil)
	(widen)
	))
    (goto-char (point-min))
    ))

(defun s2l-handle-environments ()
  (let ((case-fold-search nil))
    (set-syntax-table scribe-format-syntax-table)
    (goto-char (point-min))
    (while (re-search-forward "^@[cC]enter" nil t)
      (replace-match "\\begin{center}\n" t t)
      (let ((here (point)))
	(forward-list 1)
	(delete-char -1)
	(insert "\n\\end{center}")
	(goto-char here)
	(delete-char 1)
	))
    (s2l-do-alist 
     '(
       ("^@[bB]egin\\s([dD]escription\\s)" . "\\\\begin{description}")
       ("^@[eE]nd\\s([dD]escription\\s)" . "\\\\end{description}")
       ("\n\n\\(.+\\)@\\\\" . "\n\n\\\\item[\\1]\n")
       ("\n\\(.+\\)@\\\\" . "\n\n\\\\item[\\1]\n")
       ("^\\\\begin{description}[ \t]*\n\\(.+\\)\n@\\\\" .
	"\\\\begin{description}\n\n\\\\item[\\1]\n")
       ("\n\n@\\\\" . "\n\n\\\\item\n")
       ("\n\n\\(.+\\)\n@\\\\" . "\n\n\\\\item[\\1]\n")
       ("\n@\\\\" . "\n\n\\\\item\n")
       ))
    (goto-char (point-min))
    (while (re-search-forward "^@[bB]egin\\s([iI]temize[^]})]*\\s)" nil t)
      (replace-match "\\begin{itemize}\n" t t)
      (forward-char -1)
      (let* ((beg (point))
	     (end (save-excursion 
		    (re-search-forward "^@[eE]nd\\s([iI]temize\\s)" nil nil)
		    (point)))
	     (mid (save-excursion
		    (if (re-search-forward "^@[bB]egin\\s(\\(itemize\\|enumerate\\|description\\)\\s)" end t)
			(point)))))
	(if (and mid (< mid end))
	    (progn
	      (narrow-to-region beg mid)
	      (goto-char (point-min))
	      ;; If the item is just before an ignore, place it in the ignore
	      (while (re-search-forward "\n[ \t]*\n." nil t)
		(forward-char -1)
		(if (looking-at "\\\\begin{ignore}") (forward-line 1))
		(insert "\\item\n"))
	      (widen)
	      (narrow-to-region beg (save-excursion 
				      (re-search-forward "^@[eE]nd\\s([iI]temize\\s)" nil nil)
				      (point)))
	      (s2l-handle-environments)
	      (widen)
	      (goto-char beg)
	      (setq end (save-excursion 
			  (re-search-forward "^@[eE]nd\\s([iI]temize\\s)" nil nil)
			  (point)))
	      )
	  (goto-char  beg)
	  (narrow-to-region beg (save-excursion 
				  (re-search-forward "^@[eE]nd\\s([iI]temize\\s)" nil nil)
				  (point)))
	  (goto-char (point-max))
	  (beginning-of-line 1)
	  (delete-region (point) (point-max))
	  (insert "\\end{itemize}\n" )
	  (goto-char (point-min))
	  ;; If the item is just before an ignore, place it in the ignore
	  (while (re-search-forward "\n[ \t]*\n." nil t)
	    (forward-char -1)
	    (if (looking-at "\\\\begin{ignore}") (forward-line 1))
	    (insert "\\item\n"))
	  (widen))
	))
    (goto-char (point-min))
    (while (re-search-forward "^@[bB]egin\\s([eE]numerate[^]})]*\\s)" nil t)
      (replace-match "\\begin{itemize}\n" t t)
      (forward-char -1)
      (let* ((beg (point))
	     (end (save-excursion 
		    (re-search-forward "^@[eE]nd\\s([eE]numerate\\s)" nil nil)
		    (point)))
	     (mid (save-excursion
		    (if (re-search-forward "^@[bB]egin\\s(\\(itemize\\|enumerate\\)\\s)" end t)
			(point)))))
	(if (and mid (< mid end))
	    (progn
	      (narrow-to-region beg mid)
	      (goto-char (point-min))
	      ;; If the item is just before an ignore, place it in the ignore
	      (while (re-search-forward "\n[ \t]*\n." nil t)
		(forward-char -1)
		(if (looking-at "\\\\begin{ignore}") (forward-line 1))
		(insert "\\item\n"))
	      (widen)
	      (narrow-to-region beg (save-excursion 
				      (re-search-forward "^@[eE]nd\\s([eE]numerate\\s)" nil nil)
				      (point)))
	      (s2l-handle-environments)
	      (widen)
	      (goto-char beg)
	      (setq end (save-excursion 
			  (re-search-forward "^@[eE]nd\\s([eE]numerate\\s)" nil nil)
			  (point)))
	      )
	  (goto-char  beg)
	  (narrow-to-region beg (save-excursion 
				  (re-search-forward "^@[eE]nd\\s([eE]numerate\\s)" nil nil)
				  (point)))
	  (goto-char (point-max))
	  (beginning-of-line 1)
	  (delete-region (point) (point-max))
	  (insert "\\end{itemize}\n" )
	  (goto-char (point-min))
	  ;; If the item is just before an ignore, place it in the ignore
	  (while (re-search-forward "\n[ \t]*\n." nil t)
	    (forward-char -1)
	    (if (looking-at "\\\\begin{ignore}") (forward-line 1))
	    (insert "\\item\n"))
	  (widen))
	))
    (goto-char (point-min))
    (while (re-search-forward "^@[bB]egin\\s([fF]ormat\\s)" nil t)
      ;; Assume 2 column
      (replace-match "\\begin{table}{||l|l||}\n" t t)
      (forward-line 1)
      (narrow-to-region (point) 
			(save-excursion 
			  (re-search-forward "^@[eE]nd\\s([fF]ormat\\s)" nil t)
			  (beginning-of-line 1)
			  (replace-match "\\end{table}" t t)
			  (beginning-of-line 1)
			  (point)))
      ;; If the item is just before an ignore, place it in the ignore
      (goto-char (point-min))
      (while (re-search-forward "@\\\\" nil t)
	(replace-match "\t& "))
      (goto-char (point-min))
      (quietly-replace-regexp "$" "\t\\\\\\\\")
      (goto-char (point-min))
      (while (re-search-forward "^[ \t]*\\\\\\\\$" nil t)
	(replace-match "\\\\hline"))
      (widen))
    (goto-char (point-min))
    )
  )