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