Merge branch 'master' of git://factorcode.org/git/factor into jwmerrill

basis/http/client/client.factor

@@ -34,6 +34,8 @@ IN: http.client
 
 GENERIC: >post-data ( object -- post-data )
 
+M: f >post-data ;
+
 M: post-data >post-data ;
 
 M: string >post-data
@@ -41,15 +43,13 @@ M: string >post-data
     "application/octet-stream" <post-data>
         swap >>data ;
 
-M: byte-array >post-data
-    "application/octet-stream" <post-data>
-        swap >>data ;
-
 M: assoc >post-data
     "application/x-www-form-urlencoded" <post-data>
         swap >>params ;
 
-M: f >post-data ;
+M: object >post-data
+    "application/octet-stream" <post-data>
+        swap >>data ;
 
 : normalize-post-data ( request -- request )
     dup post-data>> [
@@ -63,8 +63,10 @@ M: f >post-data ;
     normalize-post-data ;
 
 : write-post-data ( request -- request )
-    dup method>> [ "POST" = ] [ "PUT" = ] bi or
+    dup method>> { "POST" "PUT" } member?  [
-    [ dup post-data>> data>> write ] when ; 
+        dup post-data>> data>> dup sequence?
+        [ write ] [ output-stream get stream-copy ] if
+    ] when ; 
 
 : write-request ( request -- )
     unparse-post-data

extra/fuel/fuel.factor

@@ -1,10 +1,9 @@
 ! Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz.
 ! See http://factorcode.org/license.txt for BSD license.
 
-USING: accessors arrays assocs compiler.units definitions fuel.eval
+USING: assocs compiler.units fuel.eval fuel.help fuel.remote fuel.xref
-fuel.help help.markup help.topics io.pathnames kernel math math.order
+help.topics io.pathnames kernel namespaces parser sequences
-memoize namespaces parser sequences sets sorting tools.crossref
+tools.scaffold vocabs.loader ;
-tools.scaffold tools.vocabs vocabs vocabs.loader vocabs.parser words ;
 
 IN: fuel
 
@@ -50,92 +49,40 @@ PRIVATE>
 
 ! Edit locations
 
-<PRIVATE
+: fuel-get-word-location ( word -- )
-
+    word-location fuel-eval-set-result ;
-: fuel-normalize-loc ( seq -- path line )
-    [ dup length 0 > [ first (normalize-path) ] [ drop f ] if ]
-    [ dup length 1 > [ second ] [ drop 1 ] if ] bi ;
-
-: fuel-get-loc ( object -- )
-    fuel-normalize-loc 2array fuel-eval-set-result ;
-
-PRIVATE>
-
-: fuel-get-edit-location ( word -- ) where fuel-get-loc ; inline
 
 : fuel-get-vocab-location ( vocab -- )
-    >vocab-link fuel-get-edit-location ; inline
+    vocab-location fuel-eval-set-result ;
 
-: fuel-get-doc-location ( word -- ) props>> "help-loc" swap at fuel-get-loc ;
+: fuel-get-doc-location ( word -- )
+    doc-location fuel-eval-set-result ;
 
-: fuel-get-article-location ( name -- ) article loc>> fuel-get-loc ;
+: fuel-get-article-location ( name -- )
+    article-location fuel-eval-set-result ;
+
+: fuel-get-vocabs ( -- )
+    get-vocabs fuel-eval-set-result ;
+
+: fuel-get-vocabs/prefix ( prefix -- )
+    get-vocabs/prefix fuel-eval-set-result ;
+
+: fuel-get-words ( prefix names -- )
+    get-vocabs-words/prefix fuel-eval-set-result ;
 
 ! Cross-references
 
-<PRIVATE
+: fuel-callers-xref ( word -- ) callers-xref fuel-eval-set-result ;
 
-: fuel-word>xref ( word -- xref )
+: fuel-callees-xref ( word -- ) callees-xref fuel-eval-set-result ;
-    [ name>> ] [ vocabulary>> ] [ where fuel-normalize-loc ] tri 4array ;
 
-: fuel-sort-xrefs ( seq -- seq' )
+: fuel-apropos-xref ( str -- ) apropos-xref fuel-eval-set-result ;
-    [ [ first ] dip first <=> ] sort ; inline
 
-: fuel-format-xrefs ( seq -- seq' )
+: fuel-vocab-xref ( vocab -- ) vocab-xref fuel-eval-set-result ;
-    [ word? ] filter [ fuel-word>xref ] map ; inline
 
-: (fuel-index) ( seq -- seq )
+: fuel-vocab-uses-xref ( vocab -- ) vocab-uses-xref fuel-eval-set-result ;
-    [ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ;
 
-PRIVATE>
+: fuel-vocab-usage-xref ( vocab -- ) vocab-usage-xref fuel-eval-set-result ;
-
-: fuel-callers-xref ( word -- )
-    usage fuel-format-xrefs fuel-sort-xrefs fuel-eval-set-result ; inline
-
-: fuel-callees-xref ( word -- )
-    uses fuel-format-xrefs fuel-sort-xrefs fuel-eval-set-result ; inline
-
-: fuel-apropos-xref ( str -- )
-    words-matching fuel-format-xrefs fuel-eval-set-result ; inline
-
-: fuel-vocab-xref ( vocab -- )
-    words fuel-format-xrefs fuel-eval-set-result ; inline
-
-: fuel-index ( quot: ( -- seq ) -- )
-    call (fuel-index) fuel-eval-set-result ; inline
-
-! Completion support
-
-<PRIVATE
-
-: fuel-filter-prefix ( seq prefix -- seq )
-    [ drop-prefix nip length 0 = ] curry filter prune ; inline
-
-: (fuel-get-vocabs) ( -- seq )
-    all-vocabs-seq [ vocab-name ] map ; inline
-
-MEMO: (fuel-vocab-words) ( name -- seq )
-    >vocab-link words [ name>> ] map ;
-
-: fuel-current-words ( -- seq )
-    use get [ keys ] map concat ; inline
-
-: fuel-vocabs-words ( names -- seq )
-    prune [ (fuel-vocab-words) ] map concat ; inline
-
-: (fuel-get-words) ( prefix names/f -- seq )
-    [ fuel-vocabs-words ] [ fuel-current-words ] if* natural-sort
-    swap fuel-filter-prefix ;
-
-PRIVATE>
-
-: fuel-get-vocabs ( -- )
-    (fuel-get-vocabs) fuel-eval-set-result ;
-
-: fuel-get-vocabs/prefix ( prefix -- )
-    (fuel-get-vocabs) swap fuel-filter-prefix fuel-eval-set-result ;
-
-: fuel-get-words ( prefix names -- )
-    (fuel-get-words) fuel-eval-set-result ;
 
 ! Help support
 
@@ -155,6 +102,8 @@ PRIVATE>
 : fuel-vocab-summary ( name -- )
     (fuel-vocab-summary) fuel-eval-set-result ;
 
+: fuel-index ( quot -- ) call format-index fuel-eval-set-result ;
+
 : fuel-get-vocabs/tag ( tag -- )
     (fuel-get-vocabs/tag) fuel-eval-set-result ;
 
@@ -174,3 +123,6 @@ PRIVATE>
 
 : fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ;
 
+! Remote connection
+
+MAIN: fuel-start-remote-listener*

extra/fuel/help/help.factor

@@ -109,3 +109,6 @@ MEMO: (fuel-get-vocabs/author) ( author -- element )
 MEMO: (fuel-get-vocabs/tag) ( tag -- element )
     [ "Vocabularies tagged " prepend \ $heading swap 2array ]
     [ tagged fuel-vocab-list ] bi 2array ;
+
+: format-index ( seq -- seq )
+    [ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ;

extra/fuel/remote/authors.txt

@@ -0,0 +1 @@
+Jose Antonio Ortega Ruiz

extra/fuel/remote/remote.factor

@@ -0,0 +1,28 @@
+! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors io io.encodings.utf8 io.servers.connection kernel
+listener math ;
+
+IN: fuel.remote
+
+<PRIVATE
+
+: server ( port -- server )
+    <threaded-server>
+        "tty-server" >>name
+        utf8 >>encoding
+        swap local-server >>insecure
+        [ listener ] >>handler
+        f >>timeout ;
+
+: print-banner ( -- )
+    "Starting server. Connect with 'M-x connect-to-factor' in Emacs"
+    write nl flush ;
+
+PRIVATE>
+
+: fuel-start-remote-listener ( port/f -- )
+    print-banner integer? [ 9000 ] unless* server start-server ;
+
+: fuel-start-remote-listener* ( -- ) f fuel-start-remote-listener ;
+

extra/fuel/xref/authors.txt

@@ -0,0 +1 @@
+Jose Antonio Ortega Ruiz

extra/fuel/xref/xref.factor

@@ -0,0 +1,69 @@
+! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
+! See http://factorcode.org/license.txt for BSD license.
+
+USING: accessors arrays assocs definitions help.topics io.pathnames
+kernel math math.order memoize namespaces sequences sets sorting
+tools.crossref tools.vocabs vocabs vocabs.parser words ;
+
+IN: fuel.xref
+
+<PRIVATE
+
+: normalize-loc ( seq -- path line )
+    [ dup length 0 > [ first (normalize-path) ] [ drop f ] if ]
+    [ dup length 1 > [ second ] [ drop 1 ] if ] bi ;
+
+: get-loc ( object -- loc ) normalize-loc 2array ;
+
+: word>xref ( word -- xref )
+    [ name>> ] [ vocabulary>> ] [ where normalize-loc ] tri 4array ;
+
+: vocab>xref ( vocab -- xref )
+    dup dup >vocab-link where normalize-loc 4array ;
+
+: sort-xrefs ( seq -- seq' )
+    [ [ first ] dip first <=> ] sort ; inline
+
+: format-xrefs ( seq -- seq' )
+    [ word? ] filter [ word>xref ] map ; inline
+
+: filter-prefix ( seq prefix -- seq )
+    [ drop-prefix nip length 0 = ] curry filter prune ; inline
+
+MEMO: (vocab-words) ( name -- seq )
+    >vocab-link words [ name>> ] map ;
+
+: current-words ( -- seq )
+    use get [ keys ] map concat ; inline
+
+: vocabs-words ( names -- seq )
+    prune [ (vocab-words) ] map concat ; inline
+
+PRIVATE>
+
+: callers-xref ( word -- seq ) usage format-xrefs sort-xrefs ;
+
+: callees-xref ( word -- seq ) uses format-xrefs sort-xrefs ;
+
+: apropos-xref ( str -- seq ) words-matching format-xrefs ;
+
+: vocab-xref ( vocab -- seq ) words format-xrefs ;
+
+: word-location ( word -- loc ) where get-loc ;
+
+: vocab-location ( vocab -- loc ) >vocab-link where get-loc ;
+
+: vocab-uses-xref ( vocab -- seq ) vocab-uses [ vocab>xref ] map ;
+
+: vocab-usage-xref ( vocab -- seq ) vocab-usage [ vocab>xref ] map ;
+
+: doc-location ( word -- loc ) props>> "help-loc" swap at get-loc ;
+
+: article-location ( name -- loc ) article loc>> get-loc ;
+
+: get-vocabs ( -- seq ) all-vocabs-seq [ vocab-name ] map ;
+
+: get-vocabs/prefix ( prefix -- seq ) get-vocabs swap filter-prefix ;
+
+: get-vocabs-words/prefix ( prefix names/f -- seq )
+    [ vocabs-words ] [ current-words ] if* natural-sort swap filter-prefix ;

extra/git-tool/git-tool.factor

@@ -1,470 +0,0 @@
-
-USING: accessors combinators.cleave combinators.short-circuit
-concurrency.combinators destructors fry io io.directories
-io.encodings io.encodings.utf8 io.launcher io.monitors
-io.pathnames io.pipes io.ports kernel locals math namespaces
-sequences splitting strings threads ui ui.gadgets
-ui.gadgets.buttons ui.gadgets.editors ui.gadgets.labels
-ui.gadgets.packs ui.gadgets.tracks ;
-
-IN: git-tool
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: head** ( seq obj -- seq/f ) dup number? [ head ] [ dupd find drop head ] if ;
-
-: tail** ( seq obj -- seq/f )
-  dup number?
-    [ tail ]
-    [ dupd find drop [ tail ] [ drop f ] if* ]
-  if ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: <process-stdout-stderr-reader> ( DESC -- process stream stream )
-  [
-    [let | STDOUT-PIPE [ (pipe) |dispose ]
-           STDERR-PIPE [ (pipe) |dispose ] |
-
-      [let | PROCESS [ DESC >process ] |
-
-        PROCESS
-          [ STDOUT-PIPE out>> or ] change-stdout
-          [ STDERR-PIPE out>> or ] change-stderr
-        run-detached
-
-        STDOUT-PIPE out>> dispose
-        STDERR-PIPE out>> dispose
-
-        STDOUT-PIPE in>> <input-port> utf8 <decoder>
-        STDERR-PIPE in>> <input-port> utf8 <decoder> ] ]
-  ]
-  with-destructors ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: run-process/result ( desc -- process )
-  <process-stdout-stderr-reader>
-  {
-    [ contents [ string-lines ] [ f ] if* ]
-    [ contents [ string-lines ] [ f ] if* ]
-  }
-  parallel-spread
-  [ >>stdout ] [ >>stderr ] bi*
-  dup wait-for-process >>status ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! process popup windows
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: popup-window ( title contents -- )
-  dup string? [ ] [ "\n" join ] if
-  <editor> tuck set-editor-string swap open-window ;
-
-: popup-process-window ( process -- )
-  [ stdout>> [ "output" swap popup-window ] when* ]
-  [ stderr>> [ "error"  swap popup-window ] when* ]
-  [
-    [ stdout>> ] [ stderr>> ] bi or not
-    [ "Process" "NO OUTPUT" popup-window ]
-    when
-  ]
-  tri ;
-
-: popup-if-error ( process -- )
-  { [ status>> 0 = not ] [ popup-process-window t ] } 1&& drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: git-process ( REPO DESC -- process )
-  REPO [ DESC run-process/result ] with-directory ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: git-status-section ( lines section -- lines/f )
-  '[ _ = ] tail**
-    [
-      [ "#\t" head?      ] tail**
-      [ "#\t" head?  not ] head**
-      [ 2 tail ] map
-    ]
-    [ f ]
-  if* ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: colon ( -- ch ) CHAR: : ;
-: space ( -- ch ) 32      ;
-
-: git-status-line-file ( line -- file )
-  { [ colon = ] 1 [ space = not ] } [ tail** ] each ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-TUPLE: <git-status>
-  repository
-  to-commit-new
-  to-commit-modified
-  to-commit-deleted
-  modified
-  deleted
-  untracked ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: check-empty ( seq -- seq/f ) dup empty? [ drop f ] when ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: refresh-git-status ( STATUS -- STATUS )
-
-  [let | LINES [ STATUS repository>> { "git" "status" } git-process stdout>> ] |
-
-    STATUS
-    
-      LINES "# Changes to be committed:" git-status-section
-        [ "new file:" head? ] filter
-        [ git-status-line-file ] map
-        check-empty
-      >>to-commit-new
-    
-      LINES "# Changes to be committed:" git-status-section
-        [ "modified:" head? ] filter
-        [ git-status-line-file ] map
-        check-empty
-      >>to-commit-modified
-
-      LINES "# Changes to be committed:" git-status-section
-        [ "deleted:" head? ] filter
-        [ git-status-line-file ] map
-        check-empty
-      >>to-commit-deleted
-
-      LINES "# Changed but not updated:" git-status-section
-        [ "modified:" head? ] filter
-        [ git-status-line-file ] map
-        check-empty
-      >>modified
-    
-      LINES "# Changed but not updated:" git-status-section
-        [ "deleted:" head? ] filter
-        [ git-status-line-file ] map
-        check-empty
-      >>deleted
-
-      LINES "# Untracked files:" git-status-section >>untracked ] ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: git-status ( REPO -- <git-status> )
-
-  <git-status> new REPO >>repository refresh-git-status ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: factor-git-status ( -- <git-status> ) "resource:" git-status ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! git-tool
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: to-commit ( <git-status> -- seq )
-  { to-commit-new>> to-commit-modified>> to-commit-deleted>> } 1arr concat ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: refresh-status-pile ( STATUS PILE -- )
-
-  STATUS refresh-git-status drop
-
-  PILE clear-gadget
-
-  PILE
-
-  ! Commit section
-
-  [wlet | add-commit-path-button [| TEXT PATH |
-
-            { 1 0 } <track>
-
-              TEXT <label> 2/8 track-add
-              PATH <label> 6/8 track-add
-
-              "Reset"
-              [
-                drop
-                
-                STATUS repository>>
-                { "git" "reset" "HEAD" PATH }
-                git-process
-                drop
-                
-                STATUS PILE refresh-status-pile
-              ]
-              <bevel-button> f track-add
-
-            add-gadget ] |
-
-    STATUS to-commit
-    [
-      "Changes to be committed" <label> reverse-video-theme add-gadget
-
-      STATUS to-commit-new>>
-      [| PATH | "new file: " PATH add-commit-path-button ]
-      each
-
-      STATUS to-commit-modified>>
-      [| PATH | "modified: " PATH add-commit-path-button ]
-      each
-
-      STATUS to-commit-deleted>>
-      [| PATH | "deleted: " PATH add-commit-path-button ]
-      each
-
-      <pile> 1 >>fill
-
-        [let | EDITOR [ <editor> "COMMIT MESSAGE" over set-editor-string ] |
-
-          EDITOR add-gadget
-  
-          "Commit"
-          [
-           drop
-           [let | MSG [ EDITOR editor-string ] |
-
-              STATUS repository>>
-              { "git" "commit" "-m" MSG } git-process
-              popup-if-error ]
-           STATUS PILE refresh-status-pile
-          ]
-          <bevel-button>
-          add-gadget ]
-       
-      add-gadget
-
-    ]
-    when ]
-
-  ! Modified section
-
-  STATUS modified>>
-  [
-    "Modified but not updated" <label> reverse-video-theme add-gadget
-
-    STATUS modified>>
-    [| PATH |
-
-      <shelf>
-
-        PATH <label> add-gadget
-
-        "Add"
-        [
-          drop
-          STATUS repository>> { "git" "add" PATH } git-process popup-if-error
-          STATUS PILE refresh-status-pile
-        ]
-        <bevel-button> add-gadget
-
-        "Diff"
-        [
-          drop
-          STATUS repository>> { "git" "diff" PATH } git-process
-          popup-process-window
-        ]
-        <bevel-button> add-gadget
-
-      add-gadget
-      
-    ]
-    each
-    
-  ]
-  when
-
-  ! Untracked section
-
-  STATUS untracked>>
-  [
-    "Untracked files" <label> reverse-video-theme add-gadget
-
-    STATUS untracked>>
-    [| PATH |
-
-      { 1 0 } <track>
-
-        PATH <label> f track-add
-
-        "Add"
-        [
-          drop
-          STATUS repository>> { "git" "add" PATH } git-process popup-if-error
-          STATUS PILE refresh-status-pile
-        ]
-        <bevel-button> f track-add
-
-      add-gadget
-
-    ]
-    each
-    
-  ]
-  when
-
-  ! Refresh button
-
-  "Refresh" [ drop STATUS PILE refresh-status-pile ] <bevel-button> add-gadget
-
-  drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: git-remote-branches ( REPO NAME -- seq )
-  REPO { "git" "remote" "show" NAME } git-process stdout>>
-  "  Tracked remote branches" over index 1 + tail first " " split
-  [ empty? not ] filter ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: refresh-remotes-pile ( REPO PILE -- )
-
-  PILE clear-gadget
-
-  PILE
-  
-  "Remotes" <label> reverse-video-theme add-gadget
-
-  REPO { "git" "remote" } git-process stdout>> [ empty? not ] filter
-
-  [| NAME |
-
-    [let | BRANCH! [ "master" ] |
-  
-      { 1 0 } <track>
-  
-        NAME <label> 1 track-add
-
-        [let | BRANCH-BUTTON [ "master" [ drop ] <bevel-button> ] |
-
-          BRANCH-BUTTON
-          [
-            drop
-                  
-            <pile>
-                  
-              1 >>fill
-    
-              REPO NAME git-remote-branches
-                [| OTHER-BRANCH |
-                  OTHER-BRANCH
-                    [
-                      drop
-                          
-                      OTHER-BRANCH BRANCH!
-                          
-                      OTHER-BRANCH BRANCH-BUTTON gadget-child set-label-string
-                          
-                    ]
-                  <bevel-button>
-                  add-gadget
-                ]
-              each
-                    
-            "Select a branch" open-window
-           ]
-           >>quot
-
-           1 track-add ]
-  
-        "Fetch"
-        [ drop REPO { "git" "fetch" NAME } git-process popup-process-window ]
-        <bevel-button>
-        1 track-add
-  
-        "..remote/branch"
-        [
-          drop
-          [let | ARG [ { ".." NAME "/" BRANCH } concat ] |
-            REPO { "git" "log" ARG } git-process popup-process-window ]
-        ]
-        <bevel-button>
-        1 track-add
-  
-        "Merge"
-        [
-          drop
-          [let | ARG [ { NAME "/" BRANCH } concat ] |
-            REPO { "git" "merge" ARG } git-process popup-process-window ]
-        ]
-        <bevel-button>
-        1 track-add
-  
-        "remote/branch.."
-        [
-          drop
-          [let | ARG [ { NAME "/" BRANCH ".." } concat ] |
-            REPO { "git" "log" ARG } git-process popup-process-window ]
-        ]
-        <bevel-button>
-        1 track-add
-  
-        "Push"
-        [
-          drop
-          REPO { "git" "push" NAME "master" } git-process popup-process-window 
-        ]
-        <bevel-button>
-        1 track-add
-
-        add-gadget ]
-
-    ]
-  each
-
-  drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: git-tool ( REPO -- )
-
-  <pile> 1 >>fill
-
-    "Repository: " REPO [ current-directory get ] with-directory append
-    <label>
-    add-gadget
-
-    [let | STATUS [ REPO git-status ]
-           PILE   [ <pile> 1 >>fill ] |
-
-      [
-        [
-          [let | MONITOR [ REPO t <monitor> ] |
-            [
-              [let | PATH [ MONITOR next-change drop ] |
-                ".git" PATH subseq? ! Ignore git internal operations
-                  [ ]
-                  [ STATUS PILE refresh-status-pile ]
-                if
-                t ]
-            ]
-            loop
-          ]
-        ]
-        with-monitors
-      ]
-      in-thread
-           
-      STATUS PILE refresh-status-pile
-      
-      PILE add-gadget ]
-
-    REPO <pile> 1 >>fill tuck refresh-remotes-pile add-gadget
-
-  "Git" open-window ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: factor-git-tool ( -- ) "resource:" git-tool ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-

extra/git-tool/remote/remote.factor

@@ -1,392 +0,0 @@
-
-USING: accessors calendar git-tool git-tool io.directories
-io.monitors io.pathnames kernel locals math namespaces
-sequences splitting system threads ui ui.gadgets
-ui.gadgets.buttons ui.gadgets.labels ui.gadgets.packs ;
-
-USING: git-tool ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-IN: git-tool.remote
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-TUPLE: <git-remote-gadget> < pack
-  repository
-  branch
-  remote
-  remote-branch
-  fetch-period
-  push
-  closed
-  last-refresh ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: current-branch ( REPO -- branch )
-  { "git" "branch" } git-process stdout>> [ "* " head? ] find nip 2 tail ;
-
-: list-branches ( REPO -- branches )
-  { "git" "branch" } git-process stdout>>
-  [ empty? not ] filter
-  [ 2 tail ] map ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: list-remotes ( REPO -- remotes )
-  { "git" "remote" } git-process stdout>> [ empty? not ] filter ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: list-remote-branches ( REPO REMOTE -- branches )
-  [let | OUT [ REPO { "git" "remote" "show" REMOTE } git-process stdout>> ] |
-
-    "  Tracked remote branches" OUT member?
-      [
-        OUT
-        "  Tracked remote branches" OUT index 1 + tail first " " split
-        [ empty? not ] filter
-      ]
-      [
-        OUT
-        OUT [ "  New remote branches" head? ] find drop
-        1 + tail first " " split
-        [ empty? not ] filter
-      ]
-    if ] ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: refresh-git-remote-gadget ( GADGET -- )
-
-  [let | REPO [ GADGET repository>> ] |
-
-    GADGET clear-gadget
-
-    GADGET
-
-    ! Repository label
-
-    "Repository: " REPO [ current-directory get ] with-directory append
-    <label>
-    add-gadget
-
-    ! Branch button
-    
-    <shelf>
-
-      "Branch: " <label> add-gadget
-
-      REPO current-branch
-      [
-        drop
-        
-        <pile>
-          REPO list-branches
-
-          [| BRANCH |
-
-            BRANCH
-            [
-              drop
-              REPO { "git" "checkout" BRANCH } git-process popup-if-error
-              GADGET refresh-git-remote-gadget
-            ]
-            <bevel-button> add-gadget
-
-          ]
-          each
-
-        "Select a branch" open-window
-        
-      ]
-      <bevel-button> add-gadget
-
-    add-gadget
-
-    ! Remote button
-
-    <shelf>
-
-      "Remote: " <label> add-gadget
-
-      GADGET remote>>
-      [
-        drop
-
-        <pile>
-
-          REPO list-remotes
-
-          [| REMOTE |
-
-            REMOTE
-            [
-              drop
-              GADGET REMOTE >>remote drop
-              GADGET "master" >>remote-branch drop
-              GADGET refresh-git-remote-gadget
-            ]
-            <bevel-button> add-gadget
-
-          ]
-          each
-
-        "Select a remote" open-window
-        
-      ]
-      <bevel-button> add-gadget
-
-    add-gadget
-
-    ! Remote branch button
-
-    <shelf>
-
-      "Remote branch: " <label> add-gadget
-
-      GADGET remote-branch>>
-      [
-        drop
-
-        <pile>
-
-          REPO GADGET remote>> list-remote-branches
-
-          [| REMOTE-BRANCH |
-
-            REMOTE-BRANCH
-            [
-              drop
-              GADGET REMOTE-BRANCH >>remote-branch drop
-              GADGET refresh-git-remote-gadget
-            ]
-            <bevel-button> add-gadget
-          ]
-        
-          each
-
-        "Select a remote branch" open-window
-
-      ]
-      <bevel-button> add-gadget
-
-    add-gadget
-
-    ! Fetch button
-
-    "Fetch"
-    [
-      drop
-      [let | REMOTE [ GADGET remote>> ] |
-        REPO { "git" "fetch" REMOTE } git-process popup-if-error ]
-      
-      GADGET refresh-git-remote-gadget
-    ]
-    <bevel-button> add-gadget
-
-    ! Available changes
-
-    [let | REMOTE        [ GADGET remote>>        ]
-           REMOTE-BRANCH [ GADGET remote-branch>> ] |
-
-      [let | ARG [ { ".." REMOTE "/" REMOTE-BRANCH } concat ] |
-
-        [let | PROCESS [ REPO { "git" "log" ARG } git-process ] |
-
-          PROCESS stdout>>
-            [
-              <shelf>
-              
-                "Changes available:" <label> add-gadget
-
-                "View"
-                [
-                  drop
-                  PROCESS popup-process-window
-                ]
-                <bevel-button> add-gadget
-
-                "Merge"
-                [
-                  drop
-
-                  [let | ARG [ { REMOTE "/" REMOTE-BRANCH } concat ] |
-
-                    REPO { "git" "merge" ARG } git-process popup-process-window
-
-                  ]
-
-                  GADGET refresh-git-remote-gadget
-
-                ]
-                <bevel-button> add-gadget
-
-              add-gadget
-
-            ]
-          when
-
-        ] ] ]
-
-
-    ! Pushable changes
-
-    [let | REMOTE        [ GADGET remote>>        ]
-           REMOTE-BRANCH [ GADGET remote-branch>> ] |
-
-      [let | ARG [ { REMOTE "/" REMOTE-BRANCH ".." } concat ] |
-
-        [let | PROCESS [ REPO { "git" "log" ARG } git-process ] |
-
-          PROCESS stdout>>
-            [
-              <shelf>
-              
-                "Pushable changes: " <label> add-gadget
-
-                "View"
-                [
-                  drop
-                  PROCESS popup-process-window
-                ]
-                <bevel-button> add-gadget
-
-                "Push"
-                [
-                  drop
-
-                  REPO { "git" "push" REMOTE REMOTE-BRANCH }
-                  git-process
-                  popup-process-window
-
-                  GADGET refresh-git-remote-gadget
-
-                ]
-                <bevel-button> add-gadget
-
-              add-gadget
-
-            ]
-          when
-
-        ] ] ]
-    
-    drop
-
-  ] ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: start-fetch-thread ( GADGET -- )
-
-  GADGET f >>closed drop
-  
-  [
-
-    [
-
-      GADGET closed>>
-        [ f ]
-        [
-          [let | REPO          [ GADGET repository>> ]
-                 REMOTE-BRANCH [ GADGET remote-branch>> ] |
-            
-            REPO { "git" "fetch" REMOTE-BRANCH } git-process drop ]
-
-          GADGET fetch-period>> sleep
-
-          t
-        ]
-      if
-      
-
-    ]
-    loop
-    
-  ]
-  
-  in-thread ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: start-monitor-thread ( GADGET -- )
-
-  GADGET f >>closed drop
-
-  [
-    [
-      [let | MONITOR [ GADGET repository>> t <monitor> ] |
-
-        [
-          GADGET closed>>
-          [ f ]
-          [
-            
-            [let | PATH [ MONITOR next-change drop ] |
-
-              ".git" PATH subseq?
-                [ ]
-                [
-                  micros
-                  GADGET last-refresh>> 0 or -
-                  1000000 >
-                    [
-                      GADGET micros >>last-refresh drop
-                      GADGET refresh-git-remote-gadget
-                    ]
-                  when
-                ]
-              if ]
-
-            t
-
-          ]
-          if
-        ]
-        loop
-      ]
-    ]
-    with-monitors
-  ]
-  in-thread ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-M: <git-remote-gadget> pref-dim* ( gadget -- dim ) drop { 500 500 } ;
-
-M:: <git-remote-gadget> graft*   ( GADGET -- )
-  GADGET start-fetch-thread
-  GADGET start-monitor-thread ;
-
-M:: <git-remote-gadget> ungraft* ( GADGET -- ) GADGET t >>closed drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: git-remote-tool ( REPO -- )
-
-  <git-remote-gadget> new-gadget
-  
-    { 0 1 } >>orientation
-    1       >>fill
-
-    REPO >>repository
-
-    "origin" >>remote
-
-    "master" >>remote-branch
-
-    5 minutes >>fetch-period
-
-  dup refresh-git-remote-gadget
-
-  "git-remote-tool" open-window ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: factor-git-remote-tool ( -- ) "resource:" git-remote-tool ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-MAIN: factor-git-remote-tool

misc/fuel/README

@@ -53,6 +53,20 @@ beast.
   factor image (overwriting the current one) with all the needed
   vocabs.
 
+*** Connecting to a running Factor
+
+  'run-factor' starts a new factor listener process managed by Emacs.
+  If you prefer to start Factor externally, you can also connect
+  remotely from Emacs. Here's how to proceed:
+
+  - In the factor listener, run FUEL:
+      "fuel" run
+    This will start a server listener in port 9000.
+  - Switch to Emacs and issue the command 'M-x connect-to-factor'.
+
+  That's it; you should be up and running. See the help for
+  'connect-to-factor' for how to use a different port.
+
 *** Vocabulary creation
 
     FUEL offers a basic interface with Factor's scaffolding utilities.
@@ -99,8 +113,10 @@ beast.
     - C-cC-dp : find words containing given substring (M-x fuel-apropos)
     - C-cC-dv : show words in current file (with prefix, ask for vocab)
 
-    - C-cM-<, C-cC-d< : show callers of word at point
+    - C-cM-<, C-cC-d< : show callers of word or vocabulary at point
-    - C-cM->, C-cC-d> : show callees of word at point
+                        (M-x fuel-show-callers, M-x fuel-vocab-usage)
+    - C-cM->, C-cC-d> : show callees of word or vocabulary at point
+                        (M-x fuel-show-callees, M-x fuel-vocab-uses)
 
     - C-cC-xs : extract innermost sexp (up to point)  as a separate word
     - C-cC-xr : extract region as a separate word

misc/fuel/fu.el

@@ -24,6 +24,9 @@
 (autoload 'switch-to-factor "fuel-listener.el"
   "Start a Factor listener, or switch to a running one." t)
 
+(autoload 'connect-to-factor "fuel-listener.el"
+  "Connect to an external Factor listener." t)
+
 (autoload 'fuel-autodoc-mode "fuel-help.el"
   "Minor mode showing in the minibuffer a synopsis of Factor word at point."
   t)

misc/fuel/fuel-completion.el

@@ -1,6 +1,6 @@
 ;;; fuel-completion.el -- completion utilities
 
-;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
 ;; See http://factorcode.org/license.txt for BSD license.
 
 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
@@ -32,6 +32,10 @@
              (fuel-eval--send/wait '(:fuel* (fuel-get-vocabs) "fuel" (:array)))))))
   fuel-completion--vocabs)
 
+(defun fuel-completion--read-vocab (&optional reload init-input history)
+  (let ((vocabs (fuel-completion--vocabs reload)))
+    (completing-read "Vocab name: " vocabs nil nil init-input history)))
+
 (defsubst fuel-completion--vocab-list (prefix)
   (fuel-eval--retort-result
    (fuel-eval--send/wait `(:fuel* (,prefix fuel-get-vocabs/prefix) t t))))

misc/fuel/fuel-debug.el

@@ -213,7 +213,7 @@ the debugger."
                 (goto-char (point-min))
                 (when (search-forward (car ci) nil t)
                   (setq str (format "%c %s, %s" (cdr ci) (car ci) str))))))
-          (if (and (not err) fuel-debug--uses) "u to update USING:, " "")))
+          (if fuel-debug--uses "u to update USING:, " "")))
 
 (defun fuel-debug--buffer-file ()
   (with-current-buffer (fuel-debug--buffer)

misc/fuel/fuel-edit.el

@@ -22,21 +22,30 @@
 
 ;;; Customization
 
-(defcustom fuel-edit-word-method nil
+(defmacro fuel-edit--define-custom-visit (var group doc)
-  "How the new buffer is opened when invoking
+  `(defcustom ,var nil
-\\[fuel-edit-word-at-point]."
+     ,doc
-  :group 'fuel
+     :group ',group
-  :type '(choice (const :tag "Other window" window)
+     :type '(choice (const :tag "Other window" window)
-                 (const :tag "Other frame" frame)
+                    (const :tag "Other frame" frame)
-                 (const :tag "Current window" nil)))
+                    (const :tag "Current window" nil))))
+
+(fuel-edit--define-custom-visit
+ fuel-edit-word-method fuel
+ "How the new buffer is opened when invoking \\[fuel-edit-word-at-point]")
 
 
 ;;; Auxiliar functions:
 
+(defun fuel-edit--visit-file (file method)
+  (cond ((eq method 'window) (find-file-other-window file))
+        ((eq method 'frame) (find-file-other-frame file))
+        (t (find-file file))))
+
 (defun fuel-edit--looking-at-vocab ()
   (save-excursion
     (fuel-syntax--beginning-of-defun)
-    (looking-at "USING:\\|USE:")))
+    (looking-at "USING:\\|USE:\\|IN:")))
 
 (defun fuel-edit--try-edit (ret)
   (let* ((err (fuel-eval--retort-error ret))
@@ -45,9 +54,7 @@
       (error "Couldn't find edit location"))
     (unless (file-readable-p (car loc))
       (error "Couldn't open '%s' for read" (car loc)))
-    (cond ((eq fuel-edit-word-method 'window) (find-file-other-window (car loc)))
+    (fuel-edit--visit-file (car loc) fuel-edit-word-method)
-          ((eq fuel-edit-word-method 'frame) (find-file-other-frame (car loc)))
-          (t (find-file (car loc))))
     (goto-line (if (numberp (cadr loc)) (cadr loc) 1))))
 
 (defun fuel-edit--read-vocabulary-name (refresh)
@@ -86,7 +93,7 @@ offered."
                                            nil
                                            fuel-edit--word-history
                                            arg))
-         (cmd `(:fuel* ((:quote ,word) fuel-get-edit-location))))
+         (cmd `(:fuel* ((:quote ,word) fuel-get-word-location))))
     (fuel-edit--try-edit (fuel-eval--send/wait cmd))))
 
 (defun fuel-edit-word-at-point (&optional arg)
@@ -95,7 +102,7 @@ With prefix, asks for the word to edit."
   (interactive "P")
   (let* ((word (or (and (not arg) (fuel-syntax-symbol-at-point))
                    (fuel-completion--read-word "Edit word: ")))
-         (cmd `(:fuel* ((:quote ,word) fuel-get-edit-location)))
+         (cmd `(:fuel* ((:quote ,word) fuel-get-word-location)))
          (marker (and (not arg) (point-marker))))
     (if (and (not arg) (fuel-edit--looking-at-vocab))
         (fuel-edit-vocabulary nil word)

misc/fuel/fuel-font-lock.el

@@ -92,9 +92,9 @@
   `((,fuel-syntax--stack-effect-regex . 'factor-font-lock-stack-effect)
     (,fuel-syntax--brace-words-regex 1 'factor-font-lock-parsing-word)
     (,fuel-syntax--vocab-ref-regexp  2 'factor-font-lock-vocabulary-name)
-    (,fuel-syntax--constructor-regex (1 'factor-font-lock-word)
+    (,fuel-syntax--constructor-decl-regex (1 'factor-font-lock-word)
-                                     (2 'factor-font-lock-type-name)
+                                          (2 'factor-font-lock-type-name)
-                                     (3 'factor-font-lock-invalid-syntax nil t))
+                                          (3 'factor-font-lock-invalid-syntax nil t))
     (,fuel-syntax--typedef-regex (1 'factor-font-lock-type-name)
                                  (2 'factor-font-lock-type-name)
                                  (3 'factor-font-lock-invalid-syntax nil t))

misc/fuel/fuel-listener.el

@@ -87,6 +87,17 @@ buffer."
     (fuel-listener--wait-for-prompt 10000)
     (fuel-con--setup-connection (current-buffer))))
 
+(defun fuel-listener--connect-process (port)
+  (message "Connecting to remote listener ...")
+  (pop-to-buffer (fuel-listener--buffer))
+  (let ((process (get-buffer-process (current-buffer))))
+    (when (or (not process)
+              (y-or-n-p "Kill current listener? "))
+      (make-comint-in-buffer "fuel listener" (current-buffer)
+                             (cons "localhost" port))
+      (fuel-listener--wait-for-prompt 10000)
+      (fuel-con--setup-connection (current-buffer)))))
+
 (defun fuel-listener--process (&optional start)
   (or (and (buffer-live-p (fuel-listener--buffer))
            (get-buffer-process (fuel-listener--buffer)))
@@ -123,6 +134,17 @@ buffer."
         (pop-to-buffer buf)
       (switch-to-buffer buf))))
 
+(defun connect-to-factor (&optional arg)
+  "Connects to a remote listener running in the same host.
+Without prefix argument, the default port, 9000, is used.
+Otherwise, you'll be prompted for it. To make this work, in the
+remote listener you need to issue the words
+'fuel-start-remote-listener*' or 'port
+fuel-start-remote-listener', from the fuel vocabulary."
+  (interactive "P")
+  (let ((port (if (not arg) 9000 (read-number "Port: "))))
+    (fuel-listener--connect-process port)))
+
 (defun fuel-listener-nuke ()
   "Try this command if the listener becomes unresponsive."
   (interactive)

misc/fuel/fuel-refactor.el

@@ -103,10 +103,10 @@
   (let* ((code (buffer-substring begin end))
          (existing (fuel-refactor--reuse-existing code))
          (code-str (or existing (fuel--region-to-string begin end)))
+         (word (or (car existing) (read-string "New word name: ")))
          (stack-effect (or existing
                            (fuel-stack--infer-effect code-str)
-                           (read-string "Stack effect: ")))
+                           (read-string "Stack effect: "))))
-         (word (or (car existing) (read-string "New word name: "))))
     (goto-char begin)
     (delete-region begin end)
     (insert word)
@@ -164,6 +164,11 @@ word."
         (save-excursion (font-lock-fontify-region start (point)))
         (indent-region start (point))))))
 
+
+;;; Rename word:
+
+
+
 
 ;;; Extract vocab:
 

misc/fuel/fuel-syntax.el

@@ -209,7 +209,7 @@
           (format ":[^ ]* [^ ]+\\(%s\\)*" fuel-syntax--stack-effect-regex)
           "M[^:]*: [^ ]+ [^ ]+"))
 
-(defconst fuel-syntax--constructor-regex
+(defconst fuel-syntax--constructor-decl-regex
   "\\_<C: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")
 
 (defconst fuel-syntax--typedef-regex
@@ -246,7 +246,7 @@
     ("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">"))
     ("\\_<\\((\\) \\([^)\n]*?\\) \\()\\)\\_>" (1 "<b") (2 "w") (3 ">b"))
     ;; Strings
-    ("\\_<\\(\"\\)\\([^\n\r\f\"]\\|\\\\\"\\)*\\(\"\\)\\_>" (1 "\"") (3 "\""))
+    ("\\( \\|^\\)\\(\"\\)[^\n\r\f]*\\(\"\\)\\( \\|\n\\)" (2 "\"") (3 "\""))
     ("\\_<<\\(\"\\)\\_>" (1 "<b"))
     ("\\_<\\(\"\\)>\\_>" (1 ">b"))
     ;; Multiline constructs

misc/fuel/fuel-xref.el

@@ -37,6 +37,11 @@ cursor at the first ocurrence of the used word."
   :group 'fuel-xref
   :type 'boolean)
 
+(fuel-edit--define-custom-visit
+ fuel-xref-follow-link-method
+ fuel-xref
+ "How new buffers are opened when following a crossref link.")
+
 (fuel-font-lock--defface fuel-font-lock-xref-link
   'link fuel-xref "highlighting links in cross-reference buffers")
 
@@ -59,12 +64,12 @@ cursor at the first ocurrence of the used word."
     (when (not (file-readable-p file))
       (error "File '%s' is not readable" file))
     (let ((word fuel-xref--word))
-      (find-file-other-window file)
+      (fuel-edit--visit-file file fuel-xref-follow-link-method)
       (when (numberp line) (goto-line line))
       (when (and word fuel-xref-follow-link-to-word-p)
-        (and (search-forward word
+        (and (re-search-forward (format "\\_<%s\\_>" word)
-                             (fuel-syntax--end-of-defun-pos)
+                                (fuel-syntax--end-of-defun-pos)
-                             t)
+                                t)
              (goto-char (match-beginning 0)))))))
 
 
@@ -78,11 +83,11 @@ cursor at the first ocurrence of the used word."
 (defvar fuel-xref--help-string
   "(Press RET or click to follow crossrefs, or h for help on word at point)")
 
-(defun fuel-xref--title (word cc count)
+(defun fuel-xref--title (word cc count thing)
   (put-text-property 0 (length word) 'font-lock-face 'bold word)
-  (cond ((zerop count) (format "No known words %s %s" cc word))
+  (cond ((zerop count) (format "No known %s %s %s" thing cc word))
-        ((= 1 count) (format "1 word %s %s:" cc word))
+        ((= 1 count) (format "1 %s %s %s:" thing cc word))
-        (t (format "%s words %s %s:" count cc word))))
+        (t (format "%s %ss %s %s:" count thing cc word))))
 
 (defun fuel-xref--insert-ref (ref &optional no-vocab)
   (when (and (stringp (first ref))
@@ -101,7 +106,7 @@ cursor at the first ocurrence of the used word."
     (newline)
     t))
 
-(defun fuel-xref--fill-buffer (word cc refs &optional no-vocab app)
+(defun fuel-xref--fill-buffer (word cc refs &optional no-vocab app thing)
   (let ((inhibit-read-only t)
         (count 0))
     (with-current-buffer (fuel-xref--buffer)
@@ -113,34 +118,38 @@ cursor at the first ocurrence of the used word."
         (newline)
         (goto-char start)
         (save-excursion
-          (insert (fuel-xref--title word cc count) "\n\n"))
+          (insert (fuel-xref--title word cc count (or thing "word")) "\n\n"))
         count))))
 
-(defun fuel-xref--fill-and-display (word cc refs &optional no-vocab)
+(defun fuel-xref--fill-and-display (word cc refs &optional no-vocab thing)
-  (let ((count (fuel-xref--fill-buffer word cc refs no-vocab)))
+  (let ((count (fuel-xref--fill-buffer word cc refs no-vocab nil (or thing "word"))))
     (if (zerop count)
-        (error (fuel-xref--title word cc 0))
+        (error (fuel-xref--title word cc 0 (or thing "word")))
       (message "")
       (fuel-popup--display (fuel-xref--buffer)))))
 
 (defun fuel-xref--show-callers (word)
   (let* ((cmd `(:fuel* (((:quote ,word) fuel-callers-xref))))
          (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
+    (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word word))
     (fuel-xref--fill-and-display word "using" res)))
 
 (defun fuel-xref--show-callees (word)
   (let* ((cmd `(:fuel* (((:quote ,word) fuel-callees-xref))))
          (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
+    (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil))
     (fuel-xref--fill-and-display word "used by" res)))
 
 (defun fuel-xref--apropos (str)
   (let* ((cmd `(:fuel* ((,str fuel-apropos-xref))))
          (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
+    (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil))
     (fuel-xref--fill-and-display str "containing" res)))
 
 (defun fuel-xref--show-vocab (vocab &optional app)
   (let* ((cmd `(:fuel* ((,vocab fuel-vocab-xref)) ,vocab))
          (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
+    (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil))
     (fuel-xref--fill-buffer vocab "in vocabulary" res t app)))
 
 (defun fuel-xref--show-vocab-words (vocab &optional private)
@@ -151,13 +160,25 @@ cursor at the first ocurrence of the used word."
   (fuel-popup--display (fuel-xref--buffer))
   (goto-char (point-min)))
 
+(defun fuel-xref--show-vocab-usage (vocab)
+  (let* ((cmd `(:fuel* ((,vocab fuel-vocab-usage-xref))))
+         (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
+    (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil))
+    (fuel-xref--fill-and-display vocab "using" res t "vocab")))
+
+(defun fuel-xref--show-vocab-uses (vocab)
+  (let* ((cmd `(:fuel* ((,vocab fuel-vocab-uses-xref))))
+         (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
+    (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil))
+    (fuel-xref--fill-and-display vocab "used by" res t "vocab")))
+
 
 ;;; User commands:
 
 (defvar fuel-xref--word-history nil)
 
 (defun fuel-show-callers (&optional arg)
-  "Show a list of callers of word at point.
+  "Show a list of callers of word or vocabulary at point.
 With prefix argument, ask for word."
   (interactive "P")
   (let ((word (if arg (fuel-completion--read-word "Find callers for: "
@@ -165,11 +186,14 @@ With prefix argument, ask for word."
                                                   fuel-xref--word-history)
                 (fuel-syntax-symbol-at-point))))
     (when word
-      (message "Looking up %s's callers ..." word)
+      (message "Looking up %s's users ..." word)
-      (fuel-xref--show-callers word))))
+      (if (and (not arg)
+               (fuel-edit--looking-at-vocab))
+          (fuel-xref--show-vocab-usage word)
+        (fuel-xref--show-callers word)))))
 
 (defun fuel-show-callees (&optional arg)
-  "Show a list of callers of word at point.
+  "Show a list of callers of word or vocabulary at point.
 With prefix argument, ask for word."
   (interactive "P")
   (let ((word (if arg (fuel-completion--read-word "Find callees for: "
@@ -178,7 +202,30 @@ With prefix argument, ask for word."
                 (fuel-syntax-symbol-at-point))))
     (when word
       (message "Looking up %s's callees ..." word)
-      (fuel-xref--show-callees word))))
+      (if (and (not arg)
+               (fuel-edit--looking-at-vocab))
+          (fuel-xref--show-vocab-uses word)
+        (fuel-xref--show-callees word)))))
+
+(defvar fuel-xref--vocab-history nil)
+
+(defun fuel-vocab-uses (&optional arg)
+  "Show a list of vocabularies used by a given one.
+With prefix argument, force reload of vocabulary list."
+  (interactive "P")
+  (let ((vocab (fuel-completion--read-vocab arg
+                                            (fuel-syntax-symbol-at-point)
+                                            fuel-xref--vocab-history)))
+    (fuel-xref--show-vocab-uses vocab)))
+
+(defun fuel-vocab-usage (&optional arg)
+  "Show a list of vocabularies that use a given one.
+With prefix argument, force reload of vocabulary list."
+  (interactive "P")
+  (let ((vocab (fuel-completion--read-vocab arg
+                                            (fuel-syntax-symbol-at-point)
+                                            fuel-xref--vocab-history)))
+    (fuel-xref--show-vocab-usage vocab)))
 
 (defun fuel-apropos (str)
   "Show a list of words containing the given substring."

vm/image.c

@@ -112,10 +112,7 @@ bool save_image(const F_CHAR *filename)
 	FILE* file;
 	F_HEADER h;
 
-	F_CHAR temporary_filename[] = STRING_LITERAL("##saving-factor-image##");
-
 	file = OPEN_WRITE(filename);
-	//file = OPEN_WRITE(temporary_filename);
 	if(file == NULL)
 	{
 		print_string("Cannot open image file: "); print_native_string(filename); nl();
@@ -167,16 +164,6 @@ bool save_image(const F_CHAR *filename)
 	}
 
 	return true;
-
-	if(MOVE_FILE_FAILS(temporary_filename, filename))
-	{
-		print_string("Failed to rename tempoarary image file: "); print_string(strerror(errno)); nl();
-		//if(DELETE_FILE_FAILS(temporary_filename))
-			//print_string("Failed to clean up temporary image file: "); print_string(strerror(errno)); nl();
-		return false;
-	}
-
-	return true;
 }
 
 void primitive_save_image(void)

vm/os-unix.h

@@ -22,8 +22,6 @@ typedef char F_SYMBOL;
 #define STRCMP strcmp
 #define STRNCMP strncmp
 #define STRDUP strdup
-#define MOVE_FILE_FAILS(old,new) (rename((old),(new)) < 0)
-#define DELETE_FILE_FAILS(old) (unlink((old)) < 0)
 
 #define FIXNUM_FORMAT "%ld"
 #define CELL_FORMAT "%lu"

vm/os-windows.h

@@ -19,8 +19,6 @@ typedef wchar_t F_CHAR;
 #define STRCMP wcscmp
 #define STRNCMP wcsncmp
 #define STRDUP _wcsdup
-#define MOVE_FILE_FAILS(old,new) (MoveFile((old),(new)) == 0)
-#define DELETE_FILE_FAILS(old) (DeleteFile((old)) == 0)
 
 #ifdef WIN64
 	#define CELL_FORMAT "%Iu"