Fetches a quickscript at a given url and adds it to the library
#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. | |
(require quickscript | |
quickscript/base | |
quickscript/library | |
racket/class | |
racket/file | |
racket/match | |
racket/port | |
racket/path | |
racket/string | |
racket/gui/base | |
net/url) | |
(script-help-string "Fetches a quickscript at a given url and adds it to the library.") | |
(define dir user-script-dir) | |
(define url2script-submod-name 'url2script-info) | |
;; Will be in quickscript/utils at some point | |
(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 (parse-url str) | |
(match str | |
; We can extract the filename | |
; "https://gist.githubusercontent.com/Metaxal/4449e/raw/342e26/letterfall.rkt" | |
[(regexp #px"^https://gist\\.github(?:usercontent|)\\.com/[^/]+/[0-9a-f]+/raw/[0-9a-f]+/([^/]+)$" | |
(list _ filename)) | |
(values str filename)] | |
; "https://gist.githubusercontent.com/Metaxal/4449e059959da9f344f83c7e628ad9af/raw" | |
; "https://pastebin.com/raw/EMfcc5zs" | |
[(or (regexp #px"^https://gist\\.github(?:usercontent|).com/[^/]+/[0-9a-f]+/raw$") | |
(regexp #px"^https://gitlab\\.com/snippets/[0-9]+/raw$") | |
(regexp #px"^http://pasterack\\.org/pastes/[0-9]+/raw$") | |
(regexp #px"^https://pastebin.com/raw/[0-9a-zA-Z]+$")) | |
(values str #f)] | |
; "https://gist.githubusercontent.com/Metaxal/4449e059959da9f344f83c7e628ad9af" | |
; "https://gitlab.com/snippets/1997854" | |
; "http://pasterack.org/pastes/8953" | |
[(or (regexp #px"^https://gist\\.github(?:usercontent|)\\.com/[^/]+/[0-9a-f]+$") | |
(regexp #px"^https://gitlab\\.com/snippets/[0-9]+$") | |
(regexp #px"^http://pasterack\\.org/pastes/[0-9]+$")) | |
(values (string-append str "/raw") #f)] | |
; "https://pastebin.com/EMfcc5zs" | |
[(regexp #px"^https://pastebin.com/([0-9a-zA-Z]+)$" (list _ name)) | |
(values (string-append "https://pastebin.com/raw/" name) #f)] | |
; Any other kind of url, we assume a link to a raw file | |
[else (values str #f)])) | |
;; TODO: check it is indeed a (valid?) quickscript | |
(define (get-text-at-url aurl) | |
(port->string (get-pure-port (string->url aurl) #:redirections 10) | |
#:close? #t)) | |
;; Notice: Does not ask to replace (should be done prior). | |
;; Doesn't add a submodule if one already exists. | |
;; Allows the designer to give the default file name to save the script. | |
(define (write-script fout text aurl #:filename [filename (file-name-from-path fout)]) | |
;; A s-exp test would be better… or maybe even trying to read the info? | |
(define submod-first-line | |
(string-append "(module " (symbol->string url2script-submod-name) " racket/base")) | |
(define has-submod? (string-contains? text submod-first-line)) | |
(display-to-file | |
#:exists 'replace | |
(string-append | |
text | |
(if has-submod? | |
"" | |
(string-append | |
"\n" | |
submod-first-line | |
" | |
(provide filename url) | |
(define filename " (format "~s" (and filename (path->string filename))) ") | |
(define url " (format "~s" aurl) ")) | |
"))) | |
fout)) | |
(define (get-submod-url f) | |
(parameterize ([current-namespace (make-base-empty-namespace)]) | |
(dynamic-require `(submod (file ,(path->string f)) ,url2script-submod-name) | |
'url | |
(λ () #f)))) | |
(define (get-submod-filename f) | |
(parameterize ([current-namespace (make-base-empty-namespace)]) | |
(dynamic-require `(submod (file ,(path->string f)) ,url2script-submod-name) | |
'filename | |
(λ () #f)))) | |
;; Returns a replacement string for the selected string `selection` | |
;; ("" if no text is selected), or `#f` to leave the selection as is. | |
(define-script url2script | |
#:label "Fetch script…" | |
#:menu-path ("url2script") | |
(λ (selection #:frame frame) | |
#;(make-directory* dir) | |
#;(add-third-party-script-directory! dir) | |
(define str (get-text-from-user | |
"url2script" | |
"Enter url to gist, gitlab snippet or pasterack, or to a raw racket file:")) | |
(when str | |
; at a special commit, with the name at the end, which we could extract | |
(define-values (aurl maybe-filename) (parse-url str)) | |
(define text (get-text-at-url aurl)) | |
(define ftmp (make-temporary-file)) | |
; Write a first time to maybe-write and read the submod infos | |
(write-script ftmp text aurl #:filename maybe-filename) | |
(define filename (get-submod-filename ftmp)) | |
(define fout (put-file "url2script: Save script as…" | |
frame | |
dir | |
(or filename ".rkt") | |
".rkt" | |
'() | |
'(("Racket source" "*.rkt") | |
("Any" "*.*")))) | |
(when fout | |
(write-script fout text str) | |
(smart-open-file frame fout)) | |
#f))) | |
(module+ test | |
(require rackunit) | |
(let () | |
(define f (make-temporary-file)) | |
(define aurl "https://this.is.your/home/now") | |
(write-script f "#lang racket/base\n" aurl) | |
(check-equal? (get-submod-url f) | |
aurl)) | |
(define (test-parse-url url) | |
(call-with-values (λ () (parse-url url)) list)) | |
(check-equal? | |
(test-parse-url "https://gist.github.com/Metaxal/f5ea8e94b802eac947fe9ea72870624b") | |
'("https://gist.github.com/Metaxal/f5ea8e94b802eac947fe9ea72870624b/raw" | |
#f)) | |
(check-equal? | |
(test-parse-url "https://gist.github.com/Metaxal/f5ea8e94b802eac947fe9ea72870624b/raw") | |
'("https://gist.github.com/Metaxal/f5ea8e94b802eac947fe9ea72870624b/raw" | |
#f)) | |
(check-equal? | |
(test-parse-url "https://gist.githubusercontent.com/Metaxal/4449e/raw/342e/letterfall.rkt") | |
(list "https://gist.githubusercontent.com/Metaxal/4449e/raw/342e/letterfall.rkt" | |
"letterfall.rkt"))) | |
;; Updates a script that was downloaded with url2script. | |
(define-script update-script | |
#:label "Update current script" | |
#:menu-path ("url2script") | |
(λ (selection #:file f #:frame drfr) | |
(when f | |
(define submod-url (get-submod-url f)) | |
(cond | |
[submod-url | |
(define-values (aurl _name) (parse-url submod-url)) | |
(define text (get-text-at-url aurl)) | |
(define ok? | |
(message-box "Attention" | |
"This will rewrite the current file. Continue?" | |
#f | |
'(ok-cancel caution))) | |
(when ok? | |
(write-script f text aurl) | |
(when drfr (send drfr revert)))] | |
[else | |
(message-box | |
"Error" | |
"Unable to find original url. Script may not have been downloaded with url2script." | |
#f | |
'(ok stop))])) | |
#f)) | |
(module url2script-info racket/base | |
(provide url filename) | |
(define filename "url2script.rkt") | |
(define url "https://gist.githubusercontent.com/Metaxal/77391e388303af5513d09bcd640f116c")) |
This comment has been minimized.
This comment has been minimized.
The new version can update a script that was downloaded with url2script. This is possible because the url is stored in and read from the file (in a submodule). |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
This comment has been minimized.
First install this script:
Scripts|Manage scripts|New…
, type url2script, then paste the content of the script at the url above in place of the default template, save, and finallyScripts|Manage scripts|Reload menu
Then to install a new script from (say) gist, just click on
Scripts|url2script
, paste in the url of the target script, type a script name (save it in the default directory if you don't know what you're doing) and reload the menu. Sometimes it can figure out a good default name.