Add first version of color-buffer to racket-mode

buffer.rkt

@@ -216,6 +216,31 @@
 (define (refresh-buffer [b (current-buffer)])
   ((current-refresh-buffer) b))
 
+#;(make-input-port name read-in peek close
+                   ; optionals
+                   get-progress-evt
+                   commit
+                   get-location
+                   count-lines!
+                   init-position
+                   buffer-mode)
+
+#;(define (make-input-buffer b)
+    ; State
+    (define count-lines? #f)
+    ; Setup port
+    (define name (buffer-name b)) ; name for input port
+    (define read-in
+      (λ (mbs) ; a mutable byte string to receive the read data
+        ; 1. Fill in mbs
+        ; 2. Return number of read bytes
+        )))
+
+; TODO implement it properly
+(define (open-input-buffer b) ; temporary definition
+  (open-input-string
+   (text->string (buffer-text b))))
+
 (define (make-output-buffer b)
   ;(displayln (list 'make-output-buffer 'current-frame (refresh-frame)))
   ;; State

editor.rkt

@@ -239,15 +239,16 @@
           (define get-text-color  (make-getter  color-im default-color))
           (define get-style       (make-getter  style-im default-style))
           (define get-weight      (make-getter weight-im default-weight))
-          (define cur-text-color  #f)
+          (define cur-text-color  default-color)
           (define-syntax (set-unless-same stx)
             (syntax-parse stx
               [(_set-unless-smae p msg cur get)
                (syntax/loc stx
                  (let ([t (get p)])
                    (unless (equal? t cur)
-                     (set! cur t)
-                     (send dc msg t))))]))
+                     (when (is-a? t color%)
+                       (set! cur t)
+                       (send dc msg t)))))]))
           ; contents = screen line = list of (list position string/properties)
           (define xmax
             (for/fold ([x xmin]) ([p+s contents])

racket-mode.rkt

@@ -1,11 +1,65 @@
 #lang racket/base
+(provide color-buffer)
+
 ;;;
 ;;; RACKET MODE
 ;;;
 
-(require "simple.rkt")
+(require racket/format
+         "buffer.rkt"
+         "buffer-locals.rkt"
+         "colors.rkt"
+         "parameters.rkt"
+         "representation.rkt"
+         "simple.rkt")
 
 (define (indent-for-tab)
   (insert "Racket!!!"))
 
 
+;;;
+;;; SYNTAX COLORING
+;;;
+
+;;; Colors
+
+(define brown orange)
+(define grey  (local text-color))
+(define black orange)
+
+(define color-ht  
+  (hasheq 'error               red
+          'comment             brown
+          'sexp-comment        brown
+          'white-space         #f
+          'constant            green
+          'string              green
+          'no-color            #f
+          'parenthesis         base00  ; ligth grey
+          'hash-colon-keyword  blue
+          'symbol              blue
+          'eof                 #f
+          'other               black))
+
+
+; We'll use the builtin racket color lexer
+(require syntax-color/racket-lexer)
+
+(define (color-buffer)
+  (displayln (list "racket-mode: color-buffer"))
+  (define b    (current-buffer))
+  (define from 0)
+  (define to   (buffer-length b))
+  (define in   (open-input-buffer b))  
+  (let loop ()
+    (define-values (token style paren start end) (racket-lexer in))
+    (cond
+      [(eof-object? token) (void)]
+      [else                (writeln (list token style (~a paren) (list start end)))
+                           (define color (hash-ref color-ht style grey))
+                           (overlay-set (- start 1) (- end 1) 'color color b)
+                           (loop)])))
+
+
+
+

simple.rkt

@@ -1245,7 +1245,7 @@
 (define (overlay-set from to sym val [b (current-buffer)])
   (define i (position from))
   (define j (position to))
-  (buffer-overlay-range-set! sym (min i j) (max i j) val))
+  (buffer-overlay-range-set! b (min i j) (max i j) sym val))
 
 (define (overlay-ref sym i [b (current-buffer)])
   (buffer-overlay-ref b sym i))