;;
;; VP code emacs major mode
;; Copyright (C) 2000 Lars Thomas Denstad
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
;;
;; History:
;;       larsde - 2000-09-20 - Created
;;       larsde - 2000-09-21 - Added syntax aware indenting
;;       larsde - 2000-10-10 - Started to add support for VP OO.
;;                             Fixed some indentation bugs.
;;                             Corrected some regexps.
;;                             Added flagging of mismatched indentation.
;;       larsde - 2000-10-11 - Lines starting with "*" are comments.
;;       larsde - 2000-10-12 - Fixed some more regexps, added support 
;;                             for exception handling
;;       larsde - 2000-10-18 - Fixed some indentation code
;;       larsde - 2000-10-21 - Fixed some labelling issues
;;


(defconst vp-font-lock-keywords-1 nil
  "Fair amount of highlighting.")

(defconst vp-font-lock-keywords-2 nil
  "More highlighting.")

(defvar level-at-point nil
  "Indentationlevel at point")

(defvar open-stored-point nil
  "Stored point for open search operations")

(defvar closed-stored-point nil
  "Stored point for close search operations")

(defvar temporary-stored-point nil
  "To remove comments. Should be part of regexp, but I couldn't figure it out")

(defvar tab-positions '(0 4 7 10 13 16 19 22 25 28 31 34 37 40)
  "The column numbers for the indenter.")

(defvar ctoken "[a-zA-Z0-9_:~*]+"
  "Regular expression for labels")


; Syntax-aware indentation blocks.

(defvar open-block "^tool[ \t\n]\\|^[ \t]*repeat\\|^[ \t]*loop\\|^[ \t]*if\\|else\\|elseif\\|^[ \t]*while\\|^[ \t]*defbegin\\|^[ \t]*iferrno\\|^structure\\|^[ \t]*switch\\|^[ \t]*case\\|^class[ \t\n]\\|^[ \t]*try\\|^[ \t]*except\\|^[ \t]*for \\|\.macro\\|\\.if\\|catch"
  "Regular expression for open blocks")

(defvar closed-block "toolend\\|until\\|endif\\|endloop\\|else\\|elseif\\|endwhile\\|defend\\|^[ \t]*size\\|^[ \t]*case\\|endswitch\\|classend\\|^[ \t]*endtry\\|^[ \t]*endexcept\\|^[ \t]*next\\|endm\\|^[ \t]*catch"
  "Regular expression for closed blocks")
;;(defvar closed-block ".*[^;](^toolend\\|until\\|endif\\|endloop\\|else\\|elseif\\|endwhile)"
;;  "Regular expression for closed blocks")

(let (
      (reserved-words
       '("\\.include[ \t]" "\\.data[ \t\n]" "\\.incbin[ \t]" "\\.end[ \t\n]"
	 "\\.macro[ \t]" "\\.endm[ \t\n]" "\\.if[ \t]" "\\.endif[ \t\n]"))

      (keywords 
       ;; These keywords actually contain a fair amount of macros too, but you
       ;; already knew that.
       '("abs" "add" "als" "and" "asl" "asr"
	 "b2i" "bclr" "bc" "bcr" "bit"
	 "blk" "bool" "break" "breakif"
	 "bset" "bst" "c2i" "ccall"
	 "ccl" "chainclass" "clr" "continue"
	 "continueif" "cpbb" "cpbi" "cpsb"
	 "cpy" "d_i" "d2f" "d2ir" "d2it" "d2lr"
	 "d2lt" "dat" "dc" "dec" "defbegin"
	 "defd" "defend" "defendnz" "deff" "defi"
	 "defp" "defl" "defset" "defzap" "div"
	 "divh" "divu" "else" "elseif" "endif"
	 "endloop" "endwhile" "ent" "entd"
	 "ente" "entflags" "entih" "entl"
	 "entle" "entrytag" "eq" "f_i" "f2d"
	 "f2ir" "f2it" "for" "ge" "geu" "go"
	 "gos" "gose" "gt" "gtu" "i_d" "i_f" "i_l"
	 "i2d" "i2f" "i2l" "i2p" "if" "inc"
	 "l_i" "l2d" "l2i" "ld" "le" "leu" "litb" "liti"
	 "loop" "lsl" "lsr" "lt" "ltu" "mul" "mulh"
	 "nbit" "ncall" "ne" "neg" "next" "noret"
	 "not" "notbool" "ntags" "or" "ord" "p2i"
	 "parentclass" "pcall" "pri" "qcall" "qcalle"
	 "qcallv" "qcl" "qcle" "rem" "remu" "repeat"
	 "ret" "s2i" "saveall" "schk" "st" "sub" "swb"
	 "sync" "syncreg" "tag" "toolentry" "uno"
	 "until" "while" "xor" "zap"

	 "method" "defaultmethod" 
	 "parentclass"

	 "try" "endtry" "catch"))

      (pointer-registers
       '("si" "sp" "gp" "lp" "pp"))
      
      (registers 
       '("p[0-9]+" "l[0-9]+" "i[0-9]+" "f[0-9]+" "d[0-9]+"))

      (types
       '("\\.i" "\\.l" "\\.f" "\\.d" "\\.p" "\\.b"))

      (operators
       '("add" "mul" "div" "sub" "+" "-" "*" "/"))

      
      ) ;; Closes let
      
      (setq vp-font-lock-keywords-1
	    (list
	     '(";.*$\\|^\*.*$" . font-lock-comment-face)
	     (list (concat
		    "^" ctoken ":[ \t\n]")
		   0 'font-lock-function-name-face)))

      (setq vp-font-lock-keywords-2
	    (append vp-font-lock-keywords-1
		    (list
		     '("'.*'" . font-lock-string-face)
		     (cons (concat "\\("  
				   (mapconcat 'identity reserved-words "\\|")
				   "\\)")
			   'font-lock-preprocessor-face)
		     (cons (concat "\\("
				   (mapconcat 'identity types "\\|")
				   "\\)[ \t\n(){};:,]")
			   'font-lock-type-face)
		    (cons (concat "[ \t\n]\\("
				  (mapconcat 'identity keywords "\\|")
				  "\\)[ \t\n\\.();]")
			  'font-lock-keyword-face)
		    (cons (concat "\\("
				  (mapconcat 'identity registers "\\|")
				  "\\)")
			  'font-lock-variable-name-face))))
 
)

(defvar vp-font-lock-keywords vp-font-lock-keywords-2)

(add-hook 'font-lock-mode-hook
	  (function
	   (lambda ()
	     (if (eq major-mode 'vp-mode)
		 (setq font-lock-keywords vp-font-lock-keywords)))))

(defun inclevel ()
  (interactive)
  (setq level-at-point (+ level-at-point 1)))

(defun declevel ()
  (setq level-at-point (- level-at-point 1)))

(defun get-current-level ()
  "Calculate current indentation level"
  (interactive)
  (save-excursion
    (setq level-at-point 0)
    (setq open-stored-point (point))
    (end-of-line)
    (setq closed-stored-point (point))
    (goto-char 0) ;; Start at beginning of buffer, search for open blocks
    (while (re-search-forward open-block open-stored-point t)
      (setq temporary-stored-point (point))
      (beginning-of-line)
      (if (search-forward ";" temporary-stored-point t)
	  ()
	(inclevel))
      (goto-char temporary-stored-point))
    (goto-char 0) ;; Start at beginning again, search for closed blocks
    (while (re-search-forward closed-block closed-stored-point t)
      (setq temporary-stored-point (point))
      (beginning-of-line)
      (if (search-forward ";" temporary-stored-point t)
	  ()
	(declevel))
      (goto-char temporary-stored-point))
    (goto-char open-stored-point)
    (beginning-of-line)
    (if (re-search-forward (concat "^" ctoken ":[ \t\n]") closed-stored-point t)
	(setq level-at-point 0))
    )
  level-at-point)

(defun indent-whole-buffer ()
  "Indent whole buffer according to VP code syntax."
  (interactive)
  (let ((current-line 0)
	(number-of-lines 0)
	)
	(setq current-line 0)
	(setq number-of-lines (count-lines-buffer))
	(save-excursion
	  (while (<= current-line number-of-lines)
	    (goto-line current-line)
	    (indent-to-current-level)
	    (setq current-line (+ current-line 1))
	    ))))
    

(defun indent-to-current-level ()
  (interactive)
  (beginning-of-line)
  (fixup-whitespace)
  (setq current-level (get-current-level))
  (if (>= current-level 0) 
      (indent-to-column (nth current-level tab-positions))
    (message "Mismatched indentation."))
  (end-of-line))

(defvar vp-mode-map nil)
(if vp-mode-map
    ()
  (setq vp-mode-map (make-sparse-keymap))
  (define-key vp-mode-map "\t" 'indent-to-current-level)
  (define-key vp-mode-map "\C-x\C-n" 'indent-for-comment))


(defun vp-mode ()
  "Major mode for editing VP assembly.
Special commands: \\{vp-mode-map}
Turning on the VP mode runs the hook `vp-mode-hook'."
  (interactive)
  (kill-all-local-variables)
  (use-local-map vp-mode-map)
  (setq mode-name "VP mode")
  (setq major-mode 'vp-mode)
  (setq comment-start ";")
  (setq comment-end "")
  (setq comment-column 50)
  (font-lock-mode)
  (run-hooks 'vp-mode-hook))


(provide 'vp-mode)
