From 8cdc10abdbab99f57d24d07c8fdc17d0602c521e Mon Sep 17 00:00:00 2001 From: slava Date: Sat, 20 May 2006 06:13:44 +0000 Subject: [PATCH] New remove-hash* word; UI refactorings; adding new Whisker-style word browser --- TODO.FACTOR.txt | 11 +- library/bootstrap/boot-stage1.factor | 3 +- library/cocoa/menu-bar.factor | 13 +- library/collections/hashtables.factor | 3 + library/compiler/alien/c-types.factor | 6 +- library/compiler/alien/primitive-types.factor | 14 +- library/ui/apropos.factor | 2 +- library/ui/browser.factor | 202 +++++++++--------- library/ui/frames.factor | 8 +- library/ui/inspector.factor | 105 +++++++++ library/ui/launchpad.factor | 19 +- library/ui/listener.factor | 2 +- library/ui/presentations.factor | 25 ++- library/ui/scrolling.factor | 5 +- library/ui/tracks.factor | 32 ++- library/ui/world.factor | 4 +- 16 files changed, 299 insertions(+), 155 deletions(-) create mode 100644 library/ui/inspector.factor diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 348636c1ef..928cf3c4d8 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,3 +1,5 @@ +- redefine generic as tuple constructor -- still appears generic + - remove F_USERENV rel - update walker for new interpreter - quotations should store their originating word @@ -33,16 +35,13 @@ + ui/help: +- make-frame should compile - track: - don't allow negative dimensions - - support removing items - fix round-off error -- zooming doesn't work -- implement handlers for open, quit events, and whatever else - fix top level window positioning - changing window titles - reimplement clicking input -- polish OS X menu bar code - clicks sent twice - speed up ideas: - only do clipping for certain gadgets @@ -51,8 +50,12 @@ - x11 input methods - x11 title bars are funny - cocoa: + - need to flush callbacks - don't multiplex in the event loop if there is no pending i/o - horizontal scrolling + - zooming doesn't work + - implement handlers for open, quit events, and whatever else + - polish OS X menu bar code - fix mouse-overs... - display lists - saving the image should save window configuration diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 4f26f9b9b4..7be7e84f5c 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -193,10 +193,11 @@ vectors words ; "/library/ui/outliner.factor" "/library/ui/environment.factor" "/library/ui/listener.factor" + "/library/ui/presentations.factor" + "/library/ui/inspector.factor" "/library/ui/browser.factor" "/library/ui/apropos.factor" "/library/ui/launchpad.factor" - "/library/ui/presentations.factor" "/library/continuations.facts" "/library/errors.facts" diff --git a/library/cocoa/menu-bar.factor b/library/cocoa/menu-bar.factor index b695f587ad..05b93d8491 100644 --- a/library/cocoa/menu-bar.factor +++ b/library/cocoa/menu-bar.factor @@ -1,7 +1,8 @@ -USING: cocoa compiler gadgets gadgets-launchpad gadgets-layouts -gadgets-listener kernel memory objc objc-FactorCallback -objc-NSApplication objc-NSMenu objc-NSMenuItem objc-NSObject -objc-NSWindow sequences strings words ; +USING: cocoa compiler gadgets gadgets-browser gadgets-launchpad +gadgets-layouts gadgets-listener kernel memory objc +objc-FactorCallback objc-NSApplication objc-NSMenu +objc-NSMenuItem objc-NSObject objc-NSWindow sequences strings +words ; IN: gadgets-cocoa ! ------------------------------------------------------------------------- @@ -107,9 +108,9 @@ DEFER: described-menu { "Listener" listener-window "n" } { "Run..." menu-run-file "o" } { } + { "Browser" browser-window "b" } { "Apropos" apropos-window "r" } - { "Vocabularies" vocabs-window "" } - { "Globals" global-window "" } + { "Globals" globals-window "" } { "Memory" memory-window "" } { } { "Save Image" save "s" } diff --git a/library/collections/hashtables.factor b/library/collections/hashtables.factor index 0d625d6721..608251449c 100644 --- a/library/collections/hashtables.factor +++ b/library/collections/hashtables.factor @@ -143,6 +143,9 @@ IN: hashtables 3drop ] if-key ; +: remove-hash* ( key hash -- oldvalue ) + [ hash ] 2keep remove-hash ; + : hash-size ( hash -- n ) dup hash-count swap hash-deleted - ; inline diff --git a/library/compiler/alien/c-types.factor b/library/compiler/alien/c-types.factor index b9afbe4c0e..f988bdb830 100644 --- a/library/compiler/alien/c-types.factor +++ b/library/compiler/alien/c-types.factor @@ -71,11 +71,15 @@ SYMBOL: c-types : init-c-type ( name vocab -- ) over define-pointer define-nth ; -: define-primitive-type ( quot name -- ) +: (define-primitive-type) ( quot name -- ) [ define-c-type ] keep "alien" 2dup init-c-type 2dup define-deref over c-setter [ 2dup define-set-nth define-out ] when ; +: define-primitive-type ( quot name -- ) + [ (define-primitive-type) ] keep dup c-setter + [ "alien" 2dup define-set-nth define-out ] [ drop ] if ; + : typedef ( old new -- ) over "*" append over "*" append (typedef) (typedef) ; diff --git a/library/compiler/alien/primitive-types.factor b/library/compiler/alien/primitive-types.factor index f33ac24acc..f5cacc2866 100644 --- a/library/compiler/alien/primitive-types.factor +++ b/library/compiler/alien/primitive-types.factor @@ -103,25 +103,27 @@ USING: alien compiler kernel kernel-internals math namespaces ; [ [ alien-unsigned-cell alien>string ] "getter" set + [ >r >r alien-address r> r> set-alien-unsigned-cell ] "setter" set bootstrap-cell "width" set bootstrap-cell "align" set "box_c_string" "boxer-function" set "unbox_c_string" "unboxer-function" set -] "char*" define-primitive-type +] "char*" (define-primitive-type) [ [ alien-unsigned-4 ] "getter" set - bootstrap-cell "width" set - bootstrap-cell "align" set + [ >r >r alien-address r> r> set-alien-unsigned-4 ] "setter" set + 4 "width" set + 4 "align" set "box_utf16_string" "boxer-function" set "unbox_utf16_string" "unboxer-function" set -] "ushort*" define-primitive-type +] "ushort*" (define-primitive-type) [ [ alien-unsigned-4 zero? not ] "getter" set [ 1 0 ? set-alien-unsigned-4 ] "setter" set - bootstrap-cell "width" set - bootstrap-cell "align" set + 4 "width" set + 4 "align" set "box_boolean" "boxer-function" set "unbox_boolean" "unboxer-function" set ] "bool" define-primitive-type diff --git a/library/ui/apropos.factor b/library/ui/apropos.factor index e455afecfd..05bc3477b8 100644 --- a/library/ui/apropos.factor +++ b/library/ui/apropos.factor @@ -25,7 +25,7 @@ C: apropos-gadget ( -- ) { { [ ] set-apropos-gadget-scroller @center } { [ ] set-apropos-gadget-input @top } - } make-frame ; + } make-frame* ; M: apropos-gadget pref-dim* drop { 350 200 0 } ; diff --git a/library/ui/browser.factor b/library/ui/browser.factor index 8b5fec4d36..b199925f5a 100644 --- a/library/ui/browser.factor +++ b/library/ui/browser.factor @@ -1,122 +1,114 @@ ! Copyright (C) 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-browser -USING: arrays gadgets gadgets-buttons gadgets-labels -gadgets-layouts gadgets-panes gadgets-scrolling gadgets-theme -generic hashtables help inspector kernel math namespaces -prettyprint sequences words ; +USING: gadgets gadgets-buttons gadgets-inspector gadgets-labels +gadgets-layouts gadgets-panes gadgets-presentations +gadgets-scrolling gadgets-theme gadgets-tracks generic +hashtables help inspector kernel math prettyprint sequences +words ; -SYMBOL: components - -H{ } clone components set-global - -: get-components ( class -- assoc ) - components get-global hash [ - { { "Slots" [ describe ] } } - ] unless* ; - -{ - { "Definition" [ help ] } - { "Calls in" [ usage. ] } - { "Calls out" [ uses. ] } - { "Links in" [ links-in. ] } - { "Links out" [ links-out. ] } - { "Vocabulary" [ word-vocabulary words. ] } - { "Properties" [ word-props describe ] } -} \ word components get-global set-hash - -{ - { "Article" [ help ] } - { "Links in" [ links-in. ] } - { "Links out" [ links-out. ] } -} \ link components get-global set-hash - -{ - { "Call stack" [ continuation-call callstack. ] } - { "Data stack" [ continuation-data stack. ] } - { "Retain stack" [ continuation-retain stack. ] } - { "Name stack" [ continuation-name stack. ] } - { "Catch stack" [ continuation-catch stack. ] } -} \ continuation components get-global set-hash - -TUPLE: book page pages ; - -: show-page ( key book -- ) - dup book-page unparent - [ book-pages assoc ] keep - [ set-book-page ] 2keep - add-gadget ; - -C: book ( pages -- book ) - dup delegate>gadget - [ set-book-pages ] 2keep - [ >r first first r> show-page ] keep ; - -M: book pref-dim* ( book -- dim ) book-page pref-dim ; - -M: book layout* ( book -- ) - dup rect-dim swap book-page set-gadget-dim ; - -: component-pages ( obj -- assoc ) - dup class get-components - [ first2 swapd make-pane 2array ] map-with ; - -: ( name book -- button ) - dupd [ show-page drop ] curry curry - >r