; ======================================================================
;   File      : hamster-mode.el
;   Purpose   : Simple mode for Hamster-Script-Files
;   Time-stamp: <Thu Jul/19/2001 18:23 MET Coder@ReallySoft.de>
; ======================================================================

;;; Code:


(provide 'hamster-mode)

(defvar hamster-mode-map nil
  "Local keymap for hamster-mode buffers.")

(defvar hamster-mode-syntax-table nil
  "Syntax table in use in hamster-mode buffers.")

(defvar hamster-word "[a-zA-Z_][a-zA-Z_1-9]*"
  "regular expression to match a word in hamster-mode")

(defvar hamster-path-chars "[A-Za-z0-9_~\.\\/]"
  "matches DOS-paths")

(defvar hamster-tab-width 4 "tab-width for indentation in hamster-mode")

;; --------------------------------------------------------------------------------

(if hamster-mode-map
    nil
  (setq hamster-mode-map (make-sparse-keymap))
  )

;; Make underscores count as words
(if hamster-mode-syntax-table
    ()
  (setq hamster-mode-syntax-table (make-syntax-table))
  (modify-syntax-entry ?_  "w"  hamster-mode-syntax-table)
  )

(defun hamster-mode ()
  "Mode for Hamster script files"
  (interactive)
  (kill-all-local-variables)
  (use-local-map              hamster-mode-map)
  (set-syntax-table	          hamster-mode-syntax-table)

  (make-local-variable	     'parse-sexp-ignore-comments)
  (make-local-variable	     'comment-start)
  (make-local-variable	     'comment-start-skip)
  (make-local-variable	     'comment-end)
  (make-local-variable	     'executable-command)
  (make-local-variable	     'font-lock-defaults)
  (make-local-variable	     'font-lock-keywords-case-fold-search)
  (make-local-variable	     'indent-line-function)

  (setq major-mode          'hamster-mode
        mode-name           "Hamster"
        comment-end         ""
        comment-start       "#"
        parse-sexp-ignore-comments t
        )

  ;; Global font-lock support
  (setq font-lock-defaults (list 'hamster-font-lock-keywords nil))
  (setq font-lock-keywords-case-fold-search 't)
  (setq indent-line-function 'hamster-electric-tab)

  (run-hooks 'hamster-mode-hook))

(defvar hamster-font-lock-keywords nil "Keywords to hilight in Hamster mode")
(setq hamster-font-lock-keywords
  (list
   (list (concat "\\(\\<"
                 (mapconcat 'identity
                            '(
                              "assert" "atadd" "atclear" "atexecute" "abs"

                              "chr" "copy"

                              "debug" "dec" "decodetime" "delete" "delete" "dirchange" "dircurrent" "direxists" "dirmake"
                              "dirremove" "dirsystem" "dirwindows" "do" "dump"

                              "else" "encodetime" "endfor" "endif" "endsub" "endwhile" "errcatch" "errline" "errlineno"
                              "errmodule" "errmsg" "errnum" "error" "errsender" "eval" "execute" "entercontext"

                              "false" "filecopy" "filedelete" "fileexists" "filerename" "filesize" "filetime" "for"

                              "gosub"

                              "hamartcount" "hamartdeletemid" "hamartimport" "hamartlocatemid"
                              "hamartnomax" "hamartnomin" "hamarttext" "hamarttextexport" "hamfetchmail"
                              "hamflush" "hamgroupclose" "hamgroupcount" "hamgroupindex" "hamgroupname"
                              "hamgroupopen" "hamgroupspath" "hamhscpath" "hamhsmpath" "hamisidle"
                              "hamlogspath" "hammailexchange" "hammailsoutpath" "hammailspath" "hammessage"
                              "hamnewsjobsclear" "hamnewsjobspost" "hamnewsjobspostdef" "hamnewsjobspull" "hamnewsjobspulldef"
                              "hamnewsjobsstart" "hamnewsoutpath" "hamnewspost" "hamnewspull" "hampath"
                              "hampurge" "hamrasdial" "hamrashangup" "hamrebuildgloballists" "hamrebuildhistory"
                              "hamrequireversion" "hamscorelist" "hamscoretest" "hamsendmail" "hamsendmailauth"
                              "hamserverpath" "hamsetlogin" "hamthreadcount" "hamversion" "hamwaitidle"

                              "hex"

                              "icase" "if" "iif" "inc" "iniread" "iniwrite" "inputbox" "isstr" "isint"

                              "len" "listadd" "listalloc" "listbox" "listclear" "listcount" "listdelete" "listdirs"
                              "listexists" "listfiles" "listfree" "listget" "listgetkey" "listgettag" "listgettext"
                              "listindexof" "listinsert" "listload" "listrasentries" "listsave" "listset" "listsetkey"
                              "listsettag" "listsettext" "listsort" "loop" "lowercase" "leavecontext"

                              "msgbox"

                              "ord"

                              "pos" "print"

                              "quit"

                              "rasdial" "rasgetconnection" "rasgetip" "rashangup" "rasisconnected" "re_extract" "re_match"
                              "re_parse" "re_split" "replace" "return" "repeat"

                              "sleep" "str" "str" "set" "sgn"

                              "ticks" "time" "timegmt" "trim" "trim" "true" "trace"

                              "uppercase" "until"

                              "warning" "while"
                              )
                            "\\>\\|\\<")
                 "\\>\\)") 1 font-lock-keyword-face nil t)

   (list (concat "\\(sub\\)[ \t]+\\(" hamster-word "\\)")
         '(1 font-lock-keyword-face)
         '(2 font-lock-function-name-face))

   (list (concat "\\(label\\|goto\\)[ \t]*([ \t]*\\(" hamster-word "\\)[ \t]*)")
         '(1 font-lock-keyword-face)
         '(2 font-lock-function-name-face))

   (list (concat "\\(break\\|continue\\)")
         1 'font-lock-function-name-face)

   (list (concat "\\(var\\)[ \t]*\([ \t]*\\([^\)]+\\)\)")
         '(1 font-lock-preprocessor-face)
         '(2 font-lock-function-name-face))
   (list (concat "\\(varset\\)[ \t]*\([ \t]*\\([^,]+\\)")
         '(1 font-lock-preprocessor-face)
         '(2 font-lock-function-name-face))

   (list (concat "\$\\(" hamster-word "\\)")
         1 'font-lock-variable-name-face)

   (list "\\([0-9]+\\)"
         1 'font-lock-reference-face)

   (list (concat "\\([A-Za-z][:][\\]" hamster-path-chars "+\\)")	 1 'font-lock-type-face t)
   (list (concat "\\(" hamster-path-chars "+[\\]" hamster-path-chars "+\\)") 1 'font-lock-type-face t)

   (list "\\(#.*\\)$" 1 'font-lock-comment-face t)

   (list (concat "^\\(#!"
                 "\\(\\<"
                 (mapconcat 'identity
                            '(
                              "debug"
                              "initialize"
                              "load"
                              "hs2"
                              )
                            "\\>\\|\\<")
                 "\\>\\).*$\\)")
         1 'font-lock-preprocessor-face t)


   )
  )

;; next line has to be evaluated in modes buffer to test changes
;; (progn (fundamental-mode)(hamster-mode)(center-and-refontify))

;; -------------------- indentation

(defun hamster-calculate-indent ()
  "Calculate what the indent should be for the current line in Hamster mode"
  (interactive)
  (let (limit
        (indent 0)
        (line-with-content nil)
        )
    (save-excursion
      (end-of-line)
      (beginning-of-line)
      (setq limit (point))
      (while (and (not line-with-content)
                  (> (current-lineno) 1))
        (previous-line 1)
        (beginning-of-line)
        (while (and (not (eolp))
                    (looking-at " "))
          (forward-char 1)
          )
        (if (not (eolp)) ;; found a line with content
            (progn
              (setq indent (current-column))
              (setq line-with-content 't)

              (if (or
                   (looking-at "do")
                   (looking-at "else")
                   (looking-at "for")
                   (looking-at "if[ (]")
                   (looking-at "repeat")
                   (looking-at "sub")
                   (looking-at "while")
                   )
                  (setq indent (+ indent hamster-tab-width))
                  )
              (goto-char limit) ;; go back to start of line to indent
              (if (or
                   (looking-at "else")
                   (looking-at "end")
                   (looking-at "loop")
                   (looking-at "until")
                   )
                  (setq indent (- indent hamster-tab-width)))
              )
            )
        )
      )
    indent
    )
  )

(defun hamster-electric-tab ()
  "Function called when TAB is pressed in Hamster mode."
  (interactive)
  (save-excursion
    (beginning-of-line)
    (delete-horizontal-space)
    (indent-to (hamster-calculate-indent)))
  (if (and (bolp)
           (looking-at "[ \t]+"))
      (goto-char (match-end 0)))
  )



;;; hamster-mode.el ends here