diff options
author | Ludovic Courtes | 2006-02-10 17:19:34 +0000 |
---|---|---|
committer | Ludovic Courtes | 2006-02-10 17:19:34 +0000 |
commit | 5a05a0fe9bfc54af7cb455f2b8350984b075ece0 (patch) | |
tree | 32c5b51e64f31017175d6b6671e2ce0e1341bade /src/guile/skribilo/coloring/lisp.scm | |
parent | 3f8ada7ffc0981ef7530ff34220beb622f01fabf (diff) | |
download | skribilo-5a05a0fe9bfc54af7cb455f2b8350984b075ece0.tar.gz skribilo-5a05a0fe9bfc54af7cb455f2b8350984b075ece0.tar.lz skribilo-5a05a0fe9bfc54af7cb455f2b8350984b075ece0.zip |
Fixed syntax highlighting thanks to SILex.
* arch-config: New file.
* src/guile/skribilo/coloring/c-lex.l.scm: New.
* src/guile/skribilo/coloring/lisp-lex.l.scm: New.
* src/guile/skribilo/coloring/xml-lex.l.scm: New.
* doc/user/user.skb: Include `prgm.skb' (works now).
* src/guile/skribilo/ast.scm: Export `node-body'.
* src/guile/skribilo/coloring/Makefile.am (dist_guilemodule_DATA): Added
the SILex-generated files.
(%.l.scm): New rule.
* src/guile/skribilo/coloring/lisp-lex.l: Use the SRFI-39 parameters.
* src/guile/skribilo/coloring/lisp.scm: Use SRFI-39 parameters instead of
fluids. Load `lisp-lex.l.scm'.
* src/guile/skribilo/prog.scm: Autoload `ast' upon `node-body' too.
(make-line-mark): Use `hash-set!'.
(resolve-line): Use `hash-ref'.
* src/guile/skribilo/source.scm (source-read-lines): Use
`string-prefix-length' instead of `substring=?'.
git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-33
Diffstat (limited to 'src/guile/skribilo/coloring/lisp.scm')
-rw-r--r-- | src/guile/skribilo/coloring/lisp.scm | 108 |
1 files changed, 56 insertions, 52 deletions
diff --git a/src/guile/skribilo/coloring/lisp.scm b/src/guile/skribilo/coloring/lisp.scm index 1db9a3f..e3458b1 100644 --- a/src/guile/skribilo/coloring/lisp.scm +++ b/src/guile/skribilo/coloring/lisp.scm @@ -1,8 +1,7 @@ -;;;; ;;;; lisp.scm -- Lisp Family Fontification ;;;; -;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> -;;;; Copyright © 2005 Ludovic Courtès <ludovic.courtes@laas.fr> +;;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> +;;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr> ;;;; ;;;; ;;;; This program is free software; you can redistribute it and/or modify @@ -19,31 +18,29 @@ ;;;; along with this program; if not, write to the Free Software ;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, ;;;; USA. -;;;; -;;;; Author: Erick Gallesio [eg@essi.fr] -;;;; Creation date: 16-Oct-2003 22:17 (eg) -;;;; Last file update: 28-Oct-2004 21:14 (eg) -;;;; + (define-module (skribilo coloring lisp) :use-module (skribilo utils syntax) :use-module (skribilo source) :use-module (skribilo lib) :use-module (skribilo runtime) + :use-module (srfi srfi-39) :use-module (ice-9 match) + :autoload (ice-9 regex) (make-regexp) :autoload (skribilo reader) (make-reader) :export (skribe scheme stklos bigloo lisp)) -(define *bracket-highlight* (make-fluid)) -(define *class-highlight* (make-fluid)) -(define *the-keys* (make-fluid)) +(define *bracket-highlight* (make-parameter #t)) +(define *class-highlight* (make-parameter #t)) +(define *the-keys* (make-parameter '())) -(define *lisp-keys* (make-fluid)) -(define *scheme-keys* (make-fluid)) -(define *skribe-keys* (make-fluid)) -(define *stklos-keys* (make-fluid)) -(define *lisp-keys* (make-fluid)) +(define %lisp-keys #f) +(define %scheme-keys #f) +(define %skribe-keys #f) +(define %stklos-keys #f) +(define %lisp-keys #f) ;;; @@ -58,16 +55,19 @@ (source-read-lines (port-filename inp) start stop tab)) (Loop (read inp)))))) +;; Load the SILex-generated lexer. +(load-from-path "skribilo/coloring/lisp-lex.l.scm") -(define (lisp-family-fontifier s read) - (let ((lisp-input (open-input-string s))) - (let loop ((token (read lisp-input)) - (res '())) - (if (eof-object? token) - (reverse! res) - (loop (read lisp-input) - (cons token res)))))) +(define (lisp-family-fontifier s) + (lexer-init 'port (open-input-string s)) + (let loop ((token (lexer)) + (res '())) + (if (eq? token 'eof) + (reverse! res) + (loop (lexer) + (cons token res))))) + ;;;; ====================================================================== ;;;; ;;;; LISP @@ -87,21 +87,21 @@ (else #f))))) (define (init-lisp-keys) - (unless *lisp-keys* - (set! *lisp-keys* + (unless %lisp-keys + (set! %lisp-keys (append ;; key (map (lambda (x) (cons x '&source-keyword)) '(setq if let let* letrec cond case else progn lambda)) ;; define (map (lambda (x) (cons x '&source-define)) '(defun defclass defmacro))))) - *lisp-keys*) + %lisp-keys) (define (lisp-fontifier s) - (with-fluids ((*the-keys* (init-lisp-keys)) - (*bracket-highlight* #f) - (*class-highlight* #f)) - (lisp-family-fontifier s read))) + (parameterize ((*the-keys* (init-lisp-keys)) + (*bracket-highlight* #f) + (*class-highlight* #f)) + (lisp-family-fontifier s))) (define lisp @@ -110,6 +110,7 @@ (fontifier lisp-fontifier) (extractor lisp-extractor))) + ;;;; ====================================================================== ;;;; ;;;; SCHEME @@ -130,22 +131,22 @@ (define (init-scheme-keys) - (unless *scheme-keys* - (set! *scheme-keys* + (unless %scheme-keys + (set! %scheme-keys (append ;; key (map (lambda (x) (cons x '&source-keyword)) '(set! if let let* letrec quote cond case else begin do lambda)) ;; define (map (lambda (x) (cons x '&source-define)) '(define define-syntax))))) - *scheme-keys*) + %scheme-keys) (define (scheme-fontifier s) - (with-fluids ((*the-keys* (init-scheme-keys)) - (*bracket-highlight* #f) - (*class-highlight* #f)) - (lisp-family-fontifier s read))) + (parameterize ((*the-keys* (init-scheme-keys)) + (*bracket-highlight* #f) + (*class-highlight* #f)) + (lisp-family-fontifier s))) (define scheme @@ -154,6 +155,7 @@ (fontifier scheme-fontifier) (extractor scheme-extractor))) + ;;;; ====================================================================== ;;;; ;;;; STKLOS @@ -176,9 +178,9 @@ (define (init-stklos-keys) - (unless *stklos-keys* + (unless %stklos-keys (init-scheme-keys) - (set! *stklos-keys* (append *scheme-keys* + (set! %stklos-keys (append %scheme-keys ;; Markups (map (lambda (x) (cons x '&source-key)) '(select-module import export)) @@ -192,14 +194,14 @@ ;; error (map (lambda (x) (cons x '&source-error)) '(error call/cc))))) - *stklos-keys*) + %stklos-keys) (define (stklos-fontifier s) - (with-fluids ((*the-keys* (init-stklos-keys)) - (*bracket-highlight* #t) - (*class-highlight* #t)) - (lisp-family-fontifier s read))) + (parameterize ((*the-keys* (init-stklos-keys)) + (*bracket-highlight* #t) + (*class-highlight* #t)) + (lisp-family-fontifier s))) (define stklos @@ -208,6 +210,7 @@ (fontifier stklos-fontifier) (extractor stklos-extractor))) + ;;;; ====================================================================== ;;;; ;;;; SKRIBE @@ -231,9 +234,9 @@ (define (init-skribe-keys) - (unless *skribe-keys* + (unless %skribe-keys (init-stklos-keys) - (set! *skribe-keys* (append *stklos-keys* + (set! %skribe-keys (append %stklos-keys ;; Markups (map (lambda (x) (cons x '&source-markup)) '(bold it emph tt color ref index underline @@ -254,14 +257,14 @@ ;; Define (map (lambda (x) (cons x '&source-define)) '(define-markup))))) - *skribe-keys*) + %skribe-keys) (define (skribe-fontifier s) - (with-fluids ((*the-keys* (init-skribe-keys)) - (*bracket-highlight* #t) - (*class-highlight* #t)) - (lisp-family-fontifier s (make-reader 'skribe)))) + (parameterize ((*the-keys* (init-skribe-keys)) + (*bracket-highlight* #t) + (*class-highlight* #t)) + (lisp-family-fontifier s))) (define skribe @@ -270,6 +273,7 @@ (fontifier skribe-fontifier) (extractor skribe-extractor))) + ;;;; ====================================================================== ;;;; ;;;; BIGLOO |