187 lines
7.8 KiB
EmacsLisp
187 lines
7.8 KiB
EmacsLisp
;;; fuel-font-lock.el -- font lock for factor code
|
||
|
||
;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
|
||
;; See http://factorcode.org/license.txt for BSD license.
|
||
|
||
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
|
||
;; Keywords: languages, fuel, factor
|
||
;; Start date: Wed Dec 03, 2008 21:40
|
||
|
||
;;; Comentary:
|
||
|
||
;; Font lock setup for highlighting Factor code.
|
||
|
||
;;; Code:
|
||
|
||
(require 'fuel-syntax)
|
||
(require 'fuel-base)
|
||
|
||
(require 'font-lock)
|
||
|
||
|
||
;;; Faces:
|
||
|
||
(defgroup fuel-faces nil
|
||
"Faces used by FUEL."
|
||
:group 'fuel
|
||
:group 'faces)
|
||
|
||
(defmacro fuel-font-lock--defface (face def group doc)
|
||
`(defface ,face (face-default-spec ,def)
|
||
,(format "Face for %s." doc)
|
||
:group ',group
|
||
:group 'fuel-faces
|
||
:group 'faces))
|
||
|
||
(put 'fuel-font-lock--defface 'lisp-indent-function 1)
|
||
|
||
(defmacro fuel-font-lock--make-face (prefix def-prefix group face def doc)
|
||
(let ((face (intern (format "%s-%s" prefix face)))
|
||
(def (intern (format "%s-%s-face" def-prefix def))))
|
||
`(fuel-font-lock--defface ,face ,def ,group ,doc)))
|
||
|
||
(defmacro fuel-font-lock--define-faces (prefix def-prefix group faces)
|
||
(let ((setup (make-symbol (format "%s--faces-setup" prefix))))
|
||
`(progn
|
||
(defmacro ,setup ()
|
||
(cons 'progn
|
||
(mapcar (lambda (f) (append '(fuel-font-lock--make-face
|
||
,prefix ,def-prefix ,group) f))
|
||
',faces)))
|
||
(,setup))))
|
||
|
||
(fuel-font-lock--define-faces
|
||
factor-font-lock font-lock factor-mode
|
||
((comment comment "comments")
|
||
(constructor type "constructors (<foo>)")
|
||
(constant constant "constants and literal values")
|
||
(number constant "integers and floats")
|
||
(ratio constant "ratios")
|
||
(declaration keyword "declaration words")
|
||
(ebnf-form constant "EBNF: ... ;EBNF form")
|
||
(error-form warning "ERROR: ... ; form")
|
||
(parsing-word keyword "parsing words")
|
||
(postpone-body comment "postponed form")
|
||
(setter-word function-name "setter words (>>foo)")
|
||
(getter-word function-name "getter words (foo>>)")
|
||
(stack-effect comment "stack effect specifications")
|
||
(string string "strings")
|
||
(symbol variable-name "name of symbol being defined")
|
||
(type-name type "type names")
|
||
(vocabulary-name constant "vocabulary names")
|
||
(word function-name "word, generic or method being defined")
|
||
(invalid-syntax warning "syntactically invalid constructs")))
|
||
|
||
|
||
;;; Font lock:
|
||
|
||
(defun fuel-font-lock--syntactic-face (state)
|
||
(if (nth 3 state) 'factor-font-lock-string
|
||
(let ((c (char-after (nth 8 state))))
|
||
(cond ((memq c '(?\ ?\n ?E ?P))
|
||
(save-excursion
|
||
(goto-char (nth 8 state))
|
||
(beginning-of-line)
|
||
(cond ((looking-at "E") 'factor-font-lock-ebnf-form)
|
||
((looking-at "P") 'factor-font-lock-postpone-body)
|
||
((looking-at-p "USING: ")
|
||
'factor-font-lock-vocabulary-name)
|
||
((looking-at-p
|
||
"\\(TUPLE\\|SYMBOLS\\|VARS\\|SINGLETONS\\):")
|
||
'factor-font-lock-symbol)
|
||
((looking-at-p "C-ENUM:\\( \\|\n\\)")
|
||
'factor-font-lock-constant)
|
||
(t 'default))))
|
||
((or (char-equal c ?U) (char-equal c ?C))
|
||
'factor-font-lock-parsing-word)
|
||
((char-equal c ?\") 'factor-font-lock-string)
|
||
(t 'factor-font-lock-comment)))))
|
||
|
||
(defconst fuel-font-lock--font-lock-keywords
|
||
`((,fuel-syntax--stack-effect-regex . 'factor-font-lock-stack-effect)
|
||
(,fuel-syntax--brace-words-regex 1 'factor-font-lock-parsing-word)
|
||
(,fuel-syntax--alien-function-regex (1 'factor-font-lock-type-name)
|
||
(2 'factor-font-lock-word))
|
||
(,fuel-syntax--alien-function-alias-regex (1 'factor-font-lock-word)
|
||
(2 'factor-font-lock-type-name)
|
||
(3 'factor-font-lock-word))
|
||
(,fuel-syntax--alien-callback-regex (1 'factor-font-lock-type-name)
|
||
(2 'factor-font-lock-word))
|
||
(,fuel-syntax--vocab-ref-regexp 2 'factor-font-lock-vocabulary-name)
|
||
(,fuel-syntax--constructor-decl-regex
|
||
(1 'factor-font-lock-word)
|
||
(2 'factor-font-lock-type-name)
|
||
(3 'factor-font-lock-invalid-syntax nil t))
|
||
(,fuel-syntax--typedef-regex (1 'factor-font-lock-type-name)
|
||
(2 'factor-font-lock-type-name)
|
||
(3 'factor-font-lock-invalid-syntax nil t))
|
||
(,fuel-syntax--c-global-regex (1 'factor-font-lock-type-name)
|
||
(2 'factor-font-lock-word)
|
||
(3 'factor-font-lock-invalid-syntax nil t))
|
||
(,fuel-syntax--c-type-regex (1 'factor-font-lock-type-name)
|
||
(2 'factor-font-lock-invalid-syntax nil t))
|
||
(,fuel-syntax--rename-regex (1 'factor-font-lock-word)
|
||
(2 'factor-font-lock-vocabulary-name)
|
||
(3 'factor-font-lock-word)
|
||
(4 'factor-font-lock-invalid-syntax nil t))
|
||
(,fuel-syntax--declaration-words-regex . 'factor-font-lock-declaration)
|
||
(,fuel-syntax--word-definition-regex 2 'factor-font-lock-word)
|
||
(,fuel-syntax--alias-definition-regex (1 'factor-font-lock-word)
|
||
(2 'factor-font-lock-word))
|
||
(,fuel-syntax--int-constant-def-regex 2 'factor-font-lock-constant)
|
||
(,fuel-syntax--integer-regex . 'factor-font-lock-number)
|
||
(,fuel-syntax--float-regex . 'factor-font-lock-number)
|
||
(,fuel-syntax--ratio-regex . 'factor-font-lock-ratio)
|
||
(,fuel-syntax--type-definition-regex 2 'factor-font-lock-type-name)
|
||
(,fuel-syntax--error-regex 2 'factor-font-lock-error-form)
|
||
(,fuel-syntax--method-definition-regex (1 'factor-font-lock-type-name)
|
||
(2 'factor-font-lock-word))
|
||
(,fuel-syntax--before-definition-regex (1 'factor-font-lock-type-name)
|
||
(2 'factor-font-lock-word))
|
||
(,fuel-syntax--after-definition-regex (1 'factor-font-lock-type-name)
|
||
(2 'factor-font-lock-word))
|
||
(,fuel-syntax--tuple-decl-regex 2 'factor-font-lock-type-name)
|
||
(,fuel-syntax--constructor-regex . 'factor-font-lock-constructor)
|
||
(,fuel-syntax--setter-regex . 'factor-font-lock-setter-word)
|
||
(,fuel-syntax--getter-regex . 'factor-font-lock-getter-word)
|
||
(,fuel-syntax--symbol-definition-regex 2 'factor-font-lock-symbol)
|
||
(,fuel-syntax--bad-string-regex . 'factor-font-lock-invalid-syntax)
|
||
("\\_<\\(P\\|SBUF\\|DLL\\)\"" 1 'factor-font-lock-parsing-word)
|
||
(,fuel-syntax--parsing-words-regex . 'factor-font-lock-parsing-word)))
|
||
|
||
(defun fuel-font-lock--font-lock-setup (&optional keywords no-syntax)
|
||
(set (make-local-variable 'comment-start) "! ")
|
||
(set (make-local-variable 'parse-sexp-lookup-properties) t)
|
||
(set (make-local-variable 'font-lock-defaults)
|
||
`(,(or keywords 'fuel-font-lock--font-lock-keywords)
|
||
nil nil nil nil
|
||
,@(if no-syntax nil
|
||
(list (cons 'font-lock-syntactic-keywords
|
||
fuel-syntax--syntactic-keywords)
|
||
(cons 'font-lock-syntactic-face-function
|
||
'fuel-font-lock--syntactic-face))))))
|
||
|
||
|
||
;;; Fontify strings as Factor code:
|
||
|
||
(defun fuel-font-lock--font-lock-buffer ()
|
||
(let ((name " *fuel font lock*"))
|
||
(or (get-buffer name)
|
||
(let ((buffer (get-buffer-create name)))
|
||
(set-buffer buffer)
|
||
(set-syntax-table fuel-syntax--syntax-table)
|
||
(fuel-font-lock--font-lock-setup)
|
||
buffer))))
|
||
|
||
(defun fuel-font-lock--factor-str (str)
|
||
(save-current-buffer
|
||
(set-buffer (fuel-font-lock--font-lock-buffer))
|
||
(erase-buffer)
|
||
(insert str)
|
||
(let ((font-lock-verbose nil)) (font-lock-fontify-buffer))
|
||
(buffer-string)))
|
||
|
||
|
||
(provide 'fuel-font-lock)
|
||
;;; fuel-font-lock.el ends here
|