#lang racket/gui

;(require drracket/tool-lib)
(require framework)

#| TODO
- sort the scripts in sub-menus, given in the prop-file

|#

(preferences:set-default 'user-script-dir
                         (path->string (build-path (find-system-path 'pref-dir) "user-scripts"))
                         path-string?)

(define (script-dir)
  ;"/home/laurent/Unison/Prog/Racket/tool-test/scripts/")
  (preferences:get 'user-script-dir))

(displayln (script-dir))
(make-directory* (script-dir))

(define (set-script-dir dir)
  (preferences:set 'user-script-dir (if (path? dir) (path->string dir) dir)))

(define frame (new frame:text% ;(drracket:frame:basics-mixin frame%)
                    [min-width 400] [min-height 400]))
(define menu-bar (send frame get-menu-bar));(new menu-bar% [parent frame]))
(define scripts-menu 
  (new menu% [parent menu-bar] [label "&Scripts"]
       [demand-callback
        (λ(m)
          ;; remove all scripts items, after the persistent ones:
          (for ([item (list-tail (send scripts-menu get-items) 4)])
            (send item delete))
          ;; add script items:
          (define menu-hash (make-hash))
          (for ([f (directory-list (script-dir))])
            (let ([f-prop (build-path (script-dir) (string-append (path->string f) "d"))])
              (when (and (member (filename-extension f) '(#"rkt"))
                         (file-exists? f-prop))
                (let* ([props (with-input-from-file f-prop (λ _ (read)))] ; read from the property file
                       [label (dict-ref props 'label (path->string f))]
                       [sub-menu (dict-ref props 'sub-menu #f)]
                       [parent-menu (if (string? sub-menu)
                                        (hash-ref! menu-hash sub-menu
                                                   (λ _ (new menu% [parent scripts-menu] [label sub-menu])))
                                        scripts-menu)]
                       [shortcut (dict-ref props 'shortcut #f)]
                       [shortcut-prefix (dict-ref props 'shortcut-prefix (get-default-shortcut-prefix))]
                       [help-string (dict-ref props 'help-string #f)]
                       )
                  (new menu-item% [parent parent-menu] [label label]
                       [shortcut shortcut] [shortcut-prefix shortcut-prefix]
                       [help-string help-string]
                       [callback (λ(it ev)(run-script (build-path (script-dir) f)))])))
              )))]
       ))
(new menu-item% [parent scripts-menu] [label "New Script"]
     [callback (λ _ (new-script))])
(new menu-item% [parent scripts-menu] [label "Open Script"]
     [callback (λ _ (open-script))])
(new menu-item% [parent scripts-menu] [label "Open Script Properties"]
     [callback (λ _ (open-script-properties))])
(new separator-menu-item% [parent scripts-menu])


(preferences:add-panel 
 "Scripts"
 (λ(parent)
   (define pref-panel (new vertical-panel% [parent parent] [alignment '(center center)]
                           [spacing 10]
                           [horiz-margin 10]
                           [vert-margin 10]
                           ;[min-width 400] [min-height 400]
                           ;[border 10]
                           ))
   (define dir-panel (new horizontal-panel% [parent pref-panel]))
   (define text-dir (new text-field% [parent dir-panel] [label "Script directory:"]
                         [init-value (script-dir)]
                         [enabled #f]))
   (new button% [parent dir-panel] [label "Change script directory"]
        [callback (λ _ (choose-script-dir))])
   (preferences:add-callback 'user-script-dir
                             (λ(p v)(send text-dir set-value  v)))
   pref-panel))

(define (choose-script-dir)
  (let ([d (get-directory "Choose a directory for storing scripts" #f
                          (script-dir))])
    (displayln d)
    (and d (set-script-dir d))))

(define (new-script)
  (define name (get-text-from-user "Script name" "Enter the name of the script"))
  (when name
    (define script-name (string-append name ".rkt"))
    (define f-script (build-path (script-dir) script-name))
    (define f-prop (build-path (script-dir) (string-append script-name "d")))
    
    (with-output-to-file f-prop
      (λ _ (pretty-write `((label . ,name)
                           (sub-menu . #f)))))
    (with-output-to-file f-script
      (λ _ (displayln "#lang racket/base")))
    
    (edit-script f-script)
    ;(edit-script f-prop)
    ))

;; file: path?
(define (edit-script file)
  (when file
    (define text (send frame get-editor))
    (send text load-file file)
    ))

(define (open-script)
  (define file (get-file "Open a script" frame (script-dir) #f #f '() '(("Racket" "*.rkt"))))
  (edit-script file)
  )

(define (open-script-properties)
  (define file (get-file "Open properties" frame (script-dir) #f #f '() '(("Property file" "*.rktd"))))
  (edit-script file)
  )

;; f: path?
(define (run-script f)
  (define text (send frame get-editor))
  (define str (send text get-text 
                    (send text get-start-position) 
                    (send text get-end-position)))
  (define ns (make-base-namespace))
  (define str-out
    (eval `(begin 
             (require (file ,(path->string f)))
             (modify-selection ,str)
             )
          ns))
  
  (send text begin-edit-sequence)
  (send text insert str-out)
  (send text end-edit-sequence)
  )


(send frame show #t)