From 9f09463d2f7eeacec7ff1766b647a7ed32a73991 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 14 Apr 2009 19:24:32 -0500 Subject: [PATCH 1/7] help.html: workaround for cygwin not liking unicode path names --- basis/help/html/html.factor | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index d880af5b55..3de8dae218 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -4,24 +4,26 @@ USING: io.encodings.utf8 io.encodings.ascii io.encodings.binary io.files io.files.temp io.directories html.streams help kernel assocs sequences make words accessors arrays help.topics vocabs tools.vocabs help.vocabs namespaces prettyprint io -vocabs.loader serialize fry memoize unicode.case math.order +vocabs.loader serialize fry memoize ascii unicode.case math.order sorting debugger html xml.syntax xml.writer ; IN: help.html : escape-char ( ch -- ) - dup H{ - { CHAR: " "__quo__" } - { CHAR: * "__star__" } - { CHAR: : "__colon__" } - { CHAR: < "__lt__" } - { CHAR: > "__gt__" } - { CHAR: ? "__que__" } - { CHAR: \\ "__back__" } - { CHAR: | "__pipe__" } - { CHAR: / "__slash__" } - { CHAR: , "__comma__" } - { CHAR: @ "__at__" } - } at [ % ] [ , ] ?if ; + dup ascii? [ + dup H{ + { CHAR: " "__quo__" } + { CHAR: * "__star__" } + { CHAR: : "__colon__" } + { CHAR: < "__lt__" } + { CHAR: > "__gt__" } + { CHAR: ? "__que__" } + { CHAR: \\ "__back__" } + { CHAR: | "__pipe__" } + { CHAR: / "__slash__" } + { CHAR: , "__comma__" } + { CHAR: @ "__at__" } + } at [ % ] [ , ] ?if + ] [ number>string "__" "__" surround ] if ; : escape-filename ( string -- filename ) [ [ escape-char ] each ] "" make ; From 8bbc3d577e58ffcf5813d591185df1cd5d77d887 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 14 Apr 2009 19:57:25 -0500 Subject: [PATCH 2/7] Load fix --- basis/help/html/html.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index 3de8dae218..f4a8742486 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -5,7 +5,7 @@ io.files io.files.temp io.directories html.streams help kernel assocs sequences make words accessors arrays help.topics vocabs tools.vocabs help.vocabs namespaces prettyprint io vocabs.loader serialize fry memoize ascii unicode.case math.order -sorting debugger html xml.syntax xml.writer ; +sorting debugger html xml.syntax xml.writer math.parser ; IN: help.html : escape-char ( ch -- ) @@ -23,7 +23,7 @@ IN: help.html { CHAR: , "__comma__" } { CHAR: @ "__at__" } } at [ % ] [ , ] ?if - ] [ number>string "__" "__" surround ] if ; + ] [ number>string "__" "__" surround % ] if ; : escape-filename ( string -- filename ) [ [ escape-char ] each ] "" make ; From 8d0bc707039a506628418f4ed68113a0a5a849c8 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Tue, 14 Apr 2009 23:13:21 -0300 Subject: [PATCH 3/7] irc.client: Fix NICK message declaration --- extra/irc/client/internals/internals.factor | 2 +- extra/irc/messages/messages.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/irc/client/internals/internals.factor b/extra/irc/client/internals/internals.factor index 2081ae4510..5d7cca4bfa 100644 --- a/extra/irc/client/internals/internals.factor +++ b/extra/irc/client/internals/internals.factor @@ -91,7 +91,7 @@ M: irc-message handle-outgoing-irc irc-message>string irc-print t ; : handle-reader-message ( irc-message -- ) irc> in-messages>> mailbox-put ; : (handle-disconnect) ( -- ) - irc> in-messages>> irc-disconnected swap mailbox-put + irc-disconnected irc> in-messages>> mailbox-put irc> reconnect-time>> sleep (connect-irc) (do-login) ; diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 2ea476e1b4..a6bf02f8a7 100755 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -7,7 +7,7 @@ IN: irc.messages ! connection IRC: pass "PASS" password ; -IRC: nick "NICK" nickname ; +IRC: nick "NICK" : nickname ; IRC: user "USER" user mode _ : realname ; IRC: oper "OPER" name password ; IRC: mode "MODE" name mode parameter ; From dbb35d3500d36b8450d778f9598f0a27d38f830a Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Tue, 14 Apr 2009 23:16:31 -0300 Subject: [PATCH 4/7] irc.logbot: Initial version --- extra/irc/logbot/authors.txt | 1 + extra/irc/logbot/log-line/authors.txt | 1 + extra/irc/logbot/log-line/log-line.factor | 37 +++++++++++++++ extra/irc/logbot/log-line/summary.txt | 1 + extra/irc/logbot/logbot.factor | 56 +++++++++++++++++++++++ extra/irc/logbot/summary.txt | 1 + 6 files changed, 97 insertions(+) create mode 100644 extra/irc/logbot/authors.txt create mode 100644 extra/irc/logbot/log-line/authors.txt create mode 100644 extra/irc/logbot/log-line/log-line.factor create mode 100644 extra/irc/logbot/log-line/summary.txt create mode 100644 extra/irc/logbot/logbot.factor create mode 100644 extra/irc/logbot/summary.txt diff --git a/extra/irc/logbot/authors.txt b/extra/irc/logbot/authors.txt new file mode 100644 index 0000000000..f4a8cb1dc2 --- /dev/null +++ b/extra/irc/logbot/authors.txt @@ -0,0 +1 @@ +Bruno Deferrari diff --git a/extra/irc/logbot/log-line/authors.txt b/extra/irc/logbot/log-line/authors.txt new file mode 100644 index 0000000000..f4a8cb1dc2 --- /dev/null +++ b/extra/irc/logbot/log-line/authors.txt @@ -0,0 +1 @@ +Bruno Deferrari diff --git a/extra/irc/logbot/log-line/log-line.factor b/extra/irc/logbot/log-line/log-line.factor new file mode 100644 index 0000000000..6119e8e81c --- /dev/null +++ b/extra/irc/logbot/log-line/log-line.factor @@ -0,0 +1,37 @@ +! Copyright (C) 2009 Bruno Deferrari. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors irc.messages irc.messages.base kernel make ; +EXCLUDE: sequences => join ; +IN: irc.logbot.log-line + +: dot-or-parens ( string -- string ) + [ "." ] [ " (" prepend ")." append ] if-empty ; + +GENERIC: >log-line ( object -- line ) + +M: irc-message >log-line line>> ; + +M: privmsg >log-line + [ "<" % dup sender>> % "> " % text>> % ] "" make ; + +M: join >log-line + [ "* " % sender>> % " has entered the channel." % ] "" make ; + +M: part >log-line + [ "* " % dup sender>> % " has left the channel" % + comment>> dot-or-parens % ] "" make ; + +M: quit >log-line + [ "* " % dup sender>> % " has left IRC" % + comment>> dot-or-parens % ] "" make ; + +M: kick >log-line + [ "* " % dup sender>> % " has kicked " % dup user>> % + " from the channel" % comment>> dot-or-parens % ] "" make ; + +M: participant-mode >log-line + [ "* " % dup sender>> % " has set mode " % dup mode>> % + " to " % parameter>> % ] "" make ; + +M: nick >log-line + [ "* " % dup sender>> % " is now known as " % nickname>> % ] "" make ; diff --git a/extra/irc/logbot/log-line/summary.txt b/extra/irc/logbot/log-line/summary.txt new file mode 100644 index 0000000000..96ab2bf7a2 --- /dev/null +++ b/extra/irc/logbot/log-line/summary.txt @@ -0,0 +1 @@ +IRC message formatting for logs diff --git a/extra/irc/logbot/logbot.factor b/extra/irc/logbot/logbot.factor new file mode 100644 index 0000000000..a389304b14 --- /dev/null +++ b/extra/irc/logbot/logbot.factor @@ -0,0 +1,56 @@ +! Copyright (C) 2009 Bruno Deferrari. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors calendar calendar.format destructors fry io io.encodings.8-bit +io.files io.pathnames irc.client irc.client.chats irc.messages +irc.messages.base kernel make namespaces sequences threads +irc.logbot.log-line ; +IN: irc.logbot + +CONSTANT: bot-channel "#concatenative" +CONSTANT: log-directory "/tmp/logs" + +SYMBOL: current-day +SYMBOL: current-stream + +: bot-profile ( -- obj ) + "irc.freenode.org" 6667 "flogger" f ; + +: add-timestamp ( string timestamp -- string ) + timestamp>hms "[" prepend "] " append prepend ; + +: timestamp-path ( timestamp -- path ) + timestamp>ymd ".log" append log-directory prepend-path ; + +: timestamp>stream ( timestamp -- stream ) + dup day-of-year current-day get = [ + drop + ] [ + current-stream get [ dispose ] when* + [ day-of-year current-day set ] + [ timestamp-path latin1 ] bi + current-stream set + ] if current-stream get ; + +: log-message ( string timestamp -- ) + [ add-timestamp ] [ timestamp>stream ] bi + [ stream-print ] [ stream-flush ] bi ; + +GENERIC: handle-message ( msg -- ) + +M: object handle-message drop ; +M: irc-message handle-message [ >log-line ] [ timestamp>> ] bi log-message ; + +: bot-loop ( chat -- ) dup hear handle-message bot-loop ; + +: start-bot ( -- ) + bot-profile + [ connect-irc ] + [ + [ bot-channel ] dip + '[ _ [ _ attach-chat ] [ bot-loop ] bi ] + "LogBot" spawn drop + ] bi ; + +: logbot ( -- ) start-bot ; + +MAIN: logbot diff --git a/extra/irc/logbot/summary.txt b/extra/irc/logbot/summary.txt new file mode 100644 index 0000000000..1e49fcb240 --- /dev/null +++ b/extra/irc/logbot/summary.txt @@ -0,0 +1 @@ +An IRC logging bot From 8f287b2c26a2f7dd99300ad8b4258a34d7c170f6 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Tue, 14 Apr 2009 23:36:17 -0300 Subject: [PATCH 5/7] irc.client: Forward messages before processing for now. Change text for some log lines --- extra/irc/client/internals/internals.factor | 3 ++- extra/irc/logbot/log-line/log-line.factor | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/extra/irc/client/internals/internals.factor b/extra/irc/client/internals/internals.factor index 5d7cca4bfa..89c8423f51 100644 --- a/extra/irc/client/internals/internals.factor +++ b/extra/irc/client/internals/internals.factor @@ -112,9 +112,10 @@ M: f handle-input handle-disconnect ; ! Processing loops +! FIXME: should get forward channels, process the message, and then forward : in-multiplexer-loop ( -- ? ) irc> in-messages>> mailbox-get - [ process-message ] [ forward-message ] [ irc-end? not ] tri ; + [ forward-message ] [ process-message ] [ irc-end? not ] tri ; : strings>privmsg ( name string -- privmsg ) " :" prepend append "PRIVMSG " prepend string>irc-message ; diff --git a/extra/irc/logbot/log-line/log-line.factor b/extra/irc/logbot/log-line/log-line.factor index 6119e8e81c..b3af41ad3d 100644 --- a/extra/irc/logbot/log-line/log-line.factor +++ b/extra/irc/logbot/log-line/log-line.factor @@ -15,14 +15,14 @@ M: privmsg >log-line [ "<" % dup sender>> % "> " % text>> % ] "" make ; M: join >log-line - [ "* " % sender>> % " has entered the channel." % ] "" make ; + [ "* " % sender>> % " has joined the channel." % ] "" make ; M: part >log-line [ "* " % dup sender>> % " has left the channel" % comment>> dot-or-parens % ] "" make ; M: quit >log-line - [ "* " % dup sender>> % " has left IRC" % + [ "* " % dup sender>> % " has quit" % comment>> dot-or-parens % ] "" make ; M: kick >log-line From 777cb541f780a36d92d38d443cc8763bcab2a93d Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Wed, 15 Apr 2009 00:03:25 -0300 Subject: [PATCH 6/7] irc.client: Calculate message forwards before processing it (because participants may be deleted from channels) --- extra/irc/client/internals/internals.factor | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/extra/irc/client/internals/internals.factor b/extra/irc/client/internals/internals.factor index 89c8423f51..5bae054e18 100644 --- a/extra/irc/client/internals/internals.factor +++ b/extra/irc/client/internals/internals.factor @@ -45,11 +45,11 @@ M: sequence chat-put [ chat-put ] with each ; ! Server message handling -GENERIC: forward-message ( irc-message -- ) -M: irc-message forward-message +server-chat+ chat-put ; -M: to-one-chat forward-message dup chat> chat-put ; -M: to-all-chats forward-message chats> chat-put ; -M: to-many-chats forward-message dup sender>> participant-chats chat-put ; +GENERIC: message-forwards ( irc-message -- seq ) +M: irc-message message-forwards drop +server-chat+ ; +M: to-one-chat message-forwards chat> ; +M: to-all-chats message-forwards drop chats> ; +M: to-many-chats message-forwards sender>> participant-chats ; GENERIC: process-message ( irc-message -- ) M: object process-message drop ; @@ -112,10 +112,13 @@ M: f handle-input handle-disconnect ; ! Processing loops -! FIXME: should get forward channels, process the message, and then forward : in-multiplexer-loop ( -- ? ) - irc> in-messages>> mailbox-get - [ forward-message ] [ process-message ] [ irc-end? not ] tri ; + irc> in-messages>> mailbox-get { + [ message-forwards ] + [ process-message ] + [ swap chat-put ] + [ irc-end? not ] + } cleave ; : strings>privmsg ( name string -- privmsg ) " :" prepend append "PRIVMSG " prepend string>irc-message ; From 5c6bc3f85e9561e4b454699268019962f3b0d38b Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Wed, 15 Apr 2009 08:13:56 +0200 Subject: [PATCH 7/7] FUEL: Fixes for POSTPONE: forms font-lock. --- misc/fuel/fuel-font-lock.el | 21 +++++++++++---------- misc/fuel/fuel-syntax.el | 4 +++- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/misc/fuel/fuel-font-lock.el b/misc/fuel/fuel-font-lock.el index bc1bb900ce..aa7d25ebbd 100644 --- a/misc/fuel/fuel-font-lock.el +++ b/misc/fuel/fuel-font-lock.el @@ -60,6 +60,7 @@ (declaration keyword "declaration words") (ebnf-form constant "EBNF: ... ;EBNF form") (parsing-word keyword "parsing words") + (postpone-body comment "postponed form") (setter-word function-name "setter words (>>foo)") (getter-word function-name "getter words (foo>>)") (stack-effect comment "stack effect specifications") @@ -76,20 +77,19 @@ (defun fuel-font-lock--syntactic-face (state) (if (nth 3 state) 'factor-font-lock-string (let ((c (char-after (nth 8 state)))) - (cond ((or (char-equal c ?\ ) - (char-equal c ?\n) - (char-equal c ?E)) + (cond ((memq c '(?\ ?\n ?E ?P)) (save-excursion (goto-char (nth 8 state)) (beginning-of-line) - (cond ((looking-at-p "USING: ") + (cond ((looking-at "E") 'factor-font-lock-ebnf-form) + ((looking-at "P") 'factor-font-lock-postpone-body) + ((looking-at-p "USING: ") 'factor-font-lock-vocabulary-name) - ((looking-at-p "\\(TUPLE\\|SYMBOLS\\|VARS\\|SINGLETONS\\):") + ((looking-at-p + "\\(TUPLE\\|SYMBOLS\\|VARS\\|SINGLETONS\\):") 'factor-font-lock-symbol) ((looking-at-p "C-ENUM:\\( \\|\n\\)") 'factor-font-lock-constant) - ((looking-at-p "E") - 'factor-font-lock-ebnf-form) (t 'default)))) ((or (char-equal c ?U) (char-equal c ?C)) 'factor-font-lock-parsing-word) @@ -102,9 +102,10 @@ (,fuel-syntax--alien-function-regex (1 'factor-font-lock-type-name) (2 'factor-font-lock-word)) (,fuel-syntax--vocab-ref-regexp 2 'factor-font-lock-vocabulary-name) - (,fuel-syntax--constructor-decl-regex (1 'factor-font-lock-word) - (2 'factor-font-lock-type-name) - (3 'factor-font-lock-invalid-syntax nil t)) + (,fuel-syntax--constructor-decl-regex + (1 'factor-font-lock-word) + (2 'factor-font-lock-type-name) + (3 'factor-font-lock-invalid-syntax nil t)) (,fuel-syntax--typedef-regex (1 'factor-font-lock-type-name) (2 'factor-font-lock-type-name) (3 'factor-font-lock-invalid-syntax nil t)) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 1c88989366..6b646511ca 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -247,12 +247,14 @@ ;; Strings and chars ("CHAR: \\(\"\\) [^\\\"]*?\\(\"\\)\\([^\\\"]\\|\\\\.\\)*?\\(\"\\)" (1 "w") (2 "\"") (4 "\"")) - ("\\(CHAR:\\|POSTPONE:\\|\\\\\\) \\(.\\)\\( \\|$\\)" (2 "w")) + ("\\(CHAR:\\|\\\\\\) \\(.\\)\\( \\|$\\)" (2 "w")) ("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\.\\)*?\\(\"\\)" (3 "\"") (5 "\"")) ("\\_<\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\.\\)*?\\(\"\\)" (1 "\"") (3 "\"")) ("\\_<<\\(\"\\)\\_>" (1 "\\_>" (1 ">b")) + ;; postpone + ("\\_b")) ;; Multiline constructs ("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "" (1 ">b"))