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

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

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

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

@ -50,7 +50,9 @@
(augment #t can-set-size-constraint? ())
(override can-do-edit-operation? (op) (op recursive?))
(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@
(import)

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

@ -22,7 +22,8 @@
[prefix comment-box: framework:comment-box^]
[prefix mode: framework:mode^]
[prefix color: framework:color^]
[prefix color-prefs: framework:color-prefs^])
[prefix color-prefs: framework:color-prefs^]
[prefix finder: framework:finder^])
(export (rename framework:scheme^
[-text-mode<%> text-mode<%>]
@ -1180,6 +1181,11 @@
(else
(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)))
(token-sym->style short-sym->style-name)
(matches '((|(| |)|)
@ -1219,18 +1225,7 @@
(define text-mode% (text-mode-mixin color:text-mode%))
;; ;;
; ;
; ;
;;; ;;; ; ;; ;;; ;;; ; ;;; ; ;; ;;; ;;; ;;;;;; ; ;;;; ; ;;;
; ; ; ; ;; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
;;; ; ; ; ;;;;; ; ; ; ;;;;; ;; ;;;;; ; ; ; ; ; ;;;; ; ;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;; ; ; ; ; ; ; ;
;;; ;;; ;;; ;;; ;;; ;; ; ;; ;;; ;; ;; ;;; ; ;; ; ;; ;;; ; ;;;;
; ;
; ;
;; ;;;
(define (setup-keymap keymap)
(let ([add-pos-function
(λ (name call-method)