From 3d83cfbbd12056b7884839ea20bde25b40146250 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <wayo.cavazos@gmail.com>
Date: Sun, 18 Jan 2009 18:14:14 -0600
Subject: [PATCH 01/14] git-tool.remote: minor changes
---
extra/git-tool/remote/remote.factor | 26 +++++++++++++++++---------
1 file changed, 17 insertions(+), 9 deletions(-)
diff --git a/extra/git-tool/remote/remote.factor b/extra/git-tool/remote/remote.factor
index e5291a8459..77539d5ad4 100644
--- a/extra/git-tool/remote/remote.factor
+++ b/extra/git-tool/remote/remote.factor
@@ -62,15 +62,17 @@ TUPLE: <git-remote-gadget> < pack
[let | REPO [ GADGET repository>> ] |
- GADGET clear-gadget
+ ! GADGET clear-gadget
- GADGET
+ ! GADGET
+
+ { }
! Repository label
"Repository: " REPO [ current-directory get ] with-directory append
<label>
- add-gadget
+ suffix
! Branch button
@@ -103,7 +105,7 @@ TUPLE: <git-remote-gadget> < pack
]
<bevel-button> add-gadget
- add-gadget
+ suffix
! Remote button
@@ -138,7 +140,7 @@ TUPLE: <git-remote-gadget> < pack
]
<bevel-button> add-gadget
- add-gadget
+ suffix
! Remote branch button
@@ -172,7 +174,7 @@ TUPLE: <git-remote-gadget> < pack
]
<bevel-button> add-gadget
- add-gadget
+ suffix
! Fetch button
@@ -184,7 +186,7 @@ TUPLE: <git-remote-gadget> < pack
GADGET refresh-git-remote-gadget
]
- <bevel-button> add-gadget
+ <bevel-button> suffix
! Available changes
@@ -223,7 +225,7 @@ TUPLE: <git-remote-gadget> < pack
]
<bevel-button> add-gadget
- add-gadget
+ suffix
]
when
@@ -266,12 +268,18 @@ TUPLE: <git-remote-gadget> < pack
]
<bevel-button> add-gadget
- add-gadget
+ suffix
]
when
] ] ]
+
+ GADGET clear-gadget
+
+ GADGET swap
+
+ [ add-gadget ] each
drop
From d4769aa9fc02a6d0d2c47bfdddb80b666553e2d4 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <wayo.cavazos@gmail.com>
Date: Mon, 19 Jan 2009 15:05:49 -0600
Subject: [PATCH 02/14] git-tool.remote: minor update
---
extra/git-tool/remote/remote.factor | 2 ++
1 file changed, 2 insertions(+)
diff --git a/extra/git-tool/remote/remote.factor b/extra/git-tool/remote/remote.factor
index 77539d5ad4..4d9d99b0f0 100644
--- a/extra/git-tool/remote/remote.factor
+++ b/extra/git-tool/remote/remote.factor
@@ -303,6 +303,8 @@ TUPLE: <git-remote-gadget> < pack
REPO { "git" "fetch" REMOTE-BRANCH } git-process drop ]
+ GADGET refresh-git-remote-gadget
+
GADGET fetch-period>> sleep
t
From 9e4e1c4a4dcd3b7bd7b97fc57056c66778aa868f Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <wayo.cavazos@gmail.com>
Date: Mon, 19 Jan 2009 15:10:39 -0600
Subject: [PATCH 03/14] Remote 'git-tool' (project moved to other repository)
---
extra/git-tool/git-tool.factor | 470 ----------------------------
extra/git-tool/remote/remote.factor | 402 ------------------------
2 files changed, 872 deletions(-)
delete mode 100644 extra/git-tool/git-tool.factor
delete mode 100644 extra/git-tool/remote/remote.factor
diff --git a/extra/git-tool/git-tool.factor b/extra/git-tool/git-tool.factor
deleted file mode 100644
index ff45d32c65..0000000000
--- a/extra/git-tool/git-tool.factor
+++ /dev/null
@@ -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 ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
diff --git a/extra/git-tool/remote/remote.factor b/extra/git-tool/remote/remote.factor
deleted file mode 100644
index 4d9d99b0f0..0000000000
--- a/extra/git-tool/remote/remote.factor
+++ /dev/null
@@ -1,402 +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>
- suffix
-
- ! 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
-
- suffix
-
- ! 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
-
- suffix
-
- ! 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
-
- suffix
-
- ! Fetch button
-
- "Fetch"
- [
- drop
- [let | REMOTE [ GADGET remote>> ] |
- REPO { "git" "fetch" REMOTE } git-process popup-if-error ]
-
- GADGET refresh-git-remote-gadget
- ]
- <bevel-button> suffix
-
- ! 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
-
- suffix
-
- ]
- 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
-
- suffix
-
- ]
- when
-
- ] ] ]
-
- GADGET clear-gadget
-
- GADGET swap
-
- [ add-gadget ] each
-
- 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 refresh-git-remote-gadget
-
- 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
\ No newline at end of file
From f34f7298eec95d54ab53e61bfb101802dcc97761 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Wed, 21 Jan 2009 02:37:32 +0100
Subject: [PATCH 04/14] FUEL: remote connections.
---
extra/fuel/fuel.factor | 23 ++++++++++++++++++++---
misc/fuel/README | 14 ++++++++++++++
misc/fuel/fu.el | 3 +++
misc/fuel/fuel-listener.el | 22 ++++++++++++++++++++++
4 files changed, 59 insertions(+), 3 deletions(-)
diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index f52a34ff28..663a0bb485 100644
--- a/extra/fuel/fuel.factor
+++ b/extra/fuel/fuel.factor
@@ -2,9 +2,10 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs compiler.units definitions fuel.eval
-fuel.help help.markup help.topics io.pathnames kernel math math.order
-memoize namespaces parser sequences sets sorting tools.crossref
-tools.scaffold tools.vocabs vocabs vocabs.loader vocabs.parser words ;
+fuel.help help.markup help.topics io io.encodings.utf8 io.pathnames
+io.servers.connection kernel listener math math.order memoize
+namespaces parser sequences sets sorting tools.crossref tools.scaffold
+tools.vocabs vocabs vocabs.loader vocabs.parser words ;
IN: fuel
@@ -174,3 +175,19 @@ PRIVATE>
: fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ;
+! Remote connection
+
+: fuel-start-remote-listener ( port/f -- )
+ "Starting server. Connect with 'M-x connect-to-factor' in Emacs"
+ write nl flush number? [ 9000 ] unless*
+ <threaded-server>
+ "tty-server" >>name
+ utf8 >>encoding
+ swap local-server >>insecure
+ [ listener ] >>handler
+ f >>timeout
+ start-server ;
+
+: fuel-start-remote-listener* ( -- ) f fuel-start-remote-listener ;
+
+MAIN: fuel-start-remote-listener*
diff --git a/misc/fuel/README b/misc/fuel/README
index cfb8f5b66d..da70952ec0 100644
--- a/misc/fuel/README
+++ b/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.
diff --git a/misc/fuel/fu.el b/misc/fuel/fu.el
index 95365964ab..e9217fbd03 100644
--- a/misc/fuel/fu.el
+++ b/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)
diff --git a/misc/fuel/fuel-listener.el b/misc/fuel/fuel-listener.el
index ad3c1fc272..d0898de04f 100644
--- a/misc/fuel/fuel-listener.el
+++ b/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)
From 5b785d2f38ad01331219b9f19e566464bed0e9b5 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Wed, 21 Jan 2009 02:46:50 +0100
Subject: [PATCH 05/14] FUEL: In word extraction, ask for word name before
stack effect.
---
extra/fuel/fuel.factor | 8 +++++---
misc/fuel/fuel-refactor.el | 4 ++--
2 files changed, 7 insertions(+), 5 deletions(-)
diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index 663a0bb485..fa0831f5f8 100644
--- a/extra/fuel/fuel.factor
+++ b/extra/fuel/fuel.factor
@@ -177,9 +177,7 @@ PRIVATE>
! Remote connection
-: fuel-start-remote-listener ( port/f -- )
- "Starting server. Connect with 'M-x connect-to-factor' in Emacs"
- write nl flush number? [ 9000 ] unless*
+: fuel-start-server ( port -- )
<threaded-server>
"tty-server" >>name
utf8 >>encoding
@@ -188,6 +186,10 @@ PRIVATE>
f >>timeout
start-server ;
+: fuel-start-remote-listener ( port/f -- )
+ "Starting server. Connect with 'M-x connect-to-factor' in Emacs"
+ write nl flush number? [ 9000 ] unless* fuel-start-server ;
+
: fuel-start-remote-listener* ( -- ) f fuel-start-remote-listener ;
MAIN: fuel-start-remote-listener*
diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el
index 788033cf88..738d6fff47 100644
--- a/misc/fuel/fuel-refactor.el
+++ b/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: ")))
- (word (or (car existing) (read-string "New word name: "))))
+ (read-string "Stack effect: "))))
(goto-char begin)
(delete-region begin end)
(insert word)
From e81c3927061ba82ac276600fcc0c2441ed99d6b1 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Wed, 21 Jan 2009 03:03:03 +0100
Subject: [PATCH 06/14] FUEL: Fix for regression in constructor indentation.
---
misc/fuel/fuel-font-lock.el | 6 +++---
misc/fuel/fuel-syntax.el | 2 +-
2 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/misc/fuel/fuel-font-lock.el b/misc/fuel/fuel-font-lock.el
index 2bf3f710e4..4b3607b96d 100644
--- a/misc/fuel/fuel-font-lock.el
+++ b/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)
- (2 'factor-font-lock-type-name)
- (3 'factor-font-lock-invalid-syntax nil t))
+ (,fuel-syntax--constructor-decl-regex (1 'factor-font-lock-word)
+ (2 'factor-font-lock-type-name)
+ (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))
diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el
index 3f47f55b88..5a666d5744 100644
--- a/misc/fuel/fuel-syntax.el
+++ b/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
From 28cfe0fe6371cc16b1864cb8580e531975709991 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Wed, 21 Jan 2009 03:22:37 +0100
Subject: [PATCH 07/14] FUEL: small fix.
---
misc/fuel/fuel-debug.el | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/misc/fuel/fuel-debug.el b/misc/fuel/fuel-debug.el
index 1db1d36b61..611884e087 100644
--- a/misc/fuel/fuel-debug.el
+++ b/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)
From f8632b46cec5ce600f2bb87e890a088771e6ccef Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Wed, 21 Jan 2009 12:21:21 +0100
Subject: [PATCH 08/14] FUEL: Remote listener functionality factored to a
separate vocab.
---
extra/fuel/fuel.factor | 23 ++++-------------------
extra/fuel/remote/authors.txt | 1 +
extra/fuel/remote/remote.factor | 28 ++++++++++++++++++++++++++++
3 files changed, 33 insertions(+), 19 deletions(-)
create mode 100644 extra/fuel/remote/authors.txt
create mode 100644 extra/fuel/remote/remote.factor
diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index fa0831f5f8..6efc1a9fef 100644
--- a/extra/fuel/fuel.factor
+++ b/extra/fuel/fuel.factor
@@ -2,10 +2,10 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs compiler.units definitions fuel.eval
-fuel.help help.markup help.topics io io.encodings.utf8 io.pathnames
-io.servers.connection kernel listener math math.order memoize
-namespaces parser sequences sets sorting tools.crossref tools.scaffold
-tools.vocabs vocabs vocabs.loader vocabs.parser words ;
+fuel.help fuel.remote help.markup help.topics io.pathnames kernel math
+math.order memoize namespaces parser sequences sets sorting
+tools.crossref tools.scaffold tools.vocabs vocabs vocabs.loader
+vocabs.parser words ;
IN: fuel
@@ -177,19 +177,4 @@ PRIVATE>
! Remote connection
-: fuel-start-server ( port -- )
- <threaded-server>
- "tty-server" >>name
- utf8 >>encoding
- swap local-server >>insecure
- [ listener ] >>handler
- f >>timeout
- start-server ;
-
-: fuel-start-remote-listener ( port/f -- )
- "Starting server. Connect with 'M-x connect-to-factor' in Emacs"
- write nl flush number? [ 9000 ] unless* fuel-start-server ;
-
-: fuel-start-remote-listener* ( -- ) f fuel-start-remote-listener ;
-
MAIN: fuel-start-remote-listener*
diff --git a/extra/fuel/remote/authors.txt b/extra/fuel/remote/authors.txt
new file mode 100644
index 0000000000..48f802a3cd
--- /dev/null
+++ b/extra/fuel/remote/authors.txt
@@ -0,0 +1 @@
+Jose Antonio Ortega Ruiz
\ No newline at end of file
diff --git a/extra/fuel/remote/remote.factor b/extra/fuel/remote/remote.factor
new file mode 100644
index 0000000000..454265d5d8
--- /dev/null
+++ b/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 ;
+
From 01acbddd9f46ed23c84345b085cf95811ee08dad Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Wed, 21 Jan 2009 20:39:10 +0100
Subject: [PATCH 09/14] FUEL: Small tweak in regexps.
---
misc/fuel/fuel-syntax.el | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el
index 5a666d5744..66b77df49e 100644
--- a/misc/fuel/fuel-syntax.el
+++ b/misc/fuel/fuel-syntax.el
@@ -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
From 376f332eef363bead9518d157c36a9d8500d4063 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 21 Jan 2009 22:21:40 -0600
Subject: [PATCH 10/14] allow streams in the post-data tuple
---
basis/http/client/client.factor | 16 +++++++++-------
1 file changed, 9 insertions(+), 7 deletions(-)
diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor
index f2c0a862eb..f8106f4c83 100644
--- a/basis/http/client/client.factor
+++ b/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 post-data>> data>> write ] when ;
+ dup method>> { "POST" "PUT" } member? [
+ dup post-data>> data>> dup sequence?
+ [ write ] [ output-stream get stream-copy ] if
+ ] when ;
: write-request ( request -- )
unparse-post-data
From 09b82321b59a4d7f395567f98bee455a2da504cd Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 21 Jan 2009 23:32:23 -0600
Subject: [PATCH 11/14] remove failed proper-save from vm
---
vm/image.c | 13 -------------
vm/os-unix.h | 2 --
vm/os-windows.h | 2 --
3 files changed, 17 deletions(-)
diff --git a/vm/image.c b/vm/image.c
index f7ecd34aa8..5f4492e537 100755
--- a/vm/image.c
+++ b/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)
diff --git a/vm/os-unix.h b/vm/os-unix.h
index 9f911acded..d2f34b4bc4 100755
--- a/vm/os-unix.h
+++ b/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"
diff --git a/vm/os-windows.h b/vm/os-windows.h
index beec7ad37c..a9c3f6d803 100755
--- a/vm/os-windows.h
+++ b/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"
From 4a5d8f5344ab95149bc364f42e3b8a78f824a6d2 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Thu, 22 Jan 2009 09:55:39 +0100
Subject: [PATCH 12/14] FUEL: New option fuel-xref-follow-link-method (current
buffer, new window or frame).
---
misc/fuel/fuel-edit.el | 27 +++++++++++++++++----------
misc/fuel/fuel-xref.el | 17 +++++++++++++----
2 files changed, 30 insertions(+), 14 deletions(-)
diff --git a/misc/fuel/fuel-edit.el b/misc/fuel/fuel-edit.el
index 0334ab6104..484fed66cd 100644
--- a/misc/fuel/fuel-edit.el
+++ b/misc/fuel/fuel-edit.el
@@ -22,17 +22,26 @@
;;; Customization
-(defcustom fuel-edit-word-method nil
- "How the new buffer is opened when invoking
-\\[fuel-edit-word-at-point]."
- :group 'fuel
- :type '(choice (const :tag "Other window" window)
- (const :tag "Other frame" frame)
- (const :tag "Current window" nil)))
+(defmacro fuel-edit--define-custom-visit (var group doc)
+ `(defcustom ,var nil
+ ,doc
+ :group ',group
+ :type '(choice (const :tag "Other window" window)
+ (const :tag "Other frame" frame)
+ (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)
@@ -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)))
- ((eq fuel-edit-word-method 'frame) (find-file-other-frame (car loc)))
- (t (find-file (car loc))))
+ (fuel-edit--visit-file (car loc) fuel-edit-word-method)
(goto-line (if (numberp (cadr loc)) (cadr loc) 1))))
(defun fuel-edit--read-vocabulary-name (refresh)
diff --git a/misc/fuel/fuel-xref.el b/misc/fuel/fuel-xref.el
index f754c626f7..d98c0b0a69 100644
--- a/misc/fuel/fuel-xref.el
+++ b/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
- (fuel-syntax--end-of-defun-pos)
- t)
+ (and (re-search-forward (format "\\_<%s\\_>" word)
+ (fuel-syntax--end-of-defun-pos)
+ t)
(goto-char (match-beginning 0)))))))
@@ -126,21 +131,25 @@ cursor at the first ocurrence of the used word."
(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)
From d3cbb6285108f8ceaea1e16660441f9793955324 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Thu, 22 Jan 2009 16:11:44 +0100
Subject: [PATCH 13/14] FUEL: fuel.xref subvocabulary factored out.
---
extra/fuel/fuel.factor | 106 +++++++++---------------------------
extra/fuel/help/help.factor | 3 +
extra/fuel/xref/authors.txt | 1 +
extra/fuel/xref/xref.factor | 62 +++++++++++++++++++++
misc/fuel/fuel-edit.el | 4 +-
5 files changed, 93 insertions(+), 83 deletions(-)
create mode 100644 extra/fuel/xref/authors.txt
create mode 100644 extra/fuel/xref/xref.factor
diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index 6efc1a9fef..d4bff7678d 100644
--- a/extra/fuel/fuel.factor
+++ b/extra/fuel/fuel.factor
@@ -1,11 +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
-fuel.help fuel.remote help.markup help.topics io.pathnames kernel math
-math.order memoize namespaces parser sequences sets sorting
-tools.crossref tools.scaffold tools.vocabs vocabs vocabs.loader
-vocabs.parser words ;
+USING: assocs compiler.units fuel.eval fuel.help fuel.remote fuel.xref
+help.topics io.pathnames kernel namespaces parser sequences
+tools.scaffold vocabs.loader ;
IN: fuel
@@ -51,92 +49,36 @@ PRIVATE>
! Edit locations
-<PRIVATE
-
-: 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-word-location ( word -- )
+ word-location fuel-eval-set-result ;
: 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 )
- [ name>> ] [ vocabulary>> ] [ where fuel-normalize-loc ] tri 4array ;
+: fuel-callees-xref ( word -- ) callees-xref fuel-eval-set-result ;
-: fuel-sort-xrefs ( seq -- seq' )
- [ [ first ] dip first <=> ] sort ; inline
+: fuel-apropos-xref ( str -- ) apropos-xref fuel-eval-set-result ;
-: fuel-format-xrefs ( seq -- seq' )
- [ word? ] filter [ fuel-word>xref ] map ; inline
-
-: (fuel-index) ( seq -- seq )
- [ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ;
-
-PRIVATE>
-
-: 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 ;
+: fuel-vocab-xref ( vocab -- ) vocab-xref fuel-eval-set-result ;
! Help support
@@ -156,6 +98,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 ;
diff --git a/extra/fuel/help/help.factor b/extra/fuel/help/help.factor
index ff7239ac8f..e70327bd35 100644
--- a/extra/fuel/help/help.factor
+++ b/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 ;
diff --git a/extra/fuel/xref/authors.txt b/extra/fuel/xref/authors.txt
new file mode 100644
index 0000000000..48f802a3cd
--- /dev/null
+++ b/extra/fuel/xref/authors.txt
@@ -0,0 +1 @@
+Jose Antonio Ortega Ruiz
\ No newline at end of file
diff --git a/extra/fuel/xref/xref.factor b/extra/fuel/xref/xref.factor
new file mode 100644
index 0000000000..56a2ac5803
--- /dev/null
+++ b/extra/fuel/xref/xref.factor
@@ -0,0 +1,62 @@
+! 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 ;
+
+: 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 ;
+
+: 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 ;
diff --git a/misc/fuel/fuel-edit.el b/misc/fuel/fuel-edit.el
index 484fed66cd..0037c6718a 100644
--- a/misc/fuel/fuel-edit.el
+++ b/misc/fuel/fuel-edit.el
@@ -93,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)
@@ -102,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)
From a654fac19e0130920e5a5da8fe01c9bc64c7694c Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Thu, 22 Jan 2009 21:13:38 +0100
Subject: [PATCH 14/14] FUEL: Cross-reference for vocabs (uses/usage).
---
extra/fuel/fuel.factor | 4 +++
extra/fuel/xref/xref.factor | 7 ++++
misc/fuel/README | 6 ++--
misc/fuel/fuel-completion.el | 6 +++-
misc/fuel/fuel-edit.el | 2 +-
misc/fuel/fuel-refactor.el | 5 +++
misc/fuel/fuel-xref.el | 66 ++++++++++++++++++++++++++++--------
7 files changed, 78 insertions(+), 18 deletions(-)
diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index d4bff7678d..2bf8f1b98d 100644
--- a/extra/fuel/fuel.factor
+++ b/extra/fuel/fuel.factor
@@ -80,6 +80,10 @@ PRIVATE>
: fuel-vocab-xref ( vocab -- ) vocab-xref fuel-eval-set-result ;
+: fuel-vocab-uses-xref ( vocab -- ) vocab-uses-xref fuel-eval-set-result ;
+
+: fuel-vocab-usage-xref ( vocab -- ) vocab-usage-xref fuel-eval-set-result ;
+
! Help support
: fuel-get-article ( name -- ) article fuel-eval-set-result ;
diff --git a/extra/fuel/xref/xref.factor b/extra/fuel/xref/xref.factor
index 56a2ac5803..5f5e28d1d2 100644
--- a/extra/fuel/xref/xref.factor
+++ b/extra/fuel/xref/xref.factor
@@ -18,6 +18,9 @@ IN: fuel.xref
: 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
@@ -50,6 +53,10 @@ PRIVATE>
: 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 ;
diff --git a/misc/fuel/README b/misc/fuel/README
index da70952ec0..759f26c1b2 100644
--- a/misc/fuel/README
+++ b/misc/fuel/README
@@ -113,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 callees of word at point
+ - C-cM-<, C-cC-d< : show callers of word or vocabulary 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
diff --git a/misc/fuel/fuel-completion.el b/misc/fuel/fuel-completion.el
index 6f08e0c4cd..e6ec8b2dc9 100644
--- a/misc/fuel/fuel-completion.el
+++ b/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))))
diff --git a/misc/fuel/fuel-edit.el b/misc/fuel/fuel-edit.el
index 0037c6718a..e5f0ffd26f 100644
--- a/misc/fuel/fuel-edit.el
+++ b/misc/fuel/fuel-edit.el
@@ -45,7 +45,7 @@
(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))
diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el
index 738d6fff47..f44234ae1b 100644
--- a/misc/fuel/fuel-refactor.el
+++ b/misc/fuel/fuel-refactor.el
@@ -164,6 +164,11 @@ word."
(save-excursion (font-lock-fontify-region start (point)))
(indent-region start (point))))))
+
+;;; Rename word:
+
+
+
;;; Extract vocab:
diff --git a/misc/fuel/fuel-xref.el b/misc/fuel/fuel-xref.el
index d98c0b0a69..cae7923bee 100644
--- a/misc/fuel/fuel-xref.el
+++ b/misc/fuel/fuel-xref.el
@@ -83,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))
- ((= 1 count) (format "1 word %s %s:" cc word))
- (t (format "%s words %s %s:" count cc word))))
+ (cond ((zerop count) (format "No known %s %s %s" thing cc word))
+ ((= 1 count) (format "1 %s %s %s:" thing 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))
@@ -106,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)
@@ -118,13 +118,13 @@ 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)
- (let ((count (fuel-xref--fill-buffer word cc refs 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 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)))))
@@ -160,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: "
@@ -174,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)
- (fuel-xref--show-callers word))))
+ (message "Looking up %s's users ..." 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: "
@@ -187,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."