[racket] command-line racket with mred components
I was excited that 5.1 was going to let me run graphics-library stuff
without running a GUI frontend, because I have a script for converting
wxme to txt that used to require a whole convoluted series of steps but
now could be run from the command line.
And it basically worked. I tweaked it slightly to make it a script, ran
it on a batch of files, and it did just what I wanted.
A few days later I tried it again and it was broken. Huh? After a
certain amount of experimentation, I discovered that if I was ssh'ed
into a machine from my office desktop machine, the racket script didn't
work, but if I was ssh'ed into the same machine from my laptop, the
script worked. Same machine in both cases.
I'm not sure if this is a bug in the new racket code or in how I've
called things from my script, and I'm sort of at a loss for how to even
debug this; racket seems to somehow be differentiating based on where
I'm ssh'ed in from, which is completely bizarre. I've attached the
script in case that will shed light on the matter.
--
-=-Don Blaheta-=-dblaheta at monm.edu-=-=-<http://www.monmsci.net/~dblaheta/>-=-
"They're pretty crappy wood floors (they need a bit of work in the
kitchen), which makes them only like 500 times better than carpet."
--Benoit Hudson
-------------- next part --------------
#!/usr/local/bin/racket
#lang racket
;; demunge (fka demunge.scm)
;; v2.0 20 Feb 2011]
;; [v1.1 1 Feb 2005]
;; Don Blaheta
;; Run as command-line script with .rkt files as command-line arguments.
;; Requires Racket 5.1 or later.
; (module demunge mzscheme
(require (lib "etc.ss"))
(require (lib "list.ss"))
(require (lib "class.ss"))
(require (lib "mred.ss" "mred"))
(provide src-suffixes dest-suffix line-comment-string)
(provide plt->txt demunge-files)
; (define src-suffixes (list ".ajava" ".ajava.scm" ".ijava" ".ijava.scm"
; ".bjava.scm" ".bjava" ".scm" ".sch" ".ss"))
; (define dest-suffix ".java")
; (define line-comment-string "// ")
(define src-suffixes (list ".wxme" ".rkt"))
(define dest-suffix ".txt.rkt")
(define line-comment-string ";; ");
;;; SNIP PROCESSING
(define get-snip-list
(opt-lambda (t [n 0])
(let [(fst (send t find-snip n 'after-or-none))]
(if fst
(cons fst (get-snip-list t (+ n (send fst get-count))))
'()))))
(define (sniptype snip)
(send (send snip get-snipclass) get-classname))
(define (default-snip->text snip)
(send snip get-text 0 (send snip get-count)))
(define (test-case->text tc)
(string-append
line-comment-string
;(send (get-field comment tc) get-text)
;": "
(send (get-field to-test tc) get-text)
" => "
(send (get-field expected tc) get-text)
"\n"))
(define (snip->text snip)
(cond
[(equal? (sniptype snip) "test-case-box%") (test-case->text snip)]
[else (default-snip->text snip)]))
;;; FILE AND FILENAME PROCESSING
(define (plt->string filename)
(define t (new text%))
(send t load-file filename)
(apply string-append (map snip->text (get-snip-list t))))
(define (dump-to-file str file)
(let [(out (open-output-file file))]
(display str out)
(close-output-port out)))
(define (suffix? suf str)
(equal? suf (substring str (- (string-length str) (string-length suf)))))
; (suffix? ".a" "foo.a") ; => #t
(define (detect-and-remove name suffs)
(if (empty? suffs)
name
(if (suffix? (car suffs) name)
(substring name 0 (- (string-length name)
(string-length (car suffs))))
(detect-and-remove name (cdr suffs)))))
; (detect-and-remove "foo.bar" (list ".baz" ".bar")) ; => "foo"
; (detect-and-remove "foo.bam" (list ".baz" ".bar")) ; => "foo.bam"
(define (munge-filename pltfilename)
(string-append
(detect-and-remove pltfilename src-suffixes)
dest-suffix))
(define plt->txt
(opt-lambda (pltfile [txtfile (munge-filename pltfile)])
(dump-to-file (plt->string pltfile) txtfile)))
;(define pltfile "/Users/dblaheta/courses/cs141/f04/labs/shapes.bjava")
;(plt->txt pltfile)
(define (symbol-or-string->str s)
(if (symbol? s)
(symbol->string s)
s))
;(symbol-or-string->str "foo") ; => "foo"
;(symbol-or-string->str 'foo) ; => "foo"
(define (demunge-files flist)
(for-each plt->txt (map symbol-or-string->str flist)))
;(display "To run, use: (demunge-files '( ... ))")
;) ;;end module
(demunge-files (vector->list (current-command-line-arguments)))