diff --git a/config.rkt b/config.rkt index 4333f1a..6e6c4a7 100644 --- a/config.rkt +++ b/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 diff --git a/editor.rkt b/editor.rkt index 4c8962f..8e50b6a 100644 --- a/editor.rkt +++ b/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. -; , and 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. +; , and 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)) diff --git a/mode.rkt b/mode.rkt index 88c2da2..de71d6d 100644 --- a/mode.rkt +++ b/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) + diff --git a/parameters.rkt b/parameters.rkt index 2702981..51f62f5 100644 --- a/parameters.rkt +++ b/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 diff --git a/racket-mode.rkt b/racket-mode.rkt index 356f3d8..62bdab2 100644 --- a/racket-mode.rkt +++ b/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) diff --git a/simple.rkt b/simple.rkt index 30e6644..b1a2267 100644 --- a/simple.rkt +++ b/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)] diff --git a/status-line.rkt b/status-line.rkt index 79a1c2c..e3e04b4 100644 --- a/status-line.rkt +++ b/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"]))