From 442652625285b0a4e865b2be839dfebb7efce7ea Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 25 Feb 2009 23:30:30 -0600 Subject: [PATCH 1/5] Fixing some things I broke --- basis/checksums/openssl/openssl-docs.factor | 4 +++- basis/memoize/memoize-tests.factor | 2 +- basis/tools/profiler/profiler-tests.factor | 2 +- basis/ui/gadgets/frames/frames-docs.factor | 20 ++++++++++---------- basis/ui/x11/x11.factor | 6 +++--- basis/xml/entities/entities-docs.factor | 3 ++- core/kernel/kernel-docs.factor | 1 + extra/game-input/dinput/dinput.factor | 4 ++-- 8 files changed, 23 insertions(+), 19 deletions(-) diff --git a/basis/checksums/openssl/openssl-docs.factor b/basis/checksums/openssl/openssl-docs.factor index 750e05f3c8..234e032406 100644 --- a/basis/checksums/openssl/openssl-docs.factor +++ b/basis/checksums/openssl/openssl-docs.factor @@ -1,5 +1,5 @@ IN: checksums.openssl -USING: help.syntax help.markup ; +USING: checksums help.syntax help.markup ; 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." } ; @@ -9,9 +9,11 @@ HELP: { $description "Creates a new OpenSSL checksum object." } ; HELP: openssl-md5 +{ $values { "value" checksum } } { $description "The OpenSSL MD5 message digest implementation." } ; HELP: openssl-sha1 +{ $values { "value" checksum } } { $description "The OpenSSL SHA1 message digest implementation." } ; HELP: unknown-digest diff --git a/basis/memoize/memoize-tests.factor b/basis/memoize/memoize-tests.factor index 03549d9b80..168a0061e3 100644 --- a/basis/memoize/memoize-tests.factor +++ b/basis/memoize/memoize-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: math kernel memoize tools.test parser generalizations -prettyprint io.streams.string sequences eval ; +prettyprint io.streams.string sequences eval namespaces ; IN: memoize.tests MEMO: fib ( m -- n ) diff --git a/basis/tools/profiler/profiler-tests.factor b/basis/tools/profiler/profiler-tests.factor index 5bf62ef156..3924cc7b83 100644 --- a/basis/tools/profiler/profiler-tests.factor +++ b/basis/tools/profiler/profiler-tests.factor @@ -1,6 +1,6 @@ IN: tools.profiler.tests 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 ; [ t ] [ diff --git a/basis/ui/gadgets/frames/frames-docs.factor b/basis/ui/gadgets/frames/frames-docs.factor index 36c7feed97..9b7bafd914 100644 --- a/basis/ui/gadgets/frames/frames-docs.factor +++ b/basis/ui/gadgets/frames/frames-docs.factor @@ -1,4 +1,4 @@ -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 ; IN: ui.gadgets.frames @@ -22,15 +22,15 @@ ARTICLE: "ui-frame-layout" "Frame layouts" drop { $description "Symbolic constant for a common input to " { $link grid-add } "." } print-element ; -HELP: @center $ui-frame-constant ; -HELP: @left $ui-frame-constant ; -HELP: @right $ui-frame-constant ; -HELP: @top $ui-frame-constant ; -HELP: @bottom $ui-frame-constant ; -HELP: @top-left $ui-frame-constant ; -HELP: @top-right $ui-frame-constant ; -HELP: @bottom-left $ui-frame-constant ; -HELP: @bottom-right $ui-frame-constant ; +{ @center @left @right @top @bottom @top-left @top-right @bottom-left @bottom-right } +[ + [ + { + { $values { "i" integer } { "j" integer } } + { $ui-frame-constant } + } + ] dip set-word-help +] each HELP: frame { $class-description "A frame is a gadget which lays out its children in a 3x3 grid. If the frame is enlarged past its preferred size, the center gadget fills up available room." diff --git a/basis/ui/x11/x11.factor b/basis/ui/x11/x11.factor index d0d7eeb234..2a622a6985 100755 --- a/basis/ui/x11/x11.factor +++ b/basis/ui/x11/x11.factor @@ -5,7 +5,7 @@ ui.gestures ui.backend ui.clipboards ui.gadgets.worlds ui.render ui.event-loop assocs kernel math namespaces opengl sequences strings x11.xlib x11.events x11.xim x11.glx x11.clipboard 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 environment ascii ; IN: ui.x11 @@ -73,9 +73,9 @@ CONSTANT: key-codes : valid-input? ( string gesture -- ? ) over empty? [ 2drop f ] [ 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 ; diff --git a/basis/xml/entities/entities-docs.factor b/basis/xml/entities/entities-docs.factor index 2fccb500a4..158b83d9a8 100644 --- a/basis/xml/entities/entities-docs.factor +++ b/basis/xml/entities/entities-docs.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2009 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: help.markup help.syntax ; +USING: help.markup help.syntax assocs ; IN: 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" } ; 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." } { $see-also with-entities } ; diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index b8191004db..342376fb22 100644 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -57,6 +57,7 @@ HELP: clear { $description "Clears the data stack." } ; HELP: build +{ $values { "n" integer } } { $description "The current build number. Factor increments this number whenever a new boot image is created." } ; HELP: hashcode* diff --git a/extra/game-input/dinput/dinput.factor b/extra/game-input/dinput/dinput.factor index 328e4ff013..d13fca28cb 100755 --- a/extra/game-input/dinput/dinput.factor +++ b/extra/game-input/dinput/dinput.factor @@ -235,11 +235,11 @@ M: dinput-game-input-backend instance-id succeeded-quot call ] failed-quot if ; inline -: pov-values +CONSTANT: pov-values { pov-up pov-up-right pov-right pov-down-right pov-down pov-down-left pov-left pov-up-left - } ; inline + } : >axis ( long -- float ) 32767 - 32767.0 /f ; From efede1957148aa229a79029b5ce05f38cda547b4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 26 Feb 2009 01:25:13 -0600 Subject: [PATCH 2/5] Make some errors better in the stack checker --- basis/stack-checker/backend/backend.factor | 10 +++--- basis/stack-checker/errors/errors.factor | 34 +++++++++++++++++-- .../errors/prettyprint/prettyprint.factor | 4 +-- .../known-words/known-words.factor | 2 +- 4 files changed, 40 insertions(+), 10 deletions(-) diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor index 3c298bdfed..0596f3d0bd 100755 --- a/basis/stack-checker/backend/backend.factor +++ b/basis/stack-checker/backend/backend.factor @@ -44,11 +44,11 @@ IN: stack-checker.backend : pop-r ( -- obj ) meta-r dup empty? - [ too-many-r> inference-error ] [ pop ] if ; + [ too-many-r> ] [ pop ] if ; : consume-r ( n -- seq ) meta-r 2dup length > - [ too-many-r> inference-error ] when + [ too-many-r> ] when [ swap tail* ] [ shorten-by ] 2bi ; : 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, ; : check->r ( -- ) - meta-r empty? [ \ too-many->r inference-error ] unless ; + meta-r empty? [ too-many->r ] unless ; : infer-quot-here ( quot -- ) meta-r [ @@ -104,7 +104,7 @@ M: object apply-object push-literal ; : infer-literal-quot ( literal -- ) dup recursive-quotation? [ - value>> recursive-quotation-error inference-error + value>> recursive-quotation-error ] [ dup value>> callable? [ [ value>> ] @@ -139,7 +139,7 @@ M: object apply-object push-literal ; meta-d clone #return, ; : required-stack-effect ( word -- effect ) - dup stack-effect [ ] [ missing-effect inference-error ] ?if ; + dup stack-effect [ ] [ missing-effect ] ?if ; : check-effect ( word effect -- ) over required-stack-effect 2dup effect<= diff --git a/basis/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor index 58944e7bc4..6a9a7cb8af 100644 --- a/basis/stack-checker/errors/errors.factor +++ b/basis/stack-checker/errors/errors.factor @@ -5,6 +5,9 @@ assocs accessors namespaces compiler.errors stack-checker.values stack-checker.recursive-state ; IN: stack-checker.errors +: pretty-word ( word -- word' ) + dup method-body? [ "method-generic" word-prop ] when ; + TUPLE: inference-error error type word ; M: inference-error compiler-error-type type>> ; @@ -20,9 +23,11 @@ M: inference-error compiler-error-type type>> ; : inference-warning ( ... class -- * ) +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 ; @@ -31,10 +36,17 @@ TUPLE: unbalanced-branches-error branches quots ; TUPLE: too-many->r ; +: too-many->r ( -- * ) \ too-many->r inference-error ; + TUPLE: too-many-r> ; +: too-many-r> ( -- * ) \ too-many-r> inference-error ; + TUPLE: missing-effect word ; +: missing-effect ( word -- * ) + pretty-word \ missing-effect inference-error ; + TUPLE: 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 ; +: recursive-quotation-error ( word -- * ) + \ recursive-quotation-error inference-error ; + TUPLE: undeclared-recursion-error word ; +: undeclared-recursion-error ( word -- * ) + \ undeclared-recursion-error inference-error ; + TUPLE: diverging-recursion-error word ; +: diverging-recursion-error ( word -- * ) + \ diverging-recursion-error inference-error ; + TUPLE: unbalanced-recursion-error word height ; +: unbalanced-recursion-error ( word height -- * ) + \ unbalanced-recursion-error inference-error ; + TUPLE: inconsistent-recursive-call-error word ; +: inconsistent-recursive-call-error ( word -- * ) + \ inconsistent-recursive-call-error inference-error ; + TUPLE: unknown-primitive-error ; + +: unknown-primitive-error ( -- * ) + \ unknown-primitive-error inference-error ; diff --git a/basis/stack-checker/errors/prettyprint/prettyprint.factor b/basis/stack-checker/errors/prettyprint/prettyprint.factor index 21c6d64402..9dc82339b5 100644 --- a/basis/stack-checker/errors/prettyprint/prettyprint.factor +++ b/basis/stack-checker/errors/prettyprint/prettyprint.factor @@ -9,8 +9,8 @@ M: inference-error error-help error>> error-help ; M: inference-error error. [ word>> [ "In word: " write . ] when* ] [ error>> error. ] bi ; -M: literal-expected summary - drop "Literal value expected" ; +M: literal-expected error. + "Got a computed value where a " write what>> write " was expected" print ; M: unbalanced-branches-error error. "Unbalanced branches:" print diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 4ac9d802ed..0c20c41d99 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -87,7 +87,7 @@ M: composed infer-call* terminated? get [ 1 infer-r> infer-call ] unless ; M: object infer-call* - \ literal-expected inference-warning ; + "literal quotation" literal-expected ; : infer-nslip ( n -- ) [ infer->r infer-call ] [ infer-r> ] bi ; From 1efbd686a1ce15b65bb12f720338f8d639d87009 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 26 Feb 2009 01:37:05 -0600 Subject: [PATCH 3/5] Remove two useless files: grovel.c and factor.el (superceded by fu/fu.el) --- build-support/grovel.c | 179 -------- misc/factor.el | 917 ----------------------------------------- 2 files changed, 1096 deletions(-) delete mode 100644 build-support/grovel.c delete mode 100644 misc/factor.el diff --git a/build-support/grovel.c b/build-support/grovel.c deleted file mode 100644 index db16aa9bca..0000000000 --- a/build-support/grovel.c +++ /dev/null @@ -1,179 +0,0 @@ -#include -#include - -#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 - #include - #include - #include - #include - #include - #include - #include -#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; -} diff --git a/misc/factor.el b/misc/factor.el deleted file mode 100644 index 5f56072c1d..0000000000 --- a/misc/factor.el +++ /dev/null @@ -1,917 +0,0 @@ -;;; factor.el --- Interacting with Factor within emacs -;; -;; Authors: Eduardo Cavazos -;; Jose A Ortega Ruiz -;; 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 ()." - :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 - '("{" "}" "^:" "^::" ";" "<<" ">" - "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>" " (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 From 8f10b7d9660fa4b9a4e5de69c93f7b64d7e0b90d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 26 Feb 2009 01:38:01 -0600 Subject: [PATCH 4/5] mason.release.tidy: get list of files to delete from build-support/cleanup --- extra/mason/release/tidy/tidy.factor | 16 +++------------- 1 file changed, 3 insertions(+), 13 deletions(-) diff --git a/extra/mason/release/tidy/tidy.factor b/extra/mason/release/tidy/tidy.factor index 7327209a06..497be09044 100644 --- a/extra/mason/release/tidy/tidy.factor +++ b/extra/mason/release/tidy/tidy.factor @@ -1,24 +1,14 @@ ! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: bootstrap.image continuations debugger fry -io.directories io.directories.hierarchy io.files io.launcher +USING: bootstrap.image continuations debugger fry io.directories +io.directories.hierarchy io.encodings.ascii io.files io.launcher kernel mason.common namespaces sequences ; FROM: mason.config => target-os ; IN: mason.release.tidy : common-files ( -- seq ) + "build-support/cleanup" ascii file-lines images [ boot-image-name ] map - { - "vm" - "temp" - "logs" - ".git" - ".gitignore" - "Makefile" - "unmaintained" - "unfinished" - "build-support" - } append ; : remove-common-files ( -- ) From a5561146b88ae82062275b2e09e4a6c2f56ee2f1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 26 Feb 2009 01:45:15 -0600 Subject: [PATCH 5/5] mason: still send a report of post-build tasks (binary packaging, etc) fail --- extra/mason/build/build.factor | 4 +--- extra/mason/child/child.factor | 5 +++-- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/extra/mason/build/build.factor b/extra/mason/build/build.factor index 4d705610b4..706dc12616 100644 --- a/extra/mason/build/build.factor +++ b/extra/mason/build/build.factor @@ -2,8 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays calendar io.directories io.encodings.utf8 io.files io.launcher mason.child mason.cleanup mason.common -mason.email mason.help mason.release mason.report namespaces -prettyprint ; +mason.help mason.release mason.report namespaces prettyprint ; IN: mason.build : create-build-dir ( -- ) @@ -26,7 +25,6 @@ IN: mason.build build-child upload-help release - email-report cleanup ; MAIN: build \ No newline at end of file diff --git a/extra/mason/child/child.factor b/extra/mason/child/child.factor index 5a3a0d6ceb..087ed2c3cb 100644 --- a/extra/mason/child/child.factor +++ b/extra/mason/child/child.factor @@ -3,7 +3,7 @@ USING: accessors arrays calendar combinators.short-circuit continuations debugger http.client io.directories io.files 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 : make-cmd ( -- args ) @@ -90,4 +90,5 @@ IN: mason.child build-clean? status-clean status-dirty ? return-with ] callcc1 - status set ; \ No newline at end of file + status set + email-report ; \ No newline at end of file