adjust drracket to clean up the code that sets the initial value of
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:
parent
462a348f19
commit
153dd73f6b
|
@ -440,8 +440,10 @@ profile todo:
|
||||||
(λ ()
|
(λ ()
|
||||||
(cond
|
(cond
|
||||||
[(path? src)
|
[(path? src)
|
||||||
(display (path->string (find-relative-path (current-directory)
|
(define-values (n-cd n-src)
|
||||||
(normalize-path 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))]
|
(current-error-port))]
|
||||||
[else
|
[else
|
||||||
(display "<unsaved editor>" (current-error-port))]))]
|
(display "<unsaved editor>" (current-error-port))]))]
|
||||||
|
|
|
@ -11,7 +11,20 @@
|
||||||
(provide set-basic-parameters/no-gui
|
(provide set-basic-parameters/no-gui
|
||||||
set-module-language-parameters
|
set-module-language-parameters
|
||||||
(struct-out prefab-module-settings)
|
(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
|
(struct prefab-module-settings
|
||||||
(command-line-args
|
(command-line-args
|
||||||
|
|
|
@ -89,10 +89,9 @@
|
||||||
module-language-parallel-lock-client
|
module-language-parallel-lock-client
|
||||||
#:use-use-current-security-guard? #t)
|
#:use-use-current-security-guard? #t)
|
||||||
(log-info "expanding-place.rkt: 04 setting directories")
|
(log-info "expanding-place.rkt: 04 setting directories")
|
||||||
(when path
|
(let ([init-dir (get-init-dir path)])
|
||||||
(let-values ([(base name dir?) (split-path path)])
|
(current-directory init-dir)
|
||||||
(current-directory base)
|
(current-load-relative-directory init-dir))
|
||||||
(current-load-relative-directory base)))
|
|
||||||
(define sp (open-input-string program-as-string))
|
(define sp (open-input-string program-as-string))
|
||||||
(port-count-lines! sp)
|
(port-count-lines! sp)
|
||||||
(log-info "expanding-place.rkt: 05 installing security guard")
|
(log-info "expanding-place.rkt: 05 installing security guard")
|
||||||
|
|
|
@ -8,6 +8,7 @@
|
||||||
string-constants
|
string-constants
|
||||||
mrlib/graph
|
mrlib/graph
|
||||||
"drsig.rkt"
|
"drsig.rkt"
|
||||||
|
"eval-helpers.rkt"
|
||||||
racket/unit
|
racket/unit
|
||||||
racket/async-channel
|
racket/async-channel
|
||||||
setup/private/lib-roots
|
setup/private/lib-roots
|
||||||
|
@ -855,11 +856,8 @@
|
||||||
(define init-dir
|
(define init-dir
|
||||||
(let* ([bx (box #f)]
|
(let* ([bx (box #f)]
|
||||||
[filename (send (drracket:language:text/pos-text text/pos) get-filename bx)])
|
[filename (send (drracket:language:text/pos-text text/pos) get-filename bx)])
|
||||||
(if (and filename
|
(get-init-dir
|
||||||
(not (unbox bx)))
|
(and (not (unbox bx)) filename))))
|
||||||
(let-values ([(base name dir) (split-path filename)])
|
|
||||||
base)
|
|
||||||
(current-directory))))
|
|
||||||
|
|
||||||
(define (init)
|
(define (init)
|
||||||
(set! user-custodian (current-custodian))
|
(set! user-custodian (current-custodian))
|
||||||
|
|
|
@ -41,6 +41,7 @@ If the namespace does not, they are colored the unbound color.
|
||||||
(for-syntax racket/base)
|
(for-syntax racket/base)
|
||||||
(only-in ffi/unsafe register-finalizer)
|
(only-in ffi/unsafe register-finalizer)
|
||||||
"../../syncheck-drracket-button.rkt"
|
"../../syncheck-drracket-button.rkt"
|
||||||
|
"../../private/eval-helpers.rkt"
|
||||||
"intf.rkt"
|
"intf.rkt"
|
||||||
"local-member-names.rkt"
|
"local-member-names.rkt"
|
||||||
"colors.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
|
;; sets the current-directory and current-load-relative-directory
|
||||||
;; based on the file saved in the definitions-text
|
;; based on the file saved in the definitions-text
|
||||||
(define/private (set-directory definitions-text)
|
(define/private (set-directory definitions-text)
|
||||||
(let* ([tmp-b (box #f)]
|
(define tmp-b (box #f))
|
||||||
[fn (send definitions-text get-filename tmp-b)])
|
(define fn (send definitions-text get-filename tmp-b))
|
||||||
(unless (unbox tmp-b)
|
(define dir (get-init-dir (and (not (unbox tmp-b)) fn)))
|
||||||
(when fn
|
(current-directory dir)
|
||||||
(let-values ([(base name dir?) (split-path fn)])
|
(current-load-relative-directory dir))
|
||||||
(current-directory base)
|
|
||||||
(current-load-relative-directory base))))))
|
|
||||||
|
|
||||||
;; with-lock/edit-sequence : text (-> void) -> void
|
;; with-lock/edit-sequence : text (-> void) -> void
|
||||||
;; sets and restores some state of the definitions text
|
;; sets and restores some state of the definitions text
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require racket/class
|
(require racket/class
|
||||||
racket/place
|
racket/place
|
||||||
|
"../../private/eval-helpers.rkt"
|
||||||
"traversals.rkt"
|
"traversals.rkt"
|
||||||
"local-member-names.rkt"
|
"local-member-names.rkt"
|
||||||
"intf.rkt"
|
"intf.rkt"
|
||||||
|
@ -64,10 +65,7 @@
|
||||||
(define obj (new obj% [src the-source]))
|
(define obj (new obj% [src the-source]))
|
||||||
(define-values (expanded-expression expansion-completed)
|
(define-values (expanded-expression expansion-completed)
|
||||||
(make-traversal (current-namespace)
|
(make-traversal (current-namespace)
|
||||||
(if path
|
(get-init-dir path)))
|
||||||
(let-values ([(base name dir) (split-path path)])
|
|
||||||
base)
|
|
||||||
(current-directory))))
|
|
||||||
(parameterize ([current-annotations obj])
|
(parameterize ([current-annotations obj])
|
||||||
(expanded-expression expanded)
|
(expanded-expression expanded)
|
||||||
(expansion-completed))
|
(expansion-completed))
|
||||||
|
|
|
@ -36,6 +36,7 @@ module browser threading seems wrong.
|
||||||
"insert-large-letters.rkt"
|
"insert-large-letters.rkt"
|
||||||
"get-defs.rkt"
|
"get-defs.rkt"
|
||||||
"local-member-names.rkt"
|
"local-member-names.rkt"
|
||||||
|
"eval-helpers.rkt"
|
||||||
(prefix-in drracket:arrow: "../arrow.rkt")
|
(prefix-in drracket:arrow: "../arrow.rkt")
|
||||||
|
|
||||||
mred
|
mred
|
||||||
|
@ -1200,12 +1201,10 @@ module browser threading seems wrong.
|
||||||
(send (send frame get-current-tab) clear-execution-state)))))
|
(send (send frame get-current-tab) clear-execution-state)))))
|
||||||
|
|
||||||
(define/public (get-directory)
|
(define/public (get-directory)
|
||||||
(let ([filename (send defs get-filename)])
|
(define bx (box #f))
|
||||||
(if (and (path? filename)
|
(define filename (send defs get-filename bx))
|
||||||
(file-exists? filename))
|
(get-init-dir
|
||||||
(let-values ([(base _1 _2) (split-path (normalize-path filename))])
|
(and (not (unbox bx)) filename)))
|
||||||
base)
|
|
||||||
#f)))
|
|
||||||
|
|
||||||
(define/pubment (can-close?)
|
(define/pubment (can-close?)
|
||||||
(and (send defs 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
|
;; sets the current-directory and current-load-relative-directory
|
||||||
;; based on the file saved in the definitions-text
|
;; based on the file saved in the definitions-text
|
||||||
(define/private (set-directory definitions-text)
|
(define/private (set-directory definitions-text)
|
||||||
(let* ([tmp-b (box #f)]
|
(define tmp-b (box #f))
|
||||||
[fn (send definitions-text get-filename tmp-b)])
|
(define fn (send definitions-text get-filename tmp-b))
|
||||||
(unless (unbox tmp-b)
|
(define dir (get-init-dir (and (not (unbox tmp-b)) fn)))
|
||||||
(when fn
|
(current-directory dir)
|
||||||
(let-values ([(base name dir?) (split-path fn)])
|
(current-load-relative-directory dir))
|
||||||
(current-directory base)
|
|
||||||
(current-load-relative-directory base))))))
|
|
||||||
|
|
||||||
|
|
||||||
;
|
;
|
||||||
|
|
|
@ -21,7 +21,9 @@
|
||||||
(provide #%module-begin [rename bug-datum #%datum]))
|
(provide #%module-begin [rename bug-datum #%datum]))
|
||||||
(module module-lang-test-tmp4 racket/base
|
(module module-lang-test-tmp4 racket/base
|
||||||
(/ 888 2)
|
(/ 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{}
|
(test @t{}
|
||||||
#f
|
#f
|
||||||
|
@ -370,6 +372,11 @@
|
||||||
(current-namespace (make-base-empty-namespace))}
|
(current-namespace (make-base-empty-namespace))}
|
||||||
"(+ 1 2)"
|
"(+ 1 2)"
|
||||||
"3")
|
"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")
|
(printf "starting drracket\n")
|
||||||
(fire-up-drscheme-and-run-tests run-test)
|
(fire-up-drscheme-and-run-tests run-test)
|
||||||
|
|
|
@ -1,12 +1,12 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require "drracket-test-util.rkt"
|
(require "drracket-test-util.rkt"
|
||||||
mzlib/etc
|
|
||||||
framework
|
framework
|
||||||
racket/string
|
racket/string
|
||||||
(for-syntax racket/base)
|
(for-syntax racket/base)
|
||||||
racket/class)
|
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
|
;; utilities to use with scribble/reader
|
||||||
(define t string-append)
|
(define t string-append)
|
||||||
|
@ -15,7 +15,7 @@
|
||||||
|
|
||||||
(define-struct test (definitions ; string
|
(define-struct test (definitions ; string
|
||||||
interactions ; (union #f 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)
|
all? ; boolean (#t => compare all of the text between the 3rd and n-1-st line)
|
||||||
error-ranges ; (or/c 'dont-test
|
error-ranges ; (or/c 'dont-test
|
||||||
; (-> (is-a?/c text)
|
; (-> (is-a?/c text)
|
||||||
|
@ -26,9 +26,8 @@
|
||||||
|
|
||||||
#:omit-define-syntaxes)
|
#:omit-define-syntaxes)
|
||||||
|
|
||||||
(define in-here
|
(define (in-here/path file) (path->string (build-path (find-system-path 'temp-dir) file)))
|
||||||
(let ([here (this-expression-source-directory)])
|
(define (in-here file) (format "~s" (in-here/path file)))
|
||||||
(lambda (file) (format "~s" (path->string (build-path (find-system-path 'temp-dir) file))))))
|
|
||||||
|
|
||||||
(define tests '())
|
(define tests '())
|
||||||
(define-syntax (test stx)
|
(define-syntax (test stx)
|
||||||
|
|
|
@ -1297,7 +1297,8 @@ This produces an ACK message
|
||||||
(fprintf (current-error-port)
|
(fprintf (current-error-port)
|
||||||
"FAILED load test ~a for ~s\n expected: ~s\n got: ~s\n"
|
"FAILED load test ~a for ~s\n expected: ~s\n got: ~s\n"
|
||||||
short-filename
|
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))
|
(load-test tmp-load-short-filename (make-load-answer in-vector language-cust #f))
|
||||||
(when (file-exists? tmp-load3-filename)
|
(when (file-exists? tmp-load3-filename)
|
||||||
(delete-file tmp-load3-filename))
|
(delete-file tmp-load3-filename))
|
||||||
|
|
|
@ -1,13 +1,19 @@
|
||||||
|
|
||||||
------------------------------
|
------------------------------
|
||||||
Version 5.2.1
|
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.
|
. DrRacket no longer shows a stacktrace for syntax errors in the REPL.
|
||||||
|
|
||||||
. The preference that makes a single "(" keystroke insert "()"
|
. The preference that makes a single "(" keystroke insert "()" (and
|
||||||
(and similarly for [ { " and |) now only takes effect in Racket mode,
|
similarly for [ { " and |) now only takes effect in Racket mode,
|
||||||
instead of taking effect in all of the modes, as it used to.
|
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
|
Version 5.2
|
||||||
|
|
Loading…
Reference in New Issue
Block a user