Skip to content
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
165 changes: 81 additions & 84 deletions drracket-core-lib/browser/external.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -166,68 +166,64 @@
(lambda (name browser) (try-put-preferences (list 'external-browser) (list browser)))))

(letrec
([v-panel (instantiate group-box-panel% ()
[parent pref-panel]
[alignment '(right center)]
[stretchable-height #f]
[label (string-constant external-browser-choice-title)])]
[h-panel (instantiate horizontal-panel% ()
[parent v-panel]
[alignment '(center bottom)])]
([v-panel (new group-box-panel%
[parent pref-panel]
[alignment '(right center)]
[stretchable-height #f]
[label (string-constant external-browser-choice-title)])]
[h-panel (new horizontal-panel% [parent v-panel] [alignment '(center bottom)])]
[none-index (length raw:unix-browser-list)]
[custom-index (add1 none-index)]
[r (instantiate radio-box% ()
[label #f]
[choices
(append unix-browser-names
(list (string-constant no-browser)
(string-constant browser-command-line-label)))]
[parent h-panel]
[callback
(lambda (radio event)
(let ([n (send radio get-selection)])
(set-browser! (cond
[(= n none-index) #f]
[(= n custom-index) (get-custom)]
[else (list-ref raw:unix-browser-list n)]))))])]
[r (new radio-box%
[label #f]
[choices
(append unix-browser-names
(list (string-constant no-browser)
(string-constant browser-command-line-label)))]
[parent h-panel]
[callback
(lambda (radio event)
(let ([n (send radio get-selection)])
(set-browser! (cond
[(= n none-index) #f]
[(= n custom-index) (get-custom)]
[else (list-ref raw:unix-browser-list n)]))))])]
[select-custom (lambda (_ __)
(send r set-selection custom-index)
(set-browser! (get-custom)))]
[get-custom (lambda () (cons (send pre get-value) (send post get-value)))]
[template-panel (instantiate horizontal-panel% (h-panel)
[spacing 0]
[stretchable-height #f])]
[pre (instantiate text-field% ()
[label #f]
[parent template-panel]
[callback select-custom]
[horiz-margin 0])]
[mess (instantiate message% ()
[label "<URL>"]
[parent template-panel]
[horiz-margin 0])]
[post (instantiate text-field% ()
[label #f]
[parent template-panel]
[callback select-custom]
[horiz-margin 0])]
[note1 (instantiate message% ((string-constant browser-cmdline-expl-line-1) v-panel))]
[note2 (instantiate message% ((string-constant browser-cmdline-expl-line-2) v-panel))]
[pre (new text-field%
[label #f]
[parent template-panel]
[callback select-custom]
[horiz-margin 0])]
[mess (new message% [label "<URL>"] [parent template-panel] [horiz-margin 0])]
[post (new text-field%
[label #f]
[parent template-panel]
[callback select-custom]
[horiz-margin 0])]
[note1 (make-object message% (string-constant browser-cmdline-expl-line-1) v-panel)]
[note2 (make-object message% (string-constant browser-cmdline-expl-line-2) v-panel)]
[refresh-controls (lambda (pref)
(if (pair? pref)
(begin
(send r set-selection custom-index)
(send pre set-value (car pref))
(send post set-value (cdr pref)))
(let init ([x raw:unix-browser-list]
[n 0])
(cond
[(null? x) (send r set-selection n)]
[else
(if (eq? pref (car x))
(send r set-selection n)
(init (cdr x)
(add1 n)))]))))])
(cond
[(pair? pref)
(send r set-selection custom-index)
(send pre set-value (car pref))
(send post set-value (cdr pref))]
[else
(let init ([x raw:unix-browser-list]
[n 0])
(cond
[(null? x) (send r set-selection n)]
[else
(if (eq? pref (car x))
(send r set-selection n)
(init (cdr x)
(add1 n)))]))]))])

(unless ask-later?
(send r enable none-index #f))
Expand All @@ -241,37 +237,38 @@

;; -------------------- proxy for doc downloads --------------------
(when set-help?
(letrec ([p (instantiate group-box-panel% ()
[label (string-constant http-proxy)]
[parent pref-panel]
[stretchable-height #f]
[alignment '(left top)])]
(letrec ([p (new group-box-panel%
[label (string-constant http-proxy)]
[parent pref-panel]
[stretchable-height #f]
[alignment '(left top)])]
[rb (make-object radio-box%
#f
(list (string-constant proxy-direct-connection)
(string-constant proxy-use-proxy))
p
(lambda (r e)
(let ([proxy? (= 1 (send r get-selection))])
(send proxy-spec enable proxy?)
(if proxy?
(update-proxy)
(fw:preferences:set http-proxy-preference #f)))))]
(define proxy? (= 1 (send r get-selection)))
(send proxy-spec enable proxy?)
(if proxy?
(update-proxy)
(fw:preferences:set http-proxy-preference #f))))]
[proxy-spec (instantiate horizontal-panel% (p)
[stretchable-width #f]
[stretchable-height #f]
[alignment '(left center)])]
[update-proxy (lambda ()
(let ([host (send host get-value)]
[port (send port get-value)])
(let ([ok? (and (regexp-match? #rx"^[-0-9a-zA-Z.]+$" host)
(regexp-match? #rx"^[0-9]+$" port)
(string->number port)
(<= 1 (string->number port) 65535))])
(when ok?
(fw:preferences:set http-proxy-preference
(list "http" host (string->number port))))
(send bad-host show (not ok?)))))]
(define ok?
(and (regexp-match? #rx"^[-0-9a-zA-Z.]+$" host)
(regexp-match? #rx"^[0-9]+$" port)
(string->number port)
(<= 1 (string->number port) 65535)))
(when ok?
(fw:preferences:set http-proxy-preference
(list "http" host (string->number port))))
(send bad-host show (not ok?))))]
[host (make-object text-field%
(string-constant proxy-host)
proxy-spec
Expand All @@ -285,20 +282,20 @@
[bad-host (make-object message% (string-constant proxy-bad-host) p)]
[update-gui (lambda (proxy-val)
(send bad-host show #f)
(if proxy-val
(begin
(send rb set-selection 1)
(send proxy-spec enable #t)
(unless (string=? (cadr proxy-val) (send host get-value))
(send host set-value (cadr proxy-val)))
(unless (equal? (caddr proxy-val)
(string->number (send port get-value)))
(send port set-value (number->string (caddr proxy-val)))))
(begin
(send rb set-selection 0)
(send proxy-spec enable #f)
(send host set-value "")
(send port set-value ""))))])
(cond
[proxy-val
(send rb set-selection 1)
(send proxy-spec enable #t)
(unless (string=? (cadr proxy-val) (send host get-value))
(send host set-value (cadr proxy-val)))
(unless (equal? (caddr proxy-val)
(string->number (send port get-value)))
(send port set-value (number->string (caddr proxy-val))))]
[else
(send rb set-selection 0)
(send proxy-spec enable #f)
(send host set-value "")
(send port set-value "")]))])

(fw:preferences:add-callback http-proxy-preference (lambda (name val) (update-gui val)))
(update-gui (fw:preferences:get http-proxy-preference))
Expand Down
88 changes: 44 additions & 44 deletions drracket-core-lib/drracket/private/honu-logo.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -15,36 +15,41 @@
(values (+ x (* w 1/2) (* w 1/2 ce)) (+ y (* h 1/2) (* h 1/2 se))))

(define (weighted-arc path x y w h start end ccw? [dx1 0.0] [dy1 0.2] [dx2 dx1] [dy2 (- dy1)])
(let ([sweep (let loop ([s (if ccw? (- end start) (- start end))])
(if (< s 0) (loop (+ s (* 2 pi))) s))])
(if (> sweep pi)
(let ([halfway ((if ccw? + -) start (/ sweep 2))])
(weighted-arc path x y w h start halfway ccw? dx1 dy1 dx2 dy2)
(weighted-arc path x y w h halfway end ccw? dx2 (- dy2) dx1 (- dy1)))
(let ([p (new dc-path%)])
;; Set p to be the arc for a unit circle,
;; centered on the X-axis:
(let* ([x0 (cos (/ sweep 2))]
[y0 (sin (/ sweep 2))]
[x1 (/ (- 4 x0) 3)]
[y1 (/ (* (- 1 x0) (- 3 x0)) (* 3 y0))]
[x2 x1]
[y2 (- y1)]
[x3 x0]
[y3 (- y0)]
[sw (/ w 2)]
[sh (/ h 2)])
(send p move-to x0 y0)
(send p curve-to (+ x1 dx1) (+ y1 dy1) (+ x2 dx2) (+ y2 dy2) x3 y3)
;; Rotate to match start:
(send p rotate (+ (if ccw? start end) (/ sweep 2)))
;; Scale to match width and height:
(send p scale (/ w 2) (/ h 2))
;; Translate to match x and y
(send p translate (+ x (/ w 2)) (+ y (/ h 2)))
(unless ccw?
(send p reverse)))
(send path append p)))))
(define sweep
(let loop ([s (if ccw?
(- end start)
(- start end))])
(if (< s 0)
(loop (+ s (* 2 pi)))
s)))
(if (> sweep pi)
(let ([halfway ((if ccw? + -) start (/ sweep 2))])
(weighted-arc path x y w h start halfway ccw? dx1 dy1 dx2 dy2)
(weighted-arc path x y w h halfway end ccw? dx2 (- dy2) dx1 (- dy1)))
(let ([p (new dc-path%)])
;; Set p to be the arc for a unit circle,
;; centered on the X-axis:
(let* ([x0 (cos (/ sweep 2))]
[y0 (sin (/ sweep 2))]
[x1 (/ (- 4 x0) 3)]
[y1 (/ (* (- 1 x0) (- 3 x0)) (* 3 y0))]
[x2 x1]
[y2 (- y1)]
[x3 x0]
[y3 (- y0)]
[sw (/ w 2)]
[sh (/ h 2)])
(send p move-to x0 y0)
(send p curve-to (+ x1 dx1) (+ y1 dy1) (+ x2 dx2) (+ y2 dy2) x3 y3)
;; Rotate to match start:
(send p rotate (+ (if ccw? start end) (/ sweep 2)))
;; Scale to match width and height:
(send p scale (/ w 2) (/ h 2))
;; Translate to match x and y
(send p translate (+ x (/ w 2)) (+ y (/ h 2)))
(unless ccw?
(send p reverse)))
(send path append p))))

(define overall-rotation (- (* pi 1/2 3/8)))

Expand Down Expand Up @@ -133,20 +138,15 @@
(+ big-fin-bottom-y 10)))

(define (add-big-fin-bottom add)
(let ([fin-width (- big-fin-right-edge big-fin-bottom-x)])
(add
(+ big-fin-bottom-x fin-width)
(+ big-fin-bottom-y 10)

(+ big-fin-bottom-x (* 1/3 fin-width))
(- (/ (+ big-fin-bottom-y big-fin-top-y) 2)
big-fin-curve-bottom-offset)

(+ big-fin-bottom-x (* 1/5 fin-width))
(/ (+ big-fin-bottom-y big-fin-top-y) 2)

big-fin-bottom-x
big-fin-bottom-y)))
(define fin-width (- big-fin-right-edge big-fin-bottom-x))
(add (+ big-fin-bottom-x fin-width)
(+ big-fin-bottom-y 10)
(+ big-fin-bottom-x (* 1/3 fin-width))
(- (/ (+ big-fin-bottom-y big-fin-top-y) 2) big-fin-curve-bottom-offset)
(+ big-fin-bottom-x (* 1/5 fin-width))
(/ (+ big-fin-bottom-y big-fin-top-y) 2)
big-fin-bottom-x
big-fin-bottom-y))

(define (add-little-fin-top add)
(add
Expand Down
12 changes: 5 additions & 7 deletions drracket-core-lib/drracket/sprof.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -17,10 +17,8 @@
(define new-traces
(map (λ (t) (continuation-mark-set->context (continuation-marks t))) (get-threads)))
(for ([trace (in-list new-traces)])
(for-each
(λ (line)
(hash-set! traces-table line (cons trace (hash-ref traces-table line '()))))
trace))
(for ([line (in-list trace)])
(hash-set! traces-table line (cons trace (hash-ref traces-table line '())))))
(cond
[(zero? i)
(update-gui traces-table)
Expand Down Expand Up @@ -160,9 +158,9 @@
(hash-set! line-to-source i pr)
(insert (format-percentage (/ count denom-count)))
(insert (format " ~a" (format-fn-name fn)))
(let ([after (last-position)])
(when (equal? (car pr) clicked-srcloc-pr)
(set! clear-old-pr (highlight-range before after "NavajoWhite")))))
(define after (last-position))
(when (equal? (car pr) clicked-srcloc-pr)
(set! clear-old-pr (highlight-range before after "NavajoWhite"))))
(loop (cdr prs) #f (+ i 1))])]))
(lock #t)
(end-edit-sequence)
Expand Down
22 changes: 9 additions & 13 deletions drracket/help/private/bug-report-controls.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -296,19 +296,15 @@
(cons (string->symbol (format "~a" (bri-label bri))) (bri-value bri)))))

(define (get-environment)
(string-append (send environment get-value)
"\n"
(format "Human Language: ~a\n" (send human-language get-value))
(format "(current-memory-use) ~a\n" (send memory-use get-value))
(format "raco pkg (show):\n~a\n" (send (send pkg-info get-editor) get-text))
"\n"
"\nCollections:\n"
(format "~a" (send (send collections get-editor) get-text))
"\n"
(apply
string-append
(for/list ([extra (in-list extras)])
(format "~a: ~a\n" (car extra) (send (cdr extra) get-value))))))
(format "~a\n~a~a~a\n\nCollections:\n~a\n~a"
(send environment get-value)
(format "Human Language: ~a\n" (send human-language get-value))
(format "(current-memory-use) ~a\n" (send memory-use get-value))
(format "raco pkg (show):\n~a\n" (send (send pkg-info get-editor) get-text))
(send (send collections get-editor) get-text)
(apply string-append
(for/list ([extra (in-list extras)])
(format "~a: ~a\n" (car extra) (send (cdr extra) get-value))))))

(define (get-content canvas)
(define t (send canvas get-editor))
Expand Down
6 changes: 3 additions & 3 deletions drracket/macro-debugger/tool.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -461,9 +461,9 @@
(define canvas (send obj get-canvas))
(when canvas
(define frame (send canvas get-top-level-window))
(when (is-a? frame frame/supports-macro-stepper<%>)
(when (send frame allow-macro-stepper?)
(send frame run-macro-stepper)))))))
(when (and (is-a? frame frame/supports-macro-stepper<%>)
(send frame allow-macro-stepper?))
(send frame run-macro-stepper))))))
(send keymap map-function "c:c;c:m" "macro stepper"))

(add-macro-stepper-key-bindings (drracket:rep:get-drs-bindings-keymap))
Expand Down
Loading