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-hilite.el
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 32 - (view) (download)

1 : monnier 32 ;;; sml-hilite.el. Highlighting for sml-mode using hilit19.
2 :    
3 :     ;; Copyright (C) 1995 Frederick Knabe
4 :     ;;
5 :     ;; Author: Fritz Knabe <knabe@ecrc.de>
6 :     ;; ECRC GmbH, Arabellastr. 17, 81925 Munich, Germany
7 :     ;;
8 :     ;; Created: 08-Nov-94, Fritz Knabe <knabe@ecrc.de>
9 :     ;; Modified: 14-Apr-97, M.J.Morley <mjm@scs.leeds.ac.uk>
10 :     ;; Added a few keywords to hilit-set-mode-patters.
11 :    
12 :     ;; This file is not part of GNU Emacs, but it is distributed under the
13 :     ;; same conditions.
14 :    
15 :     ;; ====================================================================
16 :    
17 :     ;; This program is free software; you can redistribute it and/or
18 :     ;; modify it under the terms of the GNU General Public License as
19 :     ;; published by the Free Software Foundation; either version 2, or (at
20 :     ;; your option) any later version.
21 :    
22 :     ;; This program is distributed in the hope that it will be useful, but
23 :     ;; WITHOUT ANY WARRANTY; without even the implied warranty of
24 :     ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
25 :     ;; General Public License for more details.
26 :    
27 :     ;; You should have received a copy of the GNU General Public License
28 :     ;; along with GNU Emacs; see the file COPYING. If not, write to the
29 :     ;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
30 :    
31 :     ;; ====================================================================
32 :    
33 :     ;; Put this code *after* the (require 'hilit19) in your .emacs.
34 :     ;; Alternatively, put it in an (eval-after-load "hilit19" ...).
35 :    
36 :     ;; Better, use sml-load-hook like this:
37 :    
38 :     ;; (setq sml-load-hook
39 :     ;; '(lambda() "Highlights." (require 'sml-hilite)))
40 :    
41 :     ;; hilit19 does not currently appear to belong to XEmacs -- they
42 :     ;; favour `font-lock'. Font-lock patterns in sml-font.el
43 :    
44 :     ;;; CODE
45 :    
46 :     (require 'hilit19)
47 :    
48 :     (cond ((and (x-display-color-p) (eq hilit-background-mode 'light))
49 :     ;; for SML
50 :     (hilit-translate sml-comment 'firebrick-italic)
51 :     (hilit-translate sml-string 'ForestGreen-italic)
52 :     (hilit-translate sml-keyword 'blue-bold))
53 :     ((and (x-display-color-p) (eq hilit-background-mode 'dark))
54 :     ;; for SML
55 :     (hilit-translate sml-comment 'moccasin-italic)
56 :     (hilit-translate sml-string 'green-italic)
57 :     (hilit-translate sml-keyword 'cyan-bold))
58 :     (t
59 :     ;; for SML
60 :     (hilit-translate sml-comment 'default-italic)
61 :     (hilit-translate sml-string 'default-bold-italic)
62 :     (hilit-translate sml-keyword 'default-bold)))
63 :    
64 :     (hilit-set-mode-patterns
65 :     'sml-mode
66 :     '((kn-hilit-sml-string-find "" sml-string)
67 :     (kn-hilit-sml-comment-find "" sml-comment)
68 :     ;; The old patterns
69 :     ;;("\"" "[^\\]\"" sml-string)
70 :     ;;("(\\*" "\\*)" sml-comment)
71 :     ("\\(\\`\\|[^_']\\)\
72 :     \\<\\(\
73 :     a\\(bstype\\|nd\\(\\|also\\)\\|s\\)\\|case\\|d\\(atatype\\|o\\)\\|\
74 :     e\\(lse\\|nd\\|qtype\\|xception\\)\\|f\\(n\\|un\\(\\|ctor\\)\\)\\|\handle\\|\
75 :     i\\([fn]\\|n\\(clude\\|fixr?\\)\\)\\|l\\(et\\|ocal\\)\\|nonfix\\|\
76 :     o\\([fp]\\|pen\\|relse\\|verload\\)\\|r\\(aise\\|ec\\)\\|\
77 :     s\\(haring\\|ig\\(\\|nature\\)\\|truct\\(\\|ure\\)\\)\\|t\\(hen\\|ype\\)\\|\
78 :     val\\|w\\(h\\(ere\\|ile\\)\\|ith\\(\\|type\\)\\)
79 :     \\)\\>\
80 :     \\(\\'\\|[^_']\\)" 2 sml-keyword)))
81 :    
82 :     (defun kn-hilit-sml-string-find (dummy)
83 :     "Find an SML string and return (START . END); if none, returns nil.
84 :     Skips over potentially nested comments when searching for the start of the
85 :     string. Skips over \f...f\ (where f is whitespace) sequences in strings."
86 :     (let ((nest 0)
87 :     (continue t)
88 :     st en)
89 :     (while (and continue
90 :     (re-search-forward "\\(\"\\)\\|\\((\\*\\)\\|\\(\\*)\\)" nil t))
91 :     (cond
92 :     ((match-beginning 1) (setq continue (> nest 0)))
93 :     ((match-beginning 2) (setq nest (+ nest 1)))
94 :     ((match-beginning 3) (setq nest (- nest 1)))))
95 :     (if (not continue)
96 :     (progn
97 :     (setq st (match-beginning 1))
98 :     (while (and (re-search-forward
99 :     "\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" nil t)
100 :     (cond
101 :     ((match-beginning 1) (setq en (point)) nil)
102 :     ((match-beginning 2) t)
103 :     ((match-beginning 3) t))))
104 :     (and en (cons st en))))))
105 :    
106 :     (defun kn-hilit-sml-comment-find (dummy)
107 :     "Find an SML comment and return (START . END); if none, returns nil.
108 :     Handles nested comments. Ensures that the comment starts outside of a string."
109 :     (let ((continue t)
110 :     (nest 1)
111 :     st en)
112 :     (while (and continue
113 :     (re-search-forward "\\(\"\\)\\|\\((\\*\\)" nil t))
114 :     (cond
115 :     ((match-beginning 1)
116 :     (while (and (re-search-forward
117 :     "\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" nil t)
118 :     (cond
119 :     ((match-beginning 1) nil)
120 :     ((match-beginning 2) t)
121 :     ((match-beginning 3) t)))))
122 :     ((match-beginning 2) (setq continue nil))))
123 :     (if (not continue)
124 :     (progn
125 :     (setq st (match-beginning 2))
126 :     (setq continue t)
127 :     (while (and continue
128 :     (re-search-forward "\\((\\*\\)\\|\\(\\*)\\)" nil t))
129 :     (cond
130 :     ((match-beginning 1) (setq nest (+ nest 1)))
131 :     ((match-beginning 2)
132 :     (setq nest (- nest 1)) (setq continue (> nest 0)))))
133 :     (if (not continue)
134 :     (cons st (match-end 2)))))))
135 :    
136 :     (provide 'sml-hilite)
137 :    
138 :     ;;; no more sml-hilite.el, it's finished.

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