(require 'font-lock)
(require 'compile)

 (defvar font-lock-preprocessor-face 'font-lock-preprocessor-face)
 (defvar relview-font-lock-star-face 'relview-font-lock-star-face)
 (defvar relview-font-lock-func-face 'relview-font-lock-func-face)
 (defvar relview-font-lock-var-face 'relview-font-lock-var-face)
 ;(defvar relview-font-lock-op-face 'relview-font-lock-op-face)

 (if (facep 'font-lock-preprocessor-face) ()
     (progn
       (make-face 'font-lock-preprocessor-face)
       (set-face-foreground 'font-lock-preprocessor-face "blue")))

 (if (facep 'relview-font-lock-star-face) ()
     (progn
       (make-face 'relview-font-lock-star-face)
       (set-face-foreground 'relview-font-lock-star-face "deeppink")))

 (if (facep 'relview-font-lock-func-face) ()
     (progn
       (make-face 'relview-font-lock-func-face)
       (set-face-foreground 'relview-font-lock-func-face "green4")))

 (if (facep 'relview-font-lock-var-face) ()
     (progn
       (make-face 'relview-font-lock-var-face)
       (set-face-foreground 'relview-font-lock-var-face "orange")))

 ;(if (facep 'relview-font-lock-op-face) ()
 ;    (progn
 ;      (make-face 'relview-font-lock-op-face)
 ;      (set-face-foreground 'relview-font-lock-op-face "pink")))

 (defconst relview-keywords
 (list
 (list "\\(BEG\\)" 1 'font-lock-preprocessor-face)
 (list "\\(DECL\\)" 1 'font-lock-preprocessor-face)
 (list "\\(DO\\b\\)" 1 'font-lock-preprocessor-face)
 (list "\\(ELSE\\)" 1 'font-lock-preprocessor-face)
 (list "\\(END[.]\\)" 1 'font-lock-preprocessor-face)
 (list "\\(FI\\)" 1 'font-lock-preprocessor-face)
 (list "\\(IF\\)" 1 'font-lock-preprocessor-face)
 (list "\\(OD\\)" 1 'font-lock-preprocessor-face)
 (list "\\(PROD\\)" 1 'font-lock-preprocessor-face)
 (list "\\(RETURN\\)" 1 'font-lock-preprocessor-face)
 (list "\\(SUM\\)" 1 'font-lock-preprocessor-face)
 (list "\\(THEN\\)" 1 'font-lock-preprocessor-face)
 (list "\\(WHILE\\)" 1 'font-lock-preprocessor-face)
 (list "\\([A-Za-z_0-9]*\\)\(" 1 'relview-font-lock-func-face)
 ;;(list "\\([*][*]+\\)" 1 'relview-font-lock-star-face t)
 (list ";" 0 'relview-font-lock-star-face)
 (list "\\([A-Za-z_0-9]*\\)[ \t]*=" 1 'relview-font-lock-var-face)
 ;(list "-\\|\|\\|&\\|\\^\\|\*\\|/\\|\\\\\\|,\\|+" 0 'relview-font-lock-op-face t)
 ))

(if (string-match "XEmacs" emacs-version) ()
  (setq font-lock-defaults-alist 
	(cons '(relview-mode relview-keywords
			 nil nil nil nil)
	      font-lock-defaults-alist)))
     


(defun find-at-beginning-of-line (s)
  (save-excursion
    (beginning-of-line)
    (skip-chars-forward " \t")
    (looking-at s)
    )
  )

(defun yy()
;  (save-excursion
  (beginning-of-line)
  (make-local-variable 'x)
  (make-local-variable 'r)
  (make-local-variable 'p-BEG)
  (make-local-variable 'p-DECL)
  (make-local-variable 'p-IF)
  (make-local-variable 'p-WHILE)
  (make-local-variable 'p-POINT)
  (make-local-variable 'p-THEN)
  (make-local-variable 'p-ELSE)
  (make-local-variable 'p-DO)
  (setq p-BEG 1)
  (setq p-DECL 1)
  (setq p-IF 1)
  (setq p-WHILE 1)
  (setq p-POINT 1)
  (setq p-THEN 1)
  (setq p-ELSE 1)
  (setq p-DO 1)
  (setq r nil)
  (while (and (> p-BEG 0)
	      (> p-DECL 0)
	      (> p-IF 0)
	      (> p-WHILE 0)
	      (> p-POINT 0)
	      (> p-THEN 0)
	      (> p-ELSE 0)
	      (> p-DO 0)
	      (> (point) 1))
    (skip-chars-backward " \t\n")
    (skip-chars-backward "\\.=;{}")
    (if (looking-at "}")  (skip-chars-backward "^{"))
    (if (looking-at "\\.")  (setq p-POINT (- p-POINT 1)))
    (skip-chars-backward "^ \t\n")
    (if (looking-at "OD[^A-Za-z0-9]") (setq p-WHILE (+ p-WHILE 1)))
    (if (looking-at "FI[^A-Za-z0-9]") (setq p-IF (+ p-IF 1)))
    (if (looking-at "DECL[^A-Za-z0-9]") (setq p-DECL (- p-DECL 1)))
    (if (looking-at "BEG[^A-Za-z0-9]") (setq p-BEG (- p-BEG 1)))
    (if (looking-at "IF[^A-Za-z0-9]") (setq p-IF (- p-IF 1)))
    (if (looking-at "WHILE[^A-Za-z0-9]") (setq p-WHILE (- p-WHILE 1)))
    (if (looking-at "THEN[^A-Za-z0-9]")
	(if (= p-IF 1)
	    (if (not (find-at-beginning-of-line "IF"))
		(setq p-THEN 0)
	      )
	  ))
    (if (looking-at "ELSE[^A-Za-z0-9]")
	(if (= p-IF 1)
	    (if (not (find-at-beginning-of-line "THEN"))
		(setq p-ELSE 0)
	      )
	  ))
    (if (looking-at "DO[^A-Za-z0-9]")
	(if (= p-WHILE 1)
	    (if (not (find-at-beginning-of-line "WHILE"))
		(setq p-DO 0)
	      )
	  ))
    )
  (progn
    (if (= (point) 0) (setq r (cons "POINT" 0))
      (if  (= p-POINT 0) (setq r (cons "POINT" 0))
	(if (= p-BEG 0) (setq r (cons "BEG" (indent-to 0)))
	  (if (= p-DECL 0) (setq r (cons "DECL" (indent-to 0)))
	    (if  (= p-IF 0) (setq r (cons "IF" (indent-to 0)))
	      (if  (= p-WHILE 0) (setq r (cons "WHILE" (indent-to 0)))
		(if  (= p-THEN 0) (setq r (cons "THEN" (indent-to 0)))
		  (if  (= p-ELSE 0) (setq r (cons "ELSE" (indent-to 0)))
		    (if  (= p-DO 0) (setq r (cons "DO" (indent-to 0)))
		      (setq r (cons "NONE" 0))
		      )))))))))
    )
  r
;  )
  ) 

(defun pos-left-to(x)
  (save-excursion
    (make-local-variable 'q)
    (beginning-of-line)
    (skip-chars-forward " \t")
    (skip-chars-forward "^ \t\n")
    (setq q (indent-to 0))
    (delete-backward-char (skip-chars-forward " \t"))
;;    (message (int-to-string (skip-chars-forward " \t")))
    (indent-to (+ q x))
    )
  )

(defun xx()
  (interactive)
  (make-local-variable 'r)
  (make-local-variable 'il)
  (make-local-variable 'i)
  (setq i -1)
  (setq il -1)
  (save-excursion
    (setq r (yy))
    )
;  (message (car r))
  (progn
    (if (find-at-beginning-of-line "DECL[^A-Za-z0-9]")
	(progn
	  (setq i (+ (cdr r) 2))
	  (setq il 1)
	  )
      (if (find-at-beginning-of-line "BEG[^A-Za-z0-9]")
	  (progn
	    (setq i (cdr r))
	    (setq il 2)
	    )
	(if (find-at-beginning-of-line "RETURN[^A-Za-z0-9]")
	    (setq i (+ (cdr r) 5))
	  (if (find-at-beginning-of-line "END[^A-Za-z0-9]")
	      (setq i (cdr r))
	  (if (find-at-beginning-of-line "OD[^A-Za-z0-9]")
	      (setq i (cdr r))
	  (if (find-at-beginning-of-line "FI[^A-Za-z0-9]")
	      (progn
		(if (string= (car r) "IF") (setq i (cdr r))
		   (setq i (- (cdr r) 2))
		   )
	      )
	    (save-excursion
	      (forward-line -1)
	      (end-of-line)
	      (skip-chars-backward " \t;,}")
	      (if (looking-at "}") (progn
				     (skip-chars-backward "^{")
				     (skip-chars-backward "{ \t;,")
				     ))
	      (if (looking-at ";\\|,")
					;FOUND ";"
		  (progn
		    (if (string= (car r) "BEG") (setq i (+ (cdr r) 5)))
		    (if (string= (car r) "DECL") (setq i (+ (cdr r) 5)))
		    (if (string= (car r) "WHILE") (setq i (+ (cdr r) 2)))
		    (if (string= (car r) "IF") (setq i (+ (cdr r) 2)))
		    (if (string= (car r) "THEN") (setq i (+(cdr r) 5)))
		    (if (string= (car r) "ELSE") (setq i (+(cdr r) 5)))
		    )
					;NO ";"
		(progn
		    (if (string= (car r) "BEG") (setq i (+ (cdr r) 5)))
		    (if (string= (car r) "DECL") (setq i (+ (cdr r) 5)))
		    (if (string= (car r) "WHILE") (setq i (+ (cdr r) 2)))
		    (if (string= (car r) "IF") (setq i (+ (cdr r) 2)))
		    (if (string= (car r) "THEN") (setq i (cdr r)))
		    (if (string= (car r) "ELSE") (setq i (cdr r)))
		  )
		  )
	      )
	    ))))))
    )
  (if (> i 0) (indent-line-to i))
  (if (> il 0) (pos-left-to il))
  (if (> i 0) (end-of-line))
  )

; (list "\\(BEG\\)" 1 'font-lock-preprocessor-face t)
; (list "\\(DECL\\)" 1 'font-lock-preprocessor-face t)
; (list "\\(DO\\)" 1 'font-lock-preprocessor-face t)
; (list "\\(ELSE\\)" 1 'font-lock-preprocessor-face t)
; (list "\\(END[.]\\)" 1 'font-lock-preprocessor-face t)
; (list "\\(FI\\)" 1 'font-lock-preprocessor-face t)
; (list "\\(IF\\)" 1 'font-lock-preprocessor-face t)
; (list "\\(OD\\)" 1 'font-lock-preprocessor-face t)
; (list "\\(PROD\\)" 1 'font-lock-preprocessor-face t)
; (list "\\(RETURN\\)" 1 'font-lock-preprocessor-face t)
; (list "\\(SUM\\)" 1 'font-lock-preprocessor-face t)
; (list "\\(THEN\\)" 1 'font-lock-preprocessor-face t)
; (list "\\(WHILE\\)" 1 'font-lock-preprocessor-face t)
; (list "\\([A-Za-z_0-9]*\\)\(" 1 'relview-font-lock-func-face t)
; ;;(list "\\([*][*]+\\)" 1 'relview-font-lock-star-face t)
; (list ";" 0 'relview-font-lock-star-face t)
; (list "\\([A-Za-z_0-9]*\\)[ \t]*=" 1 'relview-font-lock-var-face t)
; ;(list "-\\|\|\\|&\\|\\^\\|\*\\|/\\|\\\\\\|,\\|+" 0 'relview-font-lock-op-face t)

(defvar relview-font-lock-keywords
   '(("\\<\\(BEG\\|DECL\\|DO\\|ELSE\\|END\\|FI\\|IF\\|OD\\|PROD\\|RETURN\\|SUM\\|THEN\\|WHILE\\)\\>" . font-lock-keyword-face)
;    ("\\([A-Za-z_0-9]*\\)[ \t]*=" . font-lock-function-name-face)
;    ("\\<\\(four\\|five\\|six\\)\\>" . font-lock-type-face)
     (list "\\([A-Za-z_0-9]*\\)[ \t]*=" 1 'font-lock-function-name-face t)
     )
   "Default expressions to highlight in Foo mode.")

(defun relview-mode()
  (interactive)
  (setq major-mode 'relview-mode)
  (setq mode-name "Relview Mode")
;  (modify-syntax-entry ?{ "<^")
;  (modify-syntax-entry ?} ">$")
  (modify-syntax-entry ?{ "<")
  (modify-syntax-entry ?} ">")
  (defconst relview-mode-map nil  "relview keymap")
  (setq relview-mode-map (make-sparse-keymap))
  (use-local-map relview-mode-map)
;  (define-key relview-mode-map "\t"  'relview-indent-func)
;  (define-key relview-mode-map "\C-q"  'relview-indent-func)
;  (define-key relview-mode-map "\C-w"  'xx)
  (define-key relview-mode-map "\t"  'xx)
  (font-lock-mode 1)
;  (setq font-lock-keywords relview-keywords)
;

  (make-local-variable 'font-lock-defaults)
;  (setq font-lock-defaults relview-keywords)
  (setq font-lock-defaults '(relview-keywords nil t))
;
  )

;;;(relview-mode)
(provide 'relview-mode)

;;(skip-chars-forward "-\\|\|\\|&\\|\\^\\|\*\\|/\\|\\\\\\|,\\|+")+-
;;(looking-at "-\\|\|\\|&\\|\\^\\|\*\\|/\\|\\\\\\|,\\|+")