Skip to content

Instantly share code, notes, and snippets.

@Metaxal

Metaxal/workspaces.rkt

Last active Feb 2, 2021
Embed
What would you like to do?
Workspaces for DrRacket (quickscript)
#lang racket/base
;;; License: [Apache License, Version 2.0](http://www.apache.org/licenses/LICENSE-2.0) or
;;; [MIT license](http://opensource.org/licenses/MIT) at your option.
;;; See also: https://pkgs.racket-lang.org/package/drracket-restore-workspace
(require quickscript
racket/class
racket/match
racket/file
racket/list
racket/gui/base)
(script-help-string "Save and restore DrRacket tabs and cursor positions.")
;; Opens a file in a new tab and returns whether opening was successful.
;; Checks if the file exists and displays a message box otherwise and returns #f.
;; Opens the file in the first tab if drracket is still-untouched?
;; Changes to the corresponding tab if the file is already open.
;; TODO: Move this function to quickscript/utils (?) as it's quite useful!
;; appears also in quickscript-competition-2020/open-recent and open-multi.rkt (gist).
(define (smart-open-file drfr f)
(cond
[(not (file-exists? f))
(message-box "Error"
(format "File not found: ~a" f)
drfr
'(ok stop))
#f]
[(send drfr still-untouched?)
(send drfr change-to-file f)
#t]
[(send drfr find-matching-tab f)
=>
(λ (tab)
(send drfr change-to-tab tab)
#t)]
[else
(send drfr open-in-new-tab f)
#t]))
(define-script save-workspace
#:label "&Save workspace…"
#:menu-path ("&Workspaces")
(λ (selection #:frame fr)
(define current-dir (send (send fr get-current-tab) get-directory))
(define fout
(put-file "Save workspace"
fr
current-dir
"workspace.rktw"
".rktw"
'()
'(("DrRacket workspace" "*.rktw")
("Any" "*.*"))))
(when fout
(write-to-file
#:exists 'replace
(for/list ([tab (in-list (send fr get-tabs))]
#:when (send tab get-directory))
(define defs (send tab get-defs))
(define pth (send defs get-filename))
(list (if (path? pth) (path->string pth) pth)
(send defs get-start-position)
(send defs get-end-position)))
fout))
#f))
(define-script restore-workspace
#:label "&Restore workspace…"
#:menu-path ("&Workspaces")
(λ (selection #:frame fr)
(define fin
(get-file "Restore workspace"
fr
#false
#false
".rktw"
'()
'(("DrRacket workspace" "*.rktw")
("Any" "*.*"))))
(when (and fin (file-exists? fin))
(define fv (file->value fin))
#;(send fr begin-container-sequence)
(let ([fr (cond [(send fr still-untouched?) fr]
[else
(define open-new-window
(dynamic-require 'drracket/tool-lib
'drracket:unit:open-drscheme-window))
(define fr (open-new-window #f))
fr])])
(define first-tab? #true)
(define new-infos
(for/list ([info (in-list fv)])
(match info
[(list pth rst ...)
(and pth (smart-open-file fr pth) rst)])))
(for ([info (in-list new-infos)]
[tab (in-list (send fr get-tabs))])
(match info
[(list start-pos end-pos)
(define defs (send tab get-defs))
(send defs set-position start-pos end-pos)]
[else (void)]))
#;(send fr end-container-sequence))) ; buggy, not sure why
#f))
(module url2script-info racket/base
(provide filename url)
(define filename "workspaces.rkt")
(define url "https://gist.githubusercontent.com/Metaxal/f5ea8e94b802eac947fe9ea72870624b"))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment