208 lines
7.7 KiB
EmacsLisp
208 lines
7.7 KiB
EmacsLisp
|
;; haskell-c2hs.el --- -*- lexical-binding: t; -*-
|
||
|
|
|
||
|
|
;; Copyright (C) 2016 Sergey Vinokurov
|
||
|
|
;;
|
||
|
|
;; Author: Sergey Vinokurov <serg.foo@gmail.com>
|
||
|
|
;; Created: Monday, 7 March 2016
|
||
|
|
|
||
|
|
;; 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 3 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, see <http://www.gnu.org/licenses/>.
|
||
|
|
|
||
|
|
;;; Commentary:
|
||
|
|
;; This mode is mostly intended for highlighting {#...#} hooks.
|
||
|
|
;;
|
||
|
|
;; Quick setup:
|
||
|
|
;; (autoload 'haskell-c2hs-mode "haskell-c2hs-mode" nil t)
|
||
|
|
;; (add-to-list 'auto-mode-alist '("\\.chs\\'" . haskell-c2hs-mode))
|
||
|
|
;;
|
||
|
|
|
||
|
|
(require 'haskell-mode)
|
||
|
|
(require 'haskell-font-lock)
|
||
|
|
(require 'haskell-utils)
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(add-to-list 'auto-mode-alist '("\\.chs\\'" . haskell-c2hs-mode))
|
||
|
|
|
||
|
|
(defface haskell-c2hs-hook-pair-face
|
||
|
|
'((t (:inherit 'font-lock-preprocessor-face)))
|
||
|
|
"Face for highlighting {#...#} pairs."
|
||
|
|
:group 'haskell)
|
||
|
|
|
||
|
|
(defface haskell-c2hs-hook-name-face
|
||
|
|
'((t (:inherit 'font-lock-keyword-face)))
|
||
|
|
"Face for highlighting c2hs hook names."
|
||
|
|
:group 'haskell)
|
||
|
|
|
||
|
|
(defvar haskell-c2hs-font-lock-keywords
|
||
|
|
`((,(eval-when-compile
|
||
|
|
(let* ((ws '(any ?\s ?\t ?\n ?\r))
|
||
|
|
(anychar '(or (not (any ?#))
|
||
|
|
(seq "#"
|
||
|
|
(not (any ?\})))))
|
||
|
|
(any-nonquote '(or (not (any ?# ?\"))
|
||
|
|
(seq "#"
|
||
|
|
(not (any ?\} ?\")))))
|
||
|
|
(cid '(seq (any (?a . ?z) (?A . ?Z) ?_)
|
||
|
|
(* (any (?a . ?z) (?A . ?Z) (?0 . ?9) ?_))))
|
||
|
|
(hsid-type '(seq (? "'")
|
||
|
|
(any (?A . ?Z))
|
||
|
|
(* (any (?a . ?z) (?A . ?Z) (?0 . ?9) ?_ ?'))))
|
||
|
|
(equals-str-val `(seq (* ,ws)
|
||
|
|
"="
|
||
|
|
(* ,ws)
|
||
|
|
"\""
|
||
|
|
(* ,any-nonquote)
|
||
|
|
"\"")))
|
||
|
|
(eval
|
||
|
|
`(rx
|
||
|
|
(seq
|
||
|
|
(group-n 1 "{#")
|
||
|
|
(* ,ws)
|
||
|
|
(or (seq (group-n 2
|
||
|
|
"import"
|
||
|
|
(opt (+ ,ws)
|
||
|
|
"qualified"))
|
||
|
|
(+ ,ws))
|
||
|
|
(seq (group-n 2
|
||
|
|
"context")
|
||
|
|
(opt (+ ,ws)
|
||
|
|
(group-n 3
|
||
|
|
"lib")
|
||
|
|
,equals-str-val)
|
||
|
|
(opt (+ ,ws)
|
||
|
|
(group-n 4
|
||
|
|
"prefix")
|
||
|
|
,equals-str-val)
|
||
|
|
(opt (+ ,ws)
|
||
|
|
(group-n 5
|
||
|
|
"add"
|
||
|
|
(+ ,ws)
|
||
|
|
"prefix")
|
||
|
|
,equals-str-val))
|
||
|
|
(seq (group-n 2
|
||
|
|
"type")
|
||
|
|
(+ ,ws)
|
||
|
|
,cid)
|
||
|
|
(seq (group-n 2
|
||
|
|
"sizeof")
|
||
|
|
(+ ,ws)
|
||
|
|
,cid)
|
||
|
|
(seq (group-n 2
|
||
|
|
"enum"
|
||
|
|
(+ ,ws)
|
||
|
|
"define")
|
||
|
|
(+ ,ws)
|
||
|
|
,cid)
|
||
|
|
;; TODO: vanilla enum fontification is incomplete
|
||
|
|
(seq (group-n 2
|
||
|
|
"enum")
|
||
|
|
(+ ,ws)
|
||
|
|
,cid
|
||
|
|
(opt (+ ,ws)
|
||
|
|
(group-n 3
|
||
|
|
"as")))
|
||
|
|
;; TODO: fun hook highlighting is incompelete
|
||
|
|
(seq (group-n 2
|
||
|
|
(or "call"
|
||
|
|
"fun")
|
||
|
|
(opt (+ ,ws)
|
||
|
|
"pure")
|
||
|
|
(opt (+ ,ws)
|
||
|
|
"unsafe"))
|
||
|
|
(+ ,ws)
|
||
|
|
,cid
|
||
|
|
(opt (+ ,ws)
|
||
|
|
(group-n 3
|
||
|
|
"as")
|
||
|
|
(opt (+ ,ws)
|
||
|
|
(group-n 8
|
||
|
|
"^"))))
|
||
|
|
(group-n 2
|
||
|
|
"get")
|
||
|
|
(group-n 2
|
||
|
|
"set")
|
||
|
|
(seq (group-n 2
|
||
|
|
"pointer")
|
||
|
|
(or (seq (* ,ws)
|
||
|
|
(group-n 3 "*")
|
||
|
|
(* ,ws))
|
||
|
|
(+ ,ws))
|
||
|
|
,cid
|
||
|
|
(opt (+ ,ws)
|
||
|
|
(group-n 4 "as")
|
||
|
|
(+ ,ws)
|
||
|
|
,hsid-type)
|
||
|
|
(opt (+ ,ws)
|
||
|
|
(group-n 5
|
||
|
|
(or "foreign"
|
||
|
|
"stable")))
|
||
|
|
(opt
|
||
|
|
(or (seq (+ ,ws)
|
||
|
|
(group-n 6
|
||
|
|
"newtype"))
|
||
|
|
(seq (* ,ws)
|
||
|
|
"->"
|
||
|
|
(* ,ws)
|
||
|
|
,hsid-type)))
|
||
|
|
(opt (+ ,ws)
|
||
|
|
(group-n 7
|
||
|
|
"nocode")))
|
||
|
|
(group-n 2
|
||
|
|
"class")
|
||
|
|
(group-n 2
|
||
|
|
"alignof")
|
||
|
|
(group-n 2
|
||
|
|
"offsetof")
|
||
|
|
(seq (group-n 2
|
||
|
|
"const")
|
||
|
|
(+ ,ws)
|
||
|
|
,cid)
|
||
|
|
(seq (group-n 2
|
||
|
|
"typedef")
|
||
|
|
(+ ,ws)
|
||
|
|
,cid
|
||
|
|
(+ ,ws)
|
||
|
|
,hsid-type)
|
||
|
|
(group-n 2
|
||
|
|
"nonGNU")
|
||
|
|
;; TODO: default hook not implemented
|
||
|
|
)
|
||
|
|
(* ,anychar)
|
||
|
|
(group-n 9 "#}"))))))
|
||
|
|
;; Override highlighting for pairs in order to always distinguish them.
|
||
|
|
(1 'haskell-c2hs-hook-pair-face t)
|
||
|
|
(2 'haskell-c2hs-hook-name-face)
|
||
|
|
;; Make matches lax, i.e. do not signal error if nothing
|
||
|
|
;; matched.
|
||
|
|
(3 'haskell-c2hs-hook-name-face nil t)
|
||
|
|
(4 'haskell-c2hs-hook-name-face nil t)
|
||
|
|
(5 'haskell-c2hs-hook-name-face nil t)
|
||
|
|
(6 'haskell-c2hs-hook-name-face nil t)
|
||
|
|
(7 'haskell-c2hs-hook-name-face nil t)
|
||
|
|
(8 'font-lock-negation-char-face nil t)
|
||
|
|
;; Override highlighting for pairs in order to always distinguish them.
|
||
|
|
(9 'haskell-c2hs-hook-pair-face t))
|
||
|
|
,@(haskell-font-lock-keywords)))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(define-derived-mode haskell-c2hs-mode haskell-mode "C2HS"
|
||
|
|
"Mode for editing *.chs files of the c2hs haskell tool."
|
||
|
|
(setq-local font-lock-defaults
|
||
|
|
(cons 'haskell-c2hs-font-lock-keywords
|
||
|
|
(cdr font-lock-defaults))))
|
||
|
|
|
||
|
|
|
||
|
|
(provide 'haskell-c2hs)
|
||
|
|
|
||
|
|
;; haskell-c2hs.el ends here
|