Merge branch 'master' of git://factorcode.org/git/factor
commit
9b704d640d
|
|
@ -35,7 +35,7 @@ HELP: >title
|
||||||
{ $description "Converts a string to title case." } ;
|
{ $description "Converts a string to title case." } ;
|
||||||
|
|
||||||
HELP: >case-fold
|
HELP: >case-fold
|
||||||
{ $values { "string" string } { "case-fold" string } }
|
{ $values { "string" string } { "fold" string } }
|
||||||
{ $description "Converts a string to case-folded form." } ;
|
{ $description "Converts a string to case-folded form." } ;
|
||||||
|
|
||||||
HELP: upper?
|
HELP: upper?
|
||||||
|
|
|
||||||
|
|
@ -6,12 +6,12 @@ USING: unicode.case tools.test namespaces ;
|
||||||
|
|
||||||
[ "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
|
[ "FUSS" ] [ "Fu\u0000DF" >upper ] unit-test
|
||||||
[ "\u0003C3\u0003C2" ] [ "\u0003A3\u0003A3" >lower ] unit-test
|
[ "\u0003C3a\u0003C2 \u0003C3\u0003C2 \u0003C3a\u0003C2" ] [ "\u0003A3A\u0003A3 \u0003A3\u0003A3 \u0003A3A\u0003A3" >lower ] unit-test
|
||||||
[ t ] [ "hello how are you?" lower? ] unit-test
|
[ t ] [ "hello how are you?" lower? ] unit-test
|
||||||
[
|
[
|
||||||
"tr" locale set
|
"tr" locale set
|
||||||
[ "i\u000131i \u000131jj" ] [ "i\u000131I\u000307 IJj" >lower ] unit-test
|
[ "i\u000131i \u000131jj" ] [ "i\u000131I\u000307 IJj" >lower ] unit-test
|
||||||
! [ "I\u00307\u000131i Ijj" ] [ "i\u000131I\u000307 IJj" >title ] unit-test
|
[ "I\u000307\u000131i Ijj" ] [ "i\u000131I\u000307 IJj" >title ] unit-test
|
||||||
[ "I\u000307II\u000307 IJJ" ] [ "i\u000131I\u000307 IJj" >upper ] unit-test
|
[ "I\u000307II\u000307 IJJ" ] [ "i\u000131I\u000307 IJj" >upper ] unit-test
|
||||||
"lt" locale set
|
"lt" locale set
|
||||||
! Lithuanian casing tests
|
! Lithuanian casing tests
|
||||||
|
|
|
||||||
|
|
@ -1,8 +1,8 @@
|
||||||
! Copyright (C) 2008 Daniel Ehrenberg.
|
! Copyright (C) 2008 Daniel Ehrenberg.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: unicode.data sequences sequences.next namespaces make
|
USING: unicode.data sequences sequences.next namespaces make
|
||||||
unicode.normalize math unicode.categories combinators
|
unicode.normalize math unicode.categories combinators unicode.syntax
|
||||||
assocs strings splitting kernel accessors unicode.breaks ;
|
assocs strings splitting kernel accessors unicode.breaks fry ;
|
||||||
IN: unicode.case
|
IN: unicode.case
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
@ -16,6 +16,13 @@ PRIVATE>
|
||||||
SYMBOL: locale ! Just casing locale, or overall?
|
SYMBOL: locale ! Just casing locale, or overall?
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
: split-subseq ( string sep -- strings )
|
||||||
|
[ dup ] swap '[ _ split1 swap ] [ ] produce nip ;
|
||||||
|
|
||||||
|
: replace ( old new str -- newstr )
|
||||||
|
[ split-subseq ] dip join ;
|
||||||
|
|
||||||
: i-dot? ( -- ? )
|
: i-dot? ( -- ? )
|
||||||
locale get { "tr" "az" } member? ;
|
locale get { "tr" "az" } member? ;
|
||||||
|
|
||||||
|
|
@ -23,57 +30,51 @@ SYMBOL: locale ! Just casing locale, or overall?
|
||||||
|
|
||||||
: dot-over ( -- ch ) HEX: 307 ;
|
: dot-over ( -- ch ) HEX: 307 ;
|
||||||
|
|
||||||
: lithuanian-ch>upper ( ? next ch -- ? )
|
|
||||||
rot [ 2drop f ]
|
|
||||||
[ swap dot-over = over "ij" member? and swap , ] if ;
|
|
||||||
|
|
||||||
: lithuanian>upper ( string -- lower )
|
: lithuanian>upper ( string -- lower )
|
||||||
[ f swap [ lithuanian-ch>upper ] each-next drop ] "" make ;
|
"i\u000307" "i" replace
|
||||||
|
"j\u000307" "j" replace ;
|
||||||
|
|
||||||
: mark-above? ( ch -- ? )
|
: mark-above? ( ch -- ? )
|
||||||
combining-class 230 = ;
|
combining-class 230 = ;
|
||||||
|
|
||||||
: lithuanian-ch>lower ( next ch -- )
|
: with-rest ( seq quot: ( seq -- seq ) -- seq )
|
||||||
! This fails to add a dot above in certain edge cases
|
[ unclip ] dip swap slip prefix ; inline
|
||||||
! where there is a non-above combining mark before an above one
|
|
||||||
! in Lithuanian
|
: add-dots ( seq -- seq )
|
||||||
dup , "IJ" member? swap mark-above? and [ dot-over , ] when ;
|
[ [ "" ] [
|
||||||
|
dup first mark-above?
|
||||||
|
[ CHAR: combining-dot-above prefix ] when
|
||||||
|
] if-empty ] with-rest ;
|
||||||
|
|
||||||
: lithuanian>lower ( string -- lower )
|
: lithuanian>lower ( string -- lower )
|
||||||
[ [ lithuanian-ch>lower ] each-next ] "" make ;
|
"i" split add-dots "i" join
|
||||||
|
"j" split add-dots "i" join ;
|
||||||
: turk-ch>upper ( ch -- )
|
|
||||||
dup CHAR: i =
|
|
||||||
[ drop CHAR: I , dot-over , ] [ , ] if ;
|
|
||||||
|
|
||||||
: turk>upper ( string -- upper-i )
|
: turk>upper ( string -- upper-i )
|
||||||
[ [ turk-ch>upper ] each ] "" make ;
|
"i" "I\u000307" replace ;
|
||||||
|
|
||||||
: turk-ch>lower ( ? next ch -- ? )
|
|
||||||
{
|
|
||||||
{ [ rot ] [ 2drop f ] }
|
|
||||||
{ [ dup CHAR: I = ] [
|
|
||||||
drop dot-over =
|
|
||||||
dup CHAR: i HEX: 131 ? ,
|
|
||||||
] }
|
|
||||||
[ , drop f ]
|
|
||||||
} cond ;
|
|
||||||
|
|
||||||
: turk>lower ( string -- lower-i )
|
: turk>lower ( string -- lower-i )
|
||||||
[ f swap [ turk-ch>lower ] each-next drop ] "" make ;
|
"I\u000307" "i" replace
|
||||||
|
"I" "\u000131" replace ;
|
||||||
|
|
||||||
: word-boundary ( prev char -- new ? )
|
: fix-sigma-end ( string -- string )
|
||||||
dup non-starter? [ drop dup ] when
|
[ "" ] [
|
||||||
swap uncased? ;
|
dup peek CHAR: greek-small-letter-sigma =
|
||||||
|
[ 1 head* CHAR: greek-small-letter-final-sigma suffix ] when
|
||||||
|
] if-empty ;
|
||||||
|
|
||||||
: sigma-map ( string -- string )
|
: sigma-map ( string -- string )
|
||||||
[
|
{ CHAR: greek-capital-letter-sigma } split [ [
|
||||||
swap [ uncased? ] keep not or
|
[ { CHAR: greek-small-letter-sigma } ] [
|
||||||
[ drop HEX: 3C2 ] when
|
dup first uncased?
|
||||||
] map-next ;
|
CHAR: greek-small-letter-final-sigma
|
||||||
|
CHAR: greek-small-letter-sigma ? prefix
|
||||||
|
] if-empty
|
||||||
|
] map ] with-rest concat fix-sigma-end ;
|
||||||
|
|
||||||
: final-sigma ( string -- string )
|
: final-sigma ( string -- string )
|
||||||
HEX: 3A3 over member? [ sigma-map ] when ;
|
CHAR: greek-capital-letter-sigma
|
||||||
|
over member? [ sigma-map ] when ;
|
||||||
|
|
||||||
: map-case ( string string-quot char-quot -- case )
|
: map-case ( string string-quot char-quot -- case )
|
||||||
[
|
[
|
||||||
|
|
@ -83,26 +84,26 @@ SYMBOL: locale ! Just casing locale, or overall?
|
||||||
] 2curry each
|
] 2curry each
|
||||||
] "" make ; inline
|
] "" make ; inline
|
||||||
|
|
||||||
: (>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>
|
PRIVATE>
|
||||||
|
|
||||||
: >lower ( string -- lower )
|
: >lower ( string -- lower )
|
||||||
i-dot? [ turk>lower ] when
|
i-dot? [ turk>lower ] when final-sigma
|
||||||
final-sigma (>lower) ;
|
[ lower>> ] [ ch>lower ] map-case ;
|
||||||
|
|
||||||
: >upper ( string -- upper )
|
: >upper ( string -- upper )
|
||||||
i-dot? [ turk>upper ] when (>upper) ;
|
i-dot? [ turk>upper ] when
|
||||||
|
[ upper>> ] [ ch>upper ] map-case ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: (>title) ( string -- title )
|
||||||
|
i-dot? [ turk>upper ] when
|
||||||
|
[ title>> ] [ ch>title ] map-case ;
|
||||||
|
|
||||||
|
: title-word ( string -- title )
|
||||||
|
unclip 1string [ >lower ] [ (>title) ] bi* prepend ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
: >title ( string -- title )
|
: >title ( string -- title )
|
||||||
final-sigma >words [ title-word ] map concat ;
|
final-sigma >words [ title-word ] map concat ;
|
||||||
|
|
|
||||||
|
|
@ -3,57 +3,47 @@
|
||||||
USING: help.markup help.syntax kernel ;
|
USING: help.markup help.syntax kernel ;
|
||||||
IN: unicode.categories
|
IN: unicode.categories
|
||||||
|
|
||||||
HELP: LETTER?
|
HELP: LETTER
|
||||||
{ $values { "ch" "a character" } { "?" "a boolean" } }
|
{ $class-description "The class of upper cased letters" } ;
|
||||||
{ $description "Determines whether the code point is an upper-cased letter" } ;
|
|
||||||
|
|
||||||
HELP: Letter?
|
HELP: Letter
|
||||||
{ $values { "ch" "a character" } { "?" "a boolean" } }
|
{ $class-description "The class of letters" } ;
|
||||||
{ $description "Determines whether the code point is a letter of any case" } ;
|
|
||||||
|
|
||||||
HELP: alpha?
|
HELP: alpha
|
||||||
{ $values { "ch" "a character" } { "?" "a boolean" } }
|
{ $class-description "The class of code points which are alphanumeric" } ;
|
||||||
{ $description "Determines whether the code point is alphanumeric" } ;
|
|
||||||
|
|
||||||
HELP: blank?
|
HELP: blank
|
||||||
{ $values { "ch" "a character" } { "?" "a boolean" } }
|
{ $class-description "The class of code points which are whitespace" } ;
|
||||||
{ $description "Determines whether the code point is whitespace" } ;
|
|
||||||
|
|
||||||
HELP: character?
|
HELP: character
|
||||||
{ $values { "ch" "a character" } { "?" "a boolean" } }
|
{ $class-description "The class of numbers which are pre-defined Unicode code points" } ;
|
||||||
{ $description "Determines whether a number is a code point which has been assigned" } ;
|
|
||||||
|
|
||||||
HELP: control?
|
HELP: control
|
||||||
{ $values { "ch" "a character" } { "?" "a boolean" } }
|
{ $class-description "The class of control characters" } ;
|
||||||
{ $description "Determines whether a code point is a control character" } ;
|
|
||||||
|
|
||||||
HELP: digit?
|
HELP: digit
|
||||||
{ $values { "ch" "a character" } { "?" "a boolean" } }
|
{ $class-description "The class of code coints which are digits" } ;
|
||||||
{ $description "Determines whether a code point is a digit" } ;
|
|
||||||
|
|
||||||
HELP: letter?
|
HELP: letter
|
||||||
{ $values { "ch" "a character" } { "?" "a boolean" } }
|
{ $class-description "The class of code points which are lower-cased letters" } ;
|
||||||
{ $description "Determines whether a code point is a lower-cased letter" } ;
|
|
||||||
|
|
||||||
HELP: printable?
|
HELP: printable
|
||||||
{ $values { "ch" "a character" } { "?" "a boolean" } }
|
{ $class-description "The class of characters which are printable, as opposed to being control or formatting characters" } ;
|
||||||
{ $description "Determines whether a code point is printable, as opposed to being a control character or formatting character" } ;
|
|
||||||
|
|
||||||
HELP: uncased?
|
HELP: uncased
|
||||||
{ $values { "ch" "a character" } { "?" "a boolean" } }
|
{ $class-description "The class of letters which don't have a case" } ;
|
||||||
{ $description "Determines whether a character has a case" } ;
|
|
||||||
|
|
||||||
ARTICLE: "unicode.categories" "Character classes"
|
ARTICLE: "unicode.categories" "Character classes"
|
||||||
{ $vocab-link "unicode.categories" } " is a vocabulary which provides predicates for determining if a code point has a particular property, for example being a lower cased letter. These should be used in preference to the " { $vocab-link "ASCII" "ascii" } " equivalents in most cases. Below are links to the useful predicates, but note that each of these is defined to be a predicate class."
|
{ $vocab-link "unicode.categories" } " is a vocabulary which provides predicates for determining if a code point has a particular property, for example being a lower cased letter. These should be used in preference to the " { $vocab-link "ascii" } " equivalents in most cases. Below are links to classes of characters, but note that each of these also has a predicate defined, which is usually more useful."
|
||||||
{ $subsection blank? }
|
{ $subsection blank }
|
||||||
{ $subsection letter? }
|
{ $subsection letter }
|
||||||
{ $subsection LETTER? }
|
{ $subsection LETTER }
|
||||||
{ $subsection Letter? }
|
{ $subsection Letter }
|
||||||
{ $subsection digit? }
|
{ $subsection digit }
|
||||||
{ $subsection printable? }
|
{ $subsection printable }
|
||||||
{ $subsection alpha? }
|
{ $subsection alpha }
|
||||||
{ $subsection control? }
|
{ $subsection control }
|
||||||
{ $subsection uncased? }
|
{ $subsection uncased }
|
||||||
{ $subsection character? } ;
|
{ $subsection character } ;
|
||||||
|
|
||||||
ABOUT: "unicode.categories"
|
ABOUT: "unicode.categories"
|
||||||
|
|
|
||||||
|
|
@ -15,37 +15,37 @@ ARTICLE: "unicode.data" "Unicode data tables"
|
||||||
{ $subsection property? } ;
|
{ $subsection property? } ;
|
||||||
|
|
||||||
HELP: load-script
|
HELP: load-script
|
||||||
{ $value { "filename" string } { "table" "an interval map" } }
|
{ $values { "filename" string } { "table" "an interval map" } }
|
||||||
{ $description "This loads a file that looks like Script.txt in the Unicode Character Database and converts it into an efficient interval map, where the keys are characters and the values are strings for the properties." } ;
|
{ $description "This loads a file that looks like Script.txt in the Unicode Character Database and converts it into an efficient interval map, where the keys are characters and the values are strings for the properties." } ;
|
||||||
|
|
||||||
HELP: canonical-entry
|
HELP: canonical-entry
|
||||||
{ $value { "char" "a code point" } { "seq" string } }
|
{ $values { "char" "a code point" } { "seq" string } }
|
||||||
{ $description "Finds the canonical decomposition (NFD) for a code point" } ;
|
{ $description "Finds the canonical decomposition (NFD) for a code point" } ;
|
||||||
|
|
||||||
HELP: combine-chars
|
HELP: combine-chars
|
||||||
{ $value { "a" "a code point" } { "b" "a code point" } { "char/f" "a code point" } }
|
{ $values { "a" "a code point" } { "b" "a code point" } { "char/f" "a code point" } }
|
||||||
{ $description "If a followed by b can be combined in NFC, this returns the code point of their combination." } ;
|
{ $description "If a followed by b can be combined in NFC, this returns the code point of their combination." } ;
|
||||||
|
|
||||||
HELP: compatibility-entry
|
HELP: compatibility-entry
|
||||||
{ $value { "char" "a code point" } { "seq" string } }
|
{ $values { "char" "a code point" } { "seq" string } }
|
||||||
{ $description "This returns the compatibility decomposition (NFKD) for a code point" } ;
|
{ $description "This returns the compatibility decomposition (NFKD) for a code point" } ;
|
||||||
|
|
||||||
HELP: combining-class
|
HELP: combining-class
|
||||||
{ $value { "char" "a code point" } { "n" "an integer" } }
|
{ $values { "char" "a code point" } { "n" "an integer" } }
|
||||||
{ $description "Finds the combining class of a code point." } ;
|
{ $description "Finds the combining class of a code point." } ;
|
||||||
|
|
||||||
HELP: non-starter?
|
HELP: non-starter?
|
||||||
{ $value { "char" "a code point" } { "?" "a boolean" } }
|
{ $values { "char" "a code point" } { "?" "a boolean" } }
|
||||||
{ $description "Returns true if the code point has a combining class." } ;
|
{ $description "Returns true if the code point has a combining class." } ;
|
||||||
|
|
||||||
HELP: char>name
|
HELP: char>name
|
||||||
{ $value { "char" "a code point" } { "name" string } }
|
{ $values { "char" "a code point" } { "name" string } }
|
||||||
{ $description "Looks up the name of a given code point. Warning: this is not optimized for speed, to save space." } ;
|
{ $description "Looks up the name of a given code point. Warning: this is not optimized for speed, to save space." } ;
|
||||||
|
|
||||||
HELP: name>char
|
HELP: name>char
|
||||||
{ $value { "name" string } { "char" "a code point" } }
|
{ $values { "name" string } { "char" "a code point" } }
|
||||||
{ $description "Looks up the code point corresponding to a given name." } ;
|
{ $description "Looks up the code point corresponding to a given name." } ;
|
||||||
|
|
||||||
HELP: property?
|
HELP: property?
|
||||||
{ $value { "char" "a code point" } { "property" string } { "?" "a boolean" } }
|
{ $values { "char" "a code point" } { "property" string } { "?" "a boolean" } }
|
||||||
{ $description "Tests whether the code point is listed under the given property in PropList.txt in the Unicode Character Database." } ;
|
{ $description "Tests whether the code point is listed under the given property in PropList.txt in the Unicode Character Database." } ;
|
||||||
|
|
|
||||||
|
|
@ -24,8 +24,8 @@ VALUE: properties
|
||||||
: compatibility-entry ( char -- seq ) compatibility-map at ;
|
: compatibility-entry ( char -- seq ) compatibility-map at ;
|
||||||
: combining-class ( char -- n ) class-map at ;
|
: combining-class ( char -- n ) class-map at ;
|
||||||
: non-starter? ( char -- ? ) class-map key? ;
|
: non-starter? ( char -- ? ) class-map key? ;
|
||||||
: name>char ( string -- char ) name-map at ;
|
: name>char ( name -- char ) name-map at ;
|
||||||
: char>name ( char -- string ) name-map value-at ;
|
: char>name ( char -- name ) name-map value-at ;
|
||||||
: property? ( char property -- ? ) properties at interval-key? ;
|
: property? ( char property -- ? ) properties at interval-key? ;
|
||||||
|
|
||||||
! Loading data from UnicodeData.txt
|
! Loading data from UnicodeData.txt
|
||||||
|
|
|
||||||
|
|
@ -23,5 +23,5 @@ HELP: nfkc
|
||||||
{ $description "Converts a string to Normalization Form KC" } ;
|
{ $description "Converts a string to Normalization Form KC" } ;
|
||||||
|
|
||||||
HELP: nfkd
|
HELP: nfkd
|
||||||
{ $values { "string" string } { "nfc" "a string in NFKD" } }
|
{ $values { "string" string } { "nfkd" "a string in NFKD" } }
|
||||||
{ $description "Converts a string to Normalization Form KD" } ;
|
{ $description "Converts a string to Normalization Form KD" } ;
|
||||||
|
|
|
||||||
|
|
@ -201,6 +201,9 @@ SYMBOL: :uses
|
||||||
: fuel-apropos-xref ( str -- )
|
: fuel-apropos-xref ( str -- )
|
||||||
words-matching fuel-format-xrefs fuel-eval-set-result ; inline
|
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
|
! Completion support
|
||||||
|
|
||||||
: fuel-filter-prefix ( seq prefix -- seq )
|
: fuel-filter-prefix ( seq prefix -- seq )
|
||||||
|
|
|
||||||
|
|
@ -70,11 +70,13 @@ beast.
|
||||||
- C-cC-ds : short help word at point
|
- C-cC-ds : short help word at point
|
||||||
- C-cC-de : show stack effect of current sexp (with prefix, region)
|
- 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-dp : find words containing given substring (M-x fuel-apropos)
|
||||||
|
- C-cC-dv : show words in current file (with prefix, ask for vocab)
|
||||||
|
|
||||||
- C-cM-<, C-cC-d< : show callers of word at point
|
- C-cM-<, C-cC-d< : show callers of word at point
|
||||||
- C-cM->, C-cC-d> : show callees 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:
|
*** In the listener:
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -132,37 +132,6 @@ With prefix argument, ask for the file name."
|
||||||
(let ((file (car (fuel-mode--read-file arg))))
|
(let ((file (car (fuel-mode--read-file arg))))
|
||||||
(when file (fuel-debug--uses-for-file file))))
|
(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:
|
;;; 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 ?w 'fuel-edit-word)
|
||||||
(fuel-mode--key ?e ?x 'fuel-eval-definition)
|
(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-callees)
|
||||||
(fuel-mode--key ?d ?< 'fuel-show-callers)
|
(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 ?a 'fuel-autodoc-mode)
|
||||||
(fuel-mode--key ?d ?p 'fuel-apropos)
|
(fuel-mode--key ?d ?p 'fuel-apropos)
|
||||||
(fuel-mode--key ?d ?d 'fuel-help)
|
(fuel-mode--key ?d ?d 'fuel-help)
|
||||||
|
|
|
||||||
|
|
@ -20,23 +20,13 @@
|
||||||
|
|
||||||
;;; Extract word:
|
;;; Extract word:
|
||||||
|
|
||||||
(defun fuel-refactor-extract-word (begin end)
|
(defun fuel-refactor--extract (begin end)
|
||||||
"Extracts current region as a separate word."
|
|
||||||
(interactive "r")
|
|
||||||
(let* ((word (read-string "New word name: "))
|
(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 (buffer-substring begin end))
|
||||||
(code-str (fuel--region-to-string begin end))
|
(code-str (fuel--region-to-string begin end))
|
||||||
(stack-effect (or (fuel-stack--infer-effect code-str)
|
(stack-effect (or (fuel-stack--infer-effect code-str)
|
||||||
(read-string "Stack effect: "))))
|
(read-string "Stack effect: "))))
|
||||||
|
(unless (< begin end) (error "No proper region to extract"))
|
||||||
(goto-char begin)
|
(goto-char begin)
|
||||||
(delete-region begin end)
|
(delete-region begin end)
|
||||||
(insert word)
|
(insert word)
|
||||||
|
|
@ -52,6 +42,29 @@
|
||||||
(sit-for fuel-stack-highlight-period)
|
(sit-for fuel-stack-highlight-period)
|
||||||
(delete-overlay fuel-stack--overlay))))
|
(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)
|
(provide 'fuel-refactor)
|
||||||
;;; fuel-refactor.el ends here
|
;;; fuel-refactor.el ends here
|
||||||
|
|
|
||||||
|
|
@ -312,6 +312,12 @@
|
||||||
(defsubst fuel-syntax--usings ()
|
(defsubst fuel-syntax--usings ()
|
||||||
(funcall fuel-syntax--usings-function))
|
(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)
|
(defun fuel-syntax--find-usings (&optional no-private)
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(let ((usings))
|
(let ((usings))
|
||||||
|
|
@ -319,10 +325,7 @@
|
||||||
(while (re-search-backward fuel-syntax--using-lines-regex nil t)
|
(while (re-search-backward fuel-syntax--using-lines-regex nil t)
|
||||||
(dolist (u (split-string (match-string-no-properties 1) nil t))
|
(dolist (u (split-string (match-string-no-properties 1) nil t))
|
||||||
(push u usings)))
|
(push u usings)))
|
||||||
(goto-char (point-min))
|
(when (and (not no-private) (fuel-syntax--file-has-private))
|
||||||
(when (and (not no-private)
|
|
||||||
(re-search-forward "\\_<<PRIVATE\\_>" nil t)
|
|
||||||
(re-search-forward "\\_<PRIVATE>\\_>" nil t))
|
|
||||||
(goto-char (point-max))
|
(goto-char (point-max))
|
||||||
(push (concat (fuel-syntax--find-in) ".private") usings))
|
(push (concat (fuel-syntax--find-in) ".private") usings))
|
||||||
usings)))
|
usings)))
|
||||||
|
|
|
||||||
|
|
@ -13,6 +13,8 @@
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'fuel-edit)
|
||||||
|
(require 'fuel-completion)
|
||||||
(require 'fuel-help)
|
(require 'fuel-help)
|
||||||
(require 'fuel-eval)
|
(require 'fuel-eval)
|
||||||
(require 'fuel-syntax)
|
(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))
|
((= 1 count) (format "1 word %s %s:" cc word))
|
||||||
(t (format "%s words %s %s:" count 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))
|
(when (and (stringp (first ref))
|
||||||
(stringp (third ref))
|
(stringp (third ref))
|
||||||
(numberp (fourth ref)))
|
(numberp (fourth ref)))
|
||||||
|
|
@ -94,29 +96,28 @@ cursor at the first ocurrence of the used word."
|
||||||
(fourth ref))
|
(fourth ref))
|
||||||
'file (third ref)
|
'file (third ref)
|
||||||
'line (fourth ref))
|
'line (fourth ref))
|
||||||
(when (stringp (second ref))
|
(when (and (not no-vocab) (stringp (second ref)))
|
||||||
(insert (format " (in %s)" (second ref))))
|
(insert (format " (in %s)" (second ref))))
|
||||||
(newline)
|
(newline)
|
||||||
t))
|
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)
|
(let ((inhibit-read-only t)
|
||||||
(count 0))
|
(count 0))
|
||||||
(with-current-buffer (fuel-xref--buffer)
|
(with-current-buffer (fuel-xref--buffer)
|
||||||
|
(let ((start (if app (goto-char (point-max))
|
||||||
(erase-buffer)
|
(erase-buffer)
|
||||||
|
(point-min))))
|
||||||
(dolist (ref refs)
|
(dolist (ref refs)
|
||||||
(when (fuel-xref--insert-ref ref) (setq count (1+ count))))
|
(when (fuel-xref--insert-ref ref no-vocab) (setq count (1+ count))))
|
||||||
(goto-char (point-min))
|
(newline)
|
||||||
(insert (fuel-xref--title word cc count) "\n\n")
|
(goto-char start)
|
||||||
(when (> count 0)
|
(save-excursion
|
||||||
(setq fuel-xref--word (and cc word))
|
(insert (fuel-xref--title word cc count) "\n\n"))
|
||||||
(goto-char (point-max))
|
count))))
|
||||||
(insert "\n" fuel-xref--help-string "\n"))
|
|
||||||
(goto-char (point-min))
|
|
||||||
count)))
|
|
||||||
|
|
||||||
(defun fuel-xref--fill-and-display (word cc refs)
|
(defun fuel-xref--fill-and-display (word cc refs &optional no-vocab)
|
||||||
(let ((count (fuel-xref--fill-buffer word cc refs)))
|
(let ((count (fuel-xref--fill-buffer word cc refs no-vocab)))
|
||||||
(if (zerop count)
|
(if (zerop count)
|
||||||
(error (fuel-xref--title word cc 0))
|
(error (fuel-xref--title word cc 0))
|
||||||
(message "")
|
(message "")
|
||||||
|
|
@ -137,6 +138,65 @@ cursor at the first ocurrence of the used word."
|
||||||
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
|
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
|
||||||
(fuel-xref--fill-and-display str "containing" res)))
|
(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:
|
;;; Xref mode:
|
||||||
|
|
||||||
|
|
@ -159,6 +219,7 @@ cursor at the first ocurrence of the used word."
|
||||||
(kill-all-local-variables)
|
(kill-all-local-variables)
|
||||||
(buffer-disable-undo)
|
(buffer-disable-undo)
|
||||||
(use-local-map fuel-xref-mode-map)
|
(use-local-map fuel-xref-mode-map)
|
||||||
|
(set-syntax-table fuel-syntax--syntax-table)
|
||||||
(setq mode-name "FUEL Xref")
|
(setq mode-name "FUEL Xref")
|
||||||
(setq major-mode 'fuel-xref-mode)
|
(setq major-mode 'fuel-xref-mode)
|
||||||
(font-lock-add-keywords nil '(("(in \\(.+\\))" 1 'fuel-font-lock-xref-vocab)))
|
(font-lock-add-keywords nil '(("(in \\(.+\\))" 1 'fuel-font-lock-xref-vocab)))
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue