steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor into smarter_error_list

db4
Slava Pestov 2009-04-15 16:16:14 -05:00
parent 1958ae21a2 c304660fa9
commit ac5ad3582f
11 changed files with 141 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
basis/help/html/html.factor
View File

@ -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
sorting debugger html xml.syntax xml.writer ;
vocabs.loader serialize fry memoize ascii unicode.case math.order
sorting debugger html xml.syntax xml.writer math.parser ;
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 ;

20
extra/irc/client/internals/internals.factor
View File

@ -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 ;
@ -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) ;
@ -113,8 +113,12 @@ M: f handle-input handle-disconnect ;
! Processing loops
: in-multiplexer-loop ( -- ? )
irc> in-messages>> mailbox-get
[ process-message ] [ forward-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 ;

1
extra/irc/logbot/authors.txt Normal file
View File

@ -0,0 +1 @@
Bruno Deferrari

1
extra/irc/logbot/log-line/authors.txt Normal file
View File

@ -0,0 +1 @@
Bruno Deferrari

37
extra/irc/logbot/log-line/log-line.factor Normal file
View File

@ -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 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 quit" %
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 ;

1
extra/irc/logbot/log-line/summary.txt Normal file
View File

@ -0,0 +1 @@
IRC message formatting for logs

56
extra/irc/logbot/logbot.factor Normal file
View File

@ -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 <irc-profile> ;
: 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 <file-writer> ] 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 <irc-client>
[ connect-irc ]
[
[ bot-channel <irc-channel-chat> ] dip
'[ _ [ _ attach-chat ] [ bot-loop ] bi ]
"LogBot" spawn drop
] bi ;
: logbot ( -- ) start-bot ;
MAIN: logbot

1
extra/irc/logbot/summary.txt Normal file
View File

@ -0,0 +1 @@
An IRC logging bot

2
extra/irc/messages/messages.factor
View File

@ -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 ;

21
misc/fuel/fuel-font-lock.el
View File

@ -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))

4
misc/fuel/fuel-syntax.el
View File

@ -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 "<b"))
("\\_<\\(\"\\)>\\_>" (1 ">b"))
;; postpone
("\\_<POSTPONE:\\( \\).*\\(\n\\)" (1 "<b") (2 ">b"))
;; Multiline constructs
("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "<b"))
("\\_<;EBN\\(F\\)\\_>" (1 ">b"))