Advertisement
Guest User

Recompile and restart

a guest
Jan 11th, 2013
171
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Scheme 2.25 KB | None | 0 0
  1. #lang racket/gui
  2.  
  3. ;;; Recompile and restart test
  4. ;;; Author: Laurent Orseau <laurent orseau gmail com> -- 2013-01-11
  5. ;;; License: WTFPL - http://www.wtfpl.net
  6.  
  7. (require racket/runtime-path
  8.          ;ffi/unsafe ; for getpid (unix)
  9.          mzlib/os ; for getpid (all platforms, but deprecated)
  10.          compiler/cm
  11.          )
  12.  
  13. ; TODO: Shouldn't we wait for the parent to finish?
  14.  
  15. ;(define getpid (get-ffi-obj "getpid" #f (_fun -> _int)) ) ; Unix only
  16. (define pid
  17.   (getpid))
  18.  
  19. (define (dprintf fmt . lstr)
  20.   (apply printf (string-append "[" (number->string pid) "] " fmt) lstr))
  21.  
  22. (define (wait-msg str)
  23.   (dprintf "~a... " str))
  24.  
  25. (define (ok)
  26.   (printf "Ok.\n"))
  27.  
  28. (define-runtime-path this-file "recompile-restart.rkt")
  29.  
  30. (define (recompile-restart)
  31.   (define this-file-string (path->string this-file))
  32.  
  33.   (wait-msg "Modifying file")
  34.   (display-lines-to-file
  35.    (list (~s `(dprintf ,(string-append "Ancester: " (number->string pid) "\n"))))
  36.    this-file #:exists 'append)
  37.   (ok)
  38.  
  39.   (with-handlers ([exn:fail?
  40.                    (λ(e)
  41.                      (dprintf "Something went wrong during recompile & restart:\n")
  42.                      (displayln (exn-message e))
  43.                      (dprintf "Aborting procedure.\n"))])
  44.     ; Recompile this file (like "raco make ....")
  45.     (wait-msg "Recompiling")
  46.     (managed-compile-zo this-file)
  47.     (ok)
  48.        
  49.     (wait-msg "Running child")
  50.     (define-values (sp a b c)
  51.       (subprocess (current-output-port) (current-input-port) (current-error-port)
  52.                   "/usr/bin/racket" this-file-string))
  53.     (ok)
  54.        
  55.     ; I don't think I need to close the ports since we use our parent's ones
  56.     ;(displayln (list sp a b c))
  57.    
  58.     ; If all went ok, terminate program by hiding the frame
  59.     (wait-msg "Closing frame")
  60.     (send my-frame show #f)    
  61.     (ok)
  62.    
  63.     (newline)
  64.     ; Make sure to exit in case anything hangs (like some non-closed frame%)
  65.     (exit)
  66.     ))
  67.  
  68. ;;; A simple GUI
  69. (define my-frame (new frame% [label "my-frame"] [min-width 200] [min-height 200]))
  70. (define bt (new button% [parent my-frame] [label "Recompile && Restart"]
  71.                 [callback (λ(bt ev)(recompile-restart))]))
  72.  
  73.  
  74. (send my-frame show #t)
  75. (dprintf "I'm alive!\n")
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement