suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixed up handling of downloaded files

Browse Source 
svn: r1461
This commit is contained in:
Robby Findler 2005-12-01 18:58:25 +00:00
parent e3375a3c5c
commit b50dea350d
1 changed files with 86 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
collects/browser/private/hyper.ss
View File

@ -56,6 +56,7 @@ A test case:
(define-struct (exn:file-saved-instead exn) (pathname))
(define-struct (exn:cancelled exn) ())
(define-struct (exn:tcp-problem exn) ())
(define history-limit 20)
@ -144,15 +145,7 @@ A test case:
(opt-lambda (url-string [post-data #f])
(on-url-click
(lambda (url-string post-data)
(with-handlers ([(lambda (x) #t)
(lambda (x)
(unless (or (exn:break? x)
(exn:file-saved-instead? x)
(exn:cancelled? x))
((error-display-handler)
(if (exn? x) (exn-message x) (format "~s" x))
x)))])
(send (get-canvas) goto-url url-string (get-url) void post-data)))
(send (get-canvas) goto-url url-string (get-url) void post-data))
url-string
post-data)))
@ -310,7 +303,6 @@ A test case:
[(or (and mime-type (regexp-match #rx"application/" mime-type))
(and (url? url)
(not (null? (url-path url)))
(regexp-match "[.]plt$" (car (last-pair (url-path url))))
; document-not-found produces HTML:
(not html?)))
; Save the file
@ -416,7 +408,9 @@ A test case:
; Let thread run only after the dialog is shown
(queue-callback (lambda () (semaphore-post wait-to-start)))
(send d show #t)
(when exn (raise exn)))
(when exn
(raise (make-exn:tcp-problem (exn-message exn)
(current-continuation-marks)))))
(let ([sema (make-semaphore 0)])
(when (and tmp-plt-filename install?)
(run-installer tmp-plt-filename
@ -651,7 +645,7 @@ A test case:
(let ([tlw (get-top-level-window)])
(when (and tlw
(is-a? tlw hyper-frame<%>))
(let ([pre-url (cond
(let* ([pre-url (cond
[(url? in-url) in-url]
[(port? in-url) in-url]
[(string? in-url)
@ -660,15 +654,15 @@ A test case:
(string->url in-url))]
[else (error 'goto-url "unknown url ~e\n" in-url)])]
[killable-cust (make-custodian)]
[hyper-panel (send tlw get-hyper-panel)])
(let-values ([(e url)
[hyper-panel (send tlw get-hyper-panel)]
[result
(let ([e-now (get-editor)])
(cond
[(and e-now
(not post-data)
(same-page-url? pre-url (send e-now get-url)))
(progress #t)
(values e-now pre-url)]
(cons e-now pre-url)]
[else
(send hyper-panel set-stop-callback
(lambda ()
@ -684,13 +678,20 @@ A test case:
(lambda (x) (remap-url x)))
(send hyper-panel set-stop-callback void)
(send hyper-panel enable-browsing #t))]))])
(when e
(let* ([tag-pos (send e find-tag (and (url? url) (url-fragment url)))])
(cond
[(pair? result)
(let* ([e (car result)]
[url (cdr result)]
[tag-pos (send e find-tag (and (url? url) (url-fragment url)))])
(unless (and tag-pos (positive? tag-pos))
(send e hide-caret #t))
(set-page (list e (or tag-pos 0) (send e last-position)) #t)
(when tag-pos (send e set-position tag-pos))))))))))
(when tag-pos (send e set-position tag-pos)))]
[(exn? result)
(message-box (string-constant drscheme)
(exn-message result)
tlw)]
[else (void)]))))))
;; remap-url : url? -> (union #f url?)
;; this method is intended to be overridden so that derived classes can change
@ -724,7 +725,7 @@ A test case:
;; make-editor/setup-kill : custodian editor-class frame%-instance
;; url (boolean??? -> void) ??? (url -> (union port #f url))
;; -> (values (union #f editor) (union #f url))
;; -> (union (cons editor (union #f url)) exn #f)
;; if cust is shutdown, the url will stop being loaded and a dummy editor is returned.
(define (make-editor/setup-kill cust html-editor% tlw init-url progress post-data remap-url)
(let* ([c (make-channel)]
@ -751,7 +752,7 @@ A test case:
(progress void))])
(send t insert "Stopped.")
(set! ans (cons t #f)))))))
(values (car ans) (cdr ans))))
ans))
;; make-editor/follow-redirections : editor-class frame%-instance
;; url (boolean??? -> void) ??? (url -> (union port #f url))
@ -760,6 +761,11 @@ A test case:
;; but stops after 10 redirections (just in case there are too many
;; of these things, give the user a chance to stop)
(define (make-editor/follow-redirections html-editor% tlw init-url progress post-data remap-url)
(with-handlers ([(lambda (x)
(or (exn:file-saved-instead? x)
(exn:cancelled? x)
(exn:tcp-problem? x)))
values])
(let loop ([n 10]
[unmapped-url init-url])
(let ([url (if (url? unmapped-url)
@ -786,7 +792,7 @@ A test case:
(lambda (new-url) (loop (- n 1) new-url))]
[else
(cons html-editor url)]))
(cons #f #f)))))
(cons #f #f))))))
(define hyper-canvas% (hyper-canvas-mixin canvas:basic%))