From bf2fe2f64c353474a3a22c8a3fb5082f58effaac Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Tue, 1 Jul 2008 18:53:50 +0000 Subject: [PATCH] Added the auto-text feature to the module language svn: r10541 --- collects/drscheme/private/module-language.ss | 59 +++++++++++++++----- collects/drscheme/private/unit.ss | 40 ++++++++++++- 2 files changed, 83 insertions(+), 16 deletions(-) diff --git a/collects/drscheme/private/module-language.ss b/collects/drscheme/private/module-language.ss index cbd5433179..cb6ec59b3b 100644 --- a/collects/drscheme/private/module-language.ss +++ b/collects/drscheme/private/module-language.ss @@ -40,8 +40,9 @@ ;; collection-paths : (listof (union 'default string)) ;; command-line-args : (vectorof string) + ;; auto-text : string (define-struct (module-language-settings drscheme:language:simple-settings) - (collection-paths command-line-args)) + (collection-paths command-line-args auto-text)) ;; module-mixin : (implements drscheme:language:language<%>) ;; -> (implements drscheme:language:language<%>) @@ -68,7 +69,8 @@ (append (vector->list (drscheme:language:simple-settings->vector super-defaults)) (list '(default) - #()))))) + #() + default-auto-text))))) ;; default-settings? : -> boolean (define/override (default-settings? settings) @@ -76,31 +78,41 @@ (equal? (module-language-settings-collection-paths settings) '(default)) (equal? (module-language-settings-command-line-args settings) - #()))) + #()) + ;; Never show that this is a "custom" language because of the + ;; auto-text + ;; (equal? (module-language-settings-auto-text settings) + ;; default-auto-text) + )) (define/override (marshall-settings settings) (let ([super-marshalled (super marshall-settings settings)]) (list super-marshalled (module-language-settings-collection-paths settings) - (module-language-settings-command-line-args settings)))) + (module-language-settings-command-line-args settings) + (module-language-settings-auto-text settings)))) (define/override (unmarshall-settings marshalled) - (and (pair? marshalled) - (pair? (cdr marshalled)) - (pair? (cddr marshalled)) - (null? (cdddr marshalled)) + (and (list? marshalled) + ;; older formats had no auto-text + (<= 3 (length marshalled) 4) (list? (cadr marshalled)) - (vector? (caddr marshalled)) - (andmap string? (vector->list (caddr marshalled))) (andmap (λ (x) (or (string? x) (symbol? x))) (cadr marshalled)) + (vector? (caddr marshalled)) + (andmap string? (vector->list (caddr marshalled))) + (or (= 3 (length marshalled)) + (string? (cadddr marshalled))) (let ([super (super unmarshall-settings (car marshalled))]) (and super (apply make-module-language-settings (append (vector->list (drscheme:language:simple-settings->vector super)) (list (cadr marshalled) - (caddr marshalled)))))))) + (caddr marshalled) + (if (= 3 (length marshalled)) + default-auto-text + (cadddr marshalled))))))))) (define/override (on-execute settings run-in-user-thread) (set! iteration-number 0) @@ -117,6 +129,10 @@ (define/override (get-one-line-summary) (string-constant module-language-one-line-summary)) + (define default-auto-text "#lang scheme\n") + (define/public (get-auto-text settings) + (module-language-settings-auto-text settings)) + (inherit get-reader) (define/override (front-end/interaction port settings) (if (thread-cell-ref hopeless-repl) @@ -262,7 +278,8 @@ [stretchable-height #f] [stretchable-width #f])) (define simple-case-lambda - (drscheme:language:simple-module-based-language-config-panel new-parent)) + (drscheme:language:simple-module-based-language-config-panel + new-parent #:case-sensitive #t)) (define cp-panel (new group-box-panel% [parent new-parent] [label (string-constant ml-cp-collection-paths)])) @@ -275,6 +292,14 @@ [label #f] [init-value "#()"] [callback void])) + (define auto-text-panel (new group-box-panel% + [parent new-parent] + [label "Auto-text"])) ;!! need string-constant + (define auto-text-text-box (new text-field% + [parent auto-text-panel] + [label #f] + [init-value ""] + [callback void])) ;; data associated with each item in listbox : boolean ;; indicates if the entry is the default paths. @@ -389,6 +414,12 @@ (parameterize ([print-vector-length #f]) (format "~s" vec)))) + (define (get-auto-text) + (string-append (send auto-text-text-box get-value) "\n")) + + (define (install-auto-text str) + (send auto-text-text-box set-value (regexp-replace #rx"\n$" str ""))) + (send lb set '()) (update-buttons) @@ -399,11 +430,13 @@ (append (vector->list (drscheme:language:simple-settings->vector simple-settings)) (list (get-collection-paths) - (get-command-line-args)))))] + (get-command-line-args) + (get-auto-text)))))] [(settings) (simple-case-lambda settings) (install-collection-paths (module-language-settings-collection-paths settings)) (install-command-line-args (module-language-settings-command-line-args settings)) + (install-auto-text (module-language-settings-auto-text settings)) (update-buttons)])) ;; transform-module : (union #f string) syntax diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss index 12f7e1d299..3ea507d050 100644 --- a/collects/drscheme/private/unit.ss +++ b/collects/drscheme/private/unit.ss @@ -557,6 +557,8 @@ module browser threading seems wrong. drscheme:language-configuration:settings-preferences-symbol next-settings)) + (remove-auto-text) + (insert-auto-text) (after-set-next-settings _next-settings))) (define/pubment (after-set-next-settings s) @@ -660,6 +662,37 @@ module browser threading seems wrong. (values (/ (+ xl xr) 2) (/ (+ yl yr) 2))))) + (define default-changed? #f) + (define/augment (on-change) (set! default-changed? #t)) + (define/public (still-untouched?) + (and (or (= (last-position) 0) (not default-changed?)) + (not (is-modified?)) + (not (get-filename)))) + ;; inserts the auto-text if any, and executes the text if so + (define (insert-auto-text) + (define lang + (drscheme:language-configuration:language-settings-language + next-settings)) + (define auto-text + (and (= (last-position) 0) (still-untouched?) + (is-a? lang drscheme:module-language:module-language<%>) + (send lang get-auto-text + (drscheme:language-configuration:language-settings-settings + next-settings)))) + (when auto-text + (begin-edit-sequence #f) + (insert auto-text) + (set-modified #f) + (end-edit-sequence) + (set! default-changed? #f) + (send (get-top-level-window) execute-callback))) + (define (remove-auto-text) + (when (and (still-untouched?) (> (last-position) 0)) + (begin-edit-sequence #f) + (send this erase) + (set-modified #f) + (end-edit-sequence))) + (inherit invalidate-bitmap-cache) (define/public (set-error-arrows arrows) (set! error-arrows arrows) @@ -669,6 +702,9 @@ module browser threading seems wrong. (super-new) + ;; insert the default-text + (queue-callback insert-auto-text) + (inherit set-max-undo-history) (set-max-undo-history 'forever)))) @@ -1650,9 +1686,7 @@ module browser threading seems wrong. (define/override (get-editor%) (drscheme:get/extend:get-definitions-text)) (define/public (still-untouched?) - (and (= (send definitions-text last-position) 0) - (not (send definitions-text is-modified?)) - (not (send definitions-text get-filename)) + (and (send definitions-text still-untouched?) (let* ([prompt (send interactions-text get-prompt)] [first-prompt-para (let loop ([n 0])