;;; nd major mode for syntax highlighting only
;;;
;;; Add
;;;
;;; (setq nd-root "/Users/fp/programs/snax/src/")
;;; (load (concat nd-root "nd.el"))
;;; (setq auto-mode-alist (cons '("\\.nd$" . nd-mode) auto-mode-alist))
;;;
;;; to your .emacs or Preferences.el file

(defvar nd-mode-syntax-table nil "syntax table for `nd-mode'.")

(setq nd-mode-syntax-table
      (let ((synTable (make-syntax-table)))
        (modify-syntax-entry ?\( "()1" synTable)
        (modify-syntax-entry ?\) ")(4" synTable)
        (modify-syntax-entry ?{ "(}" synTable)
        (modify-syntax-entry ?} "){" synTable)
        (modify-syntax-entry ?[ "(]" synTable)
        (modify-syntax-entry ?] ")[" synTable)
        (modify-syntax-entry ?* ". 23n" synTable)
        (modify-syntax-entry ?' "w" synTable) ;; purposely, to simplify patterns
        (modify-syntax-entry ?: "." synTable)
        (modify-syntax-entry ?, "." synTable)
        (modify-syntax-entry ?+ "." synTable)
        (modify-syntax-entry ?. "." synTable)
        (modify-syntax-entry ?& "." synTable)
        (modify-syntax-entry ?^ "." synTable)
        ;; commented out the next two because of '->' and '=>'
        ;; (modify-syntax-entry ?< "(>" synTable)
        ;; (modify-syntax-entry ?> ")<" synTable)
        ;; see arrows-not-delimiter below
        ;; (modify-syntax-entry ?< "." synTable)
        ;; (modify-syntax-entry ?> "." synTable)
        ;; (modify-syntax-entry ?- "." synTable)
        (modify-syntax-entry ?= "." synTable)
        (modify-syntax-entry ?% "<" synTable)
        (modify-syntax-entry ?\n ">" synTable)
        (modify-syntax-entry ?_ "w" synTable) ;; purposely, to simplify patterns
        synTable))

;; currently not used
(defun all-type-names-regexp (limit)
  (let ((type-names nil))
    (while (re-search-forward "\\<\\(type\\)\\>\\s-+\\<\\(\\w+\\)\\>" limit t)
      (let ((type-name (match-string 2)))
        (setq type-names (cons type-name type-names))))
    (let ((type-names-regexp (concat "\\<\\(" (string-join fun-names "\\|") "\\)\\>")))
      type-names-regexp)))

(setq debug-info nil)

;; this doesn't seem to be working
(defun arrows-not-delimiters (start end)
  "Change syntax of characters ?< and ?> to symbol if part of an arrow"
  (save-excursion
    (goto-char start)
    (setq debug-info 0)
    (while (re-search-forward "->\\|=>" end t)
      (setq debug-info (buffer-substring (1- (point)) (point)))
      (put-text-property (1- (point)) (point)
                         'syntax-table (string-to-syntax ".")))))

(setq nd-highlights
      '(("\\<\\(type\\|defn\\|inst\\|match\\|with\\|end\\|fun\\|record\\|susp\\|force\\)\\>" . 'font-lock-keyword-face)
        ("\\(\\<'\\w+\\>\\)" . 'font-lock-constant-face)
        ("\\<\\(type\\)\\>\\s-+\\<\\(\\w+\\)\\>" 2 'font-lock-function-name-face)
        ("\\<\\(defn\\)\\>\\s-+\\<\\(\\w+\\)\\>" 2 'font-lock-function-name-face)
        ("\\<\\(inst\\)\\>\\s-+\\<\\(\\w+\\)\\>" 2 'font-lock-function-name-face)
        ("\\<fail\\|proc\\|read\\|write\\|cut\\|id\\|call\\|reuse\\|value\\|clos\\>" . 'font-lock-warning-face)))

(define-derived-mode nd-mode fundamental-mode "nd"
  "major mode for editing ND code"
  (setq font-lock-defaults '(nd-highlights))
  (set-syntax-table nd-mode-syntax-table)
  ;; (arrows-not-delimiters (point-min) (point-max))
  )

(provide 'nd-mode)