From 9ffc3c27beeb8e1d6ed1d1def6b6cd0c57a9a37b Mon Sep 17 00:00:00 2001 From: slava Date: Sat, 20 May 2006 20:42:33 +0000 Subject: [PATCH] Clean up inspector and browser --- TODO.FACTOR.txt | 5 +- cp_dir | 2 +- doc/handbook/tools.facts | 4 +- doc/handbook/tutorial.facts | 4 +- library/collections/sequences-epilogue.factor | 3 + library/quotations.factor | 2 - library/tools/describe.factor | 41 ++----- library/tools/describe.facts | 19 +-- library/ui/browser.factor | 112 ++++++++++++------ library/ui/layouts.factor | 20 ++-- library/ui/paint.factor | 11 +- 11 files changed, 113 insertions(+), 110 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 2a930b1bb3..4d65c3e106 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,5 +1,4 @@ - remove F_USERENV rel -- quotations should store their originating word - core foundation should use unicode strings - alien>utf16-string, utf16-string>alien words - fix compiled gc check @@ -35,13 +34,12 @@ + ui/help: - new browser: - - close boxes - separate definition & documentation tabs + - browse generic words and classes - toggle/radio buttons/tabs or something - make-frame should compile - track: - don't allow negative dimensions - - fix round-off error - fix top level window positioning - changing window titles - reimplement clicking input @@ -65,6 +63,7 @@ - saving the image should save window configuration - fix up the min thumb size hack - variable width word wrap +- new gesture style + compiler/ffi: diff --git a/cp_dir b/cp_dir index ef0e5f73f2..bcb40af43a 100644 --- a/cp_dir +++ b/cp_dir @@ -1,4 +1,4 @@ #!/bin/sh mkdir -p `dirname $2` -cp -v $1 $2 +cp $1 $2 diff --git a/doc/handbook/tools.facts b/doc/handbook/tools.facts index 8584cb75ea..9dd99dc491 100644 --- a/doc/handbook/tools.facts +++ b/doc/handbook/tools.facts @@ -43,8 +43,8 @@ ARTICLE: "word-introspection" "Word introspection" "Find words whose name contains a given string:" { $subsection apropos } "List all vocabularies, and list words in a vocabulary:" -{ $subsection vocabs. } -{ $subsection words. } +{ $subsection vocabs } +{ $subsection words } "Display callers and words called by a given word:" { $subsection usage. } { $subsection uses. } ; diff --git a/doc/handbook/tutorial.facts b/doc/handbook/tutorial.facts index ca2f57c468..65ae12e48d 100644 --- a/doc/handbook/tutorial.facts +++ b/doc/handbook/tutorial.facts @@ -147,11 +147,11 @@ ARTICLE: "tutorial-library" "The library" { $list { "To list all vocabularies:" - { $code "vocabs." } + { $code "vocabs ." } } { "To list all words in a vocabulary:" - { $code "\"sequences\" words." } + { $code "\"sequences\" words ." } } { "To show a word definition:" diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor index 7cadcadae4..ce4bef8f41 100644 --- a/library/collections/sequences-epilogue.factor +++ b/library/collections/sequences-epilogue.factor @@ -116,6 +116,9 @@ M: object like drop ; : assoc ( key assoc -- value ) [ first = ] find-with nip second ; +: rassoc ( value assoc -- key ) + [ second = ] find-with nip first ; + : last/first ( seq -- pair ) dup peek swap first 2array ; : sequence= ( seq seq -- ? ) diff --git a/library/quotations.factor b/library/quotations.factor index ae9d867156..b410b9f9f7 100644 --- a/library/quotations.factor +++ b/library/quotations.factor @@ -30,7 +30,5 @@ M: wrapper literalize ; : curry ( obj quot -- quot ) >r literalize unit r> append ; -: curry-each ( seq quot -- seq ) [ swap curry ] map-with ; - : alist>quot ( default alist -- quot ) [ [ first2 swap % , , \ if , ] [ ] make ] each ; diff --git a/library/tools/describe.factor b/library/tools/describe.factor index 64cb7619a3..140df3fb0d 100644 --- a/library/tools/describe.factor +++ b/library/tools/describe.factor @@ -1,5 +1,5 @@ -! Copyright (C) 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. +! Copyright (C) 2005, 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. IN: inspector USING: arrays generic hashtables help io kernel kernel-internals math namespaces prettyprint sequences strings vectors words ; @@ -38,12 +38,7 @@ M: object summary M: object sheet ( obj -- sheet ) slot-sheet ; M: sequence summary - dup length 1 = [ - drop "a sequence containing 1 element" - ] [ - "a sequence containing " swap length number>string - " elements" append3 - ] if ; + [ dup length # " element " % class word-name % ] "" make ; M: quotation sheet 1array ; @@ -90,26 +85,6 @@ DEFER: describe : describe ( object -- ) dup summary print sheet sheet. ; -: sequence-outliner ( strings objects quot -- ) - over curry-each 3array flip - [ first3 simple-outliner terpri ] each ; - -: unparse-outliner ( seq quot -- | quot: obj -- ) - >r natural-sort [ [ unparse-short ] map ] keep - r> sequence-outliner ; - -: word-outliner ( seq quot -- ) - >r natural-sort [ [ synopsis ] map ] keep - r> sequence-outliner ; - -: words. ( vocab -- ) words [ (help) ] unparse-outliner ; - -: vocabs. ( -- ) vocabs [ words. ] unparse-outliner ; - -: usage. ( word -- ) usage [ usage. ] word-outliner ; - -: uses. ( word -- ) uses [ uses. ] word-outliner ; - : stack. ( seq -- seq ) >array describe ; : .s datastack stack. ; @@ -125,6 +100,16 @@ DEFER: describe : .c callstack callstack. ; +: word-outliner ( seq quot -- ) + swap natural-sort [ + [ synopsis ] keep rot dupd curry + simple-outliner terpri + ] each-with ; + +: usage. ( word -- ) usage [ usage. ] word-outliner ; + +: uses. ( word -- ) uses [ uses. ] word-outliner ; + : apropos ( substring -- ) all-words completions natural-sort [ (help) ] word-outliner ; diff --git a/library/tools/describe.facts b/library/tools/describe.facts index 36db7c1370..3c83dadff9 100644 --- a/library/tools/describe.facts +++ b/library/tools/describe.facts @@ -20,21 +20,10 @@ HELP: describe "( object -- )" { $notes "Slot values are converted to strings using " { $link unparse-short } "." } { $examples { $code "global describe" } } ; -HELP: sequence-outliner "( seq quot -- )" -{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( object -- )" } } } -{ $description "Prints an expanding outliner to the default stream. The sequence elements are converted to strings using " { $link unparse-short } ", and each element is output on its own row. Expanding a row outliner applies the quotation to the object; the quotation should print output to the default stream to elaborate the object." } -{ $notes "For a lower-level outliner output facility, use " { $link simple-outliner } " or " { $link write-outliner } "." } ; - -HELP: words. "( vocab -- )" -{ $values { "vocab" "a string naming a vocabulary" } } -{ $description "Prints an outliner listing all words in a vocabulary. Expanding a row shows the word documentation and definition using " { $link help } "." } -{ $examples { $code "\"sequences\" words." } } -{ $see-also words } ; - -HELP: vocabs. "( -- )" -{ $description "Prints an outliner listing all vocabularies. Expanding a row lists the words in that vocabulary using " { $link words. } "." } -{ $examples { $code "vocabs." } } -{ $see-also vocabs } ; +HELP: word-outliner "( seq quot -- )" +{ $values { "seq" "a sequence of words" } { "quot" "a quotation with stack effect " { $snippet "( word -- )" } } } +{ $description "Prints an expanding outliner to the default stream. The sequence elements are converted to strings using " { $link synopsis } ", and each element is output on its own row. Expanding a row outliner applies the quotation to the word; the quotation should print output to the default stream to elaborate the word." } +{ $notes "For a more general outliner output facility, use " { $link simple-outliner } " or " { $link write-outliner } "." } ; HELP: usage. "( word -- )" { $values { "word" "a word" } } diff --git a/library/ui/browser.factor b/library/ui/browser.factor index aa1fb2c124..af0bfd9f8a 100644 --- a/library/ui/browser.factor +++ b/library/ui/browser.factor @@ -7,39 +7,77 @@ gadgets-scrolling gadgets-theme gadgets-tracks generic hashtables help inspector kernel math prettyprint sequences words ; -TUPLE: browser - vocabs - vocab-track showing-vocabs - word-track showing-words ; +TUPLE: browser-track showing builder closer ; + +C: browser-track ( builder closer -- gadget ) + over set-delegate + H{ } clone over set-browser-track-showing + [ set-browser-track-closer ] keep + [ set-browser-track-builder ] keep ; + +: showing-asset? ( asset track -- ? ) + browser-track-showing hash-member? ; + +: (show-asset) ( gadget asset track -- ) + [ browser-track-showing set-hash ] 3keep nip track-add ; + +: show-asset ( asset track -- ) + 2dup showing-asset? [ + 2drop + ] [ + [ browser-track-builder call ] 2keep (show-asset) + ] if ; + +: hide-asset ( asset track -- ) + [ dup browser-track-closer call ] 2keep + [ browser-track-showing remove-hash* ] keep track-remove ; + +TUPLE: browser vocabs vocab-track word-track ; : find-browser [ browser? ] find-parent ; -: ( gadget title -- gadget ) +TUPLE: tile ; + +: find-tile [ tile? ] find-parent ; + +: close-tile ( tile -- ) + dup gadget-parent [ + browser-track-showing hash>alist rassoc + ] keep hide-asset ; + +: ( -- gadget ) + { 0.0 0.0 0.0 1.0 } close-box + [ find-tile close-tile ] ; + +: ( title -- gadget ) { - { [