(defun split-UDM ()
  "Split the UDM source code into separate files."
  (interactive)
  (setq old-fold-default default-case-fold-search)
  (setq default-case-fold-search nil)
  (setq old-fold case-fold-search)
  (setq case-fold-search nil)
  (setq main-buffer (buffer-name))
  (setq buf-list '())
  (init-buffer 'UDM 'prog nil)
  (init-buffer 'OTHER 'imp t)
  (setq default-case-fold-search old-fold-default)
  (switch-to-buffer main-buffer)
  (goto-char (point-min))
  (gobble-text "udm_comm" 4 UDM)
  (gobble-text "udmStatusBlock" 13 OTHER)
  (gobble-text "END sameFSN;" 3 UDM)
  (gobble-text "END find;" 5 OTHER)
  (append-to-buffer UDM (point) (point-max))
  (progn (switch-to-buffer UDM)
	 (goto-char (point-min))
	 (search-forward "EPLWHAT")
	 (beginning-of-line 0)
	 (insert-file-contents "UDM.head" nil)
	 )
  (while (not (equal buf-list nil))
    (flush-buffer (car buf-list))
    (setq buf-list (cdr buf-list))
    )
  (switch-to-buffer main-buffer)
  (setq case-fold-search old-fold)
  )

(defun init-buffer (name type enclosed)
  (interactive "SBuffer name: \nSType: \nSEnclosed? ")
  (set name (concat (symbol-name name) (if (equal type 'def) ".def" ".mod")))
  (setq buf-list (append buf-list (list name)))
  (put name 'enclosed enclosed)
  (put name 'type type)
  (switch-to-buffer (eval name))
  (goto-char (point-min))
  (cond ((equal type 'def)
	 (insert "DEFINITION "))
	((equal type 'imp)
	 (insert "IMPLEMENTATION "))
	)
  (if enclosed
      (progn
	(insert (format "MODULE %s;\n\n" (symbol-name name)))
	(if (file-exists-p (concat (symbol-name name) ".head"))
	    (insert-file-contents (concat (symbol-name name) ".head") nil))
	(goto-char (point-max))
	)
    )
  )

(defun gobble-text (string blanks buf)
  (interactive "sString: \nsBlank lines: \nbBuffer name: ")
  (setq x (point))
  (search-forward string)
  (beginning-of-line blanks)
  (append-to-buffer buf x (point))
  )

(defun gobble-module (name blanks buf)
  (interactive "sModule name: \nsBlank lines: \nbBuffer name: ")
  (gobble-text (concat "END " name ";") blanks buf)
  )

(defun fix-complex-constant (name)
  (interactive "sName of null constant: ")
  (search-forward name)
  (just-one-space)
  (forward-word -1)
  (kill-line 0)
  (insert ?\t)
  (teco-fs "=" ":")
  (just-one-space)
  (forward-word 1)
  (setq x (point))
  (search-forward ";")
  (kill-region x (1- (point)))
  )

(defun fix-module-top (name)
  (interactive "*S")
  (switch-to-buffer (eval name))
  (goto-char (point-min))
  (re-search-forward (concat "MODULE[ \t]*" (symbol-name name)))
  (beginning-of-line)
  (kill-line 2)
  (goto-char (point-min))
  (forward-word 1)	; skip "IMPLEMENTATION"
  (forward-char 1)	; skip space
  (yank)
  )

(defun kill-lines-containing (string before after)
  (interactive "*sString: \nnLines before: \nnLines after: \n")
  (search-forward string)
  (beginning-of-line (- 1 before))
  (kill-line (+ before after))
  )

(defun replace-port-lists (buf)
  "Replace IMPORT and EXPORT lists with contents of file buf.head."
  (interactive "*SSymbol of buffer: ")
  (switch-to-buffer (eval buf))
  (goto-char (point-min))
  (search-forward "IMPORT")
  (beginning-of-line)
  (setq x (point))
  (search-forward ";" nil nil 2)
  (beginning-of-line 2)
  (delete-region x (point))
  (insert-file (concat (symbol-name buf) ".head"))
  (exchange-point-and-mark)
  )

(defun fix-import-list (module symbols)
  (interactive "*sModule name: \nsSymbols to add: ")
  (re-search-forward (concat "MODULE[ \t]*" module))
  (search-forward "IMPORT")
  (re-search-forward "[,;]")
  (forward-word -1)
  (setq col (current-column))
  (search-backward "IMPORT")
  (forward-word 1)
  (if (equal (following-char) 10)
      (forward-char 1)
    (insert "\n")
    )
  (indent-to col 0)
  (insert (format "%s\n" symbols))
  )

(defun fix-export-list (module symbols)
  (interactive "*sModule name: \nsSymbols to add: ")
  (re-search-forward (concat "MODULE[ \t]*" module))
  (search-forward "EXPORT")
  (re-search-forward "[,;]")
  (forward-word -1)
  (setq col (current-column))
  (beginning-of-line)
  (indent-to col 0)
  (insert (format "%s\n" symbols))
  )

(defun include-macros ()
  (interactive "*")
  (goto-char (point-min))
  (beginning-of-line 2)
  (insert "\n#include \"ACP_OP_macros.h\"")
  (if (not (equal (following-char) 10))
      (insert "\n"))
  )

(defun add-include-line (module)
  (interactive "*sModule name: ")
  (search-forward "IC_")
  (beginning-of-line 2)
  (insert "#include \"IOD" module ".mod\"")
  )

(defun flush-buffer (buf)
  (interactive "SSymbol of buffer to flush: ")
  (switch-to-buffer (eval buf))
  (goto-char (point-min))
  (forward-word 1)
  (just-one-space)
  (goto-char (1- (point-max)))
  (if (equal (following-char) 10)	; remove trailing blank lines
      (progn
	(while (equal (preceding-char) 10)
	  (goto-char (1- (point)))
	  )
	(delete-region (point) (1- (point-max))))
    )
  (goto-char (point-max))
  (if (get buf 'enclosed)
      (insert (format "\nEND %s.\n" (symbol-name buf)))
    (setq typ (get buf 'type))
    (if (or (equal typ 'def) (equal typ 'imp))
	(progn (search-backward "END")
	       (if (search-forward ";" nil t)
		   (replace-match "."))
	       (if (file-exists-p (concat (symbol-name buf) ".head"))
		   (replace-port-lists buf))
	       ))
    )
  (write-file (eval buf))
  )

(defun teco-fs (from-string to-string &optional arg)
  "Perform the TECO \"fs\" (find and substitute) command.
Replaces one occurrence of FROM-STRING with TO-STRING -- the ARGth
occurrence, to be precise.  Negative ARG means search backward.

When calling from a program, nil means \"no arg\",
a number counts as a prefix arg."
  (interactive "*sFind: \nsFind \"%s\" and substitute with: \nP")
  (if (or (equal arg nil) (equal arg 0))
      (setq arg 1))
  (if (< arg 0)
      (search-backward from-string nil nil (- arg))
    (search-forward from-string nil nil arg)
    )
  (replace-match to-string t t)
  )
