;;;; -*- mode:emacs-lisp;coding:utf-8 -*-
;;;;FILE:               nasal.el
;;;;LANGUAGE:           emacs lisp
;;;;SYSTEM:             POSIX
;;;;    Defines a nasal-mode.
;;;;    <PJB> Pascal J. Bourguignon <pjb@ogamita.com>
;;;;    2011-04-12 <PJB> Created, inspired from http://members.aon.at/mfranz/nasal.vim
;;;;    GPL
;;;;    Copyright Pascal J. Bourguignon 2011 - 2011
;;;;    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
;;;;    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

(require 'font-lock)
(require 'cc-mode)
(require 'cc-langs)

(defconst nasal-mode-version-number "0.1.0"
  "Nasal Mode version number.")

(defconst nasal-mode-modified "2011-04-12"
  "NASAL Mode build date.")

(defgroup nasal nil
  "Major mode `nasal-mode' for editing nasal code."
  :prefix "nasal-"
  :group 'languages)

(defcustom nasal-file-patterns '("\\.nas\\'")
  "List of file patterns for which to automatically invoke `nasal-mode'."
  :type '(repeat (regexp :tag "Pattern"))
  :set (lambda (sym val)
         (set-default sym val)
         (let ((nasal-file-patterns-temp val))
           (while nasal-file-patterns-temp
             (add-to-list 'auto-mode-alist
                          (cons (car nasal-file-patterns-temp) 'nasal-mode))
             (setq nasal-file-patterns-temp (cdr nasal-file-patterns-temp)))))
  :group 'nasal)

(defcustom nasal-mode-hook nil
  "List of functions to be executed on entry to `nasal-mode'."
  :type 'hook
  :group 'nasal)

(defun nasal-mode-version ()
  "Display string describing the version of NASAL mode."
  (message "NASAL mode %s of %s" nasal-mode-version-number nasal-mode-modified))

(defvar nasal-beginning-of-defun-regexp
  "Regular expression for a NASAL function.")

(defun nasal-beginning-of-defun (&optional arg)
  "Move to the beginning of the ARGth NASAL function from point.
Implements NASAL version of `beginning-of-defun-function'."
  (interactive "p")
  (let ((arg (or arg 1)))
    (while (> arg 0)
      (re-search-backward nasal-beginning-of-defun-regexp
                          nil 'noerror)
      (setq arg (1- arg)))
    (while (< arg 0)
      (end-of-line 1)
      (let ((opoint (point)))
        (beginning-of-defun 1)
        (forward-list 2)
        (forward-line 1)
        (if (eq opoint (point))
            (re-search-forward nasal-beginning-of-defun-regexp
                               nil 'noerror))
        (setq arg (1+ arg))))))

(defun nasal-end-of-defun (&optional arg)
  "Move the end of the ARGth NASAL function from point.
Implements NASAL befsion of `end-of-defun-function'

See `nasal-beginning-of-defun'."
  (interactive "p")
  (nasal-beginning-of-defun (- (or arg 1))))

(defvar nasal-warned-bad-indent nil)
(make-variable-buffer-local 'nasal-warned-bad-indent)

(defun nasal-check-html-for-indentation ()
;; Do it but tell it is not good if html tags in buffer.
  (let ((html-tag-re "^\\s-*</?\\sw+.*?>")
        (here (point)))
    (if (not (or (re-search-forward html-tag-re (line-end-position) t)
                 (re-search-backward html-tag-re (line-beginning-position) t)))
        (goto-char here)
        (setq nasal-warned-bad-indent t)
        (lwarn 'nasal-indent :warning
               "Indentation fails badly with mixed XML and NASAL."
               "Look for an Emacs Lisp library that supports \"multiple"
               "major modes\" like mumamo, mmm-mode or multi-mode.")

(defun nasal-cautious-indent-region (start end &optional quiet)
  (if (or nasal-warned-bad-indent
      (funcall 'c-indent-region start end quiet)))

(defun nasal-cautious-indent-line ()
  (if (or nasal-warned-bad-indent
      (funcall 'c-indent-line)))

(defun opt (regexps)
  (mapconcat 'identity regexps "\\|"))

(defvar nasal-comment-delimiter  nil)

(defvar nasal-comment
  (list "#.*$"
        (concat "\\<\\("
                 '("TODO" "FIXME" "XXX" "contained"))

(defvar nasal-constant
  (concat "\\<\\("

(defvar nasal-doc                nil)

(defvar nasal-function-name
  (concat "\\<\\("
           '("display" "contains" "size" "keys" "append" "pop" "setsize"
             "subvec" "delete" "int" "num" "streq" "substr" "chr" "typeof"
             "compile" "call" "die" "sprintf" "caller" "closure" "find" "cmp"
             "split" "rand" "bind" "sort" "ghosttype" "id"

(defvar  nasal-flightgear-function-name
  (concat "\\<\\("
           '("getprop" "setprop" "print" "_fgcommand" "settimer" "_setlistener"
             "_cmdarg" "_interpolate" "rand" "srand" "directory"
             "removelistener" "systime" "geodtocart" "carttogeod" "geodinfo"
             "parsexml" "airportinfo" "abort" "isa" "fgcommand" "cmdarg" "abs"
             "interpolate" "setlistener" "defined" "printlog" "thisfunc"
             "printf" "values" "getType" "getName" "getIndex" "getValue"
             "setValue" "setIntValue" "setBoolValue" "setDoubleValue"
             "getParent" "getChild" "getChildren" "getAttribute" "setAttribute"
             "alias" "unalias" "getAliasTarget" "clearValue" "removeChild"
             "removeChildren" "getNode" "initNode" "getPath" "getBoolValue"
             "setValues" "getValues"

(defvar nasal-highlightings      nil)

(defvar nasal-block-stmt-1-kwds  '("else"))
(defvar nasal-block-stmt-2-kwds  '("if" "elsif" "while" "for" "foreach" "forindex"))

(defvar nasal-keyword
  (concat "\\<\\("
           (append '("func" "return" "var" "break" "continue")

(defvar nasal-preprocessor       nil)
(defvar nasal-reference          nil)

(defvar nasal-string

(defvar nasal-syntactic-function
  (concat "\\<\\("
           '("and" "or"))

(defvar nasal-type
  (concat "\\<\\("

(defvar nasal-variable-name
  (concat "\\<\\("
           '("me" "arg" "parents"

(defvar nasal-warning
  (opt '("``?"

(defun nasal-font-lock-keywords ()
  "Subdued level highlighting for NASAL mode."
  (flet ((flk (regexp face)
           (when regexp
             (list (list (typecase regexp
                           (string regexp)
                           (list   (regexp-opt regexp)))
     (flk nasal-comment-delimiter          'font-lock-comment-delimiter-face)
     (flk nasal-comment                    'font-lock-comment-face)
     (flk nasal-constant                   'font-lock-constant-face)
     (flk nasal-doc                        'font-lock-doc-face)
     (flk nasal-function-name              'font-lock-function-name-face)
     (flk nasal-flightgear-function-name   'font-lock-function-name-face)
     (flk nasal-highlightings              'font-lock-highlightings-face)
     (flk nasal-keyword                    'font-lock-keyword-face)
     (flk nasal-preprocessor               'font-lock-preprocessor-face)
     (flk nasal-reference                  'font-lock-reference-face)
     (flk nasal-string                     'font-lock-string-face)
     (flk nasal-syntactic-function         'font-lock-syntactic-function-face)
     (flk nasal-type                       'font-lock-type-face)
     (flk nasal-variable-name              'font-lock-variable-name-face)
     (flk nasal-warning                    'font-lock-warning-face)
      ;; Fontify ASP-style tag
      '("<\\%\\(=\\)?" . font-lock-preprocessor-face)
      '("\\%>"         . font-lock-preprocessor-face)

      ;; HTML >
      '("<[^>]*\\(>\\)" (1 font-lock-constant-face))

      ;; HTML tags
      '("\\(<[a-z]+\\)[[:space:]]+\\([a-z:]+=\\)[^>]*?" (1 font-lock-constant-face) (2 font-lock-constant-face) )
      '("\"[[:space:]]+\\([a-z:]+=\\)" (1 font-lock-constant-face))


(put 'define-derived-mode 'indent 3)

(define-derived-mode nasal-mode c-mode "Nasal"
  "Major mode for editing Nasal code.\n\n\\{nasal-mode-map}"
  (c-add-language 'nasal-mode 'c-mode)
  (c-set-offset 'cpp-macro 0)
  (set (make-local-variable 'c-block-stmt-1-key) nasal-block-stmt-1-kwds)
  (set (make-local-variable 'c-block-stmt-2-key) nasal-block-stmt-2-kwds)

  ;; ;; Specify that nasal-mode recognize Javadoc comment style
  ;; (set (make-local-variable 'c-doc-comment-style)
  ;;      '((nasal-mode . javadoc)))

  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults
          nil                               ; KEYWORDS-ONLY
          nil                               ; CASE-FOLD
          (("_" . "w"))                     ; SYNTAX-ALIST
          nil))                             ; SYNTAX-BEGIN

  ;; Electric behaviour must be turned off, they do not work since
  ;; they can not find the correct syntax in embedded NASAL.
  ;; Seems to work with narrowing so let it be on if the user prefers it.
  ;;(setq c-electric-flag nil)

  (setq font-lock-maximum-decoration t
        case-fold-search t)         ; NASAL vars are case-sensitive
   ;; (setq imenu-generic-expression nasal-imenu-generic-expression)

  ;; Do not force newline at end of file.  Such newlines can cause
  ;; trouble if the NASAL file is included in another file before calls
  ;; to header() or cookie().
  (set (make-local-variable 'require-final-newline) nil)
  (set (make-local-variable 'next-line-add-newlines) nil)

  (set (make-local-variable  'tab-width) 4)
  (set (make-local-variable  'c-basic-offset) 4)
  (set (make-local-variable  'indent-tabs-mode) nil)
  (c-set-offset 'block-open  '- )
  (c-set-offset 'block-close '0 )

  (setq indent-line-function   'nasal-cautious-indent-line)
  (setq indent-region-function 'nasal-cautious-indent-region)
  (setq c-special-indent-hook  nil)

  (set (make-local-variable 'beginning-of-defun-function)            'nasal-beginning-of-defun)
  (set (make-local-variable 'end-of-defun-function)                  'nasal-end-of-defun)
  (set (make-local-variable 'open-paren-in-column-0-is-defun-start)  nil)
  (set (make-local-variable 'defun-prompt-regexp)                    "^\\s-*function\\s-+&?\\s-*\\(\\(\\sw\\|\\s_\\)+\\)\\s-*")
  (set (make-local-variable 'add-log-current-defun-header-regexp)    nasal-beginning-of-defun-regexp)

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

;; " :let nasal_no_fgfs=1               " turn off FlightGear extensions

;; syn match   nasalParenError	"[()]"
;; syn match   nasalBraceError	"[{}]"
;; syn match   nasalBrackError	"[\[\]]"

(provide 'nasal)