| 1 : |
monnier |
32 |
;;; sml-font.el --- Highlighting for sml-mode using font-lock.
|
| 2 : |
|
|
;;
|
| 3 : |
|
|
;; Copyright (C) 1995 Frederick Knabe
|
| 4 : |
|
|
;;
|
| 5 : |
|
|
;; Author: Fritz Knabe <knabe@ecrc.de>
|
| 6 : |
|
|
;; ECRC GmbH, Arabellastr. 17, 81925 Munich, Germany
|
| 7 : |
|
|
;; Created: 26 June 1995
|
| 8 : |
|
|
;; Modified: 14 April 1997, M.J.Morley <mjm@scs.leeds.ac.uk>
|
| 9 : |
|
|
;; Add a couple of keywords to s-f-l-standard-keywords.
|
| 10 : |
|
|
;;
|
| 11 : |
|
|
;; $Revision: 1.6 $
|
| 12 : |
|
|
;; $Date: 1997/04/29 19:55:40 $
|
| 13 : |
|
|
;;
|
| 14 : |
|
|
;; ====================================================================
|
| 15 : |
|
|
;; This program is free software; you can redistribute it and/or modify
|
| 16 : |
|
|
;; it under the terms of the GNU General Public License as published by
|
| 17 : |
|
|
;; the Free Software Foundation; either version 2 of the License, or
|
| 18 : |
|
|
;; (at your option) any later version.
|
| 19 : |
|
|
;;
|
| 20 : |
|
|
;; This program is distributed in the hope that it will be useful,
|
| 21 : |
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
| 22 : |
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
| 23 : |
|
|
;; GNU General Public License for more details.
|
| 24 : |
|
|
;;
|
| 25 : |
|
|
;; If you did not receive a copy of the GNU General Public License with
|
| 26 : |
|
|
;; this program, write to the Free Software Foundation, Inc., 675 Mass
|
| 27 : |
|
|
;; Ave, Cambridge, MA 02139, USA.
|
| 28 : |
|
|
;; ====================================================================
|
| 29 : |
|
|
;;
|
| 30 : |
|
|
;;; DESCRIPTION
|
| 31 : |
|
|
;;
|
| 32 : |
|
|
;; This package sets up highlighting of SML using font-lock. If you
|
| 33 : |
|
|
;; use the new version of font-lock distributed in GNU Emacs, SML's
|
| 34 : |
|
|
;; nested comments as well as its special string escapes will be
|
| 35 : |
|
|
;; handled properly. The version of font-lock distributed with XEmacs
|
| 36 : |
|
|
;; can also be used, but these special cases will not be handled.
|
| 37 : |
|
|
;;
|
| 38 : |
|
|
;; Should the fontification become incorrect while editing (for
|
| 39 : |
|
|
;; example, when uncommenting), M-x font-lock-fontify-buffer will clear
|
| 40 : |
|
|
;; things up.
|
| 41 : |
|
|
;;
|
| 42 : |
|
|
;; To install (assuming that you use sml-mode 3.1), put the following
|
| 43 : |
|
|
;; in your .emacs:
|
| 44 : |
|
|
;;
|
| 45 : |
|
|
;; (setq sml-hilite nil) ; Turn off highlighting based on hilit19
|
| 46 : |
|
|
;;
|
| 47 : |
|
|
;; ;; For GNU Emacs
|
| 48 : |
|
|
;; (eval-after-load "sml-mode" '(require 'sml-font))
|
| 49 : |
|
|
;;
|
| 50 : |
|
|
;; ;; For XEmacs
|
| 51 : |
|
|
;; (require 'sml-font)
|
| 52 : |
|
|
;;
|
| 53 : |
|
|
;;
|
| 54 : |
|
|
;; Versions 3.2 and later of sml-mode define sml-load-hook (and the
|
| 55 : |
|
|
;; variable sml-hilite is spurious), so you can simply put:
|
| 56 : |
|
|
;;
|
| 57 : |
|
|
;; (setq sml-load-hook
|
| 58 : |
|
|
;; '(lambda() "Fontify SML." (require 'sml-font)))
|
| 59 : |
|
|
;;
|
| 60 : |
|
|
;; By default, font-lock will be turned on automatically for every SML
|
| 61 : |
|
|
;; buffer. If you don't want this, also add the following:
|
| 62 : |
|
|
;;
|
| 63 : |
|
|
;; (setq sml-font-lock-auto-on nil)
|
| 64 : |
|
|
;;
|
| 65 : |
|
|
;; If you want to add to the keywords that will be fontified, set the
|
| 66 : |
|
|
;; variable sml-font-lock-extra-keywords (see its documentation).
|
| 67 : |
|
|
;;
|
| 68 : |
|
|
;; Thanks to Matthew Morley <morley@gmd.de> for suggestions and fixes.
|
| 69 : |
|
|
;;
|
| 70 : |
|
|
|
| 71 : |
|
|
(require 'font-lock)
|
| 72 : |
|
|
|
| 73 : |
|
|
(defvar sml-font-lock-auto-on t
|
| 74 : |
|
|
"*If non-nil, turn on font-lock unconditionally for every SML buffer.")
|
| 75 : |
|
|
|
| 76 : |
|
|
(defvar sml-font-lock-extra-keywords nil
|
| 77 : |
|
|
;; The example is easier to read if you load this package and use C-h v
|
| 78 : |
|
|
;; to view the documentation.
|
| 79 : |
|
|
"*List of regexps to fontify as additional SML keywords.
|
| 80 : |
|
|
|
| 81 : |
|
|
For example, to add `xfun', `xfn', `special', and `=>', the value could be
|
| 82 : |
|
|
|
| 83 : |
|
|
(\"\\=\\=\\=\\\\=\\=\\=\\<xfu?n\\\\|special\\\\>\" \"=>\")
|
| 84 : |
|
|
|
| 85 : |
|
|
The word delimiters in the first pattern prevent spurious highlighting
|
| 86 : |
|
|
of keywords embedded inside other words (e.g., we don't want the tail of
|
| 87 : |
|
|
`myxfun' to be highlighted). You cannot use word delimiters with
|
| 88 : |
|
|
symbolic patterns, however, because only alphanumerics are defined as
|
| 89 : |
|
|
Emacs word constituents. The second pattern would match the tail of a
|
| 90 : |
|
|
symbolic identifier such as `==>', which might not be what you want.")
|
| 91 : |
|
|
|
| 92 : |
|
|
(defvar sml-font-lock-standard-keywords
|
| 93 : |
|
|
;; Generated with Simon Marshall's make-regexp:
|
| 94 : |
|
|
;; (make-regexp
|
| 95 : |
|
|
;; '("abstype" "and" "andalso" "as" "case" "datatype"
|
| 96 : |
|
|
;; "else" "end" "eqtype" "exception" "do" "fn" "fun" "functor"
|
| 97 : |
|
|
;; "handle" "if" "in" "include" "infix" "infixr" "let" "local" "nonfix"
|
| 98 : |
|
|
;; "of" "op" "open" "orelse" "overload" "raise" "rec" "sharing" "sig"
|
| 99 : |
|
|
;; "signature" "struct" "structure" "then" "type" "val" "where" "while"
|
| 100 : |
|
|
;; "with" "withtype") t)
|
| 101 : |
|
|
|
| 102 : |
|
|
"\\<\\(a\\(bstype\\|nd\\(\\|also\\)\\|s\\)\\|case\\|d\\(atatype\\|o\\)\\|\
|
| 103 : |
|
|
e\\(lse\\|nd\\|qtype\\|xception\\)\\|f\\(n\\|un\\(\\|ctor\\)\\)\\|\handle\\|\
|
| 104 : |
|
|
i\\([fn]\\|n\\(clude\\|fixr?\\)\\)\\|l\\(et\\|ocal\\)\\|nonfix\\|\
|
| 105 : |
|
|
o\\([fp]\\|pen\\|relse\\|verload\\)\\|r\\(aise\\|ec\\)\\|\
|
| 106 : |
|
|
s\\(haring\\|ig\\(\\|nature\\)\\|truct\\(\\|ure\\)\\)\\|t\\(hen\\|ype\\)\\|\
|
| 107 : |
|
|
val\\|w\\(h\\(ere\\|ile\\)\\|ith\\(\\|type\\)\\)\\)\\>"
|
| 108 : |
|
|
|
| 109 : |
|
|
"Regexp matching standard SML keywords.")
|
| 110 : |
|
|
|
| 111 : |
|
|
(defvar sml-font-lock-all nil
|
| 112 : |
|
|
"Font-lock matchers for SML.")
|
| 113 : |
|
|
|
| 114 : |
|
|
(defun sml-font-lock-setup ()
|
| 115 : |
|
|
"Set buffer-local font-lock variables and possibly turn on font-lock."
|
| 116 : |
|
|
(let ((new-font-lock (boundp 'font-lock-defaults)))
|
| 117 : |
|
|
;; If new-font-lock is t, use sml-font-comments-and-strings to do
|
| 118 : |
|
|
;; fontification of comments and strings. Otherwise, do
|
| 119 : |
|
|
;; fontification using the SML syntax table (which will not always
|
| 120 : |
|
|
;; be correct).
|
| 121 : |
|
|
(or sml-font-lock-all
|
| 122 : |
|
|
(setq sml-font-lock-all
|
| 123 : |
|
|
(append
|
| 124 : |
|
|
(and new-font-lock (list (list 'sml-font-comments-and-strings)))
|
| 125 : |
|
|
sml-font-lock-extra-keywords
|
| 126 : |
|
|
(list (list sml-font-lock-standard-keywords 1
|
| 127 : |
|
|
'font-lock-keyword-face)))))
|
| 128 : |
|
|
(cond (new-font-lock
|
| 129 : |
|
|
(make-local-variable 'font-lock-defaults)
|
| 130 : |
|
|
(setq font-lock-defaults '(sml-font-lock-all t)))
|
| 131 : |
|
|
(t
|
| 132 : |
|
|
(setq font-lock-keywords sml-font-lock-all))))
|
| 133 : |
|
|
(and sml-font-lock-auto-on (turn-on-font-lock)))
|
| 134 : |
|
|
|
| 135 : |
|
|
(add-hook 'sml-mode-hook 'sml-font-lock-setup)
|
| 136 : |
|
|
|
| 137 : |
|
|
(defvar sml-font-cache '((0 . normal))
|
| 138 : |
|
|
"List of (POSITION . STATE) pairs for an SML buffer.
|
| 139 : |
|
|
The STATE is either `normal', `comment', or `string'. The POSITION is
|
| 140 : |
|
|
immediately after the token that caused the state change.")
|
| 141 : |
|
|
|
| 142 : |
|
|
(make-variable-buffer-local 'sml-font-cache)
|
| 143 : |
|
|
|
| 144 : |
|
|
(defun sml-font-comments-and-strings (limit)
|
| 145 : |
|
|
"Fontify SML comments and strings up to LIMIT.
|
| 146 : |
|
|
Handles nested comments and SML's escapes for breaking a string over lines.
|
| 147 : |
|
|
Uses sml-font-cache to maintain the fontification state over the buffer."
|
| 148 : |
|
|
(let ((beg (point))
|
| 149 : |
|
|
last class)
|
| 150 : |
|
|
(while (< beg limit)
|
| 151 : |
|
|
(while (and sml-font-cache
|
| 152 : |
|
|
(> (car (car sml-font-cache)) beg))
|
| 153 : |
|
|
(setq sml-font-cache (cdr sml-font-cache)))
|
| 154 : |
|
|
(setq last (car (car sml-font-cache)))
|
| 155 : |
|
|
(setq class (cdr (car sml-font-cache)))
|
| 156 : |
|
|
(goto-char last)
|
| 157 : |
|
|
(cond
|
| 158 : |
|
|
((eq class 'normal)
|
| 159 : |
|
|
(cond
|
| 160 : |
|
|
((not (re-search-forward "\\((\\*\\)\\|\\(\"\\)" limit t))
|
| 161 : |
|
|
(goto-char limit))
|
| 162 : |
|
|
((match-beginning 1)
|
| 163 : |
|
|
(setq sml-font-cache (cons (cons (point) 'comment) sml-font-cache)))
|
| 164 : |
|
|
((match-beginning 2)
|
| 165 : |
|
|
(setq sml-font-cache (cons (cons (point) 'string) sml-font-cache)))))
|
| 166 : |
|
|
((eq class 'comment)
|
| 167 : |
|
|
(cond
|
| 168 : |
|
|
((let ((nest 1))
|
| 169 : |
|
|
(while (and (> nest 0)
|
| 170 : |
|
|
(re-search-forward "\\((\\*\\)\\|\\(\\*)\\)" limit t))
|
| 171 : |
|
|
(cond
|
| 172 : |
|
|
((match-beginning 1) (setq nest (+ nest 1)))
|
| 173 : |
|
|
((match-beginning 2) (setq nest (- nest 1)))))
|
| 174 : |
|
|
(> nest 0))
|
| 175 : |
|
|
(goto-char limit))
|
| 176 : |
|
|
(t
|
| 177 : |
|
|
(setq sml-font-cache (cons (cons (point) 'normal) sml-font-cache))))
|
| 178 : |
|
|
(put-text-property (- last 2) (point) 'face 'font-lock-comment-face))
|
| 179 : |
|
|
((eq class 'string)
|
| 180 : |
|
|
(while (and (re-search-forward
|
| 181 : |
|
|
"\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" limit t)
|
| 182 : |
|
|
(not (match-beginning 1))))
|
| 183 : |
|
|
(cond
|
| 184 : |
|
|
((match-beginning 1)
|
| 185 : |
|
|
(setq sml-font-cache (cons (cons (point) 'normal) sml-font-cache)))
|
| 186 : |
|
|
(t
|
| 187 : |
|
|
(goto-char limit)))
|
| 188 : |
|
|
(put-text-property (- last 1) (point) 'face 'font-lock-string-face)))
|
| 189 : |
|
|
(setq beg (point)))))
|
| 190 : |
|
|
|
| 191 : |
|
|
(provide 'sml-font)
|
Parent Directory
| 
Revision Log
