Merge branch 'emacs' of http://git.hacks-galore.org/jao/factor into new_ui
commit
51232b4451
|
@ -3,7 +3,7 @@
|
|||
USING: combinators.short-circuit unicode.categories kernel math
|
||||
combinators splitting sequences math.parser io.files io assocs
|
||||
arrays namespaces make math.ranges unicode.normalize.private values
|
||||
io.encodings.ascii unicode.syntax unicode.data compiler.units
|
||||
io.encodings.ascii unicode.syntax unicode.data compiler.units fry
|
||||
alien.syntax sets accessors interval-maps memoize locals words ;
|
||||
IN: unicode.breaks
|
||||
|
||||
|
@ -111,14 +111,9 @@ PRIVATE>
|
|||
|
||||
<PRIVATE
|
||||
|
||||
:: (>pieces) ( str quot -- )
|
||||
str [
|
||||
dup quot call cut-slice
|
||||
swap , quot (>pieces)
|
||||
] unless-empty ; inline recursive
|
||||
|
||||
: >pieces ( str quot -- graphemes )
|
||||
[ (>pieces) ] { } make ; inline
|
||||
: >pieces ( str quot: ( str -- i ) -- graphemes )
|
||||
[ dup empty? not ] swap '[ dup @ cut-slice swap ]
|
||||
[ ] produce nip ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
@ -4,7 +4,7 @@ USING: unicode.case tools.test namespaces ;
|
|||
\ >lower must-infer
|
||||
\ >title must-infer
|
||||
|
||||
[ "Hello How Are You? I'M Good" ] [ "hEllo how ARE yOU? I'm good" >title ] unit-test
|
||||
[ "Hello How Are You? I'm Good" ] [ "hEllo how ARE yOU? I'm good" >title ] unit-test
|
||||
[ "FUSS" ] [ "Fu\u0000DF" >upper ] unit-test
|
||||
[ "\u0003C3\u0003C2" ] [ "\u0003A3\u0003A3" >lower ] unit-test
|
||||
[ t ] [ "hello how are you?" lower? ] unit-test
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: unicode.data sequences sequences.next namespaces make
|
||||
unicode.normalize math unicode.categories combinators
|
||||
assocs strings splitting kernel accessors ;
|
||||
assocs strings splitting kernel accessors unicode.breaks ;
|
||||
IN: unicode.case
|
||||
|
||||
<PRIVATE
|
||||
|
@ -82,23 +82,30 @@ SYMBOL: locale ! Just casing locale, or overall?
|
|||
[ [ % ] compose ] [ [ , ] compose ] bi* ?if
|
||||
] 2curry each
|
||||
] "" make ; inline
|
||||
PRIVATE>
|
||||
: >lower ( string -- lower )
|
||||
i-dot? [ turk>lower ] when
|
||||
final-sigma [ lower>> ] [ ch>lower ] map-case ;
|
||||
|
||||
: >upper ( string -- upper )
|
||||
i-dot? [ turk>upper ] when
|
||||
: (>lower) ( string -- lower )
|
||||
[ lower>> ] [ ch>lower ] map-case ;
|
||||
|
||||
: (>title) ( string -- title )
|
||||
[ title>> ] [ ch>title ] map-case ;
|
||||
|
||||
: (>upper) ( string -- upper )
|
||||
[ upper>> ] [ ch>upper ] map-case ;
|
||||
|
||||
: title-word ( string -- title )
|
||||
unclip 1string [ (>lower) ] [ (>title) ] bi* prepend ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: >lower ( string -- lower )
|
||||
i-dot? [ turk>lower ] when
|
||||
final-sigma (>lower) ;
|
||||
|
||||
: >upper ( string -- upper )
|
||||
i-dot? [ turk>upper ] when (>upper) ;
|
||||
|
||||
: >title ( string -- title )
|
||||
final-sigma
|
||||
CHAR: \s swap
|
||||
[ tuck word-boundary swapd
|
||||
[ title>> ] [ lower>> ] if ]
|
||||
[ tuck word-boundary swapd
|
||||
[ ch>title ] [ ch>lower ] if ]
|
||||
map-case nip ;
|
||||
final-sigma >words [ title-word ] map concat ;
|
||||
|
||||
: >case-fold ( string -- fold )
|
||||
>upper >lower ;
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
USING: io io.files splitting grouping unicode.collation
|
||||
sequences kernel io.encodings.utf8 math.parser math.order
|
||||
tools.test assocs io.streams.null words ;
|
||||
tools.test assocs words ;
|
||||
IN: unicode.collation.tests
|
||||
|
||||
: parse-test ( -- strings )
|
||||
|
@ -25,4 +25,4 @@ IN: unicode.collation.tests
|
|||
unit-test
|
||||
|
||||
parse-test 2 <clumps>
|
||||
[ [ test-two ] assoc-each ] with-null-writer
|
||||
[ test-two ] assoc-each
|
||||
|
|
|
@ -28,10 +28,6 @@ VALUE: properties
|
|||
: char>name ( char -- string ) name-map value-at ;
|
||||
: property? ( char property -- ? ) properties at interval-key? ;
|
||||
|
||||
! Convenience functions
|
||||
: ?between? ( n/f from to -- ? )
|
||||
pick [ between? ] [ 3drop f ] if ;
|
||||
|
||||
! Loading data from UnicodeData.txt
|
||||
|
||||
: split-; ( line -- array )
|
||||
|
@ -206,9 +202,9 @@ SYMBOL: interned
|
|||
: expand-ranges ( assoc -- interval-map )
|
||||
[
|
||||
[
|
||||
CHAR: . pick member? [
|
||||
swap ".." split1 [ hex> ] bi@ 2array
|
||||
] [ swap hex> ] if range,
|
||||
swap CHAR: . over member? [
|
||||
".." split1 [ hex> ] bi@ 2array
|
||||
] [ hex> ] if range,
|
||||
] assoc-each
|
||||
] { } make <interval-map> ;
|
||||
|
||||
|
|
|
@ -8,9 +8,7 @@ ARTICLE: "unicode.normalize" "Unicode normalization"
|
|||
{ $subsection nfc }
|
||||
{ $subsection nfd }
|
||||
{ $subsection nfkc }
|
||||
{ $subsection nfkd }
|
||||
"If two strings in a normalization form are appended, the result may not be in that normalization form still. To append two strings in NFD and make sure the result is in NFD, the following procedure is supplied:"
|
||||
{ $subsection string-append } ;
|
||||
{ $subsection nfkd } ;
|
||||
|
||||
HELP: nfc
|
||||
{ $values { "string" string } { "nfc" "a string in NFC" } }
|
||||
|
@ -27,7 +25,3 @@ HELP: nfkc
|
|||
HELP: nfkd
|
||||
{ $values { "string" string } { "nfc" "a string in NFKD" } }
|
||||
{ $description "Converts a string to Normalization Form KD" } ;
|
||||
|
||||
HELP: string-append
|
||||
{ $values { "s1" "a string in NFD" } { "s2" "a string in NFD" } { "string" "a string in NFD" } }
|
||||
{ $description "Appends two strings, putting the result in NFD." } ;
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
USING: unicode.normalize kernel tools.test sequences
|
||||
unicode.data io.encodings.utf8 io.files splitting math.parser
|
||||
locals math quotations assocs combinators ;
|
||||
locals math quotations assocs combinators unicode.normalize.private ;
|
||||
IN: unicode.normalize.tests
|
||||
|
||||
[ "ab\u000323\u000302cd" ] [ "ab\u000302" "\u000323cd" string-append ] unit-test
|
||||
|
|
|
@ -1,21 +1,24 @@
|
|||
! Copyright (C) 2008 Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: sequences namespaces make unicode.data kernel math arrays
|
||||
locals sorting.insertion accessors assocs ;
|
||||
locals sorting.insertion accessors assocs math.order ;
|
||||
IN: unicode.normalize
|
||||
|
||||
<PRIVATE
|
||||
! Conjoining Jamo behavior
|
||||
|
||||
: hangul-base HEX: ac00 ; inline
|
||||
: hangul-end HEX: D7AF ; inline
|
||||
: initial-base HEX: 1100 ; inline
|
||||
: medial-base HEX: 1161 ; inline
|
||||
: final-base HEX: 11a7 ; inline
|
||||
CONSTANT: hangul-base HEX: ac00
|
||||
CONSTANT: hangul-end HEX: D7AF
|
||||
CONSTANT: initial-base HEX: 1100
|
||||
CONSTANT: medial-base HEX: 1161
|
||||
CONSTANT: final-base HEX: 11a7
|
||||
|
||||
: initial-count 19 ; inline
|
||||
: medial-count 21 ; inline
|
||||
: final-count 28 ; inline
|
||||
CONSTANT: initial-count 19
|
||||
CONSTANT: medial-count 21
|
||||
CONSTANT: final-count 28
|
||||
|
||||
: ?between? ( n/f from to -- ? )
|
||||
pick [ between? ] [ 3drop f ] if ;
|
||||
|
||||
: hangul? ( ch -- ? ) hangul-base hangul-end ?between? ;
|
||||
: jamo? ( ch -- ? ) HEX: 1100 HEX: 11FF ?between? ;
|
||||
|
@ -84,8 +87,6 @@ PRIVATE>
|
|||
[ compatibility-entry ] decompose ;
|
||||
|
||||
: string-append ( s1 s2 -- string )
|
||||
! This could be more optimized,
|
||||
! but in practice, it'll almost always just be append
|
||||
[ append ] keep
|
||||
0 over ?nth non-starter?
|
||||
[ length dupd reorder-back ] [ drop ] if ;
|
||||
|
@ -154,7 +155,7 @@ DEFER: compose-iter
|
|||
] if (compose)
|
||||
] when* ;
|
||||
|
||||
: compose ( str -- comp )
|
||||
: combine ( str -- comp )
|
||||
[
|
||||
main-str set
|
||||
0 ind set
|
||||
|
@ -165,7 +166,7 @@ DEFER: compose-iter
|
|||
PRIVATE>
|
||||
|
||||
: nfc ( string -- nfc )
|
||||
nfd compose ;
|
||||
nfd combine ;
|
||||
|
||||
: nfkc ( string -- nfkc )
|
||||
nfkd compose ;
|
||||
nfkd combine ;
|
||||
|
|
|
@ -256,7 +256,9 @@ DEFER: default-L-parser-values
|
|||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: <L-system> < gadget
|
||||
camera display-list pedestal paused commands axiom rules string ;
|
||||
camera display-list pedestal paused
|
||||
turtle-values
|
||||
commands axiom rules string ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
@ -376,6 +378,7 @@ TUPLE: <L-system> < gadget
|
|||
L-SYSTEM display-list>> GL_COMPILE glNewList
|
||||
|
||||
turtle
|
||||
L-SYSTEM turtle-values>> [ ] or call
|
||||
L-SYSTEM string>> L-SYSTEM axiom>> or
|
||||
L-SYSTEM commands>>
|
||||
interpret-string
|
||||
|
@ -445,6 +448,11 @@ H{
|
|||
{ T{ key-down f f "q" } [ [ 5 roll-left ] with-camera ] }
|
||||
{ T{ key-down f f "w" } [ [ 5 roll-right ] with-camera ] }
|
||||
|
||||
{ T{ key-down f { A+ } "LEFT" } [ [ 1 strafe-left ] with-camera ] }
|
||||
{ T{ key-down f { A+ } "RIGHT" } [ [ 1 strafe-right ] with-camera ] }
|
||||
{ T{ key-down f { A+ } "UP" } [ [ 1 strafe-up ] with-camera ] }
|
||||
{ T{ key-down f { A+ } "DOWN" } [ [ 1 strafe-down ] with-camera ] }
|
||||
|
||||
{ T{ key-down f f "r" } [ start-rotation-thread ] }
|
||||
|
||||
{
|
||||
|
|
|
@ -9,20 +9,23 @@ IN: L-system.models.abop-2
|
|||
|
||||
L-parser-dialect >>commands
|
||||
|
||||
[ 30 >>angle ] >>turtle-values
|
||||
|
||||
"c(12)FAL" >>axiom
|
||||
|
||||
{
|
||||
{ "A" "F[&'(.7)!BL]>(137)[&'(.6)!BL]>(137)'(.9)!(.9)A" }
|
||||
{ "B" "F[-'(.7)!(.9)$CL]'(.9)!(.9)C" }
|
||||
{ "C" "F[+'(.7)!(.9)$BL]'(.9)!(.9)B" }
|
||||
{ "A" "F [&'(.7)!BL] >(137) [&'(.6)!BL] >(137) '(.9) !(.9) A" }
|
||||
|
||||
{ "B" "F [- '(.7) !(.9) $ C L] '(.9) !(.9) C" }
|
||||
{ "C" "F [+ '(.7) !(.9) $ B L] '(.9) !(.9) B" }
|
||||
|
||||
{ "L" "~c(8){+f(.1)-f(.1)-f(.1)+|+f(.1)-f(.1)-f(.1)}" }
|
||||
|
||||
} >>rules ;
|
||||
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: main ( -- ) [ L-system abop-2 "L-system" open-window ] with-ui ;
|
||||
|
||||
MAIN: main
|
||||
|
|
@ -9,6 +9,8 @@ IN: L-system.models.abop-3
|
|||
|
||||
L-parser-dialect >>commands
|
||||
|
||||
[ 30 >>angle ] >>turtle-values
|
||||
|
||||
"c(12)FA" >>axiom
|
||||
|
||||
{
|
||||
|
|
|
@ -9,6 +9,8 @@ IN: L-system.models.abop-4
|
|||
|
||||
L-parser-dialect >>commands
|
||||
|
||||
[ 18 >>angle ] >>turtle-values
|
||||
|
||||
"c(12)&(20)N" >>axiom
|
||||
|
||||
{
|
||||
|
|
|
@ -0,0 +1,33 @@
|
|||
|
||||
USING: accessors ui L-system ;
|
||||
|
||||
IN: L-system.models.abop-5-angular
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: abop-5-angular ( <L-system> -- <L-system> )
|
||||
|
||||
L-parser-dialect >>commands
|
||||
|
||||
"&(90)+(90)a" >>axiom
|
||||
|
||||
{
|
||||
{ "a" "F[+(45)l][-(45)l]^;ca" }
|
||||
|
||||
{ "l" "j" }
|
||||
{ "j" "h" }
|
||||
{ "h" "s" }
|
||||
{ "s" "d" }
|
||||
{ "d" "x" }
|
||||
{ "x" "a" }
|
||||
|
||||
{ "F" "'(1.17)F'(.855)" }
|
||||
}
|
||||
>>rules ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: main ( -- ) [ L-system abop-5-angular "L-system" open-window ] with-ui ;
|
||||
|
||||
MAIN: main
|
||||
|
|
@ -9,7 +9,9 @@ IN: L-system.models.abop-5
|
|||
|
||||
L-parser-dialect >>commands
|
||||
|
||||
"&(90)+(90)a" >>axiom
|
||||
[ 5 >>angle ] >>turtle-values
|
||||
|
||||
"a" >>axiom
|
||||
|
||||
{
|
||||
{ "a" "F[+(45)l][-(45)l]^;ca" }
|
||||
|
|
|
@ -0,0 +1,34 @@
|
|||
|
||||
USING: accessors ui L-system ;
|
||||
|
||||
IN: L-system.models.abop-6
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: abop-6 ( <L-system> -- <L-system> )
|
||||
|
||||
L-parser-dialect >>commands
|
||||
|
||||
[ 5 >>angle ] >>turtle-values
|
||||
|
||||
! "&(90)+(90)FFF[-(120)'(.6)x][-(60)'(.8)x][+(120)'(.6)x][+(60)'(.8)x]x"
|
||||
"FFF[-(120)'(.6)x][-(60)'(.8)x][+(120)'(.6)x][+(60)'(.8)x]x"
|
||||
>>axiom
|
||||
|
||||
{
|
||||
{ "a" "F[cdx][cex]F!(.9)a" }
|
||||
{ "x" "a" }
|
||||
|
||||
{ "d" "+d" }
|
||||
{ "e" "-e" }
|
||||
|
||||
{ "F" "'(1.25)F'(.8)" }
|
||||
}
|
||||
>>rules ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: main ( -- ) [ L-system abop-6 "L-system" open-window ] with-ui ;
|
||||
|
||||
MAIN: main
|
||||
|
|
@ -0,0 +1,53 @@
|
|||
|
||||
USING: accessors ui L-system ;
|
||||
|
||||
IN: L-system.models.airhorse
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: airhorse ( <L-system> -- <L-system> )
|
||||
|
||||
L-parser-dialect >>commands
|
||||
|
||||
[ 10 >>angle ] >>turtle-values
|
||||
|
||||
"C" >>axiom
|
||||
|
||||
{
|
||||
{ "C" "LBW" }
|
||||
|
||||
{ "B" "[[''aH]|[g]]" }
|
||||
{ "a" "Fs+;'a" }
|
||||
{ "g" "Ft+;'g" }
|
||||
{ "s" "[::cc!!!!&&[FFcccZ]^^^^FFcccZ]" }
|
||||
{ "t" "[c!!!!&[FF]^^FF]" }
|
||||
|
||||
{ "L" "O" }
|
||||
{ "O" "P" }
|
||||
{ "P" "Q" }
|
||||
{ "Q" "R" }
|
||||
{ "R" "U" }
|
||||
{ "U" "X" }
|
||||
{ "X" "Y" }
|
||||
{ "Y" "V" }
|
||||
{ "V" "[cc!!!&(90)[Zp]|[Zp]]" }
|
||||
{ "p" "h>(120)h>(120)h" }
|
||||
{ "h" "[+(40)!F'''p]" }
|
||||
|
||||
{ "H" "[cccci[>(50)dcFFF][<(50)ecFFF]]" }
|
||||
{ "d" "Z!&Z!&:'d" }
|
||||
{ "e" "Z!^Z!^:'e" }
|
||||
{ "i" "-:/i" }
|
||||
|
||||
{ "W" "[%[!!cb][<<<!!cb][>>>!!cb]]" }
|
||||
{ "b" "Fl!+Fl+;'b" }
|
||||
{ "l" "[-cc{--z++z++z--|--z++z++z}]" }
|
||||
}
|
||||
>>rules ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: main ( -- ) [ L-system airhorse "L-system" open-window ] with-ui ;
|
||||
|
||||
MAIN: main
|
||||
|
|
@ -201,6 +201,9 @@ SYMBOL: :uses
|
|||
: 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
|
||||
|
||||
! Completion support
|
||||
|
||||
: fuel-filter-prefix ( seq prefix -- seq )
|
||||
|
|
|
@ -7,7 +7,7 @@ IN: update.latest
|
|||
: git-pull-master ( -- )
|
||||
image parent-directory
|
||||
[
|
||||
{ "git" "pull" "http://factorcode.org/git/factor.git" "master" }
|
||||
{ "git" "pull" "git://factorcode.org/git/factor.git" "master" }
|
||||
run-command
|
||||
]
|
||||
with-directory ;
|
||||
|
|
|
@ -70,11 +70,13 @@ beast.
|
|||
- C-cC-ds : short help word at point
|
||||
- C-cC-de : show stack effect of current sexp (with prefix, region)
|
||||
- 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-cC-xw : extract region as a separate word
|
||||
- C-cC-xs : extract innermost sexp (up to point) as a separate word
|
||||
- C-cC-xr : extract region as a separate word
|
||||
|
||||
*** In the listener:
|
||||
|
||||
|
|
|
@ -132,37 +132,6 @@ With prefix argument, ask for the file name."
|
|||
(let ((file (car (fuel-mode--read-file arg))))
|
||||
(when file (fuel-debug--uses-for-file file))))
|
||||
|
||||
(defvar fuel-mode--word-history nil)
|
||||
|
||||
(defun fuel-show-callers (&optional arg)
|
||||
"Show a list of callers of word at point.
|
||||
With prefix argument, ask for word."
|
||||
(interactive "P")
|
||||
(let ((word (if arg (fuel-completion--read-word "Find callers for: "
|
||||
(fuel-syntax-symbol-at-point)
|
||||
fuel-mode--word-history)
|
||||
(fuel-syntax-symbol-at-point))))
|
||||
(when word
|
||||
(message "Looking up %s's callers ..." word)
|
||||
(fuel-xref--show-callers word))))
|
||||
|
||||
(defun fuel-show-callees (&optional arg)
|
||||
"Show a list of callers of word at point.
|
||||
With prefix argument, ask for word."
|
||||
(interactive "P")
|
||||
(let ((word (if arg (fuel-completion--read-word "Find callees for: "
|
||||
(fuel-syntax-symbol-at-point)
|
||||
fuel-mode--word-history)
|
||||
(fuel-syntax-symbol-at-point))))
|
||||
(when word
|
||||
(message "Looking up %s's callees ..." word)
|
||||
(fuel-xref--show-callees word))))
|
||||
|
||||
(defun fuel-apropos (str)
|
||||
"Show a list of words containing the given substring."
|
||||
(interactive "MFind words containing: ")
|
||||
(message "Looking up %s's references ..." str)
|
||||
(fuel-xref--apropos str))
|
||||
|
||||
;;; Minor mode definition:
|
||||
|
||||
|
@ -225,10 +194,12 @@ interacting with a factor listener is at your disposal.
|
|||
(fuel-mode--key ?e ?w 'fuel-edit-word)
|
||||
(fuel-mode--key ?e ?x 'fuel-eval-definition)
|
||||
|
||||
(fuel-mode--key ?x ?w 'fuel-refactor-extract-word)
|
||||
(fuel-mode--key ?x ?s 'fuel-refactor-extract-sexp)
|
||||
(fuel-mode--key ?x ?r 'fuel-refactor-extract-region)
|
||||
|
||||
(fuel-mode--key ?d ?> 'fuel-show-callees)
|
||||
(fuel-mode--key ?d ?< 'fuel-show-callers)
|
||||
(fuel-mode--key ?d ?v 'fuel-show-file-words)
|
||||
(fuel-mode--key ?d ?a 'fuel-autodoc-mode)
|
||||
(fuel-mode--key ?d ?p 'fuel-apropos)
|
||||
(fuel-mode--key ?d ?d 'fuel-help)
|
||||
|
|
|
@ -20,23 +20,13 @@
|
|||
|
||||
;;; Extract word:
|
||||
|
||||
(defun fuel-refactor-extract-word (begin end)
|
||||
"Extracts current region as a separate word."
|
||||
(interactive "r")
|
||||
(defun fuel-refactor--extract (begin end)
|
||||
(let* ((word (read-string "New word name: "))
|
||||
(begin (save-excursion
|
||||
(goto-char begin)
|
||||
(when (zerop (skip-syntax-backward "w"))
|
||||
(skip-syntax-forward "-"))
|
||||
(point)))
|
||||
(end (save-excursion
|
||||
(goto-char end)
|
||||
(skip-syntax-forward "w")
|
||||
(point)))
|
||||
(code (buffer-substring begin end))
|
||||
(code-str (fuel--region-to-string begin end))
|
||||
(stack-effect (or (fuel-stack--infer-effect code-str)
|
||||
(read-string "Stack effect: "))))
|
||||
(unless (< begin end) (error "No proper region to extract"))
|
||||
(goto-char begin)
|
||||
(delete-region begin end)
|
||||
(insert word)
|
||||
|
@ -52,6 +42,29 @@
|
|||
(sit-for fuel-stack-highlight-period)
|
||||
(delete-overlay fuel-stack--overlay))))
|
||||
|
||||
(defun fuel-refactor-extract-region (begin end)
|
||||
"Extracts current region as a separate word."
|
||||
(interactive "r")
|
||||
(let ((begin (save-excursion
|
||||
(goto-char begin)
|
||||
(when (zerop (skip-syntax-backward "w"))
|
||||
(skip-syntax-forward "-"))
|
||||
(point)))
|
||||
(end (save-excursion
|
||||
(goto-char end)
|
||||
(skip-syntax-forward "w")
|
||||
(point))))
|
||||
(fuel-refactor--extract begin end)))
|
||||
|
||||
(defun fuel-refactor-extract-sexp ()
|
||||
"Extracts current innermost sexp (up to point) as a separate
|
||||
word."
|
||||
(interactive)
|
||||
(fuel-refactor-extract-region (1+ (fuel-syntax--beginning-of-sexp-pos))
|
||||
(if (looking-at-p ";") (point)
|
||||
(fuel-syntax--end-of-symbol-pos))))
|
||||
|
||||
|
||||
|
||||
(provide 'fuel-refactor)
|
||||
;;; fuel-refactor.el ends here
|
||||
|
|
|
@ -312,6 +312,12 @@
|
|||
(defsubst fuel-syntax--usings ()
|
||||
(funcall fuel-syntax--usings-function))
|
||||
|
||||
(defun fuel-syntax--file-has-private ()
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(and (re-search-forward "\\_<<PRIVATE\\_>" nil t)
|
||||
(re-search-forward "\\_<PRIVATE>\\_>" nil t))))
|
||||
|
||||
(defun fuel-syntax--find-usings (&optional no-private)
|
||||
(save-excursion
|
||||
(let ((usings))
|
||||
|
@ -319,10 +325,7 @@
|
|||
(while (re-search-backward fuel-syntax--using-lines-regex nil t)
|
||||
(dolist (u (split-string (match-string-no-properties 1) nil t))
|
||||
(push u usings)))
|
||||
(goto-char (point-min))
|
||||
(when (and (not no-private)
|
||||
(re-search-forward "\\_<<PRIVATE\\_>" nil t)
|
||||
(re-search-forward "\\_<PRIVATE>\\_>" nil t))
|
||||
(when (and (not no-private) (fuel-syntax--file-has-private))
|
||||
(goto-char (point-max))
|
||||
(push (concat (fuel-syntax--find-in) ".private") usings))
|
||||
usings)))
|
||||
|
|
|
@ -13,6 +13,8 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'fuel-edit)
|
||||
(require 'fuel-completion)
|
||||
(require 'fuel-help)
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-syntax)
|
||||
|
@ -82,7 +84,7 @@ cursor at the first ocurrence of the used word."
|
|||
((= 1 count) (format "1 word %s %s:" cc word))
|
||||
(t (format "%s words %s %s:" count cc word))))
|
||||
|
||||
(defun fuel-xref--insert-ref (ref)
|
||||
(defun fuel-xref--insert-ref (ref &optional no-vocab)
|
||||
(when (and (stringp (first ref))
|
||||
(stringp (third ref))
|
||||
(numberp (fourth ref)))
|
||||
|
@ -94,29 +96,28 @@ cursor at the first ocurrence of the used word."
|
|||
(fourth ref))
|
||||
'file (third ref)
|
||||
'line (fourth ref))
|
||||
(when (stringp (second ref))
|
||||
(when (and (not no-vocab) (stringp (second ref)))
|
||||
(insert (format " (in %s)" (second ref))))
|
||||
(newline)
|
||||
t))
|
||||
|
||||
(defun fuel-xref--fill-buffer (word cc refs)
|
||||
(defun fuel-xref--fill-buffer (word cc refs &optional no-vocab app)
|
||||
(let ((inhibit-read-only t)
|
||||
(count 0))
|
||||
(with-current-buffer (fuel-xref--buffer)
|
||||
(erase-buffer)
|
||||
(dolist (ref refs)
|
||||
(when (fuel-xref--insert-ref ref) (setq count (1+ count))))
|
||||
(goto-char (point-min))
|
||||
(insert (fuel-xref--title word cc count) "\n\n")
|
||||
(when (> count 0)
|
||||
(setq fuel-xref--word (and cc word))
|
||||
(goto-char (point-max))
|
||||
(insert "\n" fuel-xref--help-string "\n"))
|
||||
(goto-char (point-min))
|
||||
count)))
|
||||
(let ((start (if app (goto-char (point-max))
|
||||
(erase-buffer)
|
||||
(point-min))))
|
||||
(dolist (ref refs)
|
||||
(when (fuel-xref--insert-ref ref no-vocab) (setq count (1+ count))))
|
||||
(newline)
|
||||
(goto-char start)
|
||||
(save-excursion
|
||||
(insert (fuel-xref--title word cc count) "\n\n"))
|
||||
count))))
|
||||
|
||||
(defun fuel-xref--fill-and-display (word cc refs)
|
||||
(let ((count (fuel-xref--fill-buffer word cc refs)))
|
||||
(defun fuel-xref--fill-and-display (word cc refs &optional no-vocab)
|
||||
(let ((count (fuel-xref--fill-buffer word cc refs no-vocab)))
|
||||
(if (zerop count)
|
||||
(error (fuel-xref--title word cc 0))
|
||||
(message "")
|
||||
|
@ -137,6 +138,65 @@ cursor at the first ocurrence of the used word."
|
|||
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
|
||||
(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))))
|
||||
(fuel-xref--fill-buffer vocab "in vocabulary" res t app)))
|
||||
|
||||
(defun fuel-xref--show-vocab-words (vocab &optional private)
|
||||
(fuel-xref--show-vocab vocab)
|
||||
(when private
|
||||
(fuel-xref--show-vocab (format "%s.private" (substring-no-properties vocab))
|
||||
t))
|
||||
(fuel-popup--display (fuel-xref--buffer))
|
||||
(goto-char (point-min)))
|
||||
|
||||
|
||||
;;; User commands:
|
||||
|
||||
(defvar fuel-xref--word-history nil)
|
||||
|
||||
(defun fuel-show-callers (&optional arg)
|
||||
"Show a list of callers of word at point.
|
||||
With prefix argument, ask for word."
|
||||
(interactive "P")
|
||||
(let ((word (if arg (fuel-completion--read-word "Find callers for: "
|
||||
(fuel-syntax-symbol-at-point)
|
||||
fuel-xref--word-history)
|
||||
(fuel-syntax-symbol-at-point))))
|
||||
(when word
|
||||
(message "Looking up %s's callers ..." word)
|
||||
(fuel-xref--show-callers word))))
|
||||
|
||||
(defun fuel-show-callees (&optional arg)
|
||||
"Show a list of callers of word at point.
|
||||
With prefix argument, ask for word."
|
||||
(interactive "P")
|
||||
(let ((word (if arg (fuel-completion--read-word "Find callees for: "
|
||||
(fuel-syntax-symbol-at-point)
|
||||
fuel-xref--word-history)
|
||||
(fuel-syntax-symbol-at-point))))
|
||||
(when word
|
||||
(message "Looking up %s's callees ..." word)
|
||||
(fuel-xref--show-callees word))))
|
||||
|
||||
(defun fuel-apropos (str)
|
||||
"Show a list of words containing the given substring."
|
||||
(interactive "MFind words containing: ")
|
||||
(message "Looking up %s's references ..." str)
|
||||
(fuel-xref--apropos str))
|
||||
|
||||
(defun fuel-show-file-words (&optional arg)
|
||||
"Show a list of words in current file.
|
||||
With prefix argument, ask for the vocab."
|
||||
(interactive "P")
|
||||
(let ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
|
||||
(fuel-edit--read-vocabulary-name))))
|
||||
(when vocab
|
||||
(fuel-xref--show-vocab-words vocab
|
||||
(fuel-syntax--file-has-private)))))
|
||||
|
||||
|
||||
|
||||
;;; Xref mode:
|
||||
|
||||
|
@ -159,6 +219,7 @@ cursor at the first ocurrence of the used word."
|
|||
(kill-all-local-variables)
|
||||
(buffer-disable-undo)
|
||||
(use-local-map fuel-xref-mode-map)
|
||||
(set-syntax-table fuel-syntax--syntax-table)
|
||||
(setq mode-name "FUEL Xref")
|
||||
(setq major-mode 'fuel-xref-mode)
|
||||
(font-lock-add-keywords nil '(("(in \\(.+\\))" 1 'fuel-font-lock-xref-vocab)))
|
||||
|
|
Loading…
Reference in New Issue