diff --git a/basis/bit-arrays/bit-arrays-tests.factor b/basis/bit-arrays/bit-arrays-tests.factor index 24c27fa15b..1de49d353d 100644 --- a/basis/bit-arrays/bit-arrays-tests.factor +++ b/basis/bit-arrays/bit-arrays-tests.factor @@ -78,3 +78,5 @@ IN: bit-arrays.tests } bit-array>integer ] unit-test [ 49 ] [ 49 dup set-bits [ ] count ] unit-test + +[ HEX: 100 ] [ ?{ f f f f f f f f t } bit-array>integer ] unit-test diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor index 18796fbfed..f1ba71ce1e 100644 --- a/basis/bit-arrays/bit-arrays.factor +++ b/basis/bit-arrays/bit-arrays.factor @@ -83,7 +83,7 @@ M: bit-array byte-length length 7 + -3 shift ; ] if ; : bit-array>integer ( bit-array -- n ) - 0 swap underlying>> dup length [ + 0 swap underlying>> dup length [ alien-unsigned-1 swap 8 shift bitor ] with each ; diff --git a/extra/math/primes/authors.txt b/basis/math/primes/authors.txt similarity index 100% rename from extra/math/primes/authors.txt rename to basis/math/primes/authors.txt diff --git a/extra/math/primes/erato/authors.txt b/basis/math/primes/erato/authors.txt similarity index 100% rename from extra/math/primes/erato/authors.txt rename to basis/math/primes/erato/authors.txt diff --git a/extra/math/primes/erato/erato-docs.factor b/basis/math/primes/erato/erato-docs.factor similarity index 100% rename from extra/math/primes/erato/erato-docs.factor rename to basis/math/primes/erato/erato-docs.factor diff --git a/extra/math/primes/erato/erato-tests.factor b/basis/math/primes/erato/erato-tests.factor similarity index 100% rename from extra/math/primes/erato/erato-tests.factor rename to basis/math/primes/erato/erato-tests.factor diff --git a/extra/math/primes/erato/erato.factor b/basis/math/primes/erato/erato.factor similarity index 100% rename from extra/math/primes/erato/erato.factor rename to basis/math/primes/erato/erato.factor diff --git a/extra/math/primes/erato/summary.txt b/basis/math/primes/erato/summary.txt similarity index 100% rename from extra/math/primes/erato/summary.txt rename to basis/math/primes/erato/summary.txt diff --git a/extra/math/primes/factors/authors.txt b/basis/math/primes/factors/authors.txt similarity index 100% rename from extra/math/primes/factors/authors.txt rename to basis/math/primes/factors/authors.txt diff --git a/extra/math/primes/factors/factors-docs.factor b/basis/math/primes/factors/factors-docs.factor similarity index 100% rename from extra/math/primes/factors/factors-docs.factor rename to basis/math/primes/factors/factors-docs.factor diff --git a/extra/math/primes/factors/factors-tests.factor b/basis/math/primes/factors/factors-tests.factor similarity index 100% rename from extra/math/primes/factors/factors-tests.factor rename to basis/math/primes/factors/factors-tests.factor diff --git a/basis/math/primes/factors/factors.factor b/basis/math/primes/factors/factors.factor new file mode 100644 index 0000000000..05d6b26010 --- /dev/null +++ b/basis/math/primes/factors/factors.factor @@ -0,0 +1,29 @@ +! Copyright (C) 2007-2009 Samuel Tardieu. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays combinators kernel make math math.primes sequences ; +IN: math.primes.factors + + + +: group-factors ( n -- seq ) + [ 2 [ over 1 > ] [ write-factor next-prime ] [ ] while 2drop ] { } make ; + +: unique-factors ( n -- seq ) group-factors [ first ] map ; + +: factors ( n -- seq ) group-factors [ first2 swap ] map concat ; + +: totient ( n -- t ) + { + { [ dup 2 < ] [ drop 0 ] } + [ dup unique-factors [ 1 [ 1- * ] reduce ] [ product ] bi / * ] + } cond ; foldable diff --git a/extra/math/primes/factors/summary.txt b/basis/math/primes/factors/summary.txt similarity index 100% rename from extra/math/primes/factors/summary.txt rename to basis/math/primes/factors/summary.txt diff --git a/extra/math/primes/primes-docs.factor b/basis/math/primes/primes-docs.factor similarity index 67% rename from extra/math/primes/primes-docs.factor rename to basis/math/primes/primes-docs.factor index 516b081624..c7dbc950e8 100644 --- a/extra/math/primes/primes-docs.factor +++ b/basis/math/primes/primes-docs.factor @@ -11,15 +11,7 @@ HELP: prime? { $values { "n" "an integer" } { "?" "a boolean" } } { $description "Test if an integer is a prime number." } ; -{ lprimes lprimes-from primes-upto primes-between } related-words - -HELP: lprimes -{ $values { "list" "a lazy list" } } -{ $description "Return a sorted list containing all the prime numbers." } ; - -HELP: lprimes-from -{ $values { "n" "an integer" } { "list" "a lazy list" } } -{ $description "Return a sorted list containing all the prime numbers greater or equal to " { $snippet "n" } "." } ; +{ primes-upto primes-between } related-words HELP: primes-upto { $values { "n" "an integer" } { "seq" "a sequence" } } diff --git a/basis/math/primes/primes-tests.factor b/basis/math/primes/primes-tests.factor new file mode 100644 index 0000000000..db738399ef --- /dev/null +++ b/basis/math/primes/primes-tests.factor @@ -0,0 +1,9 @@ +USING: arrays math.primes tools.test ; + +{ 1237 } [ 1234 next-prime ] unit-test +{ f t } [ 1234 prime? 1237 prime? ] unit-test +{ { 2 3 5 7 } } [ 10 primes-upto >array ] unit-test +{ { 999983 1000003 } } [ 999982 1000010 primes-between >array ] unit-test + +{ { 4999963 4999999 5000011 5000077 5000081 } } +[ 4999962 5000082 primes-between >array ] unit-test diff --git a/extra/math/primes/primes.factor b/basis/math/primes/primes.factor similarity index 69% rename from extra/math/primes/primes.factor rename to basis/math/primes/primes.factor index fa42d7385a..807ebf097b 100644 --- a/extra/math/primes/primes.factor +++ b/basis/math/primes/primes.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2007 Samuel Tardieu. +! Copyright (C) 2007-2009 Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators kernel lists.lazy math math.functions -math.miller-rabin math.order math.primes.erato math.ranges sequences ; +USING: combinators kernel math math.functions math.miller-rabin +math.order math.primes.erato math.ranges sequences ; IN: math.primes : next-prime ( n -- p ) next-odd [ dup really-prime? ] [ 2 + ] [ ] until ; foldable -: lprimes ( -- list ) 2 [ next-prime ] lfrom-by ; - -: lprimes-from ( n -- list ) - dup 3 < [ drop lprimes ] [ 1- next-prime [ next-prime ] lfrom-by ] if ; - : primes-between ( low high -- seq ) [ dup 3 max dup even? [ 1 + ] when ] dip 2 [ prime? ] filter diff --git a/extra/math/primes/summary.txt b/basis/math/primes/summary.txt similarity index 100% rename from extra/math/primes/summary.txt rename to basis/math/primes/summary.txt diff --git a/basis/unicode/case/case-docs.factor b/basis/unicode/case/case-docs.factor index a5790f9a54..86b791ed81 100644 --- a/basis/unicode/case/case-docs.factor +++ b/basis/unicode/case/case-docs.factor @@ -1,4 +1,4 @@ -USING: help.syntax help.markup ; +USING: help.syntax help.markup strings ; IN: unicode.case ABOUT: "unicode.case" @@ -9,6 +9,10 @@ ARTICLE: "unicode.case" "Case mapping" { $subsection >lower } { $subsection >title } { $subsection >case-fold } +"There are analogous routines which operate on individual code points, but these should " { $emphasis "not be used" } " in general as they have slightly different behavior. In some cases, for example, they do not perform the case operation, as a single code point must expand to more than one." +{ $subsection ch>upper } +{ $subsection ch>lower } +{ $subsection ch>title } "To test if a string is in a given case:" { $subsection upper? } { $subsection lower? } @@ -16,4 +20,51 @@ ARTICLE: "unicode.case" "Case mapping" { $subsection case-fold? } "For certain languages (Turkish, Azeri, Lithuanian), case mapping is dependent on locale; To change this, set the following variable to the ISO-639-1 code for your language:" { $subsection locale } -"This is unnecessary for most languages." ; +"This is unnecessary for most locales." ; + +HELP: >upper +{ $values { "string" string } { "upper" string } } +{ $description "Converts a string to upper case." } ; + +HELP: >lower +{ $values { "string" string } { "lower" string } } +{ $description "Converts a string to lower case." } ; + +HELP: >title +{ $values { "string" string } { "title" string } } +{ $description "Converts a string to title case." } ; + +HELP: >case-fold +{ $values { "string" string } { "case-fold" string } } +{ $description "Converts a string to case-folded form." } ; + +HELP: upper? +{ $values { "string" string } { "?" "a boolean" } } +{ $description "Tests if a string is in upper case." } ; + +HELP: lower? +{ $values { "string" string } { "?" "a boolean" } } +{ $description "Tests if a string is in lower case." } ; + +HELP: title? +{ $values { "string" string } { "?" "a boolean" } } +{ $description "Tests if a string is in title case." } ; + +HELP: case-fold? +{ $values { "string" string } { "?" "a boolean" } } +{ $description "Tests if a string is in case-folded form." } ; + +HELP: ch>lower +{ $values { "ch" "a code point" } { "lower" "a code point" } } +{ $description "Converts a code point to lower case." } +{ $warning "Don't use this unless you know what you're doing! " { $code ">lower" } " is not the same as " { $code "[ ch>lower ] map" } "." } ; + +HELP: ch>upper +{ $values { "ch" "a code point" } { "upper" "a code point" } } +{ $description "Converts a code point to upper case." } +{ $warning "Don't use this unless you know what you're doing! " { $code ">upper" } " is not the same as " { $code "[ ch>upper ] map" } "." } ; + +HELP: ch>title +{ $values { "ch" "a code point" } { "title" "a code point" } } +{ $description "Converts a code point to title case." } +{ $warning "Don't use this unless you know what you're doing! " { $code ">title" } " is not the same as " { $code "[ ch>title ] map" } "." } ; diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor index 42fd13fc97..7e61831f36 100644 --- a/basis/unicode/case/case.factor +++ b/basis/unicode/case/case.factor @@ -7,12 +7,14 @@ IN: unicode.case : ch>lower ( ch -- lower ) simple-lower at-default ; : ch>upper ( ch -- upper ) simple-upper at-default ; : ch>title ( ch -- title ) simple-title at-default ; -PRIVATE> + SYMBOL: locale ! Just casing locale, or overall? + char } +{ $subsection char>name } +{ $subsection property? } ; + +HELP: load-script +{ $value { "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." } ; + +HELP: canonical-entry +{ $value { "char" "a code point" } { "seq" string } } +{ $description "Finds the canonical decomposition (NFD) for a code point" } ; + +HELP: combine-chars +{ $value { "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." } ; + +HELP: compatibility-entry +{ $value { "char" "a code point" } { "seq" string } } +{ $description "This returns the compatibility decomposition (NFKD) for a code point" } ; + +HELP: combining-class +{ $value { "char" "a code point" } { "n" "an integer" } } +{ $description "Finds the combining class of a code point." } ; + +HELP: non-starter? +{ $value { "char" "a code point" } { "?" "a boolean" } } +{ $description "Returns true if the code point has a combining class." } ; + +HELP: char>name +{ $value { "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." } ; + +HELP: name>char +{ $value { "name" string } { "char" "a code point" } } +{ $description "Looks up the code point corresponding to a given name." } ; + +HELP: property? +{ $value { "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." } ; 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..f13eb07594 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 ; diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index bac4048706..7a53ff5172 100644 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -691,11 +691,10 @@ HELP: assert= { $values { "a" object } { "b" object } } { $description "Throws an " { $link assert } " error if " { $snippet "a" } " does not equal " { $snippet "b" } "." } ; - ARTICLE: "shuffle-words" "Shuffle words" "Shuffle words rearrange items at the top of the data stack. They control the flow of data between words that perform actions." $nl -"The " { $link "cleave-combinators" } " and " { $link "spread-combinators" } " are closely related to shuffle words and should be used instead where possible because they can result in clearer code; also, see the advice in " { $link "cookbook-philosophy" } "." +"The " { $link "cleave-combinators" } ", " { $link "spread-combinators" } " and " { $link "apply-combinators" } " are closely related to shuffle words and should be used instead where possible because they can result in clearer code; also, see the advice in " { $link "cookbook-philosophy" } "." $nl "Removing stack elements:" { $subsection drop } diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index 60420b3c39..becbf2161a 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -269,7 +269,7 @@ MEMO: fuel-article-title ( name -- title/f ) help-path [ dup article-title swap 2array ] map ; inline : (fuel-word-help) ( word -- element ) - dup \ article swap article-title rot + \ article swap dup article-title swap [ { [ fuel-parent-topics [ \ $doc-path prefix , ] unless-empty ] diff --git a/extra/math/primes/factors/factors.factor b/extra/math/primes/factors/factors.factor deleted file mode 100644 index 282c46c82e..0000000000 --- a/extra/math/primes/factors/factors.factor +++ /dev/null @@ -1,40 +0,0 @@ -! Copyright (C) 2007-2009 Samuel Tardieu. -! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel lists make math math.primes sequences ; -IN: math.primes.factors - - [ - swap uncons swap [ pick call ] dip swap (factors) - ] [ 3drop ] if ; inline recursive - -: decompose ( n quot -- seq ) [ lprimes rot (factors) ] { } make ; inline - -PRIVATE> - -: factors ( n -- seq ) [ (factor) ] decompose ; flushable - -: group-factors ( n -- seq ) [ (count) ] decompose ; flushable - -: unique-factors ( n -- seq ) [ (unique) ] decompose ; flushable - -: totient ( n -- t ) - dup 2 < [ - drop 0 - ] [ - dup unique-factors [ 1 [ 1- * ] reduce ] [ product ] bi / * - ] if ; foldable diff --git a/extra/math/primes/lists/authors.txt b/extra/math/primes/lists/authors.txt new file mode 100644 index 0000000000..f3b0233f74 --- /dev/null +++ b/extra/math/primes/lists/authors.txt @@ -0,0 +1 @@ +Samuel Tardieu diff --git a/extra/math/primes/lists/lists-docs.factor b/extra/math/primes/lists/lists-docs.factor new file mode 100644 index 0000000000..ecab12ceb7 --- /dev/null +++ b/extra/math/primes/lists/lists-docs.factor @@ -0,0 +1,10 @@ +USING: help.markup help.syntax ; +IN: math.primes.lists + +HELP: lprimes +{ $values { "list" "a lazy list" } } +{ $description "Return a sorted list containing all the prime numbers." } ; + +HELP: lprimes-from +{ $values { "n" "an integer" } { "list" "a lazy list" } } +{ $description "Return a sorted list containing all the prime numbers greater or equal to " { $snippet "n" } "." } ; diff --git a/extra/math/primes/lists/lists-tests.factor b/extra/math/primes/lists/lists-tests.factor new file mode 100644 index 0000000000..3bd7d70365 --- /dev/null +++ b/extra/math/primes/lists/lists-tests.factor @@ -0,0 +1,6 @@ +USING: lists.lazy math.primes.lists tools.test ; + +{ { 2 3 5 7 11 13 17 19 23 29 } } [ 10 lprimes ltake list>array ] unit-test +{ { 101 103 107 109 113 } } [ 5 100 lprimes-from ltake list>array ] unit-test +{ { 1000117 1000121 } } [ 2 1000100 lprimes-from ltake list>array ] unit-test +{ { 999983 1000003 } } [ 2 999982 lprimes-from ltake list>array ] unit-test diff --git a/extra/math/primes/lists/lists.factor b/extra/math/primes/lists/lists.factor new file mode 100644 index 0000000000..13f314f6ba --- /dev/null +++ b/extra/math/primes/lists/lists.factor @@ -0,0 +1,9 @@ +! Copyright (C) 2007-2009 Samuel Tardieu. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel lists.lazy math math.primes ; +IN: math.primes.lists + +: lprimes ( -- list ) 2 [ next-prime ] lfrom-by ; + +: lprimes-from ( n -- list ) + dup 3 < [ drop lprimes ] [ 1- next-prime [ next-prime ] lfrom-by ] if ; diff --git a/extra/math/primes/lists/summary.txt b/extra/math/primes/lists/summary.txt new file mode 100644 index 0000000000..39a780a26b --- /dev/null +++ b/extra/math/primes/lists/summary.txt @@ -0,0 +1 @@ +Infinite stream of prime numbers through lazy lists diff --git a/extra/math/primes/primes-tests.factor b/extra/math/primes/primes-tests.factor deleted file mode 100644 index b0b25285c0..0000000000 --- a/extra/math/primes/primes-tests.factor +++ /dev/null @@ -1,14 +0,0 @@ -USING: arrays math.primes tools.test lists.lazy ; - -{ 1237 } [ 1234 next-prime ] unit-test -{ f t } [ 1234 prime? 1237 prime? ] unit-test -{ { 2 3 5 7 11 13 17 19 23 29 } } [ 10 lprimes ltake list>array ] unit-test -{ { 101 103 107 109 113 } } [ 5 100 lprimes-from ltake list>array ] unit-test -{ { 1000117 1000121 } } [ 2 1000100 lprimes-from ltake list>array ] unit-test -{ { 999983 1000003 } } [ 2 999982 lprimes-from ltake list>array ] unit-test -{ { 2 3 5 7 } } [ 10 primes-upto >array ] unit-test -{ { 999983 1000003 } } [ 999982 1000010 primes-between >array ] unit-test - -{ { 4999963 4999999 5000011 5000077 5000081 } } -[ 4999962 5000082 primes-between >array ] -unit-test diff --git a/extra/project-euler/007/007.factor b/extra/project-euler/007/007.factor index f2b659fe94..f40108e4d7 100644 --- a/extra/project-euler/007/007.factor +++ b/extra/project-euler/007/007.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: lists math math.primes ; +USING: lists math math.primes.lists ; IN: project-euler.007 ! http://projecteuler.net/index.php?section=problems&id=7 diff --git a/extra/project-euler/134/134.factor b/extra/project-euler/134/134.factor index 7bdf17ef68..e00e86865d 100644 --- a/extra/project-euler/134/134.factor +++ b/extra/project-euler/134/134.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2007 Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel lists lists.lazy math.algebra math math.functions - math.order math.primes math.ranges project-euler.common sequences ; + math.order math.primes.lists math.ranges project-euler.common sequences ; IN: project-euler.134 ! http://projecteuler.net/index.php?section=problems&id=134 diff --git a/misc/fuel/README b/misc/fuel/README index 14a9ca8b5d..f5d366a22e 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -74,6 +74,8 @@ beast. - 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 + *** In the listener: - TAB : complete word at point diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index 651cc323d0..c1abcf414b 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -21,6 +21,7 @@ (require 'fuel-eval) (require 'fuel-help) (require 'fuel-xref) +(require 'fuel-refactor) (require 'fuel-stack) (require 'fuel-autodoc) (require 'fuel-font-lock) @@ -224,6 +225,8 @@ 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 ?d ?> 'fuel-show-callees) (fuel-mode--key ?d ?< 'fuel-show-callers) (fuel-mode--key ?d ?a 'fuel-autodoc-mode) diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el new file mode 100644 index 0000000000..547da19552 --- /dev/null +++ b/misc/fuel/fuel-refactor.el @@ -0,0 +1,57 @@ +;;; fuel-refactor.el -- code refactoring support + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Thu Jan 08, 2009 00:57 + +;;; Comentary: + +;; Utilities performing refactoring on factor code. + +;;; Code: + +(require 'fuel-stack) +(require 'fuel-syntax) +(require 'fuel-base) + + +;;; Extract word: + +(defun fuel-refactor-extract-word (begin end) + "Extracts current region as a separate word." + (interactive "r") + (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: ")))) + (goto-char begin) + (delete-region begin end) + (insert word) + (indent-region begin (point)) + (set-mark (point)) + (fuel-syntax--beginning-of-defun) + (open-line 1) + (let ((start (point))) + (insert ": " word " " stack-effect "\n" code " ;\n") + (indent-region start (point)) + (move-overlay fuel-stack--overlay start (point)) + (goto-char (mark)) + (sit-for fuel-stack-highlight-period) + (delete-overlay fuel-stack--overlay)))) + + +(provide 'fuel-refactor) +;;; fuel-refactor.el ends here