Added the auto-text feature to the module language
svn: r10541
This commit is contained in:
Eli Barzilay
parent
0c5f2745b5
commit
bf2fe2f64c
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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])
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user