misc/fuel/fuel-font-lock.el

   1 ;;; fuel-font-lock.el -- font lock for factor code
   2
   3 ;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
   4 ;; See http://factorcode.org/license.txt for BSD license.
   5
   6 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
   7 ;; Keywords: languages, fuel, factor
   8 ;; Start date: Wed Dec 03, 2008 21:40
   9
  10 ;;; Comentary:
  11
  12 ;; Font lock setup for highlighting Factor code.
  13
  14 ;;; Code:
  15
  16 (require 'fuel-syntax)
  17 (require 'fuel-base)
  18
  19 (require 'font-lock)
  20
  21 \f
  22 ;;; Faces:
  23
  24 (defgroup fuel-faces nil
  25   "Faces used by FUEL."
  26   :group 'fuel
  27   :group 'faces)
  28
  29 (defmacro fuel-font-lock--defface (face def group doc)
  30   `(defface ,face (face-default-spec ,def)
  31      ,(format "Face for %s." doc)
  32      :group ',group
  33      :group 'fuel-faces
  34      :group 'faces))
  35
  36 (put 'fuel-font-lock--defface 'lisp-indent-function 1)
  37
  38 (defmacro fuel-font-lock--make-face (prefix def-prefix group face def doc)
  39   (let ((face (intern (format "%s-%s" prefix face)))
  40         (def (intern (format "%s-%s-face" def-prefix def))))
  41     `(fuel-font-lock--defface ,face ,def ,group ,doc)))
  42
  43 (defmacro fuel-font-lock--define-faces (prefix def-prefix group faces)
  44   (let ((setup (make-symbol (format "%s--faces-setup" prefix))))
  45   `(progn
  46      (defmacro ,setup ()
  47        (cons 'progn
  48              (mapcar (lambda (f) (append '(fuel-font-lock--make-face
  49                                       ,prefix ,def-prefix ,group) f))
  50                      ',faces)))
  51      (,setup))))
  52
  53 (fuel-font-lock--define-faces
  54  factor-font-lock font-lock factor-mode
  55  ((comment comment "comments")
  56   (constructor type  "constructors (<foo>)")
  57   (constant constant  "constants and literal values")
  58   (number constant  "integers and floats")
  59   (ratio constant  "ratios")
  60   (declaration keyword "declaration words")
  61   (ebnf-form constant "EBNF: ... ;EBNF form")
  62   (error-form warning "ERROR: ... ; form")
  63   (parsing-word keyword  "parsing words")
  64   (postpone-body comment "postponed form")
  65   (setter-word function-name "setter words (>>foo)")
  66   (getter-word function-name "getter words (foo>>)")
  67   (stack-effect comment "stack effect specifications")
  68   (string string "strings")
  69   (symbol variable-name "name of symbol being defined")
  70   (type-name type "type names")
  71   (vocabulary-name constant "vocabulary names")
  72   (word function-name "word, generic or method being defined")
  73   (invalid-syntax warning "syntactically invalid constructs")))
  74
  75 \f
  76 ;;; Font lock:
  77
  78 (defun fuel-font-lock--syntactic-face (state)
  79   (if (nth 3 state) 'factor-font-lock-string
  80     (let ((c (char-after (nth 8 state))))
  81       (cond ((memq c '(?\  ?\n ?E ?P))
  82              (save-excursion
  83                (goto-char (nth 8 state))
  84                (beginning-of-line)
  85                (cond ((looking-at "E") 'factor-font-lock-ebnf-form)
  86                      ((looking-at "P") 'factor-font-lock-postpone-body)
  87                      ((looking-at-p "USING: ")
  88                       'factor-font-lock-vocabulary-name)
  89                      ((looking-at-p
  90                        "\\(TUPLE\\|SYMBOLS\\|VARS\\|SINGLETONS\\):")
  91                       'factor-font-lock-symbol)
  92                      ((looking-at-p "C-ENUM:\\( \\|\n\\)")
  93                       'factor-font-lock-constant)
  94                      (t 'default))))
  95             ((or (char-equal c ?U) (char-equal c ?C))
  96              'factor-font-lock-parsing-word)
  97             ((char-equal c ?\") 'factor-font-lock-string)
  98             (t 'factor-font-lock-comment)))))
  99
 100 (defconst fuel-font-lock--font-lock-keywords
 101   `((,fuel-syntax--stack-effect-regex . 'factor-font-lock-stack-effect)
 102     (,fuel-syntax--brace-words-regex 1 'factor-font-lock-parsing-word)
 103     (,fuel-syntax--alien-function-regex (1 'factor-font-lock-type-name)
 104                                         (2 'factor-font-lock-word))
 105     (,fuel-syntax--alien-function-alias-regex (1 'factor-font-lock-word)
 106                                               (2 'factor-font-lock-type-name)
 107                                               (3 'factor-font-lock-word))
 108     (,fuel-syntax--alien-callback-regex (1 'factor-font-lock-type-name)
 109                                         (2 'factor-font-lock-word))
 110     (,fuel-syntax--vocab-ref-regexp  2 'factor-font-lock-vocabulary-name)
 111     (,fuel-syntax--constructor-decl-regex
 112      (1 'factor-font-lock-word)
 113      (2 'factor-font-lock-type-name)
 114      (3 'factor-font-lock-invalid-syntax nil t))
 115     (,fuel-syntax--typedef-regex (1 'factor-font-lock-type-name)
 116                                  (2 'factor-font-lock-type-name)
 117                                  (3 'factor-font-lock-invalid-syntax nil t))
 118     (,fuel-syntax--c-global-regex (1 'factor-font-lock-type-name)
 119                                   (2 'factor-font-lock-word)
 120                                   (3 'factor-font-lock-invalid-syntax nil t))
 121     (,fuel-syntax--c-type-regex (1 'factor-font-lock-type-name)
 122                                 (2 'factor-font-lock-invalid-syntax nil t))
 123     (,fuel-syntax--rename-regex (1 'factor-font-lock-word)
 124                                 (2 'factor-font-lock-vocabulary-name)
 125                                 (3 'factor-font-lock-word)
 126                                 (4 'factor-font-lock-invalid-syntax nil t))
 127     (,fuel-syntax--declaration-words-regex . 'factor-font-lock-declaration)
 128     (,fuel-syntax--word-definition-regex 2 'factor-font-lock-word)
 129     (,fuel-syntax--alias-definition-regex (1 'factor-font-lock-word)
 130                                           (2 'factor-font-lock-word))
 131     (,fuel-syntax--int-constant-def-regex 2 'factor-font-lock-constant)
 132     (,fuel-syntax--integer-regex . 'factor-font-lock-number)
 133     (,fuel-syntax--float-regex . 'factor-font-lock-number)
 134     (,fuel-syntax--ratio-regex . 'factor-font-lock-ratio)
 135     (,fuel-syntax--type-definition-regex 2 'factor-font-lock-type-name)
 136     (,fuel-syntax--error-regex 2 'factor-font-lock-error-form)
 137     (,fuel-syntax--method-definition-regex (1 'factor-font-lock-type-name)
 138                                            (2 'factor-font-lock-word))
 139     (,fuel-syntax--before-definition-regex (1 'factor-font-lock-type-name)
 140                                            (2 'factor-font-lock-word))
 141     (,fuel-syntax--after-definition-regex  (1 'factor-font-lock-type-name)
 142                                            (2 'factor-font-lock-word))
 143     (,fuel-syntax--tuple-decl-regex 2 'factor-font-lock-type-name)
 144     (,fuel-syntax--constructor-regex . 'factor-font-lock-constructor)
 145     (,fuel-syntax--setter-regex . 'factor-font-lock-setter-word)
 146     (,fuel-syntax--getter-regex . 'factor-font-lock-getter-word)
 147     (,fuel-syntax--symbol-definition-regex 2 'factor-font-lock-symbol)
 148     (,fuel-syntax--bad-string-regex . 'factor-font-lock-invalid-syntax)
 149     ("\\_<\\(P\\|SBUF\\|DLL\\)\"" 1 'factor-font-lock-parsing-word)
 150     (,fuel-syntax--parsing-words-regex . 'factor-font-lock-parsing-word)))
 151
 152 (defun fuel-font-lock--font-lock-setup (&optional keywords no-syntax)
 153   (set (make-local-variable 'comment-start) "! ")
 154   (set (make-local-variable 'parse-sexp-lookup-properties) t)
 155   (set (make-local-variable 'font-lock-defaults)
 156        `(,(or keywords 'fuel-font-lock--font-lock-keywords)
 157          nil nil nil nil
 158          ,@(if no-syntax nil
 159              (list (cons 'font-lock-syntactic-keywords
 160                          fuel-syntax--syntactic-keywords)
 161                    (cons 'font-lock-syntactic-face-function
 162                          'fuel-font-lock--syntactic-face))))))
 163
 164 \f
 165 ;;; Fontify strings as Factor code:
 166
 167 (defun fuel-font-lock--font-lock-buffer ()
 168   (let ((name " *fuel font lock*"))
 169     (or (get-buffer name)
 170         (let ((buffer (get-buffer-create name)))
 171           (set-buffer buffer)
 172           (set-syntax-table fuel-syntax--syntax-table)
 173           (fuel-font-lock--font-lock-setup)
 174           buffer))))
 175
 176 (defun fuel-font-lock--factor-str (str)
 177   (save-current-buffer
 178     (set-buffer (fuel-font-lock--font-lock-buffer))
 179     (erase-buffer)
 180     (insert str)
 181     (let ((font-lock-verbose nil)) (font-lock-fontify-buffer))
 182     (buffer-string)))
 183
 184
 185 (provide 'fuel-font-lock)
 186 ;;; fuel-font-lock.el ends here