This is the mail archive of the
guile@sourceware.cygnus.com
mailing list for the Guile project.
scheme-lock.el: fancy highlighting for Scheme code in XEmacs
- To: GNU Guile Scheme <guile at sourceware dot cygnus dot com>
- Subject: scheme-lock.el: fancy highlighting for Scheme code in XEmacs
- From: karlheg at bittersweet dot inetarena dot com (Karl M. Hegbloom)
- Date: 31 May 2000 11:15:39 -0700
It works. I don't think I've set the font lock keywords correctly; I
just learned about `font-lock-defaults', and have not studied into it
yet. This won't work in GNU Emacs, and I think that's why. Anyone
know?
(require 'scheme)
(require 'scheme-lock)
`M-x customize-group scheme-lock'
;;; scheme-lock.el --- Configurable font locking for Scheme code
;; Copyright (C) 1998,2000 by Free Software Foundation, Inc.
;; Author: Karl M. Hegbloom <karlheg@debian.org>
;; Keywords: faces, languages, matching, scheme
;; This file is part of XEmacs.
;; XEmacs 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.
;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.
;;; Synched up with: Not in FSF
;;; Commentary:
;; Redefine the scheme-font-lock-keywords on the fly, using `custom'.
;;; Code:
(require 'regexp-opt)
(require 'font-lock)
(defgroup scheme-lock nil
"Font lock keywords for Scheme codes."
:group 'faces)
(defface font-lock-macro-name-face
'((((class color) (background light)) (:foreground "brown" :bold t)))
"Face for highlighting Scheme and Lisp macro names in definitions."
:group 'scheme-lock)
(defface font-lock-underline-face
'((t (:underline t)))
"Mixin face for underlining things."
:group 'scheme-lock)
(defvar scheme-lock-function-keywords
'("define"
"define*"
"define-public"
"define*-public"
))
(defvar scheme-lock-macro-keywords
'("define-syntax"
"defmacro"
"defmacro-public"
"defmacro*"
"defmacro*-public"
))
(defvar scheme-lock-class-keywords
'("define-class"))
(defvar scheme-lock-control-structure-keywords
'("lambda"
"lambda*"
"begin"
"call-with-current-continuation"
"call/cc"
"if"
"cond"
"=>"
"else"
"case"
"do"
"for-each"
"let"
"let*"
"let-optional"
"let-optional*"
"let-keywords"
"let-keywords*"
"let-syntax"
"letrec"
"letrec-syntax"
"and"
"or"
"delay"
"map"
"syntax"
"syntax-rules"
"call-with-input-file"
"call-with-output-file"
))
(defvar scheme-lock-extra-highlighting-sexps
(let ((fixme-todo (concat "\\(?:"
"[Ff][Ii][Xx] ?\\(?:[Mm][Ee]\\)?"
"\\|"
"[Tt][Oo][ -_]?[Dd][Oo]"
"\\)"))
(problem-exercise (concat "\\(?:"
"[Pp][Rr][Oo][Bb][Ll][Ee][Mm]"
"\\|"
"[Ee][Xx][Ee][Rr][Cc][Ii][Ss][Ee]"
"\\)"))
)
`(("David Fox <fox@graphics.cs.nyu.edu> for SOS/STklos class specifiers."
"\\<<\\sw+>\\>" . font-lock-type-face)
("Scheme `:' keywords as references."
"\\<:\\sw+\\>" . font-lock-reference-face)
("`(define-module (mod1 mod2 ...)"
"(\\(define-module\\)[ ]+(\\([^)]+\\))"
(1 font-lock-preprocessor-face)
(2 font-lock-type-face t))
("Second line of above."
":use-module[ ]+(\\([^)]+\\))"
(1 font-lock-type-face))
("(use-modules (ice-9 ilisp))"
"(\\(use-modules\\)[ ]+(\\([^)]+\\))"
(1 font-lock-preprocessor-face)
(2 font-lock-type-face t))
("optional args"
"#&\\(?:\\sw\\|\\s_\\)+\\>" . font-lock-reference-face)
("Bolden the dot in dotted lists"
"\\<\\.\\>" . bold)
("Todo items, boxes, etc."
;; +-------+
;; | Fixme | <--- Highlights this whole box, and...
;; +-------+
;; Problem: 3.42 <-- colon and sharp optional
;; Exercise: #4.2.1 also works inside a box.
,(concat ";+[ \t]+"
"\\(?:"
"\\(" ; 1
"\\+[-=]+\\+?"
"\\)"
"\\|"
"\\(?:"
"\\([:|#]+[ \t]*\\)?" ; 2
"\\(?:"
"\\(" ; 3
"\\(?:"
fixme-todo
"\\|"
"[#=]+"
"\\)"
":*"
"\\)"
"\\|"
"\\(" ; 4
problem-exercise ":*"
"\\)"
"\\(" ; 5
"[ \t]+#?[ \t]*"
"[0-9]\\(?:[0-9.:]\\|\\sw\\|\\s_\\)*"
"\\)?"
"\\|"
"[^:|#]*"
"\\)"
"[^:|#]*"
"\\([:|#]+\\)?" ; 6
"\\)"
"\\)"
)
(1 font-lock-warning-face t t)
(2 font-lock-warning-face t t)
(3 font-lock-warning-face t t)
(4 font-lock-preprocessor-face t t)
(5 font-lock-reference-face t t)
(6 font-lock-warning-face t t)
)
)))
(defun scheme-lock-set-keywords-internal (var val)
(set-default var val)
(setq scheme-font-lock-keywords
(append (list
(when scheme-lock-macro-keywords
(list (concat "(\\("
(regexp-opt scheme-lock-macro-keywords)
"\\)[ \t]+(?\\(\\sw+\\)?")
'(1 font-lock-keyword-face)
'(2 font-lock-macro-name-face nil t)))
;;
(when scheme-lock-class-keywords
(list (concat "(\\("
(regexp-opt scheme-lock-class-keywords)
"\\)[ \t]+(?\\(\\sw+\\)?")
'(1 font-lock-keyword-face)
'(2 font-lock-type-face nil t)))
;;
(when scheme-lock-function-keywords
(list (concat "(\\("
(regexp-opt scheme-lock-function-keywords)
"\\)[ \t]+(?\\(\\sw+\\)?")
'(1 font-lock-keyword-face)
'(2 font-lock-function-name-face nil t)))
;;
(when scheme-lock-control-structure-keywords
(cons (concat "(\\("
(regexp-opt scheme-lock-control-structure-keywords)
"\\)\\>")
1))
)
(mapcar #'cdr scheme-lock-extra-highlighting-sexps)
))
(loop
for buf in (buffer-list)
if (with-current-buffer buf
(memq major-mode '(scheme-mode inferior-scheme-mode)))
do (with-current-buffer buf
(when font-lock-mode
(font-lock-mode 0)
(font-lock-mode 1)))))
(defcustom scheme-lock-function-keywords
scheme-lock-function-keywords
"Keywords that introduce functions.
The next symbol will be highlighted in `font-lock-function-name-face'."
:type '(repeat (string :tag ""))
:set #'scheme-lock-set-keywords-internal
:group 'scheme-lock)
(defcustom scheme-lock-macro-keywords
scheme-lock-macro-keywords
"Keywords that introduce macros.
The next symbol will be highlighted in `font-lock-macro-name-face'."
:type '(repeat (string :tag ""))
:set #'scheme-lock-set-keywords-internal
:group 'scheme-lock)
(defcustom scheme-lock-class-keywords
scheme-lock-class-keywords
"Keywords that introduce classes."
:type '(repeat (string :tag ""))
:set #'scheme-lock-set-keywords-internal
:group 'scheme-lock)
(defcustom scheme-lock-control-structure-keywords
scheme-lock-control-structure-keywords
"Keywords for control structures."
:type '(repeat (string :tag ""))
:set #'scheme-lock-set-keywords-internal
:group 'scheme-lock)
;; These need to be able to have embedded comments.
(defcustom scheme-lock-extra-highlighting-sexps
scheme-lock-extra-highlighting-sexps
"Font locking keywords sexps to do extra highlighting."
:type '(repeat (cons (string :tag "Comment")
(sexp :tag "Sexp")))
:set #'scheme-lock-set-keywords-internal
:group 'scheme-lock)
(provide 'scheme-lock)
;;; scheme-lock.el ends here