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

adjust drracket to clean up the code that sets the initial value of

Browse Source 
current-directory and current-load-relative-directory and to make
current-directory's initial value be the user's home directory
This commit is contained in:
Robby Findler 2011-11-28 10:55:05 -06:00
parent 462a348f19
commit 153dd73f6b
11 changed files with 67 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/drracket/private/debug.rkt
View File

@ -440,8 +440,10 @@ profile todo:
(λ ()
(cond
[(path? src)
(display (path->string (find-relative-path (current-directory)
(normalize-path src)))
(define-values (n-cd n-src)
(with-handlers ([exn:fail? (λ (x) (values (current-directory) src))])
(values (normalize-path (current-directory)) (normalize-path src))))
(display (path->string (find-relative-path n-cd n-src))
(current-error-port))]
[else
(display "<unsaved editor>" (current-error-port))]))]

15
collects/drracket/private/eval-helpers.rkt
View File

@ -11,7 +11,20 @@
(provide set-basic-parameters/no-gui
set-module-language-parameters
(struct-out prefab-module-settings)
transform-module)
transform-module
get-init-dir)
;; get-init-dir : (or/c path? #f) -> path?
;; returns the initial directory for a program
;; that is saved in 'path/f' (with #f indicating
;; an unsaved file)
(define (get-init-dir path/f)
(cond
[path/f
(let-values ([(base name dir?) (split-path path/f)])
base)]
[else
(find-system-path 'home-dir)]))
(struct prefab-module-settings
(command-line-args

7
collects/drracket/private/expanding-place.rkt
View File

@ -89,10 +89,9 @@
module-language-parallel-lock-client
#:use-use-current-security-guard? #t)
(log-info "expanding-place.rkt: 04 setting directories")
(when path
(let-values ([(base name dir?) (split-path path)])
(current-directory base)
(current-load-relative-directory base)))
(let ([init-dir (get-init-dir path)])
(current-directory init-dir)
(current-load-relative-directory init-dir))
(define sp (open-input-string program-as-string))
(port-count-lines! sp)
(log-info "expanding-place.rkt: 05 installing security guard")

8
collects/drracket/private/module-browser.rkt
View File

@ -8,6 +8,7 @@
string-constants
mrlib/graph
"drsig.rkt"
"eval-helpers.rkt"
racket/unit
racket/async-channel
setup/private/lib-roots
@ -855,11 +856,8 @@
(define init-dir
(let* ([bx (box #f)]
[filename (send (drracket:language:text/pos-text text/pos) get-filename bx)])
(if (and filename
(not (unbox bx)))
(let-values ([(base name dir) (split-path filename)])
base)
(current-directory))))
(get-init-dir
(and (not (unbox bx)) filename))))
(define (init)
(set! user-custodian (current-custodian))

13
collects/drracket/private/syncheck/gui.rkt
View File

@ -41,6 +41,7 @@ If the namespace does not, they are colored the unbound color.
(for-syntax racket/base)
(only-in ffi/unsafe register-finalizer)
"../../syncheck-drracket-button.rkt"
"../../private/eval-helpers.rkt"
"intf.rkt"
"local-member-names.rkt"
"colors.rkt"
@ -2018,13 +2019,11 @@ If the namespace does not, they are colored the unbound color.
;; sets the current-directory and current-load-relative-directory
;; based on the file saved in the definitions-text
(define/private (set-directory definitions-text)
(let* ([tmp-b (box #f)]
[fn (send definitions-text get-filename tmp-b)])
(unless (unbox tmp-b)
(when fn
(let-values ([(base name dir?) (split-path fn)])
(current-directory base)
(current-load-relative-directory base))))))
(define tmp-b (box #f))
(define fn (send definitions-text get-filename tmp-b))
(define dir (get-init-dir (and (not (unbox tmp-b)) fn)))
(current-directory dir)
(current-load-relative-directory dir))
;; with-lock/edit-sequence : text (-> void) -> void
;; sets and restores some state of the definitions text

6
collects/drracket/private/syncheck/online-comp.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require racket/class
racket/place
"../../private/eval-helpers.rkt"
"traversals.rkt"
"local-member-names.rkt"
"intf.rkt"
@ -64,10 +65,7 @@
(define obj (new obj% [src the-source]))
(define-values (expanded-expression expansion-completed)
(make-traversal (current-namespace)
(if path
(let-values ([(base name dir) (split-path path)])
base)
(current-directory))))
(get-init-dir path)))
(parameterize ([current-annotations obj])
(expanded-expression expanded)
(expansion-completed))

23
collects/drracket/private/unit.rkt
View File

@ -36,6 +36,7 @@ module browser threading seems wrong.
"insert-large-letters.rkt"
"get-defs.rkt"
"local-member-names.rkt"
"eval-helpers.rkt"
(prefix-in drracket:arrow: "../arrow.rkt")
mred
@ -1200,12 +1201,10 @@ module browser threading seems wrong.
(send (send frame get-current-tab) clear-execution-state)))))
(define/public (get-directory)
(let ([filename (send defs get-filename)])
(if (and (path? filename)
(file-exists? filename))
(let-values ([(base _1 _2) (split-path (normalize-path filename))])
base)
#f)))
(define bx (box #f))
(define filename (send defs get-filename bx))
(get-init-dir
(and (not (unbox bx)) filename)))
(define/pubment (can-close?)
(and (send defs can-close?)
@ -3370,13 +3369,11 @@ module browser threading seems wrong.
;; sets the current-directory and current-load-relative-directory
;; based on the file saved in the definitions-text
(define/private (set-directory definitions-text)
(let* ([tmp-b (box #f)]
[fn (send definitions-text get-filename tmp-b)])
(unless (unbox tmp-b)
(when fn
(let-values ([(base name dir?) (split-path fn)])
(current-directory base)
(current-load-relative-directory base))))))
(define tmp-b (box #f))
(define fn (send definitions-text get-filename tmp-b))
(define dir (get-init-dir (and (not (unbox tmp-b)) fn)))
(current-directory dir)
(current-load-relative-directory dir))
;

9
collects/tests/drracket/module-lang-test.rkt
View File

@ -21,7 +21,9 @@
(provide #%module-begin [rename bug-datum #%datum]))
(module module-lang-test-tmp4 racket/base
(/ 888 2)
(provide (except-out (all-from-out racket/base) #%top-interaction))))
(provide (except-out (all-from-out racket/base) #%top-interaction)))
(module module-lang-test-syn-error racket/base
(lambda)))
(test @t{}
#f
@ -370,6 +372,11 @@
(current-namespace (make-base-empty-namespace))}
"(+ 1 2)"
"3")
(test @t{#lang racket/base}
@t{(parameterize ([current-directory "/does/not/exists/well/it/better/not/anwyays"])
(load @in-here{module-lang-test-syn-error.rkt}))}
;; test to make sure that we don't get "exception raised by error display handler"
#rx"module-lang-test-syn-error.rkt:[0-9]+:[0-9]+: lambda: bad syntax in: \\(lambda\\)")
(printf "starting drracket\n")
(fire-up-drscheme-and-run-tests run-test)

11
collects/tests/drracket/private/module-lang-test-utils.rkt
View File

@ -1,12 +1,12 @@
#lang racket/base
(require "drracket-test-util.rkt"
mzlib/etc
framework
racket/string
(for-syntax racket/base)
racket/class)
(provide test t rx run-test in-here write-test-modules)
(provide test t rx run-test
in-here in-here/path write-test-modules)
;; utilities to use with scribble/reader
(define t string-append)
@ -15,7 +15,7 @@
(define-struct test (definitions ; string
interactions ; (union #f string)
result ; string
result ; (or/c string regexp)
all? ; boolean (#t => compare all of the text between the 3rd and n-1-st line)
error-ranges ; (or/c 'dont-test
; (-> (is-a?/c text)
@ -26,9 +26,8 @@
#:omit-define-syntaxes)
(define in-here
(let ([here (this-expression-source-directory)])
(lambda (file) (format "~s" (path->string (build-path (find-system-path 'temp-dir) file))))))
(define (in-here/path file) (path->string (build-path (find-system-path 'temp-dir) file)))
(define (in-here file) (format "~s" (in-here/path file)))
(define tests '())
(define-syntax (test stx)

3
collects/tests/drracket/repl-test.rkt
View File

@ -1297,7 +1297,8 @@ This produces an ACK message
(fprintf (current-error-port)
"FAILED load test ~a for ~s\n expected: ~s\n got: ~s\n"
short-filename
program load-answer received-load)))))])
program load-answer received-load)
(semaphore-wait (make-semaphore 0))))))])
(load-test tmp-load-short-filename (make-load-answer in-vector language-cust #f))
(when (file-exists? tmp-load3-filename)
(delete-file tmp-load3-filename))

14
doc/release-notes/drracket/HISTORY.txt
View File

@ -1,13 +1,19 @@
------------------------------
Version 5.2.1
------------------------------
. The initial current-directory and current-load-relative-directory
for unsaved programs in DrRacket is now the user's home directory,
instead of whatever the current-directory was for the underlying
OS process.
. DrRacket no longer shows a stacktrace for syntax errors in the REPL.
. The preference that makes a single "(" keystroke insert "()"
(and similarly for [ { " and |) now only takes effect in Racket mode,
instead of taking effect in all of the modes, as it used to.
. The preference that makes a single "(" keystroke insert "()" (and
similarly for [ { " and |) now only takes effect in Racket mode,
instead of taking effect in all of the modes, as it used to. This
change is in service to a bugfix that makes the automatic opening
parentheses adjustment cooperate with the automatic balancing.
------------------------------
Version 5.2