Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

fix relative directory when loading (and saving) a project from the c…

…ommand line.

File path is now made absolute (complete) -> less problems.
  • Loading branch information...
commit f399f903bc5402b86f8af84d065c9c37f94b1ddd 1 parent 0f45d3e
@Metaxal authored
View
8 mred-designer/code-generation.rkt
@@ -62,17 +62,15 @@
(define (module-header)
(string-append "\
-#lang racket/gui
+#lang racket/base
;;==========================================================================
;;=== Code generated with MrEd Designer " application-version
- " ===
+ " ===
;;=== https://github.com/Metaxal/MrEd-Designer ===
;;==========================================================================
-") ; add the name of the project and the date ? and the username ?
-; ;;=== http://mred-designer.origo.ethz.ch ===
- )
+"))
(define (print-requires reqs)
(display "(require\n")
View
39 mred-designer/controller.rkt
@@ -273,9 +273,10 @@
;; Simplified to return #t on success, #f otherwise - kdh 2012-02-29
(define/provide (load-project file)
(debug-printf "load-project: ~a~n" file)
- (debug-printf "current-dir: ~a\n"(current-directory))
- (parameterize ([current-directory (find-system-path 'orig-dir)
- #;(path-only file)])
+ (set! file (path->complete-path file (find-system-path 'orig-dir)))
+ (debug-printf "complete path: ~a\n" file)
+ ;(debug-printf "current-dir: ~a\n"(current-directory))
+ (parameterize ([current-directory (path-only file)])
(let ([mids (load-mred file #f)])
(or
(and mids
@@ -303,25 +304,24 @@
)])
; Simplify return value - kdh 2012-02-29
(and file
- (load-project file))
- ))
+ (load-project file))))
(define/provide (save-project mid file)
(debug-printf "save-project: enter~n")
- (begin-busy-cursor)
(when mid
+ (debug-printf "Saving project in ~a\n" file)
+ (begin-busy-cursor)
(let ([project-mid (send mid get-top-mred-parent)])
(send (send (send project-mid get-property 'file) get-prop)
set-value (path-string->string file))
(save-template project-mid (->string (send project-mid get-id)) file)
;(save-mred-id project-mid file)
(set-project-changed project-mid #f)
- ))
- (end-busy-cursor)
- (debug-printf "save-project: exit~n")
+ )
+ (end-busy-cursor)
+ (debug-printf "save-project: exit~n"))
; specify return value - kdh 2012-07-09
- (void)
- )
+ (void))
(define/provide (controller-save-project [save-as? #f] [mid (get-current-mred-id)])
(debug-printf "controller-save-project: save-as?:~a mid:~a ~n" save-as? mid)
@@ -350,8 +350,7 @@
(debug-printf "controller-save-project: done~n")
; specify return value - kdh 2012-07-09
- (void)
- )
+ (void))
(define (choose-code-file dft-name [base-path #f] [parent-frame #f])
(let ([base-path (and base-path (normal-case-path (simple-form-path base-path)))]
@@ -414,17 +413,15 @@
#:ask [ask-user? #t])
(when mid
(let* ([project-mid (send mid get-top-mred-parent)]
- ;[proj-file (send project-mid get-property-value 'file)]
- [base-dir (send project-mid get-project-dir)]; (and proj-file (path-only (string->path proj-file)))]
+ [base-dir (send project-mid get-project-dir)]
[dft-file (string-append (->string (send project-mid get-id)) ".rkt")]
[file (if ask-user?
(choose-code-file dft-file base-dir toolbox-frame)
- dft-file)]
+ (path->complete-path dft-file base-dir))]
)
(when file
- (parameterize ([current-directory (or base-dir (current-directory))])
- (with-output-to-file file
- (λ()(generate-module project-mid))
- #:exists 'replace)
- )
+ (debug-printf "Generating code in file ~a\n" file)
+ (with-output-to-file file
+ (λ()(generate-module project-mid))
+ #:exists 'replace)
))))
View
6 mred-designer/mred-id.rkt
@@ -213,12 +213,10 @@
(send mred-parent get-top-mred-parent)
this))
- ;; WARNING: SHOULD be a project... (and I SHOULD test for it...)
(define/public (get-project-dir)
(let* ([top-mid (get-top-mred-parent)] ; the project-mid
- [proj-file (send top-mid get-property-value 'file)]
- [base-dir (and proj-file (path-only (string->path proj-file)))])
- base-dir))
+ [proj-file (send top-mid get-property-value 'file)])
+ (and proj-file (path-only (string->path proj-file)))))
; returns the topmost WINDOW of the current hierarchy (a frame%, not a project%)
(define/public (get-top-level-window-mred-id)
View
7 mred-designer/widgets/project/widget.rkt
@@ -8,19 +8,20 @@
[tooltip "Project"]
[button-group #f] ; no button
[widget-class project%]
-; [code-gen-class frame%] ; the class used in the generated code for the widgets of this plugin
[parent-class #f]
[pre-code (λ(mid)(if (send mid get-property-value 'runtime-paths?)
'((require racket/runtime-path))
'()))]
[necessary '(parent)] ; necessary properties (not used yet)
;[options '(id)] ; options of the init-function in the generated code
- [no-code '(file code-file code-requires changed runtime-paths?)] ; don't generate this field in the generated file
+ ; don't generate this field in the generated file:
+ [no-code '(file code-file code-requires changed runtime-paths?)]
[hidden '(file label style code-file changed)] ; don't show this in the property frame
( ; widget properties
[file #f] ; file to save the project to
[code-file #f] ; file to generate the code to. Should be relative to file ?
[changed #f] ; has the project changed since last save?
- [code-requires '("framework")] ; list of modules that the generated code needs
+ ; list of modules that the generated code needs:
+ [code-requires '("framework" "racket/gui/base" "racket/class" "racket/list")]
[runtime-paths? #f] ; do we use runtime-paths in the generated code?
))
Please sign in to comment.
Something went wrong with that request. Please try again.