suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

drschemes scheme mode now sets the default extension for files to .ss

Browse Source 
svn: r12213
This commit is contained in:
Robby Findler 2008-11-01 19:55:21 +00:00
parent de5643ade0
commit baffeea2b4
3 changed files with 24 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/framework/private/finder.ss
View File

@ -4,9 +4,7 @@
"sig.ss" "sig.ss"
"../preferences.ss" "../preferences.ss"
mred/mred-sig mred/mred-sig
mzlib/string scheme/path)
scheme/path
mzlib/etc)
(import mred^ (import mred^
@ -33,7 +31,7 @@
;; dialog wrappers ;; dialog wrappers
(define (*put-file style) (define (*put-file style)
(opt-lambda ([name #f] (lambda ([name #f]
[directory #f] [directory #f]
[replace? #f] [replace? #f]
[prompt (string-constant select-file)] [prompt (string-constant select-file)]
@ -63,7 +61,7 @@
[else f])))))) [else f]))))))
(define (*get-file style) (define (*get-file style)
(opt-lambda ([directory #f] (lambda ([directory #f]
[prompt (string-constant select-file)] [prompt (string-constant select-file)]
[filter #f] [filter #f]
[filter-msg (string-constant file-wrong-form)] [filter-msg (string-constant file-wrong-form)]

4
collects/framework/private/mode.ss
View File

@ -50,7 +50,9 @@
(augment #t can-set-size-constraint? ()) (augment #t can-set-size-constraint? ())
(override can-do-edit-operation? (op) (op recursive?)) (override can-do-edit-operation? (op) (op recursive?))
(augment #t can-load-file? (filename format)) (augment #t can-load-file? (filename format))
(augment #t can-save-file? (filename format)))])) (augment #t can-save-file? (filename format))
(override put-file (directory default-name)))]))
(define-unit mode@ (define-unit mode@
(import) (import)

21
collects/framework/private/scheme.ss
View File

@ -22,7 +22,8 @@
[prefix comment-box: framework:comment-box^] [prefix comment-box: framework:comment-box^]
[prefix mode: framework:mode^] [prefix mode: framework:mode^]
[prefix color: framework:color^] [prefix color: framework:color^]
[prefix color-prefs: framework:color-prefs^]) [prefix color-prefs: framework:color-prefs^]
[prefix finder: framework:finder^])
(export (rename framework:scheme^ (export (rename framework:scheme^
[-text-mode<%> text-mode<%>] [-text-mode<%> text-mode<%>]
@ -1180,6 +1181,11 @@
(else (else
(values lexeme type paren start end))))) (values lexeme type paren start end)))))
(define/override (put-file text sup directory default-name)
(parameterize ([finder:default-extension "ss"])
;; don't call the surrogate's super, since it sets the default extension
(sup directory default-name)))
(super-new (get-token (lambda (in) (scheme-lexer-wrapper in))) (super-new (get-token (lambda (in) (scheme-lexer-wrapper in)))
(token-sym->style short-sym->style-name) (token-sym->style short-sym->style-name)
(matches '((|(| |)|) (matches '((|(| |)|)
@ -1219,18 +1225,7 @@
(define text-mode% (text-mode-mixin color:text-mode%)) (define text-mode% (text-mode-mixin color:text-mode%))
;; ;;
; ;
; ;
;;; ;;; ; ;; ;;; ;;; ; ;;; ; ;; ;;; ;;; ;;;;;; ; ;;;; ; ;;;
; ; ; ; ;; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
;;; ; ; ; ;;;;; ; ; ; ;;;;; ;; ;;;;; ; ; ; ; ; ;;;; ; ;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;; ; ; ; ; ; ; ;
;;; ;;; ;;; ;;; ;;; ;; ; ;; ;;; ;; ;; ;;; ; ;; ; ;; ;;; ; ;;;;
; ;
; ;
;; ;;;
(define (setup-keymap keymap) (define (setup-keymap keymap)
(let ([add-pos-function (let ([add-pos-function
(λ (name call-method) (λ (name call-method)