+++ /dev/null
-;;; sml-hilite.el. Highlighting for sml-mode using hilit19.
-
-;; Copyright (C) 1995 Frederick Knabe
-;;
-;; Author: Fritz Knabe <knabe@ecrc.de>
-;; ECRC GmbH, Arabellastr. 17, 81925 Munich, Germany
-;;
-;; Created: 08-Nov-94, Fritz Knabe <knabe@ecrc.de>
-;; Modified: 14-Apr-97, M.J.Morley <mjm@scs.leeds.ac.uk>
-;; Added a few keywords to hilit-set-mode-patters.
-
-;; This file is not part of GNU Emacs, but it is distributed under the
-;; same conditions.
-
-;; ====================================================================
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;; ====================================================================
-
-;; Put this code *after* the (require 'hilit19) in your .emacs.
-;; Alternatively, put it in an (eval-after-load "hilit19" ...).
-
-;; Better, use sml-load-hook like this:
-
-;; (setq sml-load-hook
-;; '(lambda() "Highlights." (require 'sml-hilite)))
-
-;; hilit19 does not currently appear to belong to XEmacs -- they
-;; favour `font-lock'. Font-lock patterns in sml-font.el
-
-;;; CODE
-
-(require 'hilit19)
-
-(cond ((and (x-display-color-p) (eq hilit-background-mode 'light))
- ;; for SML
- (hilit-translate sml-comment 'firebrick-italic)
- (hilit-translate sml-string 'ForestGreen-italic)
- (hilit-translate sml-keyword 'blue-bold))
- ((and (x-display-color-p) (eq hilit-background-mode 'dark))
- ;; for SML
- (hilit-translate sml-comment 'moccasin-italic)
- (hilit-translate sml-string 'green-italic)
- (hilit-translate sml-keyword 'cyan-bold))
- (t
- ;; for SML
- (hilit-translate sml-comment 'default-italic)
- (hilit-translate sml-string 'default-bold-italic)
- (hilit-translate sml-keyword 'default-bold)))
-
-(hilit-set-mode-patterns
- 'sml-mode
- '((kn-hilit-sml-string-find "" sml-string)
- (kn-hilit-sml-comment-find "" sml-comment)
- ;; The old patterns
- ;;("\"" "[^\\]\"" sml-string)
- ;;("(\\*" "\\*)" sml-comment)
- ("\\(\\`\\|[^_']\\)\
-\\<\\(\
-a\\(bstype\\|nd\\(\\|also\\)\\|s\\)\\|case\\|d\\(atatype\\|o\\)\\|\
-e\\(lse\\|nd\\|qtype\\|xception\\)\\|f\\(n\\|un\\(\\|ctor\\)\\)\\|\handle\\|\
-i\\([fn]\\|n\\(clude\\|fixr?\\)\\)\\|l\\(et\\|ocal\\)\\|nonfix\\|\
-o\\([fp]\\|pen\\|relse\\|verload\\)\\|r\\(aise\\|ec\\)\\|\
-s\\(haring\\|ig\\(\\|nature\\)\\|truct\\(\\|ure\\)\\)\\|t\\(hen\\|ype\\)\\|\
-val\\|w\\(h\\(ere\\|ile\\)\\|ith\\(\\|type\\)\\)
-\\)\\>\
-\\(\\'\\|[^_']\\)" 2 sml-keyword)))
-
-(defun kn-hilit-sml-string-find (dummy)
- "Find an SML string and return (START . END); if none, returns nil.
-Skips over potentially nested comments when searching for the start of the
-string. Skips over \f...f\ (where f is whitespace) sequences in strings."
- (let ((nest 0)
- (continue t)
- st en)
- (while (and continue
- (re-search-forward "\\(\"\\)\\|\\((\\*\\)\\|\\(\\*)\\)" nil t))
- (cond
- ((match-beginning 1) (setq continue (> nest 0)))
- ((match-beginning 2) (setq nest (+ nest 1)))
- ((match-beginning 3) (setq nest (- nest 1)))))
- (if (not continue)
- (progn
- (setq st (match-beginning 1))
- (while (and (re-search-forward
- "\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" nil t)
- (cond
- ((match-beginning 1) (setq en (point)) nil)
- ((match-beginning 2) t)
- ((match-beginning 3) t))))
- (and en (cons st en))))))
-
-(defun kn-hilit-sml-comment-find (dummy)
- "Find an SML comment and return (START . END); if none, returns nil.
-Handles nested comments. Ensures that the comment starts outside of a string."
- (let ((continue t)
- (nest 1)
- st en)
- (while (and continue
- (re-search-forward "\\(\"\\)\\|\\((\\*\\)" nil t))
- (cond
- ((match-beginning 1)
- (while (and (re-search-forward
- "\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" nil t)
- (cond
- ((match-beginning 1) nil)
- ((match-beginning 2) t)
- ((match-beginning 3) t)))))
- ((match-beginning 2) (setq continue nil))))
- (if (not continue)
- (progn
- (setq st (match-beginning 2))
- (setq continue t)
- (while (and continue
- (re-search-forward "\\((\\*\\)\\|\\(\\*)\\)" nil t))
- (cond
- ((match-beginning 1) (setq nest (+ nest 1)))
- ((match-beginning 2)
- (setq nest (- nest 1)) (setq continue (> nest 0)))))
- (if (not continue)
- (cons st (match-end 2)))))))
-
-(provide 'sml-hilite)
-
-;;; no more sml-hilite.el, it's finished.