Fix conflicts
commit
c8d5e98898
|
@ -1,5 +1,5 @@
|
||||||
IN: checksums.openssl
|
IN: checksums.openssl
|
||||||
USING: help.syntax help.markup ;
|
USING: checksums help.syntax help.markup ;
|
||||||
|
|
||||||
HELP: openssl-checksum
|
HELP: openssl-checksum
|
||||||
{ $class-description "The class of checksum algorithms implemented by OpenSSL. The exact set of algorithms supported depends on how the OpenSSL library was compiled; " { $snippet "md5" } " and " { $snippet "sha1" } " should be universally available." } ;
|
{ $class-description "The class of checksum algorithms implemented by OpenSSL. The exact set of algorithms supported depends on how the OpenSSL library was compiled; " { $snippet "md5" } " and " { $snippet "sha1" } " should be universally available." } ;
|
||||||
|
@ -9,9 +9,11 @@ HELP: <openssl-checksum>
|
||||||
{ $description "Creates a new OpenSSL checksum object." } ;
|
{ $description "Creates a new OpenSSL checksum object." } ;
|
||||||
|
|
||||||
HELP: openssl-md5
|
HELP: openssl-md5
|
||||||
|
{ $values { "value" checksum } }
|
||||||
{ $description "The OpenSSL MD5 message digest implementation." } ;
|
{ $description "The OpenSSL MD5 message digest implementation." } ;
|
||||||
|
|
||||||
HELP: openssl-sha1
|
HELP: openssl-sha1
|
||||||
|
{ $values { "value" checksum } }
|
||||||
{ $description "The OpenSSL SHA1 message digest implementation." } ;
|
{ $description "The OpenSSL SHA1 message digest implementation." } ;
|
||||||
|
|
||||||
HELP: unknown-digest
|
HELP: unknown-digest
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
|
! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: math kernel memoize tools.test parser generalizations
|
USING: math kernel memoize tools.test parser generalizations
|
||||||
prettyprint io.streams.string sequences eval ;
|
prettyprint io.streams.string sequences eval namespaces ;
|
||||||
IN: memoize.tests
|
IN: memoize.tests
|
||||||
|
|
||||||
MEMO: fib ( m -- n )
|
MEMO: fib ( m -- n )
|
||||||
|
|
|
@ -44,11 +44,11 @@ IN: stack-checker.backend
|
||||||
|
|
||||||
: pop-r ( -- obj )
|
: pop-r ( -- obj )
|
||||||
meta-r dup empty?
|
meta-r dup empty?
|
||||||
[ too-many-r> inference-error ] [ pop ] if ;
|
[ too-many-r> ] [ pop ] if ;
|
||||||
|
|
||||||
: consume-r ( n -- seq )
|
: consume-r ( n -- seq )
|
||||||
meta-r 2dup length >
|
meta-r 2dup length >
|
||||||
[ too-many-r> inference-error ] when
|
[ too-many-r> ] when
|
||||||
[ swap tail* ] [ shorten-by ] 2bi ;
|
[ swap tail* ] [ shorten-by ] 2bi ;
|
||||||
|
|
||||||
: output-r ( seq -- ) meta-r push-all ;
|
: output-r ( seq -- ) meta-r push-all ;
|
||||||
|
@ -81,7 +81,7 @@ M: object apply-object push-literal ;
|
||||||
terminated? on meta-d clone meta-r clone #terminate, ;
|
terminated? on meta-d clone meta-r clone #terminate, ;
|
||||||
|
|
||||||
: check->r ( -- )
|
: check->r ( -- )
|
||||||
meta-r empty? [ \ too-many->r inference-error ] unless ;
|
meta-r empty? [ too-many->r ] unless ;
|
||||||
|
|
||||||
: infer-quot-here ( quot -- )
|
: infer-quot-here ( quot -- )
|
||||||
meta-r [
|
meta-r [
|
||||||
|
@ -104,7 +104,7 @@ M: object apply-object push-literal ;
|
||||||
|
|
||||||
: infer-literal-quot ( literal -- )
|
: infer-literal-quot ( literal -- )
|
||||||
dup recursive-quotation? [
|
dup recursive-quotation? [
|
||||||
value>> recursive-quotation-error inference-error
|
value>> recursive-quotation-error
|
||||||
] [
|
] [
|
||||||
dup value>> callable? [
|
dup value>> callable? [
|
||||||
[ value>> ]
|
[ value>> ]
|
||||||
|
@ -139,7 +139,7 @@ M: object apply-object push-literal ;
|
||||||
meta-d clone #return, ;
|
meta-d clone #return, ;
|
||||||
|
|
||||||
: required-stack-effect ( word -- effect )
|
: required-stack-effect ( word -- effect )
|
||||||
dup stack-effect [ ] [ missing-effect inference-error ] ?if ;
|
dup stack-effect [ ] [ missing-effect ] ?if ;
|
||||||
|
|
||||||
: check-effect ( word effect -- )
|
: check-effect ( word effect -- )
|
||||||
over required-stack-effect 2dup effect<=
|
over required-stack-effect 2dup effect<=
|
||||||
|
|
|
@ -5,6 +5,9 @@ assocs accessors namespaces compiler.errors stack-checker.values
|
||||||
stack-checker.recursive-state ;
|
stack-checker.recursive-state ;
|
||||||
IN: stack-checker.errors
|
IN: stack-checker.errors
|
||||||
|
|
||||||
|
: pretty-word ( word -- word' )
|
||||||
|
dup method-body? [ "method-generic" word-prop ] when ;
|
||||||
|
|
||||||
TUPLE: inference-error error type word ;
|
TUPLE: inference-error error type word ;
|
||||||
|
|
||||||
M: inference-error compiler-error-type type>> ;
|
M: inference-error compiler-error-type type>> ;
|
||||||
|
@ -20,9 +23,11 @@ M: inference-error compiler-error-type type>> ;
|
||||||
: inference-warning ( ... class -- * )
|
: inference-warning ( ... class -- * )
|
||||||
+warning+ (inference-error) ; inline
|
+warning+ (inference-error) ; inline
|
||||||
|
|
||||||
TUPLE: literal-expected ;
|
TUPLE: literal-expected what ;
|
||||||
|
|
||||||
M: object (literal) \ literal-expected inference-warning ;
|
: literal-expected ( what -- * ) \ literal-expected inference-warning ;
|
||||||
|
|
||||||
|
M: object (literal) "literal value" literal-expected ;
|
||||||
|
|
||||||
TUPLE: unbalanced-branches-error branches quots ;
|
TUPLE: unbalanced-branches-error branches quots ;
|
||||||
|
|
||||||
|
@ -31,10 +36,17 @@ TUPLE: unbalanced-branches-error branches quots ;
|
||||||
|
|
||||||
TUPLE: too-many->r ;
|
TUPLE: too-many->r ;
|
||||||
|
|
||||||
|
: too-many->r ( -- * ) \ too-many->r inference-error ;
|
||||||
|
|
||||||
TUPLE: too-many-r> ;
|
TUPLE: too-many-r> ;
|
||||||
|
|
||||||
|
: too-many-r> ( -- * ) \ too-many-r> inference-error ;
|
||||||
|
|
||||||
TUPLE: missing-effect word ;
|
TUPLE: missing-effect word ;
|
||||||
|
|
||||||
|
: missing-effect ( word -- * )
|
||||||
|
pretty-word \ missing-effect inference-error ;
|
||||||
|
|
||||||
TUPLE: effect-error word inferred declared ;
|
TUPLE: effect-error word inferred declared ;
|
||||||
|
|
||||||
: effect-error ( word inferred declared -- * )
|
: effect-error ( word inferred declared -- * )
|
||||||
|
@ -42,12 +54,30 @@ TUPLE: effect-error word inferred declared ;
|
||||||
|
|
||||||
TUPLE: recursive-quotation-error quot ;
|
TUPLE: recursive-quotation-error quot ;
|
||||||
|
|
||||||
|
: recursive-quotation-error ( word -- * )
|
||||||
|
\ recursive-quotation-error inference-error ;
|
||||||
|
|
||||||
TUPLE: undeclared-recursion-error word ;
|
TUPLE: undeclared-recursion-error word ;
|
||||||
|
|
||||||
|
: undeclared-recursion-error ( word -- * )
|
||||||
|
\ undeclared-recursion-error inference-error ;
|
||||||
|
|
||||||
TUPLE: diverging-recursion-error word ;
|
TUPLE: diverging-recursion-error word ;
|
||||||
|
|
||||||
|
: diverging-recursion-error ( word -- * )
|
||||||
|
\ diverging-recursion-error inference-error ;
|
||||||
|
|
||||||
TUPLE: unbalanced-recursion-error word height ;
|
TUPLE: unbalanced-recursion-error word height ;
|
||||||
|
|
||||||
|
: unbalanced-recursion-error ( word height -- * )
|
||||||
|
\ unbalanced-recursion-error inference-error ;
|
||||||
|
|
||||||
TUPLE: inconsistent-recursive-call-error word ;
|
TUPLE: inconsistent-recursive-call-error word ;
|
||||||
|
|
||||||
|
: inconsistent-recursive-call-error ( word -- * )
|
||||||
|
\ inconsistent-recursive-call-error inference-error ;
|
||||||
|
|
||||||
TUPLE: unknown-primitive-error ;
|
TUPLE: unknown-primitive-error ;
|
||||||
|
|
||||||
|
: unknown-primitive-error ( -- * )
|
||||||
|
\ unknown-primitive-error inference-error ;
|
||||||
|
|
|
@ -9,8 +9,8 @@ M: inference-error error-help error>> error-help ;
|
||||||
M: inference-error error.
|
M: inference-error error.
|
||||||
[ word>> [ "In word: " write . ] when* ] [ error>> error. ] bi ;
|
[ word>> [ "In word: " write . ] when* ] [ error>> error. ] bi ;
|
||||||
|
|
||||||
M: literal-expected summary
|
M: literal-expected error.
|
||||||
drop "Literal value expected" ;
|
"Got a computed value where a " write what>> write " was expected" print ;
|
||||||
|
|
||||||
M: unbalanced-branches-error error.
|
M: unbalanced-branches-error error.
|
||||||
"Unbalanced branches:" print
|
"Unbalanced branches:" print
|
||||||
|
|
|
@ -87,7 +87,7 @@ M: composed infer-call*
|
||||||
terminated? get [ 1 infer-r> infer-call ] unless ;
|
terminated? get [ 1 infer-r> infer-call ] unless ;
|
||||||
|
|
||||||
M: object infer-call*
|
M: object infer-call*
|
||||||
\ literal-expected inference-warning ;
|
"literal quotation" literal-expected ;
|
||||||
|
|
||||||
: infer-nslip ( n -- )
|
: infer-nslip ( n -- )
|
||||||
[ infer->r infer-call ] [ infer-r> ] bi ;
|
[ infer->r infer-call ] [ infer-r> ] bi ;
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
IN: tools.profiler.tests
|
IN: tools.profiler.tests
|
||||||
USING: accessors tools.profiler tools.test kernel memory math
|
USING: accessors tools.profiler tools.test kernel memory math
|
||||||
threads alien tools.profiler.private sequences compiler
|
threads alien tools.profiler.private sequences compiler compiler.units
|
||||||
words ;
|
words ;
|
||||||
|
|
||||||
[ t ] [
|
[ t ] [
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
USING: help.syntax help.markup ui.gadgets kernel arrays
|
USING: help.syntax help.markup ui.gadgets kernel arrays math help sequences
|
||||||
quotations classes.tuple ui.gadgets.grids parser math ;
|
quotations classes.tuple ui.gadgets.grids ;
|
||||||
IN: ui.gadgets.frames
|
IN: ui.gadgets.frames
|
||||||
|
|
||||||
ARTICLE: "ui-frame-layout" "Frame layouts"
|
ARTICLE: "ui-frame-layout" "Frame layouts"
|
||||||
|
|
|
@ -5,7 +5,7 @@ ui.gestures ui.backend ui.clipboards ui.gadgets.worlds ui.render
|
||||||
ui.event-loop assocs kernel math namespaces opengl sequences
|
ui.event-loop assocs kernel math namespaces opengl sequences
|
||||||
strings x11.xlib x11.events x11.xim x11.glx x11.clipboard
|
strings x11.xlib x11.events x11.xim x11.glx x11.clipboard
|
||||||
x11.constants x11.windows io.encodings.string io.encodings.ascii
|
x11.constants x11.windows io.encodings.string io.encodings.ascii
|
||||||
io.encodings.utf8 combinators command-line
|
io.encodings.utf8 combinators combinators.short-circuit command-line
|
||||||
math.vectors classes.tuple opengl.gl threads math.geometry.rect
|
math.vectors classes.tuple opengl.gl threads math.geometry.rect
|
||||||
environment ascii ;
|
environment ascii ;
|
||||||
IN: ui.x11
|
IN: ui.x11
|
||||||
|
@ -73,9 +73,9 @@ CONSTANT: key-codes
|
||||||
: valid-input? ( string gesture -- ? )
|
: valid-input? ( string gesture -- ? )
|
||||||
over empty? [ 2drop f ] [
|
over empty? [ 2drop f ] [
|
||||||
mods>> { f { S+ } } member? [
|
mods>> { f { S+ } } member? [
|
||||||
[ [ 127 = not ] [ CHAR: \s >= ] bi and ] all?
|
[ { [ 127 = not ] [ CHAR: \s >= ] } 1&& ] all?
|
||||||
] [
|
] [
|
||||||
[ [ 127 = not ] [ CHAR: \s >= ] [ alpha? not ] tri and and ] all?
|
[ { [ 127 = not ] [ CHAR: \s >= ] [ alpha? not ] } 1&& ] all?
|
||||||
] if
|
] if
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2005, 2009 Daniel Ehrenberg
|
! Copyright (C) 2005, 2009 Daniel Ehrenberg
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: help.markup help.syntax ;
|
USING: help.markup help.syntax assocs ;
|
||||||
IN: xml.entities
|
IN: xml.entities
|
||||||
|
|
||||||
ABOUT: "xml.entities"
|
ABOUT: "xml.entities"
|
||||||
|
@ -12,6 +12,7 @@ ARTICLE: "xml.entities" "XML entities"
|
||||||
"For entities used in HTML/XHTML, see " { $vocab-link "xml.entities.html" } ;
|
"For entities used in HTML/XHTML, see " { $vocab-link "xml.entities.html" } ;
|
||||||
|
|
||||||
HELP: entities
|
HELP: entities
|
||||||
|
{ $values { "value" assoc } }
|
||||||
{ $description "A hash table from default XML entity names (like " { $snippet "&" } " and " { $snippet "<" } ") to the characters they represent. This is automatically included when parsing any XML document." }
|
{ $description "A hash table from default XML entity names (like " { $snippet "&" } " and " { $snippet "<" } ") to the characters they represent. This is automatically included when parsing any XML document." }
|
||||||
{ $see-also with-entities } ;
|
{ $see-also with-entities } ;
|
||||||
|
|
||||||
|
|
|
@ -1,179 +0,0 @@
|
||||||
#include <stdio.h>
|
|
||||||
#include <sys/event.h>
|
|
||||||
|
|
||||||
#if defined(__FreeBSD__)
|
|
||||||
#define BSD
|
|
||||||
#define FREEBSD
|
|
||||||
#define UNIX
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#if defined(__NetBSD__)
|
|
||||||
#define BSD
|
|
||||||
#define NETBSD
|
|
||||||
#define UNIX
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#if defined(__OpenBSD__)
|
|
||||||
#define BSD
|
|
||||||
#define OPENBSD
|
|
||||||
#define UNIX
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#if defined(__APPLE__)
|
|
||||||
#define BSD
|
|
||||||
#define MACOSX
|
|
||||||
#define UNIX
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#if defined(linux)
|
|
||||||
#define LINUX
|
|
||||||
#define UNIX
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#if defined(__amd64__) || defined(__x86_64__)
|
|
||||||
#define BIT64
|
|
||||||
#else
|
|
||||||
#define BIT32
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#if defined(UNIX)
|
|
||||||
#include <sys/types.h>
|
|
||||||
#include <sys/stat.h>
|
|
||||||
#include <sys/socket.h>
|
|
||||||
#include <sys/errno.h>
|
|
||||||
#include <sys/mman.h>
|
|
||||||
#include <sys/syslimits.h>
|
|
||||||
#include <fcntl.h>
|
|
||||||
#include <unistd.h>
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#define BL printf(" ");
|
|
||||||
#define QUOT printf("\"");
|
|
||||||
#define NL printf("\n");
|
|
||||||
#define LB printf("{"); BL
|
|
||||||
#define RB BL printf("}");
|
|
||||||
#define SEMI printf(";");
|
|
||||||
#define grovel(t) printf("TYPEDEF: "); printf("%d", sizeof(t)); BL printf(#t); NL
|
|
||||||
#define grovel2impl(t,n) BL BL BL BL LB QUOT printf(#t); QUOT BL QUOT printf((n)); QUOT RB
|
|
||||||
#define grovel2(t,n) grovel2impl(t,n) NL
|
|
||||||
#define grovel2end(t,n) grovel2impl(t,n) BL SEMI NL
|
|
||||||
#define header(os) printf("vvv %s vvv", (os)); NL
|
|
||||||
#define footer(os) printf("^^^ %s ^^^", (os)); NL
|
|
||||||
#define header2(os,struct) printf("vvv %s %s vvv", (os), (struct)); NL
|
|
||||||
#define footer2(os,struct) printf("^^^ %s %s ^^^", (os), (struct)); NL
|
|
||||||
#define struct(n) printf("C-STRUCT: %s\n", (n));
|
|
||||||
#define constant(n) printf("#define "); printf(#n); printf(" %d (HEX: %04x)", (n), (n)); NL
|
|
||||||
|
|
||||||
void openbsd_types()
|
|
||||||
{
|
|
||||||
header2("openbsd", "types");
|
|
||||||
grovel(dev_t);
|
|
||||||
grovel(gid_t);
|
|
||||||
grovel(ino_t);
|
|
||||||
grovel(int32_t);
|
|
||||||
grovel(int64_t);
|
|
||||||
grovel(mode_t);
|
|
||||||
grovel(nlink_t);
|
|
||||||
grovel(off_t);
|
|
||||||
grovel(struct timespec);
|
|
||||||
grovel(uid_t);
|
|
||||||
footer2("openbsd", "types");
|
|
||||||
}
|
|
||||||
|
|
||||||
void openbsd_stat()
|
|
||||||
{
|
|
||||||
header2("openbsd", "stat");
|
|
||||||
struct("stat");
|
|
||||||
grovel2(dev_t, "st_dev");
|
|
||||||
grovel2(ino_t, "st_ino");
|
|
||||||
grovel2(mode_t, "st_mode");
|
|
||||||
grovel2(nlink_t, "st_nlink");
|
|
||||||
grovel2(uid_t, "st_uid");
|
|
||||||
grovel2(gid_t, "st_gid");
|
|
||||||
grovel2(dev_t, "st_rdev");
|
|
||||||
grovel2(int32_t, "st_lspare0");
|
|
||||||
grovel2(struct timespec, "st_atim");
|
|
||||||
grovel2(struct timespec, "st_mtim");
|
|
||||||
grovel2(struct timespec, "st_ctim");
|
|
||||||
grovel2(off_t, "st_size");
|
|
||||||
grovel2(int64_t, "st_blocks");
|
|
||||||
grovel2(u_int32_t, "st_blksize");
|
|
||||||
grovel2(u_int32_t, "st_flags");
|
|
||||||
grovel2(u_int32_t, "st_gen");
|
|
||||||
grovel2(int32_t, "st_lspare1");
|
|
||||||
grovel2(struct timespec, "st_birthtimespec");
|
|
||||||
grovel2(int64_t, "st_qspare1");
|
|
||||||
grovel2end(int64_t, "st_qspare2");
|
|
||||||
footer2("openbsd", "stat");
|
|
||||||
}
|
|
||||||
|
|
||||||
void unix_types()
|
|
||||||
{
|
|
||||||
grovel(dev_t);
|
|
||||||
grovel(gid_t);
|
|
||||||
grovel(ino_t);
|
|
||||||
grovel(int32_t);
|
|
||||||
grovel(int64_t);
|
|
||||||
grovel(mode_t);
|
|
||||||
grovel(nlink_t);
|
|
||||||
grovel(off_t);
|
|
||||||
grovel(struct timespec);
|
|
||||||
grovel(struct stat);
|
|
||||||
grovel(time_t);
|
|
||||||
grovel(uid_t);
|
|
||||||
}
|
|
||||||
|
|
||||||
void unix_constants()
|
|
||||||
{
|
|
||||||
constant(O_RDONLY);
|
|
||||||
constant(O_WRONLY);
|
|
||||||
constant(O_RDWR);
|
|
||||||
constant(O_APPEND);
|
|
||||||
constant(O_CREAT);
|
|
||||||
constant(O_TRUNC);
|
|
||||||
constant(O_EXCL);
|
|
||||||
constant(FD_SETSIZE);
|
|
||||||
constant(SOL_SOCKET);
|
|
||||||
constant(SO_REUSEADDR);
|
|
||||||
constant(SO_OOBINLINE);
|
|
||||||
constant(SO_SNDTIMEO);
|
|
||||||
constant(SO_RCVTIMEO);
|
|
||||||
constant(F_SETFL);
|
|
||||||
constant(O_NONBLOCK);
|
|
||||||
constant(EINTR);
|
|
||||||
constant(EAGAIN);
|
|
||||||
constant(EINPROGRESS);
|
|
||||||
constant(PROT_READ);
|
|
||||||
constant(PROT_WRITE);
|
|
||||||
constant(MAP_FILE);
|
|
||||||
constant(MAP_SHARED);
|
|
||||||
constant(PATH_MAX);
|
|
||||||
grovel(pid_t);
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
int main() {
|
|
||||||
#ifdef FREEBSD
|
|
||||||
grovel(blkcnt_t);
|
|
||||||
grovel(blksize_t);
|
|
||||||
grovel(fflags_t);
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#ifdef OPENBSD
|
|
||||||
openbsd_stat();
|
|
||||||
openbsd_types();
|
|
||||||
#endif
|
|
||||||
grovel(blkcnt_t);
|
|
||||||
grovel(blksize_t);
|
|
||||||
//grovel(fflags_t);
|
|
||||||
grovel(ssize_t);
|
|
||||||
|
|
||||||
grovel(size_t);
|
|
||||||
grovel(struct kevent);
|
|
||||||
#ifdef UNIX
|
|
||||||
unix_types();
|
|
||||||
unix_constants();
|
|
||||||
#endif
|
|
||||||
|
|
||||||
return 0;
|
|
||||||
}
|
|
|
@ -57,6 +57,7 @@ HELP: clear
|
||||||
{ $description "Clears the data stack." } ;
|
{ $description "Clears the data stack." } ;
|
||||||
|
|
||||||
HELP: build
|
HELP: build
|
||||||
|
{ $values { "n" integer } }
|
||||||
{ $description "The current build number. Factor increments this number whenever a new boot image is created." } ;
|
{ $description "The current build number. Factor increments this number whenever a new boot image is created." } ;
|
||||||
|
|
||||||
HELP: hashcode*
|
HELP: hashcode*
|
||||||
|
|
|
@ -235,11 +235,11 @@ M: dinput-game-input-backend instance-id
|
||||||
succeeded-quot call
|
succeeded-quot call
|
||||||
] failed-quot if ; inline
|
] failed-quot if ; inline
|
||||||
|
|
||||||
: pov-values
|
CONSTANT: pov-values
|
||||||
{
|
{
|
||||||
pov-up pov-up-right pov-right pov-down-right
|
pov-up pov-up-right pov-right pov-down-right
|
||||||
pov-down pov-down-left pov-left pov-up-left
|
pov-down pov-down-left pov-left pov-up-left
|
||||||
} ; inline
|
}
|
||||||
|
|
||||||
: >axis ( long -- float )
|
: >axis ( long -- float )
|
||||||
32767 - 32767.0 /f ;
|
32767 - 32767.0 /f ;
|
||||||
|
|
|
@ -2,8 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: arrays calendar io.directories io.encodings.utf8
|
USING: arrays calendar io.directories io.encodings.utf8
|
||||||
io.files io.launcher mason.child mason.cleanup mason.common
|
io.files io.launcher mason.child mason.cleanup mason.common
|
||||||
mason.email mason.help mason.release mason.report namespaces
|
mason.help mason.release mason.report namespaces prettyprint ;
|
||||||
prettyprint ;
|
|
||||||
IN: mason.build
|
IN: mason.build
|
||||||
|
|
||||||
: create-build-dir ( -- )
|
: create-build-dir ( -- )
|
||||||
|
@ -26,7 +25,6 @@ IN: mason.build
|
||||||
build-child
|
build-child
|
||||||
upload-help
|
upload-help
|
||||||
release
|
release
|
||||||
email-report
|
|
||||||
cleanup ;
|
cleanup ;
|
||||||
|
|
||||||
MAIN: build
|
MAIN: build
|
|
@ -3,7 +3,7 @@
|
||||||
USING: accessors arrays calendar combinators.short-circuit
|
USING: accessors arrays calendar combinators.short-circuit
|
||||||
continuations debugger http.client io.directories io.files
|
continuations debugger http.client io.directories io.files
|
||||||
io.launcher io.pathnames kernel make mason.common mason.config
|
io.launcher io.pathnames kernel make mason.common mason.config
|
||||||
mason.platform mason.report namespaces sequences ;
|
mason.platform mason.report mason.email namespaces sequences ;
|
||||||
IN: mason.child
|
IN: mason.child
|
||||||
|
|
||||||
: make-cmd ( -- args )
|
: make-cmd ( -- args )
|
||||||
|
@ -90,4 +90,5 @@ IN: mason.child
|
||||||
|
|
||||||
build-clean? status-clean status-dirty ? return-with
|
build-clean? status-clean status-dirty ? return-with
|
||||||
] callcc1
|
] callcc1
|
||||||
status set ;
|
status set
|
||||||
|
email-report ;
|
|
@ -1,24 +1,14 @@
|
||||||
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
|
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: bootstrap.image continuations debugger fry
|
USING: bootstrap.image continuations debugger fry io.directories
|
||||||
io.directories io.directories.hierarchy io.files io.launcher
|
io.directories.hierarchy io.encodings.ascii io.files io.launcher
|
||||||
kernel mason.common namespaces sequences ;
|
kernel mason.common namespaces sequences ;
|
||||||
FROM: mason.config => target-os ;
|
FROM: mason.config => target-os ;
|
||||||
IN: mason.release.tidy
|
IN: mason.release.tidy
|
||||||
|
|
||||||
: common-files ( -- seq )
|
: common-files ( -- seq )
|
||||||
|
"build-support/cleanup" ascii file-lines
|
||||||
images [ boot-image-name ] map
|
images [ boot-image-name ] map
|
||||||
{
|
|
||||||
"vm"
|
|
||||||
"temp"
|
|
||||||
"logs"
|
|
||||||
".git"
|
|
||||||
".gitignore"
|
|
||||||
"Makefile"
|
|
||||||
"unmaintained"
|
|
||||||
"unfinished"
|
|
||||||
"build-support"
|
|
||||||
}
|
|
||||||
append ;
|
append ;
|
||||||
|
|
||||||
: remove-common-files ( -- )
|
: remove-common-files ( -- )
|
||||||
|
|
917
misc/factor.el
917
misc/factor.el
|
@ -1,917 +0,0 @@
|
||||||
;;; factor.el --- Interacting with Factor within emacs
|
|
||||||
;;
|
|
||||||
;; Authors: Eduardo Cavazos <wayo.cavazos@gmail.com>
|
|
||||||
;; Jose A Ortega Ruiz <jao@gnu.org>
|
|
||||||
;; Keywords: languages
|
|
||||||
|
|
||||||
;;; Commentary:
|
|
||||||
|
|
||||||
;;; Quick setup:
|
|
||||||
|
|
||||||
;; Add these lines to your .emacs file:
|
|
||||||
;;
|
|
||||||
;; (load-file "/scratch/repos/Factor/misc/factor.el")
|
|
||||||
;; (setq factor-binary "/scratch/repos/Factor/factor")
|
|
||||||
;; (setq factor-image "/scratch/repos/Factor/factor.image")
|
|
||||||
;;
|
|
||||||
;; Of course, you'll have to edit the directory paths for your system
|
|
||||||
;; accordingly. Alternatively, put this file in your load-path and use
|
|
||||||
;;
|
|
||||||
;; (require 'factor)
|
|
||||||
;;
|
|
||||||
;; instead of load-file.
|
|
||||||
;;
|
|
||||||
;; That's all you have to do to "install" factor.el on your
|
|
||||||
;; system. Whenever you edit a factor file, Emacs will know to switch
|
|
||||||
;; to Factor mode.
|
|
||||||
;;
|
|
||||||
;; For further customization options,
|
|
||||||
;; M-x customize-group RET factor
|
|
||||||
;;
|
|
||||||
;; To start a Factor listener inside Emacs,
|
|
||||||
;; M-x run-factor
|
|
||||||
|
|
||||||
;;; Requirements:
|
|
||||||
|
|
||||||
(require 'font-lock)
|
|
||||||
(require 'comint)
|
|
||||||
(require 'view)
|
|
||||||
(require 'ring)
|
|
||||||
|
|
||||||
;;; Customization:
|
|
||||||
|
|
||||||
(defgroup factor nil
|
|
||||||
"Factor mode"
|
|
||||||
:group 'languages)
|
|
||||||
|
|
||||||
(defcustom factor-default-indent-width 4
|
|
||||||
"Default indentantion width for factor-mode.
|
|
||||||
|
|
||||||
This value will be used for the local variable
|
|
||||||
`factor-indent-width' in new factor buffers. For existing code,
|
|
||||||
we first check if `factor-indent-width' is set explicitly in a
|
|
||||||
local variable section or line (e.g. '! -*- factor-indent-witdth: 2 -*-').
|
|
||||||
If that's not the case, `factor-mode' tries to infer its correct
|
|
||||||
value from the existing code in the buffer."
|
|
||||||
:type 'integer
|
|
||||||
:group 'factor)
|
|
||||||
|
|
||||||
(defcustom factor-binary "~/factor/factor"
|
|
||||||
"Full path to the factor executable to use when starting a listener."
|
|
||||||
:type '(file :must-match t)
|
|
||||||
:group 'factor)
|
|
||||||
|
|
||||||
(defcustom factor-image "~/factor/factor.image"
|
|
||||||
"Full path to the factor image to use when starting a listener."
|
|
||||||
:type '(file :must-match t)
|
|
||||||
:group 'factor)
|
|
||||||
|
|
||||||
(defcustom factor-use-doc-window t
|
|
||||||
"When on, use a separate window to display help information.
|
|
||||||
Disable to see that information in the factor-listener comint
|
|
||||||
window."
|
|
||||||
:type 'boolean
|
|
||||||
:group 'factor)
|
|
||||||
|
|
||||||
(defcustom factor-listener-use-other-window t
|
|
||||||
"Use a window other than the current buffer's when switching to
|
|
||||||
the factor-listener buffer."
|
|
||||||
:type 'boolean
|
|
||||||
:group 'factor)
|
|
||||||
|
|
||||||
(defcustom factor-listener-window-allow-split t
|
|
||||||
"Allow window splitting when switching to the factor-listener
|
|
||||||
buffer."
|
|
||||||
:type 'boolean
|
|
||||||
:group 'factor)
|
|
||||||
|
|
||||||
(defcustom factor-help-always-ask t
|
|
||||||
"When enabled, always ask for confirmation in help prompts."
|
|
||||||
:type 'boolean
|
|
||||||
:group 'factor)
|
|
||||||
|
|
||||||
(defcustom factor-help-use-minibuffer t
|
|
||||||
"When enabled, use the minibuffer for short help messages."
|
|
||||||
:type 'boolean
|
|
||||||
:group 'factor)
|
|
||||||
|
|
||||||
(defcustom factor-display-compilation-output t
|
|
||||||
"Display the REPL buffer before compiling files."
|
|
||||||
:type 'boolean
|
|
||||||
:group 'factor)
|
|
||||||
|
|
||||||
(defcustom factor-mode-hook nil
|
|
||||||
"Hook run when entering Factor mode."
|
|
||||||
:type 'hook
|
|
||||||
:group 'factor)
|
|
||||||
|
|
||||||
(defcustom factor-help-mode-hook nil
|
|
||||||
"Hook run by `factor-help-mode'."
|
|
||||||
:type 'hook
|
|
||||||
:group 'factor)
|
|
||||||
|
|
||||||
(defgroup factor-faces nil
|
|
||||||
"Faces used in Factor mode"
|
|
||||||
:group 'factor
|
|
||||||
:group 'faces)
|
|
||||||
|
|
||||||
(defface factor-font-lock-parsing-word (face-default-spec font-lock-keyword-face)
|
|
||||||
"Face for parsing words."
|
|
||||||
:group 'factor-faces)
|
|
||||||
|
|
||||||
(defface factor-font-lock-declaration (face-default-spec font-lock-keyword-face)
|
|
||||||
"Face for declaration words (inline, parsing ...)."
|
|
||||||
:group 'factor-faces)
|
|
||||||
|
|
||||||
(defface factor-font-lock-comment (face-default-spec font-lock-comment-face)
|
|
||||||
"Face for comments."
|
|
||||||
:group 'factor-faces)
|
|
||||||
|
|
||||||
(defface factor-font-lock-string (face-default-spec font-lock-string-face)
|
|
||||||
"Face for strings."
|
|
||||||
:group 'factor-faces)
|
|
||||||
|
|
||||||
(defface factor-font-lock-stack-effect (face-default-spec font-lock-comment-face)
|
|
||||||
"Face for stack effect specifications."
|
|
||||||
:group 'factor-faces)
|
|
||||||
|
|
||||||
(defface factor-font-lock-word-definition (face-default-spec font-lock-function-name-face)
|
|
||||||
"Face for word, generic or method being defined."
|
|
||||||
:group 'factor-faces)
|
|
||||||
|
|
||||||
(defface factor-font-lock-symbol-definition (face-default-spec font-lock-variable-name-face)
|
|
||||||
"Face for name of symbol being defined."
|
|
||||||
:group 'factor-faces)
|
|
||||||
|
|
||||||
(defface factor-font-lock-vocabulary-name (face-default-spec font-lock-constant-face)
|
|
||||||
"Face for names of vocabularies in USE or USING."
|
|
||||||
:group 'factor-faces)
|
|
||||||
|
|
||||||
(defface factor-font-lock-type-definition (face-default-spec font-lock-type-face)
|
|
||||||
"Face for type (tuple) names."
|
|
||||||
:group 'factor-faces)
|
|
||||||
|
|
||||||
(defface factor-font-lock-constructor (face-default-spec font-lock-type-face)
|
|
||||||
"Face for constructors (<foo>)."
|
|
||||||
:group 'factor-faces)
|
|
||||||
|
|
||||||
(defface factor-font-lock-setter-word (face-default-spec font-lock-function-name-face)
|
|
||||||
"Face for setter words (>>foo)."
|
|
||||||
:group 'factor-faces)
|
|
||||||
|
|
||||||
(defface factor-font-lock-parsing-word (face-default-spec font-lock-keyword-face)
|
|
||||||
"Face for parsing words."
|
|
||||||
:group 'factor-faces)
|
|
||||||
|
|
||||||
(defface factor-font-lock-help-mode-headlines '((t (:bold t :weight bold)))
|
|
||||||
"Face for headlines in help buffers."
|
|
||||||
:group 'factor-faces)
|
|
||||||
|
|
||||||
|
|
||||||
;;; Compatibility
|
|
||||||
(when (not (fboundp 'ring-member))
|
|
||||||
(defun ring-member (ring item)
|
|
||||||
(catch 'found
|
|
||||||
(dotimes (ind (ring-length ring) nil)
|
|
||||||
(when (equal item (ring-ref ring ind))
|
|
||||||
(throw 'found ind))))))
|
|
||||||
|
|
||||||
|
|
||||||
;;; Factor mode font lock:
|
|
||||||
|
|
||||||
(defconst factor--parsing-words
|
|
||||||
'("{" "}" "^:" "^::" ";" "<<" "<PRIVATE" ">>"
|
|
||||||
"BIN:" "BV{" "B{" "C:" "C-STRUCT:" "C-UNION:" "CHAR:" "CS{" "C{"
|
|
||||||
"DEFER:" "ERROR:" "EXCLUDE:" "FORGET:"
|
|
||||||
"GENERIC#" "GENERIC:" "HEX:" "HOOK:" "H{"
|
|
||||||
"IN:" "INSTANCE:" "INTERSECTION:"
|
|
||||||
"M:" "MACRO:" "MACRO::" "MAIN:" "MATH:" "METHOD:" "MIXIN:"
|
|
||||||
"OCT:" "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:"
|
|
||||||
"REQUIRE:" "REQUIRES:" "SINGLETON:" "SLOT:" "SYMBOL:" "SYMBOLS:"
|
|
||||||
"TUPLE:" "T{" "t\\??" "TYPEDEF:"
|
|
||||||
"UNION:" "USE:" "USING:" "V{" "VARS:" "W{"))
|
|
||||||
|
|
||||||
(defconst factor--regex-parsing-words-ext
|
|
||||||
(regexp-opt '("B" "call-next-method" "delimiter" "f" "initial:" "read-only")
|
|
||||||
'words))
|
|
||||||
|
|
||||||
(defconst factor--declaration-words
|
|
||||||
'("flushable" "foldable" "inline" "parsing" "recursive"))
|
|
||||||
|
|
||||||
(defconst factor--regex-declaration-words
|
|
||||||
(regexp-opt factor--declaration-words 'words))
|
|
||||||
|
|
||||||
(defsubst factor--regex-second-word (prefixes)
|
|
||||||
(format "^%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t)))
|
|
||||||
|
|
||||||
(defconst factor--regex-method-definition
|
|
||||||
"^M: +\\([^ ]+\\) +\\([^ ]+\\)")
|
|
||||||
|
|
||||||
(defconst factor--regex-word-definition
|
|
||||||
(factor--regex-second-word '(":" "::" "GENERIC:")))
|
|
||||||
|
|
||||||
(defconst factor--regex-type-definition
|
|
||||||
(factor--regex-second-word '("TUPLE:" "SINGLETON:")))
|
|
||||||
|
|
||||||
(defconst factor--regex-parent-type "^TUPLE: +[^ ]+ +< +\\([^ ]+\\)")
|
|
||||||
|
|
||||||
(defconst factor--regex-constructor "<[^ >]+>")
|
|
||||||
|
|
||||||
(defconst factor--regex-setter "\\W>>[^ ]+\\b")
|
|
||||||
|
|
||||||
(defconst factor--regex-symbol-definition
|
|
||||||
(factor--regex-second-word '("SYMBOL:" "VAR:")))
|
|
||||||
|
|
||||||
(defconst factor--regex-stack-effect " ( .* )")
|
|
||||||
|
|
||||||
(defconst factor--regex-using-lines "^USING: +\\(\\([^;]\\|[\n\r\f]\\)*\\);")
|
|
||||||
|
|
||||||
(defconst factor--regex-use-line "^USE: +\\(.*\\)$")
|
|
||||||
|
|
||||||
(defconst factor--font-lock-keywords
|
|
||||||
`((,factor--regex-stack-effect . 'factor-font-lock-stack-effect)
|
|
||||||
("\\(P\\|SBUF\\)\"" 1 'factor-font-lock-parsing-word)
|
|
||||||
,@(mapcar #'(lambda (w) (cons (concat "\\(^\\| \\)\\(" w "\\)\\($\\| \\)")
|
|
||||||
'(2 'factor-font-lock-parsing-word)))
|
|
||||||
factor--parsing-words)
|
|
||||||
(,factor--regex-parsing-words-ext . 'factor-font-lock-parsing-word)
|
|
||||||
(,factor--regex-declaration-words 1 'factor-font-lock-declaration)
|
|
||||||
(,factor--regex-word-definition 2 'factor-font-lock-word-definition)
|
|
||||||
(,factor--regex-type-definition 2 'factor-font-lock-type-definition)
|
|
||||||
(,factor--regex-method-definition (1 'factor-font-lock-type-definition)
|
|
||||||
(2 'factor-font-lock-word-definition))
|
|
||||||
(,factor--regex-parent-type 1 'factor-font-lock-type-definition)
|
|
||||||
(,factor--regex-constructor . 'factor-font-lock-constructor)
|
|
||||||
(,factor--regex-setter . 'factor-font-lock-setter-word)
|
|
||||||
(,factor--regex-symbol-definition 2 'factor-font-lock-symbol-definition)
|
|
||||||
(,factor--regex-use-line 1 'factor-font-lock-vocabulary-name))
|
|
||||||
"Font lock keywords definition for Factor mode.")
|
|
||||||
|
|
||||||
|
|
||||||
;;; Factor mode syntax:
|
|
||||||
|
|
||||||
(defconst factor--regex-definition-starters
|
|
||||||
(regexp-opt '("VARS" "TUPLE" "MACRO" "MACRO:" "M" ":" "")))
|
|
||||||
|
|
||||||
(defconst factor--regex-definition-start
|
|
||||||
(format "^\\(%s:\\) " factor--regex-definition-starters))
|
|
||||||
|
|
||||||
(defconst factor--regex-definition-end
|
|
||||||
(format "\\(;\\( +%s\\)*\\)" factor--regex-declaration-words))
|
|
||||||
|
|
||||||
(defconst factor--font-lock-syntactic-keywords
|
|
||||||
`(("\\(#!\\)" (1 "<"))
|
|
||||||
(" \\(!\\)" (1 "<"))
|
|
||||||
("^\\(!\\)" (1 "<"))
|
|
||||||
("\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))))
|
|
||||||
|
|
||||||
(defvar factor-mode-syntax-table nil
|
|
||||||
"Syntax table used while in Factor mode.")
|
|
||||||
|
|
||||||
(if factor-mode-syntax-table
|
|
||||||
()
|
|
||||||
(let ((i 0))
|
|
||||||
(setq factor-mode-syntax-table (make-syntax-table))
|
|
||||||
|
|
||||||
;; Default is atom-constituent
|
|
||||||
(while (< i 256)
|
|
||||||
(modify-syntax-entry i "_ " factor-mode-syntax-table)
|
|
||||||
(setq i (1+ i)))
|
|
||||||
|
|
||||||
;; Word components.
|
|
||||||
(setq i ?0)
|
|
||||||
(while (<= i ?9)
|
|
||||||
(modify-syntax-entry i "w " factor-mode-syntax-table)
|
|
||||||
(setq i (1+ i)))
|
|
||||||
(setq i ?A)
|
|
||||||
(while (<= i ?Z)
|
|
||||||
(modify-syntax-entry i "w " factor-mode-syntax-table)
|
|
||||||
(setq i (1+ i)))
|
|
||||||
(setq i ?a)
|
|
||||||
(while (<= i ?z)
|
|
||||||
(modify-syntax-entry i "w " factor-mode-syntax-table)
|
|
||||||
(setq i (1+ i)))
|
|
||||||
|
|
||||||
;; Whitespace
|
|
||||||
(modify-syntax-entry ?\t " " factor-mode-syntax-table)
|
|
||||||
(modify-syntax-entry ?\f " " factor-mode-syntax-table)
|
|
||||||
(modify-syntax-entry ?\r " " factor-mode-syntax-table)
|
|
||||||
(modify-syntax-entry ? " " factor-mode-syntax-table)
|
|
||||||
|
|
||||||
;; (end of) Comments
|
|
||||||
(modify-syntax-entry ?\n ">" factor-mode-syntax-table)
|
|
||||||
|
|
||||||
;; Parenthesis
|
|
||||||
(modify-syntax-entry ?\[ "(] " factor-mode-syntax-table)
|
|
||||||
(modify-syntax-entry ?\] ")[ " factor-mode-syntax-table)
|
|
||||||
(modify-syntax-entry ?{ "(} " factor-mode-syntax-table)
|
|
||||||
(modify-syntax-entry ?} "){ " factor-mode-syntax-table)
|
|
||||||
|
|
||||||
(modify-syntax-entry ?\( "()" factor-mode-syntax-table)
|
|
||||||
(modify-syntax-entry ?\) ")(" factor-mode-syntax-table)
|
|
||||||
|
|
||||||
;; Strings
|
|
||||||
(modify-syntax-entry ?\" "\"" factor-mode-syntax-table)
|
|
||||||
(modify-syntax-entry ?\\ "/" factor-mode-syntax-table)))
|
|
||||||
|
|
||||||
|
|
||||||
;;; symbol-at-point
|
|
||||||
|
|
||||||
(defun factor--beginning-of-symbol ()
|
|
||||||
"Move point to the beginning of the current symbol."
|
|
||||||
(while (eq (char-before) ?:) (backward-char))
|
|
||||||
(skip-syntax-backward "w_"))
|
|
||||||
|
|
||||||
(defun factor--end-of-symbol ()
|
|
||||||
"Move point to the end of the current symbol."
|
|
||||||
(skip-syntax-forward "w_")
|
|
||||||
(while (looking-at ":") (forward-char)))
|
|
||||||
|
|
||||||
(put 'factor-symbol 'end-op 'factor--end-of-symbol)
|
|
||||||
(put 'factor-symbol 'beginning-op 'factor--beginning-of-symbol)
|
|
||||||
|
|
||||||
(defsubst factor--symbol-at-point ()
|
|
||||||
(let ((s (substring-no-properties (thing-at-point 'factor-symbol))))
|
|
||||||
(and (> (length s) 0) s)))
|
|
||||||
|
|
||||||
|
|
||||||
;;; Factor mode indentation:
|
|
||||||
|
|
||||||
(make-variable-buffer-local
|
|
||||||
(defvar factor-indent-width factor-default-indent-width
|
|
||||||
"Indentation width in factor buffers. A local variable."))
|
|
||||||
|
|
||||||
(defun factor--guess-indent-width ()
|
|
||||||
"Chooses an indentation value from existing code."
|
|
||||||
(let ((word-cont "^ +[^ ]")
|
|
||||||
(iw))
|
|
||||||
(save-excursion
|
|
||||||
(beginning-of-buffer)
|
|
||||||
(while (not iw)
|
|
||||||
(if (not (re-search-forward factor--regex-definition-start nil t))
|
|
||||||
(setq iw factor-default-indent-width)
|
|
||||||
(forward-line)
|
|
||||||
(when (looking-at word-cont)
|
|
||||||
(setq iw (current-indentation))))))
|
|
||||||
iw))
|
|
||||||
|
|
||||||
(defsubst factor--ppss-brackets-depth ()
|
|
||||||
(nth 0 (syntax-ppss)))
|
|
||||||
|
|
||||||
(defsubst factor--ppss-brackets-start ()
|
|
||||||
(nth 1 (syntax-ppss)))
|
|
||||||
|
|
||||||
(defun factor--ppss-brackets-end ()
|
|
||||||
(save-excursion
|
|
||||||
(goto-char (factor--ppss-brackets-start))
|
|
||||||
(condition-case nil
|
|
||||||
(progn (forward-sexp)
|
|
||||||
(1- (point)))
|
|
||||||
(error -1))))
|
|
||||||
|
|
||||||
(defsubst factor--indentation-at (pos)
|
|
||||||
(save-excursion (goto-char pos) (current-indentation)))
|
|
||||||
|
|
||||||
(defsubst factor--at-first-char-p ()
|
|
||||||
(= (- (point) (line-beginning-position)) (current-indentation)))
|
|
||||||
|
|
||||||
(defconst factor--regex-single-liner
|
|
||||||
(format "^%s" (regexp-opt '("DEFER:" "GENERIC:" "IN:"
|
|
||||||
"PRIVATE>" "<PRIVATE"
|
|
||||||
"SINGLETON:" "SYMBOL:" "USE:" "VAR:"))))
|
|
||||||
|
|
||||||
(defconst factor--regex-begin-of-def
|
|
||||||
(format "^USING: \\|\\(%s\\)\\|\\(%s .*\\)"
|
|
||||||
factor--regex-definition-start
|
|
||||||
factor--regex-single-liner))
|
|
||||||
|
|
||||||
(defconst factor--regex-end-of-def-line
|
|
||||||
(format "^.*%s" factor--regex-definition-end))
|
|
||||||
|
|
||||||
(defconst factor--regex-end-of-def
|
|
||||||
(format "\\(%s\\)\\|\\(%s .*\\)"
|
|
||||||
factor--regex-end-of-def-line
|
|
||||||
factor--regex-single-liner))
|
|
||||||
|
|
||||||
(defsubst factor--at-begin-of-def ()
|
|
||||||
(looking-at factor--regex-begin-of-def))
|
|
||||||
|
|
||||||
(defsubst factor--at-end-of-def ()
|
|
||||||
(looking-at factor--regex-end-of-def))
|
|
||||||
|
|
||||||
(defsubst factor--looking-at-emptiness ()
|
|
||||||
(looking-at "^[ \t]*$"))
|
|
||||||
|
|
||||||
(defun factor--at-setter-line ()
|
|
||||||
(save-excursion
|
|
||||||
(beginning-of-line)
|
|
||||||
(if (not (factor--looking-at-emptiness))
|
|
||||||
(re-search-forward factor--regex-setter (line-end-position) t)
|
|
||||||
(forward-line -1)
|
|
||||||
(or (factor--at-constructor-line)
|
|
||||||
(factor--at-setter-line)))))
|
|
||||||
|
|
||||||
(defun factor--at-constructor-line ()
|
|
||||||
(save-excursion
|
|
||||||
(beginning-of-line)
|
|
||||||
(re-search-forward factor--regex-constructor (line-end-position) t)))
|
|
||||||
|
|
||||||
(defsubst factor--increased-indentation (&optional i)
|
|
||||||
(+ (or i (current-indentation)) factor-indent-width))
|
|
||||||
(defsubst factor--decreased-indentation (&optional i)
|
|
||||||
(- (or i (current-indentation)) factor-indent-width))
|
|
||||||
|
|
||||||
(defun factor--indent-in-brackets ()
|
|
||||||
(save-excursion
|
|
||||||
(beginning-of-line)
|
|
||||||
(when (> (factor--ppss-brackets-depth) 0)
|
|
||||||
(let ((op (factor--ppss-brackets-start))
|
|
||||||
(cl (factor--ppss-brackets-end))
|
|
||||||
(ln (line-number-at-pos)))
|
|
||||||
(when (> ln (line-number-at-pos op))
|
|
||||||
(if (and (> cl 0) (= ln (line-number-at-pos cl)))
|
|
||||||
(factor--indentation-at op)
|
|
||||||
(factor--increased-indentation (factor--indentation-at op))))))))
|
|
||||||
|
|
||||||
(defun factor--indent-definition ()
|
|
||||||
(save-excursion
|
|
||||||
(beginning-of-line)
|
|
||||||
(when (factor--at-begin-of-def) 0)))
|
|
||||||
|
|
||||||
(defun factor--indent-setter-line ()
|
|
||||||
(when (factor--at-setter-line)
|
|
||||||
(save-excursion
|
|
||||||
(let ((indent (and (factor--at-constructor-line) (current-indentation))))
|
|
||||||
(while (not (or indent
|
|
||||||
(bobp)
|
|
||||||
(factor--at-begin-of-def)
|
|
||||||
(factor--at-end-of-def)))
|
|
||||||
(if (factor--at-constructor-line)
|
|
||||||
(setq indent (factor--increased-indentation))
|
|
||||||
(forward-line -1)))
|
|
||||||
indent))))
|
|
||||||
|
|
||||||
(defun factor--indent-continuation ()
|
|
||||||
(save-excursion
|
|
||||||
(forward-line -1)
|
|
||||||
(while (and (not (bobp)) (factor--looking-at-emptiness))
|
|
||||||
(forward-line -1))
|
|
||||||
(if (or (factor--at-end-of-def) (factor--at-setter-line))
|
|
||||||
(factor--decreased-indentation)
|
|
||||||
(if (and (factor--at-begin-of-def)
|
|
||||||
(not (looking-at factor--regex-using-lines)))
|
|
||||||
(factor--increased-indentation)
|
|
||||||
(current-indentation)))))
|
|
||||||
|
|
||||||
(defun factor--calculate-indentation ()
|
|
||||||
"Calculate Factor indentation for line at point."
|
|
||||||
(or (and (bobp) 0)
|
|
||||||
(factor--indent-definition)
|
|
||||||
(factor--indent-in-brackets)
|
|
||||||
(factor--indent-setter-line)
|
|
||||||
(factor--indent-continuation)
|
|
||||||
0))
|
|
||||||
|
|
||||||
(defun factor--indent-line ()
|
|
||||||
"Indent current line as Factor code"
|
|
||||||
(let ((target (factor--calculate-indentation))
|
|
||||||
(pos (- (point-max) (point))))
|
|
||||||
(if (= target (current-indentation))
|
|
||||||
(if (< (current-column) (current-indentation))
|
|
||||||
(back-to-indentation))
|
|
||||||
(beginning-of-line)
|
|
||||||
(delete-horizontal-space)
|
|
||||||
(indent-to target)
|
|
||||||
(if (> (- (point-max) pos) (point))
|
|
||||||
(goto-char (- (point-max) pos))))))
|
|
||||||
|
|
||||||
|
|
||||||
;; Factor mode:
|
|
||||||
(defvar factor-mode-map (make-sparse-keymap)
|
|
||||||
"Key map used by Factor mode.")
|
|
||||||
|
|
||||||
(defsubst factor--beginning-of-defun (&optional times)
|
|
||||||
(re-search-backward factor--regex-begin-of-def nil t times))
|
|
||||||
|
|
||||||
(defsubst factor--end-of-defun ()
|
|
||||||
(re-search-forward factor--regex-end-of-def nil t))
|
|
||||||
|
|
||||||
;;;###autoload
|
|
||||||
(defun factor-mode ()
|
|
||||||
"A mode for editing programs written in the Factor programming language.
|
|
||||||
\\{factor-mode-map}"
|
|
||||||
(interactive)
|
|
||||||
(kill-all-local-variables)
|
|
||||||
(use-local-map factor-mode-map)
|
|
||||||
(setq major-mode 'factor-mode)
|
|
||||||
(setq mode-name "Factor")
|
|
||||||
;; Font locking
|
|
||||||
(set (make-local-variable 'comment-start) "! ")
|
|
||||||
(set (make-local-variable 'parse-sexp-lookup-properties) t)
|
|
||||||
(set (make-local-variable 'font-lock-comment-face) 'factor-font-lock-comment)
|
|
||||||
(set (make-local-variable 'font-lock-string-face) 'factor-font-lock-string)
|
|
||||||
(set (make-local-variable 'font-lock-defaults)
|
|
||||||
`(factor--font-lock-keywords
|
|
||||||
nil nil nil nil
|
|
||||||
(font-lock-syntactic-keywords . ,factor--font-lock-syntactic-keywords)))
|
|
||||||
|
|
||||||
(set-syntax-table factor-mode-syntax-table)
|
|
||||||
;; Defun navigation
|
|
||||||
(set (make-local-variable 'beginning-of-defun-function) 'factor--beginning-of-defun)
|
|
||||||
(set (make-local-variable 'end-of-defun-function) 'factor--end-of-defun)
|
|
||||||
(set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
|
|
||||||
;; Indentation
|
|
||||||
(set (make-local-variable 'indent-line-function) 'factor--indent-line)
|
|
||||||
(setq factor-indent-width (factor--guess-indent-width))
|
|
||||||
(setq indent-tabs-mode nil)
|
|
||||||
;; ElDoc
|
|
||||||
(set (make-local-variable 'eldoc-documentation-function) 'factor--eldoc)
|
|
||||||
|
|
||||||
(run-hooks 'factor-mode-hook))
|
|
||||||
|
|
||||||
(add-to-list 'auto-mode-alist '("\\.factor\\'" . factor-mode))
|
|
||||||
|
|
||||||
|
|
||||||
;;; Factor listener mode:
|
|
||||||
|
|
||||||
;;;###autoload
|
|
||||||
(define-derived-mode factor-listener-mode comint-mode "Factor Listener"
|
|
||||||
"Major mode for interacting with an inferior Factor listener process.
|
|
||||||
\\{factor-listener-mode-map}"
|
|
||||||
(set (make-local-variable 'comint-prompt-regexp) "^( [^)]+ ) "))
|
|
||||||
|
|
||||||
(defvar factor--listener-buffer nil
|
|
||||||
"The buffer in which the Factor listener is running.")
|
|
||||||
|
|
||||||
(defun factor--listener-start-process ()
|
|
||||||
"Start an inferior Factor listener process, using
|
|
||||||
`factor-binary' and `factor-image'."
|
|
||||||
(setq factor--listener-buffer
|
|
||||||
(apply 'make-comint "factor" (expand-file-name factor-binary) nil
|
|
||||||
`("-run=listener" ,(format "-i=%s" (expand-file-name factor-image)))))
|
|
||||||
(with-current-buffer factor--listener-buffer
|
|
||||||
(factor-listener-mode)))
|
|
||||||
|
|
||||||
(defun factor--listener-process (&optional start)
|
|
||||||
(or (and (buffer-live-p factor--listener-buffer)
|
|
||||||
(get-buffer-process factor--listener-buffer))
|
|
||||||
(if (not start)
|
|
||||||
(error "No running factor listener. Try M-x run-factor.")
|
|
||||||
(factor--listener-start-process)
|
|
||||||
(factor--listener-process t))))
|
|
||||||
|
|
||||||
;;;###autoload
|
|
||||||
(defalias 'switch-to-factor 'run-factor)
|
|
||||||
;;;###autoload
|
|
||||||
(defun run-factor (&optional arg)
|
|
||||||
"Show the factor-listener buffer, starting the process if needed."
|
|
||||||
(interactive)
|
|
||||||
(let ((buf (process-buffer (factor--listener-process t)))
|
|
||||||
(pop-up-windows factor-listener-window-allow-split))
|
|
||||||
(if factor-listener-use-other-window
|
|
||||||
(pop-to-buffer buf)
|
|
||||||
(switch-to-buffer buf))))
|
|
||||||
|
|
||||||
(defun factor-telnet-to-port (port)
|
|
||||||
(interactive "nPort: ")
|
|
||||||
(switch-to-buffer
|
|
||||||
(make-comint-in-buffer "factor-telnet" nil (cons "localhost" port))))
|
|
||||||
|
|
||||||
(defun factor-telnet ()
|
|
||||||
(interactive)
|
|
||||||
(factor-telnet-to-port 9000))
|
|
||||||
|
|
||||||
(defun factor-telnet-factory ()
|
|
||||||
(interactive)
|
|
||||||
(factor-telnet-to-port 9010))
|
|
||||||
|
|
||||||
|
|
||||||
;;; Factor listener interaction:
|
|
||||||
|
|
||||||
(defun factor--listener-send-cmd (cmd)
|
|
||||||
(let ((proc (factor--listener-process)))
|
|
||||||
(when proc
|
|
||||||
(let* ((out (get-buffer-create "*factor messages*"))
|
|
||||||
(beg (with-current-buffer out (goto-char (point-max)))))
|
|
||||||
(comint-redirect-send-command-to-process cmd out proc nil t)
|
|
||||||
(with-current-buffer factor--listener-buffer
|
|
||||||
(while (not comint-redirect-completed) (sleep-for 0 1)))
|
|
||||||
(with-current-buffer out
|
|
||||||
(split-string (buffer-substring-no-properties beg (point-max))
|
|
||||||
"[\"\f\n\r\v]+" t))))))
|
|
||||||
|
|
||||||
;;;;; Current vocabulary:
|
|
||||||
(make-variable-buffer-local
|
|
||||||
(defvar factor--current-vocab nil
|
|
||||||
"Current vocabulary."))
|
|
||||||
|
|
||||||
(defconst factor--regexp-current-vocab "^IN: +\\([^ \r\n\f]+\\)")
|
|
||||||
|
|
||||||
(defun factor--current-buffer-vocab ()
|
|
||||||
(save-excursion
|
|
||||||
(when (or (re-search-backward factor--regexp-current-vocab nil t)
|
|
||||||
(re-search-forward factor--regexp-current-vocab nil t))
|
|
||||||
(setq factor--current-vocab (match-string-no-properties 1)))))
|
|
||||||
|
|
||||||
(defun factor--current-listener-vocab ()
|
|
||||||
(car (factor--listener-send-cmd "USING: parser ; in get .")))
|
|
||||||
|
|
||||||
(defun factor--set-current-listener-vocab (&optional vocab)
|
|
||||||
(factor--listener-send-cmd
|
|
||||||
(format "IN: %s" (or vocab (factor--current-buffer-vocab))))
|
|
||||||
t)
|
|
||||||
|
|
||||||
(defmacro factor--with-vocab (vocab &rest body)
|
|
||||||
(let ((current (make-symbol "current")))
|
|
||||||
`(let ((,current (factor--current-listener-vocab)))
|
|
||||||
(factor--set-current-listener-vocab ,vocab)
|
|
||||||
(prog1 (condition-case nil (progn . ,body) (error nil))
|
|
||||||
(factor--set-current-listener-vocab ,current)))))
|
|
||||||
|
|
||||||
(put 'factor--with-vocab 'lisp-indent-function 1)
|
|
||||||
|
|
||||||
;;;;; Synchronous interaction:
|
|
||||||
|
|
||||||
(defsubst factor--listener-vocab-cmds (cmds &optional vocab)
|
|
||||||
(factor--with-vocab vocab
|
|
||||||
(mapcar #'factor--listener-send-cmd cmds)))
|
|
||||||
|
|
||||||
(defsubst factor--listener-vocab-cmd (cmd &optional vocab)
|
|
||||||
(factor--with-vocab vocab
|
|
||||||
(factor--listener-send-cmd cmd)))
|
|
||||||
|
|
||||||
|
|
||||||
;;;;; Buffer cycling and docs
|
|
||||||
|
|
||||||
|
|
||||||
(defconst factor--cycle-endings
|
|
||||||
'(".factor" "-tests.factor" "-docs.factor"))
|
|
||||||
|
|
||||||
(defconst factor--regex-cycle-endings
|
|
||||||
(format "\\(.*?\\)\\(%s\\)$"
|
|
||||||
(regexp-opt factor--cycle-endings)))
|
|
||||||
|
|
||||||
(defconst factor--cycle-endings-ring
|
|
||||||
(let ((ring (make-ring (length factor--cycle-endings))))
|
|
||||||
(dolist (e factor--cycle-endings ring)
|
|
||||||
(ring-insert ring e))))
|
|
||||||
|
|
||||||
(defun factor--cycle-next (file)
|
|
||||||
(let* ((match (string-match factor--regex-cycle-endings file))
|
|
||||||
(base (and match (match-string-no-properties 1 file)))
|
|
||||||
(ending (and match (match-string-no-properties 2 file)))
|
|
||||||
(idx (and ending (ring-member factor--cycle-endings-ring ending)))
|
|
||||||
(gfl (lambda (i) (concat base (ring-ref factor--cycle-endings-ring i)))))
|
|
||||||
(if (not idx) file
|
|
||||||
(let ((l (length factor--cycle-endings)) (i 1) next)
|
|
||||||
(while (and (not next) (< i l))
|
|
||||||
(when (file-exists-p (funcall gfl (+ idx i)))
|
|
||||||
(setq next (+ idx i)))
|
|
||||||
(setq i (1+ i)))
|
|
||||||
(funcall gfl (or next idx))))))
|
|
||||||
|
|
||||||
(defun factor-visit-other-file (&optional file)
|
|
||||||
"Cycle between code, tests and docs factor files."
|
|
||||||
(interactive)
|
|
||||||
(find-file (factor--cycle-next (or file (buffer-file-name)))))
|
|
||||||
|
|
||||||
|
|
||||||
;;;;; Interface: See
|
|
||||||
|
|
||||||
(defconst factor--regex-error-marker "^Type :help for debugging")
|
|
||||||
(defconst factor--regex-data-stack "^--- Data stack:")
|
|
||||||
|
|
||||||
(defun factor--prune-ans-strings (ans)
|
|
||||||
(nreverse
|
|
||||||
(catch 'done
|
|
||||||
(let ((res))
|
|
||||||
(dolist (a ans res)
|
|
||||||
(cond ((string-match factor--regex-stack-effect a)
|
|
||||||
(throw 'done (cons a res)))
|
|
||||||
((string-match factor--regex-data-stack a)
|
|
||||||
(throw 'done res))
|
|
||||||
((string-match factor--regex-error-marker a)
|
|
||||||
(throw 'done nil))
|
|
||||||
(t (push a res))))))))
|
|
||||||
|
|
||||||
(defun factor--see-ans-to-string (ans)
|
|
||||||
(let ((s (mapconcat #'identity (factor--prune-ans-strings ans) " "))
|
|
||||||
(font-lock-verbose nil))
|
|
||||||
(and (> (length s) 0)
|
|
||||||
(with-temp-buffer
|
|
||||||
(insert s)
|
|
||||||
(factor-mode)
|
|
||||||
(font-lock-fontify-buffer)
|
|
||||||
(buffer-string)))))
|
|
||||||
|
|
||||||
(defun factor--see-current-word (&optional word)
|
|
||||||
(let ((word (or word (factor--symbol-at-point))))
|
|
||||||
(when word
|
|
||||||
(let ((answer (factor--listener-send-cmd (format "\\ %s see" word))))
|
|
||||||
(and answer (factor--see-ans-to-string answer))))))
|
|
||||||
|
|
||||||
(defalias 'factor--eldoc 'factor--see-current-word)
|
|
||||||
|
|
||||||
(defun factor-see-current-word (&optional word)
|
|
||||||
"Echo in the minibuffer information about word at point."
|
|
||||||
(interactive)
|
|
||||||
(let* ((proc (factor--listener-process))
|
|
||||||
(word (or word (factor--symbol-at-point)))
|
|
||||||
(msg (factor--see-current-word word)))
|
|
||||||
(if msg (message "%s" msg)
|
|
||||||
(if word (message "No help found for '%s'" word)
|
|
||||||
(message "No word at point")))))
|
|
||||||
|
|
||||||
;;; to fix:
|
|
||||||
(defun factor-run-file ()
|
|
||||||
(interactive)
|
|
||||||
(when (and (buffer-modified-p)
|
|
||||||
(y-or-n-p (format "Save file %s? " (buffer-file-name))))
|
|
||||||
(save-buffer))
|
|
||||||
(when factor-display-compilation-output
|
|
||||||
(factor-display-output-buffer))
|
|
||||||
(comint-send-string "*factor*" (format "\"%s\"" (buffer-file-name)))
|
|
||||||
(comint-send-string "*factor*" " run-file\n"))
|
|
||||||
|
|
||||||
(defun factor-display-output-buffer ()
|
|
||||||
(with-current-buffer "*factor*"
|
|
||||||
(goto-char (point-max))
|
|
||||||
(unless (get-buffer-window (current-buffer) t)
|
|
||||||
(display-buffer (current-buffer) t))))
|
|
||||||
|
|
||||||
(defun factor-send-string (str)
|
|
||||||
(let ((n (length (split-string str "\n"))))
|
|
||||||
(save-excursion
|
|
||||||
(set-buffer "*factor*")
|
|
||||||
(goto-char (point-max))
|
|
||||||
(if (> n 1) (newline))
|
|
||||||
(insert str)
|
|
||||||
(comint-send-input))))
|
|
||||||
|
|
||||||
(defun factor-send-region (start end)
|
|
||||||
(interactive "r")
|
|
||||||
(let ((str (buffer-substring start end))
|
|
||||||
(n (count-lines start end)))
|
|
||||||
(save-excursion
|
|
||||||
(set-buffer "*factor*")
|
|
||||||
(goto-char (point-max))
|
|
||||||
(if (> n 1) (newline))
|
|
||||||
(insert str)
|
|
||||||
(comint-send-input))))
|
|
||||||
|
|
||||||
(defun factor-send-definition ()
|
|
||||||
(interactive)
|
|
||||||
(factor-send-region (search-backward ":")
|
|
||||||
(search-forward ";")))
|
|
||||||
|
|
||||||
(defun factor-edit ()
|
|
||||||
(interactive)
|
|
||||||
(comint-send-string "*factor*" "\\ ")
|
|
||||||
(comint-send-string "*factor*" (thing-at-point 'sexp))
|
|
||||||
(comint-send-string "*factor*" " edit\n"))
|
|
||||||
|
|
||||||
(defun factor-clear ()
|
|
||||||
(interactive)
|
|
||||||
(factor-send-string "clear"))
|
|
||||||
|
|
||||||
(defun factor-comment-line ()
|
|
||||||
(interactive)
|
|
||||||
(beginning-of-line)
|
|
||||||
(insert "! "))
|
|
||||||
|
|
||||||
|
|
||||||
;;;; Factor help mode:
|
|
||||||
|
|
||||||
(defvar factor-help-mode-map (make-sparse-keymap)
|
|
||||||
"Keymap for Factor help mode.")
|
|
||||||
|
|
||||||
(defconst factor--help-headlines
|
|
||||||
(regexp-opt '("Definition"
|
|
||||||
"Examples"
|
|
||||||
"Generic word contract"
|
|
||||||
"Inputs and outputs"
|
|
||||||
"Parent topics:"
|
|
||||||
"See also"
|
|
||||||
"Syntax"
|
|
||||||
"Vocabulary"
|
|
||||||
"Warning"
|
|
||||||
"Word description")
|
|
||||||
t))
|
|
||||||
|
|
||||||
(defconst factor--help-headlines-regexp (format "^%s" factor--help-headlines))
|
|
||||||
|
|
||||||
(defconst factor--help-font-lock-keywords
|
|
||||||
`((,factor--help-headlines-regexp . 'factor-font-lock-help-mode-headlines)
|
|
||||||
,@factor--font-lock-keywords))
|
|
||||||
|
|
||||||
(defun factor-help-mode ()
|
|
||||||
"Major mode for displaying Factor help messages.
|
|
||||||
\\{factor-help-mode-map}"
|
|
||||||
(interactive)
|
|
||||||
(kill-all-local-variables)
|
|
||||||
(use-local-map factor-help-mode-map)
|
|
||||||
(setq mode-name "Factor Help")
|
|
||||||
(setq major-mode 'factor-help-mode)
|
|
||||||
(set (make-local-variable 'font-lock-defaults)
|
|
||||||
'(factor--help-font-lock-keywords t nil nil nil))
|
|
||||||
(set (make-local-variable 'comint-redirect-subvert-readonly) t)
|
|
||||||
(set (make-local-variable 'comint-redirect-echo-input) nil)
|
|
||||||
(set (make-local-variable 'view-no-disable-on-exit) t)
|
|
||||||
(view-mode)
|
|
||||||
(setq view-exit-action
|
|
||||||
(lambda (buffer)
|
|
||||||
;; Use `with-current-buffer' to make sure that `bury-buffer'
|
|
||||||
;; also removes BUFFER from the selected window.
|
|
||||||
(with-current-buffer buffer
|
|
||||||
(bury-buffer))))
|
|
||||||
(run-mode-hooks 'factor-help-mode-hook))
|
|
||||||
|
|
||||||
(defun factor--listener-help-buffer ()
|
|
||||||
(with-current-buffer (get-buffer-create "*factor-help*")
|
|
||||||
(let ((inhibit-read-only t)) (erase-buffer))
|
|
||||||
(factor-help-mode)
|
|
||||||
(current-buffer)))
|
|
||||||
|
|
||||||
(defvar factor--help-history nil)
|
|
||||||
|
|
||||||
(defun factor--listener-show-help (&optional see)
|
|
||||||
(let* ((proc (factor--listener-process))
|
|
||||||
(def (factor--symbol-at-point))
|
|
||||||
(prompt (format "See%s help on%s: " (if see " short" "")
|
|
||||||
(if def (format " (%s)" def) "")))
|
|
||||||
(ask (or (not (eq major-mode 'factor-mode))
|
|
||||||
(not def)
|
|
||||||
factor-help-always-ask))
|
|
||||||
(cmd (format "\\ %s %s"
|
|
||||||
(if ask (read-string prompt nil 'factor--help-history def) def)
|
|
||||||
(if see "see" "help")))
|
|
||||||
(hb (factor--listener-help-buffer)))
|
|
||||||
(comint-redirect-send-command-to-process cmd hb proc nil)
|
|
||||||
(pop-to-buffer hb)
|
|
||||||
(beginning-of-buffer hb)))
|
|
||||||
|
|
||||||
;;;; Interface: see/help commands
|
|
||||||
|
|
||||||
(defun factor-see (&optional arg)
|
|
||||||
"See a help summary of symbol at point.
|
|
||||||
By default, the information is shown in the minibuffer. When
|
|
||||||
called with a prefix argument, the information is displayed in a
|
|
||||||
separate help buffer."
|
|
||||||
(interactive "P")
|
|
||||||
(if (if factor-help-use-minibuffer (not arg) arg)
|
|
||||||
(factor-see-current-word)
|
|
||||||
(factor--listener-show-help t)))
|
|
||||||
|
|
||||||
(defun factor-help ()
|
|
||||||
"Show extended help about the symbol at point, using a help
|
|
||||||
buffer."
|
|
||||||
(interactive)
|
|
||||||
(factor--listener-show-help))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(defun factor-refresh-all ()
|
|
||||||
"Reload source files and documentation for all loaded
|
|
||||||
vocabularies which have been modified on disk."
|
|
||||||
(interactive)
|
|
||||||
(comint-send-string "*factor*" "refresh-all\n"))
|
|
||||||
|
|
||||||
|
|
||||||
;;; Key bindings:
|
|
||||||
|
|
||||||
(defun factor--define-key (key cmd &optional both)
|
|
||||||
(let ((ms (list factor-mode-map)))
|
|
||||||
(when both (push factor-help-mode-map ms))
|
|
||||||
(dolist (m ms)
|
|
||||||
(define-key m (vector '(control ?c) key) cmd)
|
|
||||||
(define-key m (vector '(control ?c) `(control ,key)) cmd))))
|
|
||||||
|
|
||||||
(defun factor--define-auto-indent-key (key)
|
|
||||||
(define-key factor-mode-map (vector key)
|
|
||||||
(lambda (n)
|
|
||||||
(interactive "p")
|
|
||||||
(self-insert-command n)
|
|
||||||
(indent-for-tab-command))))
|
|
||||||
|
|
||||||
(factor--define-key ?f 'factor-run-file)
|
|
||||||
(factor--define-key ?r 'factor-send-region)
|
|
||||||
(factor--define-key ?d 'factor-send-definition)
|
|
||||||
(factor--define-key ?s 'factor-see t)
|
|
||||||
(factor--define-key ?e 'factor-edit)
|
|
||||||
(factor--define-key ?z 'switch-to-factor t)
|
|
||||||
(factor--define-key ?o 'factor-visit-other-file)
|
|
||||||
(factor--define-key ?c 'comment-region)
|
|
||||||
|
|
||||||
(factor--define-auto-indent-key ?\])
|
|
||||||
(factor--define-auto-indent-key ?\})
|
|
||||||
|
|
||||||
(define-key factor-mode-map "\C-ch" 'factor-help)
|
|
||||||
(define-key factor-help-mode-map "\C-ch" 'factor-help)
|
|
||||||
(define-key factor-mode-map "\C-m" 'newline-and-indent)
|
|
||||||
|
|
||||||
(define-key factor-listener-mode-map [f8] 'factor-refresh-all)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(provide 'factor)
|
|
||||||
;;; factor.el ends here
|
|
Loading…
Reference in New Issue