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

started on an 'always on' notifications of planet activity via drscheme

Browse Source 
svn: r13490
This commit is contained in:
Robby Findler 2009-02-07 21:48:34 +00:00
parent 8cd0fe5e72
commit 3b046b05ec
5 changed files with 83 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/drscheme/private/rep.ss
View File

@ -31,7 +31,12 @@ TODO
scheme/gui/base
framework
browser/external
"drsig.ss")
"drsig.ss"
;; the dynamic-require below loads this module,
;; so we make the dependency explicit here, even
;; tho nothing is used from this module.
planet/terse-logger)
(provide rep@ with-stacktrace-name)
@ -1269,7 +1274,6 @@ TODO
(queue-callback (λ () (new-log-message vec))))
(loop))))))))
(let ([drscheme-exit-handler
(λ (x)
(parameterize-break
@ -1287,7 +1291,13 @@ TODO
(semaphore-wait s)
(custodian-shutdown-all user-custodian))))])
(exit-handler drscheme-exit-handler))
(initialize-parameters snip-classes))))
(initialize-parameters snip-classes)
;; register drscheme with the planet-terse-register for this namespace
((dynamic-require 'planet/terse-logger 'planet-terse-register)
(lambda (tag package)
(parameterize ([current-eventspace drscheme:init:system-eventspace])
(queue-callback (λ () (new-planet-info tag package)))))))))
;; disable breaks until an evaluation actually occurs
(send context set-breakables #f #f)
@ -1451,6 +1461,13 @@ TODO
(let ([frame (get-frame)])
(when frame
(send frame update-logger-window))))
(define/private (new-planet-info tag package)
(void)
#;
(let ([frame (get-frame)])
(send frame open-status-line 'planet)
(send frame update-status-line 'planet (format "~s ~s" tag package))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

29
collects/planet/resolver.ss
View File

@ -208,7 +208,10 @@ subdirectory.
;; if #f, will not install packages and instead give an error
(define install? (make-parameter #t))
;; this calls the terse logger from the current-namespace,
;; not the original one when the planet resolver was loaded.
(define (planet-terse-log id str)
((dynamic-require 'planet/terse-logger 'planet-terse-log) id str))
;; =============================================================================
;; DIAMOND PROPERTY STUFF
@ -536,6 +539,7 @@ subdirectory.
"Internal PLaneT error: trying to install already-installed package"
(current-continuation-marks)))
(begin
(planet-terse-log 'install (pkg-spec->string pkg))
(with-logging
(LOG-FILE)
(lambda ()
@ -560,9 +564,12 @@ subdirectory.
;; raises an exception if some protocol failure occurs in the download process
(define (download-package/planet pkg)
(define stupid-internal-define-syntax (planet-log "downloading ~a from ~a via planet protocol"
(pkg-spec->string pkg)
(PLANET-SERVER-NAME)))
(define stupid-internal-define-syntax
(let ([msg (format "downloading ~a from ~a via planet protocol"
(pkg-spec->string pkg)
(PLANET-SERVER-NAME))])
(planet-terse-log 'download (pkg-spec->string pkg))
(planet-log msg)))
(define-values (ip op) (tcp-connect (PLANET-SERVER-NAME) (PLANET-SERVER-PORT)))
@ -656,12 +663,14 @@ subdirectory.
(when (> attempts 5)
(return "Download failed too many times (possibly due to an unreliable network connection)"))
(planet-log "downloading ~a from ~a via HTTP~a"
(pkg-spec->string pkg)
(PLANET-SERVER-NAME)
(if (= attempts 1)
""
(format ", attempt #~a" attempts)))
(let ([msg (format "downloading ~a from ~a via HTTP~a"
(pkg-spec->string pkg)
(PLANET-SERVER-NAME)
(if (= attempts 1)
""
(format ", attempt #~a" attempts)))])
(planet-terse-log 'download (pkg-spec->string pkg))
(planet-log "~a" msg))
(with-handlers ([exn:fail:network? (λ (e) (return (exn-message e)))])
(let* ([target (pkg->download-url pkg)]

34
collects/planet/terse-logger.ss Normal file
View File

@ -0,0 +1,34 @@
(module terse-logger '#%kernel
;; This file is dynamically loaded by drscheme in a (possibly)
;; empty namespace (ie possibly no scheme/base module yet)
;; and it is dynamically loaded by the planet resolver.
(#%provide planet-terse-register planet-terse-log)
(define-values (terse-log-message-chan) (make-channel))
(define-values (terse-log-proc-chan) (make-channel))
(thread
(lambda ()
(letrec-values ([(loop)
(lambda (procs)
(sync
(handle-evt
terse-log-message-chan
(lambda (msg)
(for-each (lambda (proc) (proc (car msg) (cdr msg))) procs)
(loop procs)))
(handle-evt
terse-log-proc-chan
(lambda (proc)
(loop (cons proc procs))))))])
(loop '()))))
(define-values (planet-terse-log)
(lambda (id str)
(sync (channel-put-evt terse-log-message-chan (cons id str)))))
(define-values (planet-terse-register)
(lambda (proc)
(sync (channel-put-evt terse-log-proc-chan proc)))))

2
collects/planet/util.ss
View File

@ -6,6 +6,8 @@
"private/planet-shared.ss"
"private/linkage.ss"
"terse-logger.ss"
"resolver.ss"
net/url
xml/xml

16
collects/scribblings/framework/frame.scrbl
View File

@ -81,7 +81,7 @@ framework)) @(require (for-label scheme/gui)) @(require
Returns @scheme[#f].
}
@defmethod*[(((get-filename (temp (union |#f| (box boolean?)) |#f|)) (union |#f| path)))]{
@defmethod*[(((get-filename (temp (or/c #f (box boolean?)) #f)) (or/c #f path)))]{
This returns the filename that the frame is currently being saved as,
or @scheme[#f] if there is no appropriate filename.
@ -185,7 +185,7 @@ framework)) @(require (for-label scheme/gui)) @(require
}
@defmixin[frame:size-pref-mixin (frame:basic<%>) (frame:size-pref<%>)]{
@defconstructor[((size-preferences-key symbol?) (label label-string?) (parent (or/c (is-a?/c frame%) false/c) #f) (x (or/c (integer-in -10000 10000) false/c) #f) (y (or/c (integer-in -10000 10000) false/c) #f) (style (listof (one-of/c (quote no-resize-border) (quote no-caption) (quote no-system-menu) (quote hide-menu-bar) (quote mdi-parent) (quote mdi-child) (quote toolbar-button) (quote float) (quote metal))) null) (enabled any/c #t) (border (integer-in 0 1000) 0) (spacing (integer-in 0 1000) 0) (alignment (list/c (one-of/c (quote left) (quote center) (quote right)) (one-of/c (quote top) (quote center) (quote bottom))) (quote (center top))) (min-width (integer-in 0 10000) graphical-minimum-width) (min-height (integer-in 0 10000) graphical-minimum-height) (stretchable-width any/c #t) (stretchable-height any/c #t))]{
@defconstructor[((size-preferences-key symbol?) (label label-string?) (parent (or/c (is-a?/c frame%) false/c) #f) (x (or/c (integer-in -10000 10000) false/c) #f) (y (or/c (integer-in -10000 10000) false/c) #f) (style (listof (or/c (quote no-resize-border) (quote no-caption) (quote no-system-menu) (quote hide-menu-bar) (quote mdi-parent) (quote mdi-child) (quote toolbar-button) (quote float) (quote metal))) null) (enabled any/c #t) (border (integer-in 0 1000) 0) (spacing (integer-in 0 1000) 0) (alignment (list/c (or/c (quote left) (quote center) (quote right)) (or/c (quote top) (quote center) (quote bottom))) (quote (center top))) (min-width (integer-in 0 10000) graphical-minimum-width) (min-height (integer-in 0 10000) graphical-minimum-height) (stretchable-width any/c #t) (stretchable-height any/c #t))]{
The size @scheme[size-preferences-key] symbol is used with
@scheme[preferences:get]
@ -297,7 +297,7 @@ framework)) @(require (for-label scheme/gui)) @(require
Closes the status line @scheme[id].
}
@defmethod*[(((update-status-line (id symbol?) (status (union |#f| string))) void))]{
@defmethod*[(((update-status-line (id symbol?) (status (or/c #f string))) void))]{
Updates the status line named by @scheme[id] with
@scheme[status]. If @scheme[status] is @scheme[#f], the status
line is becomes blank (and may be used by other ids).
@ -355,7 +355,7 @@ framework)) @(require (for-label scheme/gui)) @(require
@method[frame:info<%> set-info-canvas]
}
@defmethod*[(((get-info-editor) (union |#f| (is-a?/c editor<%>))))]{
@defmethod*[(((get-info-editor) (or/c #f (is-a?/c editor<%>))))]{
Override this method to specify the editor that the status line
contains information about.
@ -549,7 +549,7 @@ framework)) @(require (for-label scheme/gui)) @(require
is a
@scheme[text%], the start and end positions are restored.
}
@defmethod*[(((save (format (union (quote guess) (quote standard) (quote text) (quote text-force-cr) (quote same) (quote copy)) (quote same))) boolean?))]{
@defmethod*[(((save (format (or/c (quote guess) (quote standard) (quote text) (quote text-force-cr) (quote same) (quote copy)) (quote same))) boolean?))]{
Saves the file being edited, possibly calling
@method[frame:editor<%> save-as]
if the editor has no filename yet.
@ -560,7 +560,7 @@ framework)) @(require (for-label scheme/gui)) @(require
the user is prompted for a new filename) and returns
@scheme[#t] if not.
}
@defmethod*[(((save-as (format (union (quote guess) (quote standard) (quote text) (quote text-force-cr) (quote same) (quote copy)) (quote same))) boolean?))]{
@defmethod*[(((save-as (format (or/c (quote guess) (quote standard) (quote text) (quote text-force-cr) (quote same) (quote copy)) (quote same))) boolean?))]{
Queries the use for a file name and saves the file with that name.
@ -590,10 +590,10 @@ framework)) @(require (for-label scheme/gui)) @(require
The size of this frame with be either 600 by 650 or 65 less than the
width and height of the screen, whichever is smaller.
@defconstructor[((filename string?) (editor% (is-a?/c editor<%>)) (parent (or/c (is-a?/c frame%) false/c) #f) (width (or/c (integer-in 0 10000) false/c) #f) (height (or/c (integer-in 0 10000) false/c) #f) (x (or/c (integer-in -10000 10000) false/c) #f) (y (or/c (integer-in -10000 10000) false/c) #f) (style (listof (one-of/c (quote no-resize-border) (quote no-caption) (quote no-system-menu) (quote hide-menu-bar) (quote mdi-parent) (quote mdi-child) (quote toolbar-button) (quote float) (quote metal))) null) (enabled any/c #t) (border (integer-in 0 1000) 0) (spacing (integer-in 0 1000) 0) (alignment (list/c (one-of/c (quote left) (quote center) (quote right)) (one-of/c (quote top) (quote center) (quote bottom))) (quote (center top))) (min-width (integer-in 0 10000) graphical-minimum-width) (min-height (integer-in 0 10000) graphical-minimum-height) (stretchable-width any/c #t) (stretchable-height any/c #t))]{
@defconstructor[((filename string?) (editor% (is-a?/c editor<%>)) (parent (or/c (is-a?/c frame%) false/c) #f) (width (or/c (integer-in 0 10000) false/c) #f) (height (or/c (integer-in 0 10000) false/c) #f) (x (or/c (integer-in -10000 10000) false/c) #f) (y (or/c (integer-in -10000 10000) false/c) #f) (style (listof (or/c (quote no-resize-border) (quote no-caption) (quote no-system-menu) (quote hide-menu-bar) (quote mdi-parent) (quote mdi-child) (quote toolbar-button) (quote float) (quote metal))) null) (enabled any/c #t) (border (integer-in 0 1000) 0) (spacing (integer-in 0 1000) 0) (alignment (list/c (or/c (quote left) (quote center) (quote right)) (or/c (quote top) (quote center) (quote bottom))) (quote (center top))) (min-width (integer-in 0 10000) graphical-minimum-width) (min-height (integer-in 0 10000) graphical-minimum-height) (stretchable-width any/c #t) (stretchable-height any/c #t))]{
}
@defmethod*[#:mode override (((get-filename) (union |#f| path)))]{
@defmethod*[#:mode override (((get-filename) (or/c #f path)))]{
Returns the filename in the editor returned by
@method[frame:editor<%> get-editor].