diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor index b85e8879e1..1d2f821750 100644 --- a/basis/unicode/breaks/breaks.factor +++ b/basis/unicode/breaks/breaks.factor @@ -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> 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> diff --git a/basis/unicode/case/case-tests.factor b/basis/unicode/case/case-tests.factor index 0083e49672..f9d304e05c 100644 --- a/basis/unicode/case/case-tests.factor +++ b/basis/unicode/case/case-tests.factor @@ -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 diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor index 7e61831f36..5d103e2dd0 100644 --- a/basis/unicode/case/case.factor +++ b/basis/unicode/case/case.factor @@ -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 -: >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 ; diff --git a/basis/unicode/collation/collation-tests.factor b/basis/unicode/collation/collation-tests.factor index be6af2d920..d3d0b8199d 100644 --- a/basis/unicode/collation/collation-tests.factor +++ b/basis/unicode/collation/collation-tests.factor @@ -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 -[ [ test-two ] assoc-each ] with-null-writer +[ test-two ] assoc-each diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor index 3e19c5c30d..8f99b6c160 100644 --- a/basis/unicode/data/data.factor +++ b/basis/unicode/data/data.factor @@ -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 ; diff --git a/basis/unicode/normalize/normalize-docs.factor b/basis/unicode/normalize/normalize-docs.factor index 423332fb6e..65f50ab0ae 100644 --- a/basis/unicode/normalize/normalize-docs.factor +++ b/basis/unicode/normalize/normalize-docs.factor @@ -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." } ; diff --git a/basis/unicode/normalize/normalize-tests.factor b/basis/unicode/normalize/normalize-tests.factor index 9662389531..25d5ce365c 100644 --- a/basis/unicode/normalize/normalize-tests.factor +++ b/basis/unicode/normalize/normalize-tests.factor @@ -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 diff --git a/basis/unicode/normalize/normalize.factor b/basis/unicode/normalize/normalize.factor index eacdb2724a..58ce412a2e 100644 --- a/basis/unicode/normalize/normalize.factor +++ b/basis/unicode/normalize/normalize.factor @@ -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 [ 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 ; diff --git a/extra/L-system/L-system.factor b/extra/L-system/L-system.factor index 9b8bdc1914..5bc7ce1db6 100644 --- a/extra/L-system/L-system.factor +++ b/extra/L-system/L-system.factor @@ -256,7 +256,9 @@ DEFER: default-L-parser-values ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! TUPLE: < 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: < 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 ] } { diff --git a/extra/L-system/models/abop-2/abop-2.factor b/extra/L-system/models/abop-2/abop-2.factor index 2ed8f64abe..1168780300 100644 --- a/extra/L-system/models/abop-2/abop-2.factor +++ b/extra/L-system/models/abop-2/abop-2.factor @@ -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 - \ No newline at end of file diff --git a/extra/L-system/models/abop-3/abop-3.factor b/extra/L-system/models/abop-3/abop-3.factor index 49a63eb074..f594cafcd3 100644 --- a/extra/L-system/models/abop-3/abop-3.factor +++ b/extra/L-system/models/abop-3/abop-3.factor @@ -9,6 +9,8 @@ IN: L-system.models.abop-3 L-parser-dialect >>commands + [ 30 >>angle ] >>turtle-values + "c(12)FA" >>axiom { diff --git a/extra/L-system/models/abop-4/abop-4.factor b/extra/L-system/models/abop-4/abop-4.factor index 6b2688a478..71cf32d4d7 100644 --- a/extra/L-system/models/abop-4/abop-4.factor +++ b/extra/L-system/models/abop-4/abop-4.factor @@ -9,6 +9,8 @@ IN: L-system.models.abop-4 L-parser-dialect >>commands + [ 18 >>angle ] >>turtle-values + "c(12)&(20)N" >>axiom { diff --git a/extra/L-system/models/abop-5-angular/abop-5-angular.factor b/extra/L-system/models/abop-5-angular/abop-5-angular.factor new file mode 100644 index 0000000000..29b1c72cbc --- /dev/null +++ b/extra/L-system/models/abop-5-angular/abop-5-angular.factor @@ -0,0 +1,33 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-5-angular + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-5-angular ( -- ) + + 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 + \ No newline at end of file diff --git a/extra/L-system/models/abop-5/abop-5.factor b/extra/L-system/models/abop-5/abop-5.factor index abc346946a..2e373f713c 100644 --- a/extra/L-system/models/abop-5/abop-5.factor +++ b/extra/L-system/models/abop-5/abop-5.factor @@ -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" } diff --git a/extra/L-system/models/abop-6/abop-6.factor b/extra/L-system/models/abop-6/abop-6.factor new file mode 100644 index 0000000000..0639d53274 --- /dev/null +++ b/extra/L-system/models/abop-6/abop-6.factor @@ -0,0 +1,34 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-6 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-6 ( -- ) + + 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 + \ No newline at end of file diff --git a/extra/L-system/models/airhorse/airhorse.factor b/extra/L-system/models/airhorse/airhorse.factor new file mode 100644 index 0000000000..f65c7b824f --- /dev/null +++ b/extra/L-system/models/airhorse/airhorse.factor @@ -0,0 +1,53 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.airhorse + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: airhorse ( -- ) + + 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]]" } + { "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 + \ No newline at end of file diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index becbf2161a..50f02f1a1a 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -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 ) diff --git a/extra/update/latest/latest.factor b/extra/update/latest/latest.factor index 98d264d227..77cd184cdb 100644 --- a/extra/update/latest/latest.factor +++ b/extra/update/latest/latest.factor @@ -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 ; diff --git a/misc/fuel/README b/misc/fuel/README index f5d366a22e..f722b18598 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -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: diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index c1abcf414b..f448e67d57 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -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) diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el index 547da19552..a414f17795 100644 --- a/misc/fuel/fuel-refactor.el +++ b/misc/fuel/fuel-refactor.el @@ -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 diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 2c3de32d4f..e1981eff47 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -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 "\\_<" nil t) + (re-search-forward "\\_\\_>" 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 "\\_<" nil t) - (re-search-forward "\\_\\_>" 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))) diff --git a/misc/fuel/fuel-xref.el b/misc/fuel/fuel-xref.el index 470c2a8762..f754c626f7 100644 --- a/misc/fuel/fuel-xref.el +++ b/misc/fuel/fuel-xref.el @@ -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)))