Skip to content

Instantly share code, notes, and snippets.

@Metaxal

Metaxal/url2script.rkt

Last active Mar 2, 2021
Embed
What would you like to do?
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"))
@Metaxal

This comment has been minimized.

Copy link
Owner Author

@Metaxal Metaxal commented Jan 29, 2021

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 finally Scripts|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.

@Metaxal

This comment has been minimized.

Copy link
Owner Author

@Metaxal Metaxal commented Feb 1, 2021

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