Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/sml-mode/sml-font.el
ViewVC logotype

Annotation of /sml/trunk/sml-mode/sml-font.el

Parent Directory Parent Directory | Revision Log Revision Log


Revision 32 - (view) (download)

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)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0