;;; d-flock-lisp++.el ---  Fontification of lisp++ mode code

;; Copyright (C) 2016 Davin Pearson

;; Emacs Lisp Archive Entry
;; Filename: d-flock-lisp++.el
;; Author/Maintainer: m4_davin_pearson
;; Keywords: Lisp++
;; Version: 1.0

;;; Commentary:

;; This file is not part of GNU Emacs.

;; This code fontifies lisp++ mode buffers.
;; The actual major mode for editing lisp++ mode buffers is c++-mode

;;; m4_limitation_of_warranty

;;; m4_install_instructions(d-flock-lisp++)

;;; Version History:

;; Version 1.0 first release version.

;;; Known Bugs:

;; None so far!

;;; Code:

(setq auto-mode-alist
      (append
             '(
               ("\\.lisp\\+\\+$" . c++-mode)
              )
      auto-mode-alist))

(add-hook 'font-lock-mode-hook 'lisp++-font-lock-mode-hook)

(defun lisp++-font-lock-mode-hook ()

  (if (eq major-mode 'c++-mode)
      (d-font-lock-add-begin
       '(
         ("^[ \t]+.*\\<[A-Z][a-zA-Z0-9_]*::\\([a-z][a-zA-Z0-9_]*\\)(" 1 default t)
         ("::\\(ctor\\)(" 1 fg:lightmagenta t)
         )))

  (if (or (eq major-mode 'c++-mode)
          (eq major-mode 'emacs-lisp-mode)
          (eq major-mode 'text-mode))
      (d-font-lock-add-begin
        '(
         ;;("\\(\\<cpause\\);" 1 lisp++-keywords nil)
         ("\\<red[-a-zA-Z0-9_]*"       0 lisp++-face-lightred nil)
         ("\\<\\(cpause\\|cinline\\)"  1 lisp++-face-keywords nil)
         )
       ))

  (if (or (eq major-mode 'emacs-lisp-mode)
          (eq major-mode 'text-mode)
          (eq major-mode 'c++-mode)
          (and (buffer-file-name)
               (or (string-match "\\.cmethod$"    (buffer-file-name))
                   (string-match "\\.lisp[+][+]$" (buffer-file-name))
                   (string-match "\\.temp$"       (buffer-file-name))
                   (string-match "\\.lpp$"        (buffer-file-name))
                   )))
      (d-font-lock-add-end
       `(
         ("(\\(cnamespace\\) \\([a-z]*\\)"
          (1 lisp++-face-keywords t)
          (2 fg:lightred t))

         ;;("(cname \\(operator\\)[ \t]*\\([^ ]*\\))"
         ;; (1 bold t)
         ;; (2 font-lock-function-name-face t))
         ;;("(cname \\([^_][^()]+\\))"          1 font-lock-function-name-face t)
         ;;("(cname \\(_[a-z][a-zA-Z0-9_]*\\))" 1 d-face-cc-private t)

         ("\\<debug-[a-z-]*\\>"               0 lisp++-face-illegal-type nil)

         ("(\\(cmethod\\).*(cret \\([^()]*\\)).*(cname \\([^()]*\\))"
          (1 lisp++-face-keywords         nil)
          (2 font-lock-type-face          nil)
          (3 font-lock-function-name-face nil)
          )

         ("(\\(c-static-method\\).*(cret \\([a-zA-Z0-9_<>]+[&*]*\\)).*(cname \\([^()]+\\))"
          (1 lisp++-face-keywords         nil)
          (2 font-lock-type-face          nil)
          (3 font-lock-function-name-face nil)
          )

         ("(\\(cfriend\\).*(cname \\([^()]*\\))"
          (1 lisp++-face-keywords         nil)
          ;;(2 font-lock-function-name-face t)
          )

         ;;("(\\(cfunction\\).*(cname \\([^()]*\\))"
         ;; (1 lisp++-face-keywords         t)
         ;; ;;(2 font-lock-function-name-face nil)
         ;; )

         ("(\\(cmethod\\).*(cname \\([^()]*\\))"
          (1 lisp++-face-keywords          nil)
          ;;(2 font-lock-function-name-face nil)
          )

         ("(\\(c-static-method\\).*(cname \\([^()]*\\))"
          (1 lisp++-face-keywords         nil)
          ;;(2 font-lock-function-name-face nil)
          )

         ("(\\(c-constructor-method\\).*(cname \\([^()]*\\))"
          (1 lisp++-face-keywords         nil)
          (2 font-lock-function-name-face nil)
          )

         ("(\\(c-destructor-method\\).*(cname \\([^()]*\\))"
          (1 lisp++-face-keywords         nil)
          ;;(2 font-lock-function-name-face nil)
          )

         ("(\\(cproperty\\).*(ctype \\([^()]*\\)).*(cname \\([^_][^()]*\\))"
          (1 lisp++-face-keywords         nil)
          (2 font-lock-type-face          nil)
          (3 font-lock-variable-name-face nil))

         ("(\\(cproperty\\).*(ctype \\([^()]*\\)).*(cname \\(_[^()]*\\))"
          (1 lisp++-face-keywords         nil)
          (2 font-lock-type-face          nil)
          (3 d-face-cc-private            nil)
          )

         ("(\\(c-static-property\\).*(ctype \\([^()]*\\)).*(cname \\([^()]*\\))"
          (1 lisp++-face-keywords         t)
          (2 font-lock-type-face          t)
          (3 font-lock-variable-name-face t))

         ("(\\(cglobal\\).*(ctype \\([^()]*\\)).*(cname \\([^()]*\\))"
          (1 lisp++-face-keywords         t)
          (2 font-lock-type-face          t)
          (3 font-lock-variable-name-face t))

         ;;("(cvariable.*(cname \\([^()]*\\))" 1 font-lock-variable-name-face nil)

         (,(concat "\\(c-public-extends\\|"
                   "c-private-extends\\|"
                   "c-protected-extends\\) "
                   "\\([^()\t\r\n]*\\))")
          (1 lisp++-face-keywords nil)
          (2 font-lock-type-face nil))

         ("\\<slot[a-zA-Z0-9-]*" 0 lisp++-face-property nil)

         ("\\<\\(cstr\\|cstr-reduced\\|cstr-new\\|cstr-progn\\)\\>"
          0 lisp++-face-property nil)

         ("\\<c-[-a-zA-Z0-9_+]+" 0 lisp++-face-keywords nil)

         ("(carg .* \\([a-zA-Z_][a-zA-Z0-9_<>]*\\))"
          1 font-lock-variable-name-face nil)

         ("\\(c-basic-offset\\|c-mode\\|c-call\\)" 0 default t)

         ("\\*[a-zA-Z][-a-zA-Z0-9 +<>:!]+\\*" 0 d-face-cc-global nil)

         (,(concat "\\(^\\|['() ]\\)\\(cautogc[-a-z]*\\|cdefine\\|"
                   "cbrackets\\|ccallback\\|ccomment\\|cfptr\\|cargs?\\|cassert\\|"
                   "cnamespace\\|cclass\\|CASSERT\\|chead\\|cbody\\|cdecl\\|cdo\\|"
                   "cenum\\|cinit\\|citems\\|citem\\|"
                   "cif[?]\\|cif\\|celseif\\|celse\\|cinclude\\|"
                   "cfor\\|cglobal\\|cenum\\|cequals\\|"
                   "carray\\|cred\\|cname\\|cpublic\\|"
                   "cprivate\\|cprotected\\|cprogn\\|cprogn[-a-z]*\\|"
                   "cstatic\\|cret\\|ctype\\|"
                   "cforever\\|c-raw-c\\+\\+\\|c-raw-h\\+\\+\\|"
                   "cmethod\\|cfunction\\|cglobal\\|c-raw-global-h\\+\\+\\|"
                   "ctypedef\\|cswitch\\|cvariable\\|cwhile\\)\\>")
          2 lisp++-face-keywords t)

         ;;("\\<c-static-property\\>" 0 lisp++-face-keywords nil)

         ("\\<clet[*]*[ \t]+" 0 lisp++-face-keywords nil)
         ("\\<sc\\>"          0 lisp++-face-keywords nil)
         ("\\<nl\\>"          0 lisp++-face-keywords nil)

         ("(cret[ \t]*[a-zA-Z0-9_ &*<>]* \\([a-zA-Z_][a-zA-Z0-9_]*\\))"
          1 font-lock-variable-name-face nil)

         ("(cret\\([^()]*\\))" 1 font-lock-type-face nil)

         (,(concat "(cret[^()]*)[ \t]*\\([a-zA-Z_][a-zA-Z0-9_]*::\\)?"
                   "\\(~?[A-Z][a-zA-Z0-9_:]+\\)")
          2 font-lock-type-face nil)

         ("(cret \\(~?[A-Za-z0-9_]*\\))" 1 font-lock-type-face nil)

         ("(\\(cclass\\)[ \t]+\\([a-zA-Z_][a-zA-Z0-9_]*\\)"
          (1 lisp++-face-keywords nil)
          (2 font-lock-type-face nil))

         ("\\([a-zA-Z_][a-zA-Z0-9_]*\\)(carg"
          1 font-lock-function-name-face t)

         ;;("\\(operator\\)[ \t]*\\([^ ]*\\)(carg"
         ;; (1 font-lock-keyword-face nil)
         ;; (2 font-lock-function-name-face nil))

         ;;("(\\(cproperty\\|c-static-property\\).* \\([a-zA-Z_][a-zA-Z0-9_]*\\))"
         ;; (1 lisp++-face-keywords         t)
         ;; (2 font-lock-variable-name-face t))

         ("<\\(class\\) \\([a-zA-Z_][a-zA-Z0-9_]*\\)>"
          (1 font-lock-keyword-face t)
          (2 font-lock-type-face    t))

         ("^\\(cinclude\\)(\\([^()]*\\))"
          (1 font-lock-function-name-face t)
          (2 bold t))

         ("\\<char[&*]*[ \t]"   0 font-lock-type-face nil)
         ("\\<int[&*]*[ \t]"    0 font-lock-type-face nil)
         ("\\<double[&*]*[ \t]" 0 font-lock-type-face nil)
         ("\\<float[&*]*[ \t]"  0 font-lock-type-face nil)
         ("\\([ :]\\|[^a-zA-Z0-9_]\\)\\(ctor[a-zA-Z0-9_]*\\)(" 2 lisp++-face-ctor nil)
         ("\\<null\\>"             0 fg:lightred nil)
         ("\\<casto_[a-zA-Z0-9_]*" 0 fg:lightred nil)
         )))

  (if (or (eq major-mode 'emacs-lisp-mode)
          (and (buffer-file-name)
               (or (string-match "\\.cmethod$"     (buffer-file-name))
                   (string-match "\\.lisp[+][+]$"  (buffer-file-name))
                   (string-match "\\.temp$"        (buffer-file-name))
                   )))
      (d-font-lock-add-begin
       '(
         ("\\<s\\>" 0 lisp++-face-keywords nil)
         ("\\<f\\>" 0 lisp++-face-keywords nil)
         )))

  (if (or (eq major-mode 'emacs-lisp-mode)
          (and (buffer-file-name)
               (or (string-match "\\.cmethod$"     (buffer-file-name))
                   (string-match "\\.lisp[+][+]$"  (buffer-file-name))
                   (string-match "\\.temp$"        (buffer-file-name))
                   )))
      (d-font-lock-add-begin
       `(
         (,(concat "\\<\\(bool\\|v3d\\|v3i\\|xyd\\|xyi\\|int\\|float\\|double\\|"
                   "ptr<[a-zA-Z0-9_<]+[ >]*[&*]*\\) \\([a-zA-Z0-9_]*\\)")
          (1 font-lock-type-face          t)
          (2 font-lock-variable-name-face t))

         ("\\<f\\>" 0 lisp++-face-keywords t)
         )))

  (if (and (or (eq major-mode 'emacs-lisp-mode) (eq major-mode 'c++-mode))
           (buffer-file-name)
           (string-match "\\.\\(temp\\|cmethod\\|lisp\\+\\+\\)$" (buffer-file-name)))
      (d-font-lock-add-begin
       '(
         ("(\\(cfunction\\) (cret .*) (cname \\([a-zA-Z_][a-zA-Z0-9_]*\\))"
          (1 lisp++-face-keywords         nil)
          (2 font-lock-function-name-face nil)
          )

         ("(\\(cmethod\\) (cret .*) (cname \\([a-zA-Z_][a-zA-Z0-9_]*\\))"
          (1 lisp++-face-keywords nil)
          ;;(2 font-lock-function-name-face t)
          )

         ("(\\(c-static-method\\) (cret .*) (cname \\([a-zA-Z_][a-zA-Z0-9_]*\\))"
          (1 lisp++-face-keywords nil)
          ;;(2 font-lock-function-name-face t)
          )
         ("(\\(cfriend\\) (cret .*) (cname \\([a-zA-Z_][a-zA-Z0-9_]*\\))"
          (1 lisp++-face-keywords nil)
          ;;(2 font-lock-function-name-face t)
          )

         ;;("(cname \\(_[a-zA-Z0-9]+\\))" 1 private-face t)

         ("\\<\\(cproperty\\|cmethod\\|c-static-method\\|c-super-for\\)\\>"        1 lisp++-face-keywords nil)
         ("\\(c-raw-global-h\\+\\+\\)"                                             1 lisp++-face-keywords t)
         ("\\(cargs\\|cinit\\|cret\\|cname\\)[^()]*)"                              1 lisp++-face-keywords nil)
         ("\\(s\\) .*)"                                                            1 lisp++-face-keywords nil)
         ("\\<\\(cpublic\\|cprotected\\|cprivate\\)\\>"                            1 lisp++-face-keywords nil)
         ("\\<\\(c-public-extends\\|c-private-extends\\|c-protected-extends\\)\\>" 1 lisp++-face-keywords nil)
         ("\\(cclass\\)[ \t]+\\([a-zA-Z_][a-zA-Z0-9_]*\\)\\>"
          (1 lisp++-face-keywords t)
          (2 font-lock-type-face  t))
       )))

  (if (eq major-mode 'c++-mode)
      (d-font-lock-add-end
       '(
         ("^[ \t]*//.*$" 0 font-lock-comment-face t))))

  (if (eq major-mode 'emacs-lisp-mode)
      (d-font-lock-add-end
       '(
         ("^[ \t]*;;.*$" 0 font-lock-comment-face t))))

  (if (string-match "\\.lisp\\+\\+$" (buffer-name))
      (d-font-lock-add-end
       '(
         ("\\<\\(downto\\|to\\|step\\)\\>" 1 lisp++-face-keywords nil)
         )))

  (if (eq major-mode 'emacs-lisp-mode)
      (d-font-lock-add-end
       '(
         ("^[ \t]*;;;.*$" 0 d-face-super-comment t))))
  )

(defun lisp++-font-lock-mode-hook-append ()

  (if (or (eq major-mode 'c++-mode)
          (eq major-mode 'emacs-lisp-mode))
      (d-font-lock-add-end
       '(
         ("^[ \t]*//.*$"               0 font-lock-comment-face t)
         ("^[ \t]*///.*$"              0 d-face-super-comment   t)
         ("\\<c-super-for\\>"          0 lisp++-face-keywords   t)
         ("\\<c-for-each\\>"           0 lisp++-face-keywords   t)
         ("\\<c-for-list\\>"           0 lisp++-face-keywords   t)
         ("\\<c-for-list-backwards\\>" 0 lisp++-face-keywords   t)
         )
       )
    )
  )

(add-hook 'font-lock-mode-hook 'lisp++-font-lock-mode-hook-append 'APPEND)

(make-face 'lisp++-face-lightred)
(set-face-foreground 'lisp++-face-lightred "#f33")
(make-face-bold 'lisp++-face-lightred)
(setq lisp++-face-lightred 'lisp++-face-lightred)

(make-face 'lisp++-face-illegal-type)
(set-face-foreground 'lisp++-face-illegal-type "#f00")
(set-face-background 'lisp++-face-illegal-type "#0ff")
(make-face-bold 'lisp++-face-illegal-type)
(setq lisp++-face-illegal-type 'lisp++-face-illegal-type)

(make-face 'lisp++-face-keywords)
(set-face-foreground 'lisp++-face-keywords "#0c0")
;;(set-face-background 'lisp++-face-keywords bg-colour)
(make-face-bold 'lisp++-face-keywords)
(setq lisp++-face-keywords 'lisp++-face-keywords)

(make-face 'lisp++-face-ctor)
(set-face-foreground 'lisp++-face-ctor "#f0f")
(make-face-bold 'lisp++-face-ctor)
(setq lisp++-face-ctor 'lisp++-face-ctor)

(make-face 'lisp++-face-property)
(set-face-foreground 'lisp++-face-property "#f80")
(make-face-bold 'lisp++-face-property)
(setq lisp++-face-property 'lisp++-face-property)

(provide 'd-flock-lisp++)
;;; d-flock-lisp++.el ends here
