First step of syntax coloring in racket-mode

config.rkt

@@ -17,8 +17,9 @@
 ;;;
 
 ; Set the initial mode to the fundamental mode.
-(define major-mode 'fundamental-mode)
-(define mode-name  "Fundamental")
+(define major-mode      'fundamental-mode)
+(define mode-name       "Fundamental")
+(define color-buffer    #f)
 
 ;;;
 ;;; EDITING

editor.rkt

@@ -68,12 +68,14 @@
          "keymap.rkt"
          "killing.rkt"
          "mark.rkt"
+         "mode.rkt"
          "parameters.rkt"
          "point.rkt"
          "render.rkt"
          "region.rkt"
          "representation.rkt"
          "simple.rkt"
+         "status-line.rkt"
          "window.rkt")
 
 (current-global-keymap global-keymap)
@@ -106,6 +108,7 @@
 (define (screen-line-length) (ref-buffer-local 'screen-line-length))
 
 (define (render-buffer w)
+  (define now (current-milliseconds))
   (define (marks-between marks from to)
     (for/list ([m marks] #:when (<= from (mark-position m) to))
       (mark-position m)))
@@ -170,7 +173,8 @@
              (char=? (string-ref s (- (string-length s) 1)) #\newline)
              (substring s 0 (max 0 (- (string-length s) 1))))
         s))
-
+  (cond [(local color-buffer) => (λ (f) (f))]
+        [else                    (void)])
   (unless (current-rendering-suspended?)
     (define b  (window-buffer w))
     (define c  (window-canvas w))
@@ -322,7 +326,9 @@
         (send dc resume-flush)
         (void)))
     ; draw points
-    (render-points w start-row end-row)))
+    (render-points w start-row end-row)
+    (define later (current-milliseconds))
+    (status-line-render-time (- later now))))
 
 (define debug-buffer #f)
 (define debug-info #f)
@@ -463,10 +469,11 @@
 
 ;;; MINI BUFFER
 
-; The mini buffer is a buffer displayed in the mini canvas.
-; Most buffer operations are avaialble, but it can not be split.
-; <tab>, <space> and <return> are usually bound to completion 
-; operations in a minibuffer.
+; This is how mini buffers work in Emacs:
+;   The mini buffer is a buffer displayed in the mini canvas.
+;   Most buffer operations are available, but it can not be split.
+;   <tab>, <space> and <return> are usually bound to completion 
+;   operations in a minibuffer.
 
 #;(define (message format-string . arguments)
     ; TODO
@@ -618,5 +625,7 @@
   (set-frame-windows! f w)
   (current-window w)
   (current-frame f)
+
+  (register-auto-mode "rkt" racket-mode)
 
   (send (window-canvas w) focus))

mode.rkt

@@ -1,5 +1,9 @@
 #lang racket/base
-(require "representation.rkt" "parameters.rkt" "buffer-locals.rkt")
+(require racket/path
+         "buffer-locals.rkt"
+         "parameters.rkt"
+         "representation.rkt")
+
 (provide (all-defined-out))
 
 ;;;
@@ -45,3 +49,14 @@
 ; (add-to-list 'auto-mode-alist '("\\.wpd\\'" . wpdl-mode))
 ; syntax table
 ; local (key)map
+
+(define (register-auto-mode extension mode)  
+  (hash-set! (current-auto-mode-ht) extension mode))
+
+
+(define (file-path->mode-function path)
+  (define ext-bytes (bytes->string/utf-8 (path-get-extension path)))
+  (define ext       (substring ext-bytes 1 (string-length ext-bytes)))
+  (define mode      (hash-ref (current-auto-mode-ht)  ext #f))
+  mode)
+

parameters.rkt

@@ -25,6 +25,7 @@
          current-next-screen-context-lines
          ;;; Globals
          cached-screen-lines-ht
+         current-auto-mode-ht
          )
 
 (require (for-syntax racket/base syntax/parse))
@@ -41,6 +42,13 @@
 
 (define current-append-next-kill   (make-parameter #f))
 
+;;;
+;;; FILE AND I/O
+;;;
+
+; current-auto-mode-ht : hashtable from string to mode function
+;   see mode.rkt
+(define current-auto-mode-ht       (make-parameter (make-hash)))
 
 ;;;
 ;;;GUI PARAMETERS

racket-mode.rkt

@@ -46,7 +46,7 @@
 (require syntax-color/racket-lexer)
 
 (define (color-buffer)
-  (displayln (list "racket-mode: color-buffer"))
+  ; (displayln (list "racket-mode: color-buffer"))
   (define b    (current-buffer))
   (define from 0)
   (define to   (buffer-length b))
@@ -55,11 +55,11 @@
     (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)))
+      [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)])))
 
-
+(local! color-buffer color-buffer)
 
 

simple.rkt

@@ -39,6 +39,7 @@
          "region.rkt"
          "render.rkt"
          "search.rkt"
+         "status-line.rkt"
          "string-utils.rkt"
          "text.rkt"
          "window.rkt"
@@ -240,10 +241,17 @@
 
 (define-interactive (open-file-or-create [path (finder:get-file)])
   (when path ; #f = none selected
+    ; open buffer and display it in window
     (define b (buffer-open-file-or-create path))
     (set-window-buffer! (current-window) b)
     (current-buffer b)
-    (refresh-frame (current-frame))))
+    ; set mode
+    (cond [(file-path->mode-function path) => (λ (mode) (mode))]
+          [else                               (fundamental-mode)])
+    (define f (current-frame))
+    ; make sure a mode change is seen in the status line below
+    (send (frame-status-line f) set-label (status-line-hook))
+    (refresh-frame f)))
 
 (define-interactive (next-buffer) ; show next buffer in current window
   (define w (current-window))
@@ -567,6 +575,7 @@
   ; name
   (set-major-mode! 'racket)
   (set-mode-name!  "Racket")
+  ; (set-buffer-local! 'color-buffer  b)
   ; keymap
   ;   Demonstrates how to override a keymap
   (local! local-keymap
@@ -1149,7 +1158,7 @@
     (define end-state
       (parse-partial-sexp (point) (position-of-end)
                           #:state state-here #:target-depth depth-here))
-    (displayln end-state)
+    ; (displayln end-state)
     end-state)
   (match n
     [#f (forward-sexp-1)]

status-line.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 (provide status-line-hook
-         status-line-time)
+         status-line-time
+         status-line-render-time)
 ;;;
 ;;; STATUS LINE
 ;;;
@@ -27,6 +28,9 @@
 (define the-time 0)
 (define (status-line-time t) (set! the-time t))
 
+(define the-render-time 0)
+(define (status-line-render-time t) (set! the-render-time t))
+
 ; The default function used to compute status line information
 (define (status-line-hook)
   (define b (current-buffer))
@@ -42,10 +46,11 @@
                                       [col?             (~a "C" col)]
                                       [else             ""]))
        (~a save-status  
-           "   " "Buffer: "   (buffer-name) "    " line+col
-           "   " "Position: " (mark-position (buffer-point (current-buffer)))
-           "   " "Length: "   (buffer-length (current-buffer))
-           "   " "Mode: "     "(" (get-mode-name) ")"
-           "   " "Time: "     the-time)]
+           "   " "Buffer: "          (buffer-name) "    " line+col
+           "   " "Position: "        (mark-position (buffer-point (current-buffer)))
+           "   " "Length: "          (buffer-length (current-buffer))
+           "   " "Mode: "            "(" (get-mode-name) ")"
+           "   " "Time: "            the-time
+           "   " "Render Time: "     the-render-time)]
     [else
      "No current buffer"]))