Merge commit 'origin/master'
Jose A. Ortega Ruiz
commit
034c8f6cb3
|
|
@ -85,13 +85,13 @@ IN: formatting.tests
|
|||
|
||||
[ t ] [ "12:03:15" testtime "%H:%M:%S" strftime = ] unit-test
|
||||
[ t ] [ "12:03:15" testtime "%X" strftime = ] unit-test
|
||||
|
||||
[ t ] [ "10/09/2008" testtime "%m/%d/%Y" strftime = ] unit-test
|
||||
[ t ] [ "10/09/2008" testtime "%x" strftime = ] unit-test
|
||||
|
||||
[ t ] [ "10/09/08" testtime "%m/%d/%y" strftime = ] unit-test
|
||||
[ t ] [ "Thu" testtime "%a" strftime = ] unit-test
|
||||
[ t ] [ "Thursday" testtime "%A" strftime = ] unit-test
|
||||
|
||||
[ t ] [ "Oct" testtime "%b" strftime = ] unit-test
|
||||
[ t ] [ "October" testtime "%B" strftime = ] unit-test
|
||||
[ t ] [ "Thu Oct 09 12:03:15 2008" testtime "%c" strftime = ] unit-test
|
||||
[ t ] [ "PM" testtime "%p" strftime = ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: accessors arrays ascii calendar combinators fry kernel
|
||||
io io.encodings.ascii io.files io.streams.string
|
||||
generalizations io io.encodings.ascii io.files io.streams.string
|
||||
macros math math.functions math.parser peg.ebnf quotations
|
||||
sequences splitting strings unicode.case vectors ;
|
||||
|
||||
|
|
@ -32,10 +32,7 @@ IN: formatting
|
|||
[ "." split1 ] dip [ CHAR: 0 pad-right ] [ head-slice ] bi "." glue ;
|
||||
|
||||
: max-digits ( n digits -- n' )
|
||||
10 swap ^ [ * round ] keep / ;
|
||||
|
||||
: max-width ( string length -- string' )
|
||||
short head ;
|
||||
10 swap ^ [ * round ] keep / ; inline
|
||||
|
||||
: >exp ( x -- exp base )
|
||||
[
|
||||
|
|
@ -69,7 +66,7 @@ pad = pad-align pad-char pad-width => [[ reverse >quotation dup first 0 =
|
|||
|
||||
sign = ("+")? => [[ [ dup CHAR: - swap index [ "+" prepend ] unless ] [ ] ? ]]
|
||||
|
||||
width_ = "." ([0-9])* => [[ second >digits '[ _ max-width ] ]]
|
||||
width_ = "." ([0-9])* => [[ second >digits '[ _ short head ] ]]
|
||||
width = (width_)? => [[ [ ] or ]]
|
||||
|
||||
digits_ = "." ([0-9])* => [[ second >digits ]]
|
||||
|
|
@ -113,23 +110,25 @@ MACRO: printf ( format-string -- )
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: zero-pad ( str -- str' ) 2 CHAR: 0 pad-left ; inline
|
||||
: pad-00 ( n -- string ) number>string 2 CHAR: 0 pad-left ; inline
|
||||
|
||||
: pad-000 ( n -- string ) number>string 3 CHAR: 0 pad-left ; inline
|
||||
|
||||
: >time ( timestamp -- string )
|
||||
[ hour>> ] [ minute>> ] [ second>> floor ] tri 3array
|
||||
[ number>string zero-pad ] map ":" join ; inline
|
||||
[ pad-00 ] map ":" join ; inline
|
||||
|
||||
: >date ( timestamp -- string )
|
||||
[ month>> ] [ day>> ] [ year>> ] tri 3array
|
||||
[ number>string zero-pad ] map "/" join ; inline
|
||||
[ pad-00 ] map "/" join ; inline
|
||||
|
||||
: >datetime ( timestamp -- string )
|
||||
{ [ day-of-week day-abbreviation3 ]
|
||||
[ month>> month-abbreviation ]
|
||||
[ day>> number>string zero-pad ]
|
||||
[ day>> pad-00 ]
|
||||
[ >time ]
|
||||
[ year>> number>string ]
|
||||
} cleave 3array [ 2array ] dip append " " join ; inline
|
||||
} cleave 5 narray " " join ; inline
|
||||
|
||||
: (week-of-year) ( timestamp day -- n )
|
||||
[ dup clone 1 >>month 1 >>day day-of-week dup ] dip > [ 7 swap - ] when
|
||||
|
|
@ -147,20 +146,20 @@ fmt-A = "A" => [[ [ dup day-of-week day-name ] ]]
|
|||
fmt-b = "b" => [[ [ dup month>> month-abbreviation ] ]]
|
||||
fmt-B = "B" => [[ [ dup month>> month-name ] ]]
|
||||
fmt-c = "c" => [[ [ dup >datetime ] ]]
|
||||
fmt-d = "d" => [[ [ dup day>> number>string zero-pad ] ]]
|
||||
fmt-H = "H" => [[ [ dup hour>> number>string zero-pad ] ]]
|
||||
fmt-I = "I" => [[ [ dup hour>> dup 12 > [ 12 - ] when number>string zero-pad ] ]]
|
||||
fmt-j = "j" => [[ [ dup day-of-year number>string ] ]]
|
||||
fmt-m = "m" => [[ [ dup month>> number>string zero-pad ] ]]
|
||||
fmt-M = "M" => [[ [ dup minute>> number>string zero-pad ] ]]
|
||||
fmt-d = "d" => [[ [ dup day>> pad-00 ] ]]
|
||||
fmt-H = "H" => [[ [ dup hour>> pad-00 ] ]]
|
||||
fmt-I = "I" => [[ [ dup hour>> dup 12 > [ 12 - ] when pad-00 ] ]]
|
||||
fmt-j = "j" => [[ [ dup day-of-year pad-000 ] ]]
|
||||
fmt-m = "m" => [[ [ dup month>> pad-00 ] ]]
|
||||
fmt-M = "M" => [[ [ dup minute>> pad-00 ] ]]
|
||||
fmt-p = "p" => [[ [ dup hour>> 12 < "AM" "PM" ? ] ]]
|
||||
fmt-S = "S" => [[ [ dup second>> round number>string zero-pad ] ]]
|
||||
fmt-U = "U" => [[ [ dup week-of-year-sunday ] ]]
|
||||
fmt-S = "S" => [[ [ dup second>> floor pad-00 ] ]]
|
||||
fmt-U = "U" => [[ [ dup week-of-year-sunday pad-00 ] ]]
|
||||
fmt-w = "w" => [[ [ dup day-of-week number>string ] ]]
|
||||
fmt-W = "W" => [[ [ dup week-of-year-monday ] ]]
|
||||
fmt-W = "W" => [[ [ dup week-of-year-monday pad-00 ] ]]
|
||||
fmt-x = "x" => [[ [ dup >date ] ]]
|
||||
fmt-X = "X" => [[ [ dup >time ] ]]
|
||||
fmt-y = "y" => [[ [ dup year>> 100 mod number>string ] ]]
|
||||
fmt-y = "y" => [[ [ dup year>> 100 mod pad-00 ] ]]
|
||||
fmt-Y = "Y" => [[ [ dup year>> number>string ] ]]
|
||||
fmt-Z = "Z" => [[ [ "Not yet implemented" throw ] ]]
|
||||
unknown = (.)* => [[ "Unknown directive" throw ]]
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
USING: io.directories io.files.links tools.test sequences
|
||||
io.files.unique tools.files fry math kernel math.parser
|
||||
io.pathnames namespaces ;
|
||||
IN: io.files.links.tests
|
||||
IN: io.files.links.unix.tests
|
||||
|
||||
: make-test-links ( n path -- )
|
||||
[ '[ [ 1+ ] keep [ number>string _ prepend ] bi@ make-link ] each ]
|
||||
|
|
@ -13,7 +13,7 @@ HELP: parse-log
|
|||
} ;
|
||||
|
||||
ARTICLE: "logging.parser" "Log file parser"
|
||||
"The " { $vocab-link "logging.parser" } " vocabulary parses log files output by the " { $vocab-link "logging" } " vocabulary. It is used by " { $link "logging.analysis" } " and " { $link "logging.insomniac" } " to analyze logs."
|
||||
"The " { $vocab-link "logging.parser" } " vocabulary parses log files output by the " { $vocab-link "logging" } " vocabulary. It is used by " { $link "logging.analysis" } " and " { $vocab-link "logging.insomniac" } " to analyze logs."
|
||||
$nl
|
||||
"There is only one primary entry point:"
|
||||
{ $subsection parse-log } ;
|
||||
|
|
|
|||
|
|
@ -2,14 +2,18 @@ USING: tools.profiler.private tools.time help.markup help.syntax
|
|||
quotations io strings words definitions ;
|
||||
IN: tools.profiler
|
||||
|
||||
ARTICLE: "profiling" "Profiling code"
|
||||
"The " { $vocab-link "tools.profiler" } " vocabulary implements a simple call counting profiler. The profiler is completely accurate with words and methods which are compiled with the non-optimizing compiler. Some optimizations performed by the optimizing compiler can inhibit accurate call counting, however:"
|
||||
ARTICLE: "profiler-limitations" "Profiler limitations"
|
||||
"Certain optimizations performed by the compiler can inhibit accurate call counting:"
|
||||
{ $list
|
||||
"The optimizing compiler open-codes certain primitives with inline machine code, and in some cases optimizes them out altogether; this includes stack shuffling operations, conditionals, and many object allocation operations."
|
||||
{ "Calls to " { $link POSTPONE: inline } " words are not counted.." }
|
||||
"Calls to open-coded intrinsics are not counted. Certain words are open-coded as inline machine code, and in some cases optimized out altogether; this includes stack shuffling operations, conditionals, and many object allocation operations."
|
||||
{ "Calls to " { $link POSTPONE: inline } " words are not counted." }
|
||||
{ "Calls to methods which were inlined as a result of type inference are not counted." }
|
||||
"Tail-recursive loops will only count the initial invocation of the word, not every tail call."
|
||||
}
|
||||
} ;
|
||||
|
||||
ARTICLE: "profiling" "Profiling code"
|
||||
"The " { $vocab-link "tools.profiler" } " vocabulary implements a simple call counting profiler."
|
||||
$nl
|
||||
"Quotations can be passed to a combinator which calls them with the profiler enabled:"
|
||||
{ $subsection profile }
|
||||
"After a quotation has been profiled, call counts can be presented in various ways:"
|
||||
|
|
@ -17,7 +21,9 @@ ARTICLE: "profiling" "Profiling code"
|
|||
{ $subsection vocab-profile. }
|
||||
{ $subsection usage-profile. }
|
||||
{ $subsection vocabs-profile. }
|
||||
{ $subsection method-profile. } ;
|
||||
{ $subsection method-profile. }
|
||||
{ $subsection "profiler-limitations" }
|
||||
{ $see-also "ui-profiler" } ;
|
||||
|
||||
ABOUT: "profiling"
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
John Benediktsson
|
||||
|
|
@ -0,0 +1 @@
|
|||
Generates UUID's.
|
||||
|
|
@ -0,0 +1,45 @@
|
|||
|
||||
USING: help.syntax help.markup kernel prettyprint sequences strings ;
|
||||
|
||||
IN: uuid
|
||||
|
||||
HELP: uuid1
|
||||
{ $description
|
||||
"Generates a UUID (version 1) from the host ID, sequence number, "
|
||||
"and current time."
|
||||
} ;
|
||||
|
||||
HELP: uuid3
|
||||
{ $description
|
||||
"Generates a UUID (version 3) from the MD5 hash of a namespace "
|
||||
"UUID and a name."
|
||||
} ;
|
||||
|
||||
HELP: uuid4
|
||||
{ $description
|
||||
"Generates a UUID (version 4) from random bits."
|
||||
} ;
|
||||
|
||||
HELP: uuid5
|
||||
{ $description
|
||||
"Generates a UUID (version 5) from the SHA-1 hash of a namespace "
|
||||
"UUID and a name."
|
||||
} ;
|
||||
|
||||
|
||||
ARTICLE: "uuid" "UUID (Universally Unique Identifier)"
|
||||
"The " { $vocab-link "uuid" } " vocabulary is used to generate UUID's. "
|
||||
"The words uuid1, uuid3, uuid4, uuid5 can be used to generate version "
|
||||
"1, 3, 4, and 5 UUIDs as specified in RFC 4122.\n"
|
||||
"\n"
|
||||
"If all you want is a unique ID, you should probably call uuid1 or uuid4."
|
||||
"\n"
|
||||
{ $subsection uuid1 }
|
||||
{ $subsection uuid3 }
|
||||
{ $subsection uuid4 }
|
||||
{ $subsection uuid5 }
|
||||
;
|
||||
|
||||
ABOUT: "uuid"
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
! Copyright (C) 2008 John Benediktsson
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: kernel uuid tools.test ;
|
||||
|
||||
IN: uuid.tests
|
||||
|
||||
[ t ] [ NAMESPACE_DNS [ uuid-parse uuid-unparse ] keep = ] unit-test
|
||||
[ t ] [ NAMESPACE_URL [ uuid-parse uuid-unparse ] keep = ] unit-test
|
||||
[ t ] [ NAMESPACE_OID [ uuid-parse uuid-unparse ] keep = ] unit-test
|
||||
[ t ] [ NAMESPACE_X500 [ uuid-parse uuid-unparse ] keep = ] unit-test
|
||||
|
||||
[ t ] [ NAMESPACE_URL "ABCD" uuid3
|
||||
"2e10e403-d7fa-3ffb-808f-ab834a46890e" = ] unit-test
|
||||
|
||||
[ t ] [ NAMESPACE_URL "ABCD" uuid5
|
||||
"0aa883d6-7953-57e7-a8f0-66db29ce5a91" = ] unit-test
|
||||
|
||||
|
|
@ -0,0 +1,94 @@
|
|||
! Copyright (C) 2008 John Benediktsson
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: byte-arrays checksums checksums.md5 checksums.sha1
|
||||
kernel math math.parser math.ranges random unicode.case
|
||||
sequences strings system ;
|
||||
|
||||
IN: uuid
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: (timestamp) ( -- time_high time_mid time_low )
|
||||
! 0x01b21dd213814000L is the number of 100-ns intervals
|
||||
! between the UUID epoch 1582-10-15 00:00:00 and the
|
||||
! Unix epoch 1970-01-01 00:00:00.
|
||||
micros 10 * HEX: 01b21dd213814000 +
|
||||
[ -48 shift HEX: 0fff bitand ]
|
||||
[ -32 shift HEX: ffff bitand ]
|
||||
[ HEX: ffffffff bitand ] tri ;
|
||||
|
||||
: (hardware) ( -- address )
|
||||
! Choose a random 48-bit number with eighth bit
|
||||
! set to 1 (as recommended in RFC 4122)
|
||||
48 random-bits HEX: 010000000000 bitor ;
|
||||
|
||||
: (clock) ( -- clockseq )
|
||||
! Choose a random 14-bit number
|
||||
14 random-bits ;
|
||||
|
||||
: <uuid> ( address clockseq time_high time_mid time_low -- n )
|
||||
96 shift
|
||||
[ 80 shift ] dip bitor
|
||||
[ 64 shift ] dip bitor
|
||||
[ 48 shift ] dip bitor
|
||||
bitor ;
|
||||
|
||||
: (version) ( n version -- n' )
|
||||
[ HEX: c000 48 shift bitnot bitand
|
||||
HEX: 8000 48 shift bitor
|
||||
HEX: f000 64 shift bitnot bitand
|
||||
] dip 76 shift bitor ;
|
||||
|
||||
: uuid>string ( n -- string )
|
||||
>hex 32 CHAR: 0 pad-left
|
||||
[ CHAR: - 20 ] dip insert-nth
|
||||
[ CHAR: - 16 ] dip insert-nth
|
||||
[ CHAR: - 12 ] dip insert-nth
|
||||
[ CHAR: - 8 ] dip insert-nth ;
|
||||
|
||||
: string>uuid ( string -- n )
|
||||
[ CHAR: - = not ] filter 16 base> ;
|
||||
|
||||
: uuid>byte-array ( n -- byte-array )
|
||||
16 <byte-array> 15 -1 [a,b) [
|
||||
[ dup HEX: ff bitand ] 2dip swap
|
||||
[ set-nth -8 shift ] keep
|
||||
] each nip ;
|
||||
|
||||
: byte-array>uuid ( byte-array -- n )
|
||||
0 swap [ [ 8 shift ] dip + ] each ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: uuid-parse ( string -- byte-array )
|
||||
string>uuid uuid>byte-array ;
|
||||
|
||||
: uuid-unparse ( byte-array -- string )
|
||||
byte-array>uuid uuid>string ;
|
||||
|
||||
: uuid1 ( -- string )
|
||||
(hardware) (clock) (timestamp) <uuid>
|
||||
1 (version) uuid>string ;
|
||||
|
||||
: uuid3 ( namespace name -- string )
|
||||
[ uuid-parse ] dip >byte-array append
|
||||
md5 checksum-bytes 16 short head byte-array>uuid
|
||||
3 (version) uuid>string ;
|
||||
|
||||
: uuid4 ( -- string )
|
||||
128 random-bits
|
||||
4 (version) uuid>string ;
|
||||
|
||||
: uuid5 ( namespace name -- string )
|
||||
[ uuid-parse ] dip >byte-array append
|
||||
sha1 checksum-bytes 16 short head byte-array>uuid
|
||||
5 (version) uuid>string ;
|
||||
|
||||
|
||||
: NAMESPACE_DNS "6ba7b810-9dad-11d1-80b4-00c04fd430c8" ; inline
|
||||
: NAMESPACE_URL "6ba7b811-9dad-11d1-80b4-00c04fd430c8" ; inline
|
||||
: NAMESPACE_OID "6ba7b812-9dad-11d1-80b4-00c04fd430c8" ; inline
|
||||
: NAMESPACE_X500 "6ba7b814-9dad-11d1-80b4-00c04fd430c8" ; inline
|
||||
|
||||
|
||||
|
|
@ -3,18 +3,20 @@ USING: help.markup help.syntax vocabs.loader words io
|
|||
quotations words.symbol ;
|
||||
|
||||
ARTICLE: "compiler-errors" "Compiler warnings and errors"
|
||||
"The compiler saves various notifications in a global variable:"
|
||||
"The compiler saves " { $link "inference-errors" } " in a global variable:"
|
||||
{ $subsection compiler-errors }
|
||||
"These notifications can be viewed later:"
|
||||
{ $subsection :errors }
|
||||
{ $subsection :warnings }
|
||||
{ $subsection :linkage }
|
||||
"Words such as " { $link require } " use a combinator which counts errors and prints a report at the end:"
|
||||
{ $link with-compiler-errors } ;
|
||||
{ $subsection with-compiler-errors } ;
|
||||
|
||||
HELP: compiler-errors
|
||||
{ $var-description "Global variable holding an assoc mapping words to compiler errors. This variable is set by " { $link with-compiler-errors } "." } ;
|
||||
|
||||
ABOUT: "compiler-errors"
|
||||
|
||||
HELP: compiler-error
|
||||
{ $values { "error" "an error" } { "word" word } }
|
||||
{ $description "If inside a " { $link with-compiler-errors } ", saves the error for future persual via " { $link :errors } ", " { $link :warnings } " and " { $link :linkage } ". If not inside a " { $link with-compiler-errors } ", ignores the error." } ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
USING: arrays byte-arrays kernel kernel.private math memory
|
||||
namespaces sequences tools.test math.private quotations
|
||||
continuations prettyprint io.streams.string debugger assocs
|
||||
sequences.private accessors ;
|
||||
sequences.private accessors locals.backend ;
|
||||
IN: kernel.tests
|
||||
|
||||
[ 0 ] [ f size ] unit-test
|
||||
|
|
@ -35,7 +35,7 @@ IN: kernel.tests
|
|||
|
||||
[ ] [ [ :c ] with-string-writer drop ] unit-test
|
||||
|
||||
: overflow-r 3 [ overflow-r ] dip ;
|
||||
: overflow-r 3 load-local overflow-r ;
|
||||
|
||||
[ overflow-r ] [ { "kernel-error" 14 f f } = ] must-fail-with
|
||||
|
||||
|
|
|
|||
|
|
@ -122,8 +122,8 @@ M: source-file fuel-pprint path>> fuel-pprint ;
|
|||
fuel-forget-result
|
||||
fuel-forget-output ;
|
||||
|
||||
: (fuel-end-eval) ( quot -- )
|
||||
with-string-writer fuel-eval-output set-global fuel-retort
|
||||
: (fuel-end-eval) ( result -- )
|
||||
fuel-eval-output set-global fuel-retort
|
||||
pop-fuel-status ; inline
|
||||
|
||||
: (fuel-eval) ( lines -- )
|
||||
|
|
@ -141,39 +141,29 @@ M: source-file fuel-pprint path>> fuel-pprint ;
|
|||
[ dup "IN: " prepend 1vector (fuel-eval) in set ] when* ; inline
|
||||
|
||||
: fuel-eval-in-context ( lines in usings -- )
|
||||
(fuel-begin-eval) [
|
||||
(fuel-eval-usings)
|
||||
(fuel-eval-in)
|
||||
(fuel-eval)
|
||||
] (fuel-end-eval) ;
|
||||
|
||||
: fuel-begin-eval ( in -- )
|
||||
(fuel-begin-eval)
|
||||
(fuel-eval-in)
|
||||
fuel-retort ;
|
||||
|
||||
: fuel-eval ( lines -- )
|
||||
(fuel-begin-eval) [ (fuel-eval) ] (fuel-end-eval) ; inline
|
||||
|
||||
: fuel-end-eval ( -- ) [ ] (fuel-end-eval) ; inline
|
||||
[ (fuel-eval-usings) (fuel-eval-in) (fuel-eval) ] with-string-writer
|
||||
(fuel-end-eval) ;
|
||||
|
||||
: fuel-run-file ( path -- ) run-file ; inline
|
||||
|
||||
! Edit locations
|
||||
|
||||
: fuel-get-edit-location ( defspec -- )
|
||||
where [
|
||||
first2 [ (normalize-path) ] dip 2array fuel-eval-set-result
|
||||
] when* ; inline
|
||||
: fuel-normalize-loc ( seq -- path line )
|
||||
dup length 1 > [ first2 [ (normalize-path) ] dip ] [ f ] if ; inline
|
||||
|
||||
: fuel-xref-desc ( word -- str )
|
||||
[ name>> ]
|
||||
[ vocabulary>> [ " (" prepend ")" append ] [ "" ] if* ] bi append ; inline
|
||||
: fuel-get-edit-location ( defspec -- )
|
||||
where fuel-normalize-loc 2array fuel-eval-set-result ; inline
|
||||
|
||||
: fuel-get-doc-location ( defspec -- )
|
||||
props>> "help-loc" swap at
|
||||
fuel-normalize-loc 2array fuel-eval-set-result ;
|
||||
|
||||
: fuel-format-xrefs ( seq -- seq )
|
||||
[ word? ] filter [
|
||||
[ fuel-xref-desc ]
|
||||
[ where [ first2 [ (normalize-path) ] dip ] [ f f ] if* ] bi 3array
|
||||
[ name>> ]
|
||||
[ vocabulary>> ]
|
||||
[ where fuel-normalize-loc ] tri 4array
|
||||
] map [ [ first ] dip first <=> ] sort ; inline
|
||||
|
||||
: fuel-callers-xref ( word -- )
|
||||
|
|
|
|||
|
|
@ -203,7 +203,7 @@ IN: google-tech-talk
|
|||
{ $code "13 <circle> tell-me" }
|
||||
{ $code "103 76 <rectangle> tell-me" }
|
||||
{ $code "101 tell-me" }
|
||||
{ { $link integer } ", " { $link array } ", and others area built-in classes" }
|
||||
{ { $link integer } ", " { $link array } ", and others are built-in classes" }
|
||||
}
|
||||
{ $slide "Object system"
|
||||
"Anyone can define new shapes..."
|
||||
|
|
|
|||
|
|
@ -58,7 +58,8 @@ C-cC-eC-r is the same as C-cC-er)).
|
|||
- M-. : edit word at point in Emacs
|
||||
- M-TAB : complete word at point
|
||||
- C-cC-ev : edit vocabulary (M-x fuel-edit-vocabulary)
|
||||
- C-cC-ew : edit word (M-x fuel-edit-word)
|
||||
- C-cC-ew : edit word (M-x fuel-edit-word-at-point)
|
||||
- C-cC-ed : edit word's doc (M-x fuel-edit-word-at-point)
|
||||
|
||||
- C-cr, C-cC-er : eval region
|
||||
- C-M-r, C-cC-ee : eval region, extending it to definition boundaries
|
||||
|
|
@ -78,6 +79,7 @@ C-cC-eC-r is the same as C-cC-er)).
|
|||
- TAB : complete word at point
|
||||
- M-. : edit word at point in Emacs
|
||||
- C-ca : toggle autodoc mode
|
||||
- C-cs : toggle stack mode
|
||||
- C-cv : edit vocabulary
|
||||
- C-ch : help for word at point
|
||||
- C-ck : run file
|
||||
|
|
@ -98,3 +100,8 @@ C-cC-eC-r is the same as C-cC-er)).
|
|||
- C-cz : switch to listener
|
||||
- q : bury buffer
|
||||
|
||||
* In crossref buffers
|
||||
|
||||
- TAB/BACKTAB : navigate links
|
||||
- RET/mouse click : follow link
|
||||
- q : bury buffer
|
||||
|
|
|
|||
|
|
@ -24,8 +24,9 @@
|
|||
;;; Customization:
|
||||
|
||||
(defgroup factor-mode nil
|
||||
"Major mode for Factor source code"
|
||||
:group 'fuel)
|
||||
"Major mode for Factor source code."
|
||||
:group 'fuel
|
||||
:group 'languages)
|
||||
|
||||
(defcustom factor-mode-use-fuel t
|
||||
"Whether to use the full FUEL facilities in factor mode.
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@
|
|||
;;; Customization:
|
||||
|
||||
(defgroup fuel-autodoc nil
|
||||
"Options controlling FUEL's autodoc system"
|
||||
"Options controlling FUEL's autodoc system."
|
||||
:group 'fuel)
|
||||
|
||||
(defcustom fuel-autodoc-minibuffer-font-lock t
|
||||
|
|
|
|||
|
|
@ -25,8 +25,8 @@
|
|||
|
||||
;;;###autoload
|
||||
(defgroup fuel nil
|
||||
"Factor's Ultimate Emacs Library"
|
||||
:group 'language)
|
||||
"Factor's Ultimate Emacs Library."
|
||||
:group 'languages)
|
||||
|
||||
|
||||
;;; Emacs compatibility:
|
||||
|
|
@ -74,12 +74,14 @@
|
|||
len))
|
||||
|
||||
(defsubst fuel--region-to-string (begin &optional end)
|
||||
(let ((end (or end (point))))
|
||||
(if (< begin end)
|
||||
(mapconcat 'identity
|
||||
(split-string (buffer-substring-no-properties begin
|
||||
(or end (point)))
|
||||
(split-string (buffer-substring-no-properties begin end)
|
||||
nil
|
||||
t)
|
||||
" "))
|
||||
" ")
|
||||
"")))
|
||||
|
||||
(defsubst empty-string-p (str) (equal str ""))
|
||||
|
||||
|
|
|
|||
|
|
@ -134,7 +134,7 @@
|
|||
|
||||
(defconst fuel-con--prompt-regex "( .+ ) ")
|
||||
(defconst fuel-con--eot-marker "<~FUEL~>")
|
||||
(defconst fuel-con--init-stanza "USE: fuel f fuel-eval")
|
||||
(defconst fuel-con--init-stanza "USE: fuel fuel-retort")
|
||||
|
||||
(defconst fuel-con--comint-finished-regex
|
||||
(format "^%s$" fuel-con--eot-marker))
|
||||
|
|
|
|||
|
|
@ -14,29 +14,30 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'fuel-base)
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-popup)
|
||||
(require 'fuel-font-lock)
|
||||
(require 'fuel-base)
|
||||
|
||||
|
||||
;;; Customization:
|
||||
|
||||
(defgroup fuel-debug nil
|
||||
"Major mode for interaction with the Factor debugger"
|
||||
"Major mode for interaction with the Factor debugger."
|
||||
:group 'fuel)
|
||||
|
||||
(defcustom fuel-debug-mode-hook nil
|
||||
"Hook run after `fuel-debug-mode' activates"
|
||||
"Hook run after `fuel-debug-mode' activates."
|
||||
:group 'fuel-debug
|
||||
:type 'hook)
|
||||
|
||||
(defcustom fuel-debug-show-short-help t
|
||||
"Whether to show short help on available keys in debugger"
|
||||
"Whether to show short help on available keys in debugger."
|
||||
:group 'fuel-debug
|
||||
:type 'boolean)
|
||||
|
||||
(fuel-font-lock--define-faces
|
||||
fuel-debug-font-lock font-lock fuel-debug
|
||||
fuel-font-lock-debug font-lock fuel-debug
|
||||
((error warning "highlighting errors")
|
||||
(line variable-name "line numbers in errors/warnings")
|
||||
(column variable-name "column numbers in errors/warnings")
|
||||
|
|
@ -66,14 +67,14 @@
|
|||
(defconst fuel-debug--restart-regex "^:\\([0-9]+\\) \\(.+\\)")
|
||||
|
||||
(defconst fuel-debug--font-lock-keywords
|
||||
`((,fuel-debug--error-file-regex . 'fuel-debug-font-lock-error)
|
||||
(,fuel-debug--error-line-regex 1 'fuel-debug-font-lock-line)
|
||||
(,fuel-debug--error-cont-regex 1 'fuel-debug-font-lock-column)
|
||||
(,fuel-debug--restart-regex (1 'fuel-debug-font-lock-restart-number)
|
||||
(2 'fuel-debug-font-lock-restart-name))
|
||||
(,fuel-debug--compiler-info-regex 1 'fuel-debug-font-lock-restart-number)
|
||||
("^\\(Restarts?\\|Loading\\) .+$" . 'fuel-debug-font-lock-info)
|
||||
("^Error: " . 'fuel-debug-font-lock-error)))
|
||||
`((,fuel-debug--error-file-regex . 'fuel-font-lock-debug-error)
|
||||
(,fuel-debug--error-line-regex 1 'fuel-font-lock-debug-line)
|
||||
(,fuel-debug--error-cont-regex 1 'fuel-font-lock-debug-column)
|
||||
(,fuel-debug--restart-regex (1 'fuel-font-lock-debug-restart-number)
|
||||
(2 'fuel-font-lock-debug-restart-name))
|
||||
(,fuel-debug--compiler-info-regex 1 'fuel-font-lock-debug-restart-number)
|
||||
("^\\(Restarts?\\|Loading\\) .+$" . 'fuel-font-lock-debug-info)
|
||||
("^Error: " . 'fuel-font-lock-debug-error)))
|
||||
|
||||
(defun fuel-debug--font-lock-setup ()
|
||||
(set (make-local-variable 'font-lock-defaults)
|
||||
|
|
@ -82,7 +83,8 @@
|
|||
|
||||
;;; Debug buffer:
|
||||
|
||||
(defvar fuel-debug--buffer nil)
|
||||
(fuel-popup--define fuel-debug--buffer
|
||||
"*fuel debug*" 'fuel-debug-mode)
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar fuel-debug--last-ret nil))
|
||||
|
|
@ -90,13 +92,6 @@
|
|||
(make-variable-buffer-local
|
||||
(defvar fuel-debug--file nil))
|
||||
|
||||
(defun fuel-debug--buffer ()
|
||||
(or (and (buffer-live-p fuel-debug--buffer) fuel-debug--buffer)
|
||||
(with-current-buffer
|
||||
(setq fuel-debug--buffer (get-buffer-create "*fuel dbg*"))
|
||||
(fuel-debug-mode)
|
||||
(current-buffer))))
|
||||
|
||||
(defun fuel-debug--display-retort (ret &optional success-msg no-pop file)
|
||||
(let ((err (fuel-eval--retort-error ret))
|
||||
(inhibit-read-only t))
|
||||
|
|
@ -111,16 +106,16 @@
|
|||
(when err
|
||||
(fuel-debug--display-restarts err)
|
||||
(delete-blank-lines)
|
||||
(newline)
|
||||
(newline))
|
||||
(let ((hstr (fuel-debug--help-string err file)))
|
||||
(if fuel-debug-show-short-help
|
||||
(insert "-----------\n" hstr "\n")
|
||||
(message "%s" hstr))))
|
||||
(message "%s" hstr)))
|
||||
(setq fuel-debug--last-ret ret)
|
||||
(setq fuel-debug--file file)
|
||||
(goto-char (point-max))
|
||||
(font-lock-fontify-buffer)
|
||||
(when (and err (not no-pop)) (pop-to-buffer fuel-debug--buffer))
|
||||
(when (and err (not no-pop)) (fuel-popup--display))
|
||||
(not err))))
|
||||
|
||||
(defun fuel-debug--display-output (ret)
|
||||
|
|
@ -179,16 +174,16 @@
|
|||
|
||||
(defun fuel-debug-goto-error ()
|
||||
(interactive)
|
||||
(let* ((err (or (fuel-debug--buffer-error)
|
||||
(error "No errors reported")))
|
||||
(let* ((err (fuel-debug--buffer-error))
|
||||
(file (or (fuel-debug--buffer-file)
|
||||
(error "No file associated with error")))
|
||||
(l/c (fuel-eval--error-line/column err))
|
||||
(error "No file associated with compilation")))
|
||||
(l/c (and err (fuel-eval--error-line/column err)))
|
||||
(line (or (car l/c) 1))
|
||||
(col (or (cdr l/c) 0)))
|
||||
(find-file-other-window file)
|
||||
(when line
|
||||
(goto-line line)
|
||||
(forward-char col)))
|
||||
(when col (forward-char col)))))
|
||||
|
||||
(defun fuel-debug--read-restart-no ()
|
||||
(let ((rs (fuel-debug--buffer-restarts)))
|
||||
|
|
@ -224,9 +219,11 @@
|
|||
(unless (re-search-forward (format "^%s" info) nil t)
|
||||
(error "%s information not available" info))
|
||||
(message "Retrieving %s info ..." info)
|
||||
(unless (fuel-debug--display-retort
|
||||
(fuel-eval--send/wait `(:fuel ((:factor ,info))))
|
||||
"" (fuel-debug--buffer-file))
|
||||
(unless (fuel-debug--display-retort (fuel-eval--send/wait
|
||||
`(:fuel ((:factor ,info))))
|
||||
""
|
||||
nil
|
||||
(fuel-debug--buffer-file))
|
||||
(error "Sorry, no %s info available" info))))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -21,13 +21,24 @@
|
|||
|
||||
;;; Faces:
|
||||
|
||||
(defmacro fuel-font-lock--make-face (prefix def-prefix group face def doc)
|
||||
(let ((face (intern (format "%s-%s" prefix face)))
|
||||
(def (intern (format "%s-%s-face" def-prefix def))))
|
||||
(defgroup fuel-faces nil
|
||||
"Faces used by FUEL."
|
||||
:group 'fuel
|
||||
:group 'faces)
|
||||
|
||||
(defmacro fuel-font-lock--defface (face def group doc)
|
||||
`(defface ,face (face-default-spec ,def)
|
||||
,(format "Face for %s." doc)
|
||||
:group ',group
|
||||
:group 'faces)))
|
||||
:group 'fuel-faces
|
||||
:group 'faces))
|
||||
|
||||
(put 'fuel-font-lock--defface 'lisp-indent-function 1)
|
||||
|
||||
(defmacro fuel-font-lock--make-face (prefix def-prefix group face def doc)
|
||||
(let ((face (intern (format "%s-%s" prefix face)))
|
||||
(def (intern (format "%s-%s-face" def-prefix def))))
|
||||
`(fuel-font-lock--defface ,face ,def ,group ,doc)))
|
||||
|
||||
(defmacro fuel-font-lock--define-faces (prefix def-prefix group faces)
|
||||
(let ((setup (make-symbol (format "%s--faces-setup" prefix))))
|
||||
|
|
|
|||
|
|
@ -18,13 +18,14 @@
|
|||
(require 'fuel-autodoc)
|
||||
(require 'fuel-completion)
|
||||
(require 'fuel-font-lock)
|
||||
(require 'fuel-popup)
|
||||
(require 'fuel-base)
|
||||
|
||||
|
||||
;;; Customization:
|
||||
|
||||
(defgroup fuel-help nil
|
||||
"Options controlling FUEL's help system"
|
||||
"Options controlling FUEL's help system."
|
||||
:group 'fuel)
|
||||
|
||||
(defcustom fuel-help-always-ask t
|
||||
|
|
@ -47,10 +48,8 @@
|
|||
:type 'integer
|
||||
:group 'fuel-help)
|
||||
|
||||
(defface fuel-help-font-lock-headlines '((t (:bold t :weight bold)))
|
||||
"Face for headlines in help buffers."
|
||||
:group 'fuel-help
|
||||
:group 'faces)
|
||||
(fuel-font-lock--defface fuel-font-lock-help-headlines
|
||||
'bold fuel-hep "headlines in help buffers")
|
||||
|
||||
|
||||
;;; Help browser history:
|
||||
|
|
@ -81,10 +80,9 @@
|
|||
|
||||
;;; Fuel help buffer and internals:
|
||||
|
||||
(defun fuel-help--help-buffer ()
|
||||
(with-current-buffer (get-buffer-create "*fuel help*")
|
||||
(fuel-help-mode)
|
||||
(current-buffer)))
|
||||
(fuel-popup--define fuel-help--buffer
|
||||
"*fuel help*" 'fuel-help-mode)
|
||||
|
||||
|
||||
(defvar fuel-help--prompt-history nil)
|
||||
|
||||
|
|
@ -111,7 +109,7 @@
|
|||
(fuel-help--insert-contents def out))))
|
||||
|
||||
(defun fuel-help--insert-contents (def str &optional nopush)
|
||||
(let ((hb (fuel-help--help-buffer))
|
||||
(let ((hb (fuel-help--buffer))
|
||||
(inhibit-read-only t)
|
||||
(font-lock-verbose nil))
|
||||
(set-buffer hb)
|
||||
|
|
@ -124,7 +122,7 @@
|
|||
(kill-region (point-min) (point))
|
||||
(fuel-help--history-push (cons def (buffer-string)))))
|
||||
(set-buffer-modified-p nil)
|
||||
(pop-to-buffer hb)
|
||||
(fuel-popup--display)
|
||||
(goto-char (point-min))
|
||||
(message "%s" def)))
|
||||
|
||||
|
|
@ -154,7 +152,7 @@
|
|||
|
||||
(defconst fuel-help--font-lock-keywords
|
||||
`(,@fuel-font-lock--font-lock-keywords
|
||||
(,fuel-help--headlines-regexp . 'fuel-help-font-lock-headlines)))
|
||||
(,fuel-help--headlines-regexp . 'fuel-font-lock-help-headlines)))
|
||||
|
||||
|
||||
|
||||
|
|
@ -211,7 +209,6 @@ buffer."
|
|||
(let ((map (make-sparse-keymap)))
|
||||
(suppress-keymap map)
|
||||
(define-key map "\C-m" 'fuel-help)
|
||||
(define-key map "q" 'bury-buffer)
|
||||
(define-key map "b" 'fuel-help-previous)
|
||||
(define-key map "f" 'fuel-help-next)
|
||||
(define-key map "l" 'fuel-help-previous)
|
||||
|
|
@ -222,6 +219,7 @@ buffer."
|
|||
(define-key map [(backtab)] 'fuel-help-previous-headline)
|
||||
(define-key map (kbd "SPC") 'scroll-up)
|
||||
(define-key map (kbd "S-SPC") 'scroll-down)
|
||||
(define-key map "\M-." 'fuel-edit-word-at-point)
|
||||
(define-key map "\C-cz" 'run-factor)
|
||||
(define-key map "\C-c\C-z" 'run-factor)
|
||||
map))
|
||||
|
|
@ -245,6 +243,7 @@ buffer."
|
|||
(fuel-autodoc-mode)
|
||||
|
||||
(run-mode-hooks 'fuel-help-mode-hook)
|
||||
|
||||
(setq buffer-read-only t))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -13,8 +13,9 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-stack)
|
||||
(require 'fuel-completion)
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-connection)
|
||||
(require 'fuel-syntax)
|
||||
(require 'fuel-base)
|
||||
|
|
@ -25,7 +26,7 @@
|
|||
;;; Customization:
|
||||
|
||||
(defgroup fuel-listener nil
|
||||
"Interacting with a Factor listener inside Emacs"
|
||||
"Interacting with a Factor listener inside Emacs."
|
||||
:group 'fuel)
|
||||
|
||||
(defcustom fuel-listener-factor-binary "~/factor/factor"
|
||||
|
|
@ -102,16 +103,9 @@ buffer."
|
|||
(goto-char (point-max))
|
||||
(unless seen (error "No prompt found!"))))
|
||||
|
||||
|
||||
;;; Completion support
|
||||
|
||||
(defsubst fuel-listener--current-vocab () nil)
|
||||
(defsubst fuel-listener--usings () nil)
|
||||
|
||||
(defun fuel-listener--setup-completion ()
|
||||
(setq fuel-syntax--current-vocab-function 'fuel-listener--current-vocab)
|
||||
(setq fuel-syntax--usings-function 'fuel-listener--usings)
|
||||
(set-syntax-table fuel-syntax--syntax-table))
|
||||
(defun fuel-listener-nuke ()
|
||||
(interactive)
|
||||
(fuel-con--setup-connection fuel-listener--buffer))
|
||||
|
||||
|
||||
;;; Interface: starting fuel listener
|
||||
|
|
@ -128,6 +122,28 @@ buffer."
|
|||
(pop-to-buffer buf)
|
||||
(switch-to-buffer buf))))
|
||||
|
||||
|
||||
;;; Completion support
|
||||
|
||||
(defsubst fuel-listener--current-vocab () nil)
|
||||
(defsubst fuel-listener--usings () nil)
|
||||
|
||||
(defun fuel-listener--setup-completion ()
|
||||
(setq fuel-syntax--current-vocab-function 'fuel-listener--current-vocab)
|
||||
(setq fuel-syntax--usings-function 'fuel-listener--usings)
|
||||
(set-syntax-table fuel-syntax--syntax-table))
|
||||
|
||||
|
||||
;;; Stack mode support
|
||||
|
||||
(defun fuel-listener--stack-region ()
|
||||
(fuel--region-to-string (if (zerop (fuel-syntax--brackets-depth))
|
||||
(comint-line-beginning-position)
|
||||
(1+ (fuel-syntax--brackets-start)))))
|
||||
|
||||
(defun fuel-listener--setup-stack-mode ()
|
||||
(setq fuel-stack--region-function 'fuel-listener--stack-region))
|
||||
|
||||
|
||||
;;; Fuel listener mode:
|
||||
|
||||
|
|
@ -138,12 +154,15 @@ buffer."
|
|||
(set (make-local-variable 'comint-prompt-regexp) fuel-con--prompt-regex)
|
||||
(set (make-local-variable 'comint-use-prompt-regexp) t)
|
||||
(set (make-local-variable 'comint-prompt-read-only) t)
|
||||
(fuel-listener--setup-completion))
|
||||
(set-syntax-table fuel-syntax--syntax-table)
|
||||
(fuel-listener--setup-completion)
|
||||
(fuel-listener--setup-stack-mode))
|
||||
|
||||
(define-key fuel-listener-mode-map "\C-cz" 'run-factor)
|
||||
(define-key fuel-listener-mode-map "\C-c\C-z" 'run-factor)
|
||||
(define-key fuel-listener-mode-map "\C-ca" 'fuel-autodoc-mode)
|
||||
(define-key fuel-listener-mode-map "\C-ch" 'fuel-help)
|
||||
(define-key fuel-listener-mode-map "\C-cs" 'fuel-stack-mode)
|
||||
(define-key fuel-listener-mode-map "\M-." 'fuel-edit-word-at-point)
|
||||
(define-key fuel-listener-mode-map "\C-cv" 'fuel-edit-vocabulary)
|
||||
(define-key fuel-listener-mode-map "\C-c\C-v" 'fuel-edit-vocabulary)
|
||||
|
|
|
|||
|
|
@ -136,11 +136,27 @@ With prefix, asks for the word to edit."
|
|||
(interactive "P")
|
||||
(let* ((word (or (and (not arg) (fuel-syntax-symbol-at-point))
|
||||
(fuel-completion--read-word "Edit word: ")))
|
||||
(cmd `(:fuel ((:quote ,word) fuel-get-edit-location))))
|
||||
(cmd `(:fuel* ((:quote ,word) fuel-get-edit-location))))
|
||||
(condition-case nil
|
||||
(fuel--try-edit (fuel-eval--send/wait cmd))
|
||||
(error (fuel-edit-vocabulary nil word)))))
|
||||
|
||||
(defun fuel-edit-word-doc-at-point (&optional arg)
|
||||
"Opens a new window visiting the documentation file for the word at point.
|
||||
With prefix, asks for the word to edit."
|
||||
(interactive "P")
|
||||
(let* ((word (or (and (not arg) (fuel-syntax-symbol-at-point))
|
||||
(fuel-completion--read-word "Edit word: ")))
|
||||
(cmd `(:fuel* ((:quote ,word) fuel-get-doc-location))))
|
||||
(condition-case nil
|
||||
(fuel--try-edit (fuel-eval--send/wait cmd))
|
||||
(error (when (y-or-n-p (concat "No documentation found. "
|
||||
"Do you want to open the vocab's "
|
||||
"doc file? "))
|
||||
(find-file-other-window
|
||||
(format "%s-docs.factor"
|
||||
(file-name-sans-extension (buffer-file-name)))))))))
|
||||
|
||||
(defvar fuel-mode--word-history nil)
|
||||
|
||||
(defun fuel-edit-word (&optional arg)
|
||||
|
|
@ -152,7 +168,7 @@ offered."
|
|||
nil
|
||||
fuel-mode--word-history
|
||||
arg))
|
||||
(cmd `(:fuel ((:quote ,word) fuel-get-edit-location))))
|
||||
(cmd `(:fuel* ((:quote ,word) fuel-get-edit-location))))
|
||||
(fuel--try-edit (fuel-eval--send/wait cmd))))
|
||||
|
||||
(defvar fuel--vocabs-prompt-history nil)
|
||||
|
|
@ -183,8 +199,7 @@ With prefix argument, ask for word."
|
|||
(fuel-syntax-symbol-at-point))))
|
||||
(when word
|
||||
(message "Looking up %s's callers ..." word)
|
||||
(fuel-xref--show-callers word)
|
||||
(message ""))))
|
||||
(fuel-xref--show-callers word))))
|
||||
|
||||
(defun fuel-show-callees (&optional arg)
|
||||
"Show a list of callers of word at point.
|
||||
|
|
@ -196,8 +211,7 @@ With prefix argument, ask for word."
|
|||
(fuel-syntax-symbol-at-point))))
|
||||
(when word
|
||||
(message "Looking up %s's callees ..." word)
|
||||
(fuel-xref--show-callees word)
|
||||
(message ""))))
|
||||
(fuel-xref--show-callees word))))
|
||||
|
||||
|
||||
;;; Minor mode definition:
|
||||
|
|
@ -252,6 +266,7 @@ interacting with a factor listener is at your disposal.
|
|||
(define-key fuel-mode-map "\C-c\M->" 'fuel-show-callees)
|
||||
(define-key fuel-mode-map (kbd "M-TAB") 'fuel-completion--complete-symbol)
|
||||
|
||||
(fuel-mode--key ?e ?d 'fuel-edit-word-doc-at-point)
|
||||
(fuel-mode--key ?e ?e 'fuel-eval-extended-region)
|
||||
(fuel-mode--key ?e ?l 'fuel-run-file)
|
||||
(fuel-mode--key ?e ?r 'fuel-eval-region)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,60 @@
|
|||
;;; fuel-popup.el -- popup windows
|
||||
|
||||
;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
|
||||
;; See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
|
||||
;; Keywords: languages, fuel, factor
|
||||
;; Start date: Sun Dec 21, 2008 14:37
|
||||
|
||||
;;; Comentary:
|
||||
|
||||
;; A minor mode to pop up windows and restore configurations
|
||||
;; afterwards.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar fuel-popup--created-window nil))
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar fuel-popup--selected-window nil))
|
||||
|
||||
(defun fuel-popup--display (&optional buffer)
|
||||
(when buffer (set-buffer buffer))
|
||||
(let ((selected-window (selected-window))
|
||||
(buffer (current-buffer)))
|
||||
(unless (eq selected-window (get-buffer-window buffer))
|
||||
(let ((windows))
|
||||
(walk-windows (lambda (w) (push w windows)) nil t)
|
||||
(prog1 (pop-to-buffer buffer)
|
||||
(set (make-local-variable 'fuel-popup--created-window)
|
||||
(unless (memq (selected-window) windows) (selected-window)))
|
||||
(set (make-local-variable 'fuel-popup--selected-window)
|
||||
selected-window))))))
|
||||
|
||||
(defun fuel-popup--quit ()
|
||||
(interactive)
|
||||
(let ((selected fuel-popup--selected-window)
|
||||
(created fuel-popup--created-window))
|
||||
(bury-buffer)
|
||||
(when (eq created (selected-window)) (delete-window created))
|
||||
(when (window-live-p selected) (select-window selected))))
|
||||
|
||||
(define-minor-mode fuel-popup-mode
|
||||
"Mode for displaying read only stuff"
|
||||
nil nil
|
||||
'(("q" . fuel-popup--quit)))
|
||||
|
||||
(defmacro fuel-popup--define (fun name mode)
|
||||
`(defun ,fun ()
|
||||
(or (get-buffer ,name)
|
||||
(with-current-buffer (get-buffer-create ,name)
|
||||
(funcall ,mode)
|
||||
(fuel-popup-mode)
|
||||
(current-buffer)))))
|
||||
|
||||
(put 'fuel-popup--define 'lisp-indent-function 1)
|
||||
|
||||
(provide 'fuel-popup)
|
||||
;;; fuel-popup.el ends here
|
||||
|
|
@ -17,21 +17,20 @@
|
|||
(require 'fuel-autodoc)
|
||||
(require 'fuel-syntax)
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-font-lock)
|
||||
(require 'fuel-base)
|
||||
|
||||
|
||||
;;; Customization
|
||||
|
||||
(defgroup fuel-stack nil
|
||||
"Customization for FUEL's stack inference engine"
|
||||
"Customization for FUEL's stack inference engine."
|
||||
:group 'fuel)
|
||||
|
||||
(defface fuel-font-lock-stack-region (face-user-default-spec 'highlight)
|
||||
"Face used to highlight the region whose stack effect is shown"
|
||||
:group 'fuel-stack
|
||||
:group 'faces)
|
||||
(fuel-font-lock--defface fuel-font-lock-stack-region
|
||||
'highlight fuel-stack "highlighting the stack effect region")
|
||||
|
||||
(defcustom fuel-stack-highlight-period 2
|
||||
(defcustom fuel-stack-highlight-period 2.0
|
||||
"Time, in seconds, the region is highlighted when showing its
|
||||
stack effect.
|
||||
|
||||
|
|
@ -97,13 +96,20 @@ With prefix argument, use current region instead"
|
|||
(defvar fuel-stack-mode-string " S"
|
||||
"Modeline indicator for fuel-stack-mode"))
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar fuel-stack--region-function
|
||||
'(lambda ()
|
||||
(fuel--region-to-string (1+ (fuel-syntax--beginning-of-sexp-pos))))))
|
||||
|
||||
(defun fuel-stack--eldoc ()
|
||||
(when (looking-at-p " \\|$")
|
||||
(let* ((r (fuel--region-to-string (1+ (fuel-syntax--beginning-of-sexp-pos))))
|
||||
(e (fuel-stack--infer-effect/prop r)))
|
||||
(let* ((r (funcall fuel-stack--region-function))
|
||||
(e (and r
|
||||
(not (string-match "^ *$" r))
|
||||
(fuel-stack--infer-effect/prop r))))
|
||||
(when e
|
||||
(if fuel-stack-mode-show-sexp-p
|
||||
(concat (fuel--shorten-str r 30) ": " e)
|
||||
(concat (fuel--shorten-str r 30) " -> " e)
|
||||
e)))))
|
||||
|
||||
(define-minor-mode fuel-stack-mode
|
||||
|
|
|
|||
|
|
@ -277,6 +277,11 @@
|
|||
(defsubst fuel-syntax--end-of-defun ()
|
||||
(re-search-forward fuel-syntax--end-of-def-regex nil t))
|
||||
|
||||
(defsubst fuel-syntax--end-of-defun-pos ()
|
||||
(save-excursion
|
||||
(re-search-forward fuel-syntax--end-of-def-regex nil t)
|
||||
(point)))
|
||||
|
||||
(defconst fuel-syntax--defun-signature-regex
|
||||
(format "\\(%s\\|%s\\)"
|
||||
(format ":[^ ]* [^ ]+\\(%s\\)*" fuel-syntax--stack-effect-regex)
|
||||
|
|
|
|||
|
|
@ -13,6 +13,10 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-syntax)
|
||||
(require 'fuel-popup)
|
||||
(require 'fuel-font-lock)
|
||||
(require 'fuel-base)
|
||||
|
||||
(require 'button)
|
||||
|
|
@ -24,13 +28,25 @@
|
|||
"FUEL's cross-referencing engine."
|
||||
:group 'fuel)
|
||||
|
||||
(defcustom fuel-xref-follow-link-to-word-p t
|
||||
"Whether, when following a link to a caller, we position the
|
||||
cursor at the first ocurrence of the used word."
|
||||
:group 'fuel-xref
|
||||
:type 'boolean)
|
||||
|
||||
(fuel-font-lock--defface fuel-font-lock-xref-link
|
||||
'link fuel-xref "highlighting links in cross-reference buffers")
|
||||
|
||||
(fuel-font-lock--defface fuel-font-lock-xref-vocab
|
||||
'italic fuel-xref "vocabulary names in cross-reference buffers")
|
||||
|
||||
|
||||
;;; Buttons:
|
||||
|
||||
(define-button-type 'fuel-xref--button-type
|
||||
'action 'fuel-xref--follow-link
|
||||
'follow-link t
|
||||
'face 'default)
|
||||
'face 'fuel-font-lock-xref-link)
|
||||
|
||||
(defun fuel-xref--follow-link (button)
|
||||
(let ((file (button-get button 'file))
|
||||
|
|
@ -39,60 +55,81 @@
|
|||
(error "No file for this ref"))
|
||||
(when (not (file-readable-p file))
|
||||
(error "File '%s' is not readable" file))
|
||||
(let ((word fuel-xref--word))
|
||||
(find-file-other-window file)
|
||||
(when (numberp line) (goto-line line))))
|
||||
(when (numberp line) (goto-line line))
|
||||
(when (and word fuel-xref-follow-link-to-word-p)
|
||||
(and (search-forward word
|
||||
(fuel-syntax--end-of-defun-pos)
|
||||
t)
|
||||
(goto-char (match-beginning 0)))))))
|
||||
|
||||
|
||||
;;; The xref buffer:
|
||||
|
||||
(defvar fuel-xref--buffer-name "*fuel xref*")
|
||||
(fuel-popup--define fuel-xref--buffer
|
||||
"*fuel xref*" 'fuel-xref-mode)
|
||||
|
||||
(defun fuel-xref--get-buffer ()
|
||||
(let ((buffer (get-buffer fuel-xref--buffer-name)))
|
||||
(or (and (buffer-live-p buffer) buffer)
|
||||
(prog1
|
||||
(set-buffer (get-buffer-create fuel-xref--buffer-name))
|
||||
(fuel-xref-mode)))))
|
||||
(make-local-variable (defvar fuel-xref--word nil))
|
||||
|
||||
(defvar fuel-xref--help-string "(Press RET or click to follow crossrefs)")
|
||||
|
||||
(defun fuel-xref--fill-buffer (title refs)
|
||||
(let ((inhibit-read-only t))
|
||||
(with-current-buffer (fuel-xref--get-buffer)
|
||||
(erase-buffer)
|
||||
(insert title "\n\n")
|
||||
(dolist (ref refs)
|
||||
(when (and (first ref) (second ref) (numberp (third ref)))
|
||||
(defun fuel-xref--title (word cc count)
|
||||
(let ((cc (if cc "using" "used by")))
|
||||
(put-text-property 0 (length word) 'font-lock-face 'bold word)
|
||||
(cond ((zerop count) (format "No known words %s %s" cc word))
|
||||
((= 1 count) (format "1 word %s %s:" cc word))
|
||||
(t (format "%s words %s %s:" count cc word)))))
|
||||
|
||||
(defun fuel-xref--insert-ref (ref)
|
||||
(when (and (stringp (first ref))
|
||||
(stringp (third ref))
|
||||
(numberp (fourth ref)))
|
||||
(insert " ")
|
||||
(insert-text-button (first ref)
|
||||
:type 'fuel-xref--button-type
|
||||
'help-echo (format "File: %s (%s)"
|
||||
(second ref)
|
||||
(third ref))
|
||||
'file (second ref)
|
||||
'line (third ref))
|
||||
(newline)))
|
||||
(when refs
|
||||
(insert "\n\n" fuel-xref--help-string "\n"))
|
||||
(goto-char (point-min)))))
|
||||
(third ref)
|
||||
(fourth ref))
|
||||
'file (third ref)
|
||||
'line (fourth ref))
|
||||
(when (stringp (second ref))
|
||||
(insert (format " (in %s)" (second ref))))
|
||||
(newline)
|
||||
t))
|
||||
|
||||
(defun fuel-xref--fill-buffer (word cc refs)
|
||||
(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)))
|
||||
|
||||
(defun fuel-xref--fill-and-display (word cc refs)
|
||||
(let ((count (fuel-xref--fill-buffer word cc refs)))
|
||||
(if (zerop count)
|
||||
(error (fuel-xref--title word cc 0))
|
||||
(message "")
|
||||
(fuel-popup--display (fuel-xref--buffer)))))
|
||||
|
||||
(defun fuel-xref--show-callers (word)
|
||||
(let* ((cmd `(:fuel* (((:quote ,word) fuel-callers-xref))))
|
||||
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))
|
||||
(title (format (if res "Callers of '%s':"
|
||||
"No callers found for '%s'")
|
||||
word)))
|
||||
(fuel-xref--fill-buffer title res)
|
||||
(pop-to-buffer (fuel-xref--get-buffer))))
|
||||
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
|
||||
(fuel-xref--fill-and-display word t res)))
|
||||
|
||||
(defun fuel-xref--show-callees (word)
|
||||
(let* ((cmd `(:fuel* (((:quote ,word) fuel-callees-xref))))
|
||||
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))
|
||||
(title (format (if res "Words called by '%s':"
|
||||
"No callees found for '%s'")
|
||||
word)))
|
||||
(fuel-xref--fill-buffer title res)
|
||||
(pop-to-buffer (fuel-xref--get-buffer))))
|
||||
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
|
||||
(fuel-xref--fill-and-display word nil res)))
|
||||
|
||||
|
||||
;;; Xref mode:
|
||||
|
|
@ -113,7 +150,7 @@
|
|||
(use-local-map fuel-xref-mode-map)
|
||||
(setq mode-name "FUEL Xref")
|
||||
(setq major-mode 'fuel-xref-mode)
|
||||
(fuel-font-lock--font-lock-setup)
|
||||
(font-lock-add-keywords nil '(("(in \\(.+\\))" 1 'fuel-font-lock-xref-vocab)))
|
||||
(setq buffer-read-only t))
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue