[racket] command-line racket with mred components

From: Don Blaheta (dblaheta at monm.edu)
Date: Fri Mar 4 15:43:14 EST 2011

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)))

Posted on the users mailing list.