]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' into new_ui
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 18 Dec 2008 00:15:01 +0000 (18:15 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 18 Dec 2008 00:15:01 +0000 (18:15 -0600)
1  2 
basis/help/markup/markup.factor
basis/prettyprint/prettyprint.factor
basis/tools/vocabs/browser/browser.factor
basis/ui/tools/interactor/interactor.factor
basis/ui/tools/search/search.factor
core/parser/parser.factor

index 09712145184c08597ee71bf1d357dbdc63fd0b24,bf933cd9f12008335ab84d6972b77812cd7f71ea..c31a15af1c8c10a7b314dddf2e33309de97b717d
@@@ -3,8 -3,7 +3,7 @@@
  USING: accessors arrays definitions generic io kernel assocs
  hashtables namespaces make parser prettyprint sequences strings
  io.styles vectors words math sorting splitting classes slots
- vocabs help.stylesheet help.topics vocabs.loader alias
- quotations ;
+ vocabs help.stylesheet help.topics vocabs.loader quotations ;
  IN: help.markup
  
  ! Simple markup language.
@@@ -356,7 -355,4 +355,7 @@@ M: array elements
      ] H{ } make-assoc keys ;
  
  : <$link> ( topic -- element )
 -    \ $link swap 2array ;
 +    1array \ $link prefix ;
 +
 +: <$snippet> ( str -- element )
 +    1array \ $snippet prefix ;
index 50c522e25556a40c84429c37fb43335eaf7e645c,b3800babe8fdb3a4ca76038b87931d4db07710af..37a75de9b3d9398328e88f4ea91302f43113d8fc
@@@ -2,13 -2,13 +2,13 @@@
  ! See http://factorcode.org/license.txt for BSD license.
  USING: arrays generic generic.standard assocs io kernel math
  namespaces make sequences strings io.styles io.streams.string
- vectors words prettyprint.backend prettyprint.custom
+ vectors words words.symbol prettyprint.backend prettyprint.custom
  prettyprint.sections prettyprint.config sorting splitting
  grouping math.parser vocabs definitions effects classes.builtin
- classes.tuple io.files classes continuations hashtables
+ classes.tuple io.pathnames classes continuations hashtables
  classes.mixin classes.union classes.intersection
  classes.predicate classes.singleton combinators quotations sets
- accessors colors parser summary ;
+ accessors colors parser summary vocabs.parser ;
  IN: prettyprint
  
  : make-pprint ( obj quot -- block in use )
@@@ -234,6 -234,15 +234,6 @@@ M: pathname synopsis* pprint* 
  
  M: word summary synopsis ;
  
 -: synopsis-alist ( definitions -- alist )
 -    [ dup synopsis swap ] { } map>assoc ;
 -
 -: definitions. ( alist -- )
 -    [ write-object nl ] assoc-each ;
 -
 -: sorted-definitions. ( definitions -- )
 -    synopsis-alist sort-keys definitions. ;
 -
  GENERIC: declarations. ( obj -- )
  
  M: object declarations. drop ;
@@@ -348,12 -357,12 +348,12 @@@ M: builtin-class see-class
      ] when drop ;
  
  M: word see
-     dup see-class
-     dup class? over symbol? not and [
-         nl
-     ] when
-     dup [ class? ] [ symbol? ] bi and
-     [ drop ] [ call-next-method ] if ;
+     [ see-class ]
+     [ [ class? ] [ symbol? not ] bi and [ nl ] when ]
+     [
+         dup [ class? ] [ symbol? ] bi and
+         [ drop ] [ call-next-method ] if
+     ] tri ;
  
  : see-all ( seq -- )
      natural-sort [ nl ] [ see ] interleave ;
index 8b3292e3ac1a1b72c2220788d2ed61ebe65d038c,36f23a8298aa2f6244406db3fbc7a15d8db501e9..3c8ffa5c5b00852d362c59f21bfe6abd39b01445
@@@ -3,40 -3,50 +3,40 @@@
  USING: accessors arrays assocs classes classes.builtin
  classes.intersection classes.mixin classes.predicate
  classes.singleton classes.tuple classes.union combinators
- definitions effects fry generic help help.markup
- help.stylesheet help.topics io io.files io.styles kernel macros
+ definitions effects fry generic help help.markup help.stylesheet
+ help.topics io io.files io.pathnames io.styles kernel macros
  make namespaces prettyprint sequences sets sorting summary
- tools.vocabs vocabs vocabs.loader words ;
+ tools.vocabs vocabs vocabs.loader words words.symbol ;
  IN: tools.vocabs.browser
  
  : vocab-status-string ( vocab -- string )
      {
 -        { [ dup not ] [ drop "" ] }
 +        { [ dup vocab not ] [ drop "" ] }
          { [ dup vocab-main ] [ drop "[Runnable]" ] }
          [ drop "[Loaded]" ]
      } cond ;
  
 -: write-status ( vocab -- )
 -    vocab vocab-status-string write ;
 +: vocab-row ( vocab -- row )
 +    [ <$link> ] [ vocab-status-string ] [ vocab-summary ] tri
 +    3array ;
  
 -: vocab. ( vocab -- )
 -    [
 -        [ [ write-status ] with-cell ]
 -        [ [ ($link) ] with-cell ]
 -        [ [ vocab-summary write ] with-cell ] tri
 -    ] with-row ;
 -
 -: vocab-headings. ( -- )
 -    [
 -        [ "State" write ] with-cell
 -        [ "Vocabulary" write ] with-cell
 -        [ "Summary" write ] with-cell
 -    ] with-row ;
 +: vocab-headings ( -- headings )
 +    {
 +        { $strong "Vocabulary" }
 +        { $strong "State" }
 +        { $strong "Summary" }
 +    } ;
  
 -: root-heading. ( root -- )
 +: root-heading ( root -- )
      [ "Children from " prepend ] [ "Children" ] if*
      $heading ;
  
 -: $vocabs ( assoc -- )
 +: $vocabs ( seq -- )
 +    [ vocab-row ] map vocab-headings prefix $table ;
 +
 +: $vocab-roots ( assoc -- )
      [
 -        [ drop ] [
 -            [ root-heading. ]
 -            [
 -                standard-table-style [
 -                    vocab-headings. [ vocab. ] each
 -                ] ($grid)
 -            ] bi*
 -        ] if-empty
 +        [ drop ] [ [ root-heading ] [ $vocabs ] bi* ] if-empty
      ] assoc-each ;
  
  TUPLE: vocab-tag name ;
@@@ -64,7 -74,7 +64,7 @@@ C: <vocab-author> vocab-autho
      ] unless-empty ;
  
  : describe-children ( vocab -- )
 -    vocab-name all-child-vocabs $vocabs ;
 +    vocab-name all-child-vocabs $vocab-roots ;
  
  : describe-files ( vocab -- )
      vocab-files [ <pathname> ] map [
@@@ -84,7 -94,7 +84,7 @@@
          [
              [ <$link> ]
              [ superclass <$link> ]
 -            [ "slots" word-prop [ name>> ] map " " join \ $snippet swap 2array ]
 +            [ "slots" word-prop [ name>> ] map " " join <$snippet> ]
              tri 3array
          ] map
          { { $strong "Class" } { $strong "Superclass" } { $strong "Slots" } } prefix
          "Parsing words" $subheading
          [
              [ <$link> ]
 -            [ word-syntax dup [ \ $snippet swap 2array ] when ]
 +            [ word-syntax dup [ <$snippet> ] when ]
              bi 2array
          ] map
          { { $strong "Word" } { $strong "Syntax" } } prefix
          $table
      ] unless-empty ;
  
 +: words-table ( words -- )
 +    [
 +        [ <$link> ]
 +        [ stack-effect dup [ effect>string <$snippet> ] when ]
 +        bi 2array
 +    ] map
 +    { { $strong "Word" } { $strong "Stack effect" } } prefix
 +    $table ;
 +
  : (describe-words) ( words heading -- )
 -    '[
 -        _ $subheading
 -        [
 -            [ <$link> ]
 -            [ stack-effect dup [ effect>string \ $snippet swap 2array ] when ]
 -            bi 2array
 -        ] map
 -        { { $strong "Word" } { $strong "Stack effect" } } prefix
 -        $table
 -    ] unless-empty ;
 +    '[ _ $subheading words-table ] unless-empty ;
  
  : describe-generics ( words -- )
      "Generic words" (describe-words) ;
          [ <$link> 1array ] map $table
      ] unless-empty ;
  
 -: describe-words ( vocab -- )
 -    words [
 +: $words ( words -- )
 +    [
          "Words" $heading
  
          natural-sort
  
  : words. ( vocab -- )
      last-element off
 -    vocab-name describe-words ;
 +    words $words ;
  
  : describe-metadata ( vocab -- )
      [
      ] { } make
      [ "Meta-data" $heading $table ] unless-empty ;
  
 -: $describe-vocab ( element -- )
 +: $vocab ( element -- )
      first {
          [ describe-help ]
          [ describe-metadata ]
 -        [ describe-words ]
 +        [ words $words ]
          [ describe-files ]
          [ describe-children ]
      } cleave ;
      [ vocab-authors ] keyed-vocabs ;
  
  : $tagged-vocabs ( element -- )
 -    first tagged $vocabs ;
 +    first tagged $vocab-roots ;
  
  : $authored-vocabs ( element -- )
 -    first authored $vocabs ;
 +    first authored $vocab-roots ;
  
  : $all-tags ( element -- )
      drop "Tags" $heading all-tags $tags ;
@@@ -272,7 -282,7 +272,7 @@@ M: vocab-spec article-title vocab-name 
  M: vocab-spec article-name vocab-name ;
  
  M: vocab-spec article-content
 -    vocab-name \ $describe-vocab swap 2array ;
 +    vocab-name \ $vocab swap 2array ;
  
  M: vocab-spec article-parent drop "vocab-index" ;
  
index 8d261d4a223723a04276a62f9a65f08dfd8a78c2,40da6ebafc7bb185fdd3404d828e8f116e9e042d..02d81807b33e44b3bccd8d5a8aea338f4e8cb224
@@@ -7,7 -7,7 +7,7 @@@ quotations sequences strings threads li
  ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.status-bar
  ui.gadgets.presentations ui.gadgets.worlds ui.gestures
  definitions calendar concurrency.flags concurrency.mailboxes
- ui.tools.workspace accessors sets destructors fry ;
+ ui.tools.workspace accessors sets destructors fry vocabs.parser ;
  IN: ui.tools.interactor
  
  ! If waiting is t, we're waiting for user input, and invoking
@@@ -81,11 -81,15 +81,11 @@@ M: interactor model-change
  : interactor-continue ( obj interactor -- )
      mailbox>> mailbox-put ;
  
 -: clear-input ( interactor -- )
 -    #! The with-datastack is a kludge to make it infer. Stupid.
 -    model>> 1array [ clear-doc ] with-datastack drop ;
 -
  : interactor-finish ( interactor -- )
      [ editor-string ] keep
      [ interactor-input. ] 2keep
      [ add-interactor-history ] keep
 -    clear-input ;
 +    clear-editor ;
  
  : interactor-eof ( interactor -- )
      dup interactor-busy? [
@@@ -177,5 -181,5 +177,5 @@@ M: interactor stream-read-quo
  
  interactor "interactor" f {
      { T{ key-down f f "RET" } evaluate-input }
 -    { T{ key-down f { C+ } "k" } clear-input }
 +    { T{ key-down f { C+ } "k" } clear-editor }
  } define-command-map
index 89a5ccea84c222f519a99020404e014eca47ae9a,9d248e29bdb9ceae5ceef453d41d6cd536dba056..a8f70cf76d003300063d709dc604b7518f07c8d1
@@@ -1,14 -1,14 +1,14 @@@
  ! Copyright (C) 2006, 2008 Slava Pestov.
  ! See http://factorcode.org/license.txt for BSD license.
- USING: accessors assocs help help.topics io.files io.styles
+ USING: accessors assocs help help.topics io.pathnames io.styles
  kernel models models.delay models.filter namespaces prettyprint
  quotations sequences sorting source-files definitions strings
 -tools.completion tools.crossref classes.tuple vocabs words
 -vocabs.loader tools.vocabs unicode.case calendar locals
 -ui.tools.interactor ui.tools.listener ui.tools.workspace
 -ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.lists
 -ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.borders
 -ui.gestures ui.operations ui ;
 +tools.completion tools.apropos tools.crossref classes.tuple
 +vocabs words vocabs.loader tools.vocabs unicode.case calendar
 +locals fry ui.tools.interactor ui.tools.listener
 +ui.tools.workspace ui.commands ui.gadgets ui.gadgets.editors
 +ui.gadgets.lists ui.gadgets.scrollers ui.gadgets.tracks
 +ui.gadgets.borders ui.gestures ui.operations ui ;
  IN: ui.tools.search
  
  TUPLE: live-search < track field list ;
@@@ -55,10 -55,7 +55,10 @@@ search-field H
  
  : init-search-model ( live-search seq limited? -- live-search )
      [ 2drop ]
 -    [ [ limited-completions ] [ completions ] ? curry <search-model> ] 3bi
 +    [
 +        [ limited-completions ] [ completions ] ?
 +        '[ _ @ [ first ] map ] <search-model>
 +    ] 3bi
      >>model ; inline
  
  : <search-list> ( presenter live-search -- list )
@@@ -87,6 -84,9 +87,6 @@@ M: live-search pref-dim* drop { 400 20
  : <definition-search> ( string words limited? -- gadget )
      [ definition-candidates ] dip [ synopsis ] <live-search> ;
  
 -: word-candidates ( words -- candidates )
 -    [ dup name>> >lower ] { } map>assoc ;
 -
  : <word-search> ( string words limited? -- gadget )
      [ word-candidates ] dip [ synopsis ] <live-search> ;
  
      [ "Words and methods using " swap name>> append ]
      bi show-titled-popup ;
  
 -: help-candidates ( seq -- candidates )
 -    [ dup >link swap article-title >lower ] { } map>assoc
 -    sort-values ;
 -
  : <help-search> ( string -- gadget )
      all-articles help-candidates
      f [ article-title ] <live-search> ;
      [ "Source files in " swap vocab-name append ]
      bi show-titled-popup ;
  
 -: vocab-candidates ( -- candidates )
 -    all-vocabs-seq [ dup vocab-name >lower ] { } map>assoc ;
 -
  : <vocab-search> ( string -- gadget )
      vocab-candidates f [ vocab-name ] <live-search> ;
  
      "Vocabulary search" show-titled-popup ;
  
  : history-candidates ( seq -- candidates )
 -    [ dup <input> swap >lower ] { } map>assoc ;
 +    [ [ <input> ] [ >lower ] bi ] { } map>assoc ;
  
  : <history-search> ( string seq -- gadget )
      history-candidates
index a9b60acb078463a4ebc7f071f8d9d310cc36e11a,81ed91290c1236035943716d6d047d6874701b1d..ecb6ac1cfdb7e4f9eb03d5d4b1209aace3cbfc2c
@@@ -1,11 -1,11 +1,11 @@@
  ! Copyright (C) 2005, 2008 Slava Pestov.
  ! See http://factorcode.org/license.txt for BSD license.
  USING: arrays definitions generic assocs kernel math namespaces
- sequences strings vectors words quotations io
+ sequences strings vectors words words.symbol quotations io
  combinators sorting splitting math.parser effects continuations
  io.files io.streams.string vocabs io.encodings.utf8 source-files
  classes hashtables compiler.errors compiler.units accessors sets
- lexer ;
+ lexer vocabs.parser ;
  IN: parser
  
  : location ( -- loc )
@@@ -29,27 -29,6 +29,6 @@@ t parser-notes set-globa
          "Note: " write dup print
      ] when drop ;
  
- SYMBOL: use
- SYMBOL: in
- : (use+) ( vocab -- )
-     vocab-words use get push ;
- : use+ ( vocab -- )
-     load-vocab (use+) ;
- : add-use ( seq -- ) [ use+ ] each ;
- : set-use ( seq -- )
-     [ vocab-words ] V{ } map-as sift use set ;
- : check-vocab-string ( name -- name )
-     dup string?
-     [ "Vocabulary name must be a string" throw ] unless ;
- : set-in ( name -- )
-     check-vocab-string dup in set create-vocab (use+) ;
  M: parsing-word stack-effect drop (( parsed -- parsed )) ;
  
  TUPLE: no-current-vocab ;
  
  : CREATE-WORD ( -- word ) CREATE dup reset-generic ;
  
- : word-restarts ( name possibilities -- restarts )
-     natural-sort
-     [ [ vocabulary>> "Use the " " vocabulary" surround ] keep ] { } map>assoc
-     swap "Defer word in current vocabulary" swap 2array
-     suffix ;
- ERROR: no-word-error name ;
- : <no-word-error> ( name possibilities -- error restarts )
-     [ drop \ no-word-error boa ] [ word-restarts ] 2bi ;
  SYMBOL: amended-use
  
  SYMBOL: auto-use?
@@@ -209,9 -177,7 +177,9 @@@ SYMBOL: interactive-vocab
      "strings"
      "syntax"
      "tools.annotations"
 +    "tools.apropos"
      "tools.crossref"
 +    "tools.disassembler"
      "tools.memory"
      "tools.profiler"
      "tools.test"