From ca27c897d092b4b4d5d80c73ea24fb0f635a27b6 Mon Sep 17 00:00:00 2001 From: William Schlieper Date: Wed, 13 Aug 2008 20:52:30 -0400 Subject: [PATCH 01/14] irc.ui: Removed reference to irc.messages.private --- extra/irc/ui/ui.factor | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index 4757e36660..f144674ce9 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -8,7 +8,7 @@ USING: accessors kernel threads combinators concurrency.mailboxes ui.gadgets.scrollers ui.commands ui.gadgets.frames ui.gestures ui.gadgets.tabs ui.gadgets.grids ui.gadgets.packs ui.gadgets.labels io io.styles namespaces calendar calendar.format models continuations - irc.client irc.client.private irc.messages irc.messages.private + irc.client irc.client.private irc.messages irc.ui.commandparser irc.ui.load ; RENAME: join sequences => sjoin @@ -39,7 +39,7 @@ M: ping write-irc M: privmsg write-irc "<" blue write-color - [ prefix>> parse-name write ] keep + [ irc-message-sender write ] keep "> " blue write-color trailing>> write ; @@ -61,24 +61,24 @@ M: own-message write-irc M: join write-irc "* " dark-green write-color - prefix>> parse-name write + irc-message-sender write " has entered the channel." dark-green write-color ; M: part write-irc "* " dark-red write-color - [ prefix>> parse-name write ] keep + [ irc-message-sender write ] keep " has left the channel" dark-red write-color trailing>> dot-or-parens dark-red write-color ; M: quit write-irc "* " dark-red write-color - [ prefix>> parse-name write ] keep + [ irc-message-sender write ] keep " has left IRC" dark-red write-color trailing>> dot-or-parens dark-red write-color ; M: kick write-irc "* " dark-red write-color - [ prefix>> parse-name write ] keep + [ irc-message-sender write ] keep " has kicked " dark-red write-color [ who>> write ] keep " from the channel" dark-red write-color @@ -89,7 +89,7 @@ M: kick write-irc M: mode write-irc "* " blue write-color - [ prefix>> parse-name write ] keep + [ irc-message-sender write ] keep " has applied mode " blue write-color [ full-mode write ] keep " to " blue write-color @@ -97,7 +97,7 @@ M: mode write-irc M: nick write-irc "* " blue write-color - [ prefix>> parse-name write ] keep + [ irc-message-sender write ] keep " is now known as " blue write-color trailing>> write ; From 83574cb5ee01c152e58f0873ca568092c70b76cc Mon Sep 17 00:00:00 2001 From: William Schlieper Date: Wed, 13 Aug 2008 20:58:05 -0400 Subject: [PATCH 02/14] irc.ui: Removed userlist slot from irc-tab --- extra/irc/ui/ui.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index f144674ce9..956644dc52 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -21,7 +21,7 @@ SYMBOL: client TUPLE: ui-window < tabbed client ; -TUPLE: irc-tab < frame listener client window userlist ; +TUPLE: irc-tab < frame listener client window ; : write-color ( str color -- ) foreground associate format ; From 805cb650bd889221009b5841d6298fed8dee49c1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 13 Aug 2008 23:09:43 -0500 Subject: [PATCH 03/14] add find-hrefs word --- extra/html/parser/analyzer/analyzer.factor | 6 ++++++ extra/html/parser/parser.factor | 10 ++++++---- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index dca727b9dc..f167feba06 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -140,6 +140,12 @@ TUPLE: link attributes clickable ; : href-contains? ( str tag -- ? ) attributes>> "href" swap at* [ subseq? ] [ 2drop f ] if ; +: find-hrefs ( vector -- vector' ) + find-links + [ [ + [ name>> "a" = ] + [ attributes>> "href" swap key? ] bi and ] filter + ] map sift [ [ attributes>> "href" swap at ] map ] map concat ; : find-forms ( vector -- vector' ) "form" over find-opening-tags-by-name diff --git a/extra/html/parser/parser.factor b/extra/html/parser/parser.factor index c8aa9aa9e6..dbf6c52a0d 100644 --- a/extra/html/parser/parser.factor +++ b/extra/html/parser/parser.factor @@ -1,4 +1,4 @@ -USING: arrays html.parser.utils hashtables io kernel +USING: accessors arrays html.parser.utils hashtables io kernel namespaces prettyprint quotations sequences splitting state-parser strings unicode.categories unicode.case ; IN: html.parser @@ -23,8 +23,10 @@ SYMBOL: tagstack ] if ; : ( name attributes closing? -- tag ) - { set-tag-name set-tag-attributes set-tag-closing? } - tag construct ; + tag new + swap >>closing? + swap >>attributes + swap >>name ; : make-tag ( str attribs -- tag ) >r [ closing-tag? ] keep "/" trim1 r> rot ; @@ -75,7 +77,7 @@ SYMBOL: tagstack read-quote ] [ read-token - ] if ; + ] if [ blank? ] trim ; : read-comment ( -- ) "-->" take-string* make-comment-tag push-tag ; From d50afc2a35317618b1b3c5ca70b863edef3d6304 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 13 Aug 2008 23:13:13 -0500 Subject: [PATCH 04/14] remove unfinished code for now --- extra/html/parser/printer/printer.factor | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/extra/html/parser/printer/printer.factor b/extra/html/parser/printer/printer.factor index d352a97688..27cb21a927 100644 --- a/extra/html/parser/printer/printer.factor +++ b/extra/html/parser/printer/printer.factor @@ -83,13 +83,6 @@ M: src-printer print-closing-named-tag ( tag -- ) SYMBOL: tab-width SYMBOL: #indentations -: html-pp ( vector -- ) - [ - 0 #indentations set - 2 tab-width set - - ] with-scope ; - : print-tabs ( -- ) tab-width get #indentations get * CHAR: \s write ; @@ -125,3 +118,6 @@ M: printer print-tag ( tag -- ) ! H{ { table-gap { 10 10 } } } [ ! [ [ [ [ . ] with-cell ] each ] with-row ] each ! ] tabular-output + +! : html-pp ( vector -- ) + ! [ 0 #indentations set 2 tab-width set ] with-scope ; From d9074c9d4e0c5ba7b634c5d5e5dee13cfa447554 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 13 Aug 2008 23:20:44 -0500 Subject: [PATCH 05/14] fix bootstrap --- basis/unix/bsd/bsd.factor | 1 + basis/unix/linux/linux.factor | 1 + basis/unix/unix.factor | 3 --- 3 files changed, 2 insertions(+), 3 deletions(-) diff --git a/basis/unix/bsd/bsd.factor b/basis/unix/bsd/bsd.factor index 68444de85f..6934d5b8dc 100755 --- a/basis/unix/bsd/bsd.factor +++ b/basis/unix/bsd/bsd.factor @@ -16,6 +16,7 @@ IN: unix : O_TRUNC HEX: 0400 ; inline : O_EXCL HEX: 0800 ; inline : O_NOCTTY HEX: 20000 ; inline +: O_NDELAY O_NONBLOCK ; inline : SOL_SOCKET HEX: ffff ; inline : SO_REUSEADDR HEX: 4 ; inline diff --git a/basis/unix/linux/linux.factor b/basis/unix/linux/linux.factor index cc1e056b8b..0c08cf0f2b 100755 --- a/basis/unix/linux/linux.factor +++ b/basis/unix/linux/linux.factor @@ -16,6 +16,7 @@ USING: alien.syntax ; : O_TRUNC HEX: 0200 ; inline : O_APPEND HEX: 0400 ; inline : O_NONBLOCK HEX: 0800 ; inline +: O_NDELAY O_NONBLOCK ; inline : SOL_SOCKET 1 ; inline diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index 065087fa59..4ae74f8267 100755 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -25,8 +25,6 @@ TYPEDEF: uint socklen_t : NGROUPS_MAX 16 ; inline -: O_NDELAY O_NONBLOCK ; inline - C-STRUCT: group { "char*" "gr_name" } { "char*" "gr_passwd" } @@ -194,4 +192,3 @@ FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ; { [ os bsd? ] [ "unix.bsd" require ] } { [ os solaris? ] [ "unix.solaris" require ] } } cond - From 2186999fee2a7c66f79ba7cab9a5e2eba16d35a6 Mon Sep 17 00:00:00 2001 From: William Schlieper Date: Thu, 14 Aug 2008 00:52:29 -0400 Subject: [PATCH 06/14] irc.ui: Fixed userlist>> bug --- extra/irc/ui/ui.factor | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index 956644dc52..5d74c884c4 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -21,6 +21,9 @@ SYMBOL: client TUPLE: ui-window < tabbed client ; +M: ui-window ungraft* + client>> terminate-irc ; + TUPLE: irc-tab < frame listener client window ; : write-color ( str color -- ) @@ -139,16 +142,6 @@ GENERIC: handle-inbox ( tab message -- ) : add-gadget-color ( pack seq color -- pack ) '[ , >>color add-gadget ] each ; -: update-participants ( tab -- ) - [ userlist>> [ clear-gadget ] keep ] - [ listener>> participants>> ] bi - [ +operator+ value-labels dark-green add-gadget-color ] - [ +voice+ value-labels blue add-gadget-color ] - [ +normal+ value-labels black add-gadget-color ] tri drop ; - -M: participant-changed handle-inbox - drop update-participants ; - M: object handle-inbox nip print-irc ; @@ -198,15 +191,21 @@ TUPLE: irc-channel-tab < irc-tab userlist ; irc-tab new-irc-tab [ @right grid-add ] keep >>userlist ; +: update-participants ( tab -- ) + [ userlist>> [ clear-gadget ] keep ] + [ listener>> participants>> ] bi + [ +operator+ value-labels dark-green add-gadget-color ] + [ +voice+ value-labels blue add-gadget-color ] + [ +normal+ value-labels black add-gadget-color ] tri drop ; + +M: participant-changed handle-inbox + drop update-participants ; + TUPLE: irc-server-tab < irc-tab ; : ( listener -- irc-tab ) f irc-server-tab new-irc-tab ; -M: irc-server-tab ungraft* - [ window>> client>> terminate-irc ] - [ listener>> ] [ window>> client>> ] tri remove-listener ; - : ( listener ui-window -- irc-tab ) irc-tab new-irc-tab ; From a84404bc0d2937baf143169ef59b08ff099e6444 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 14 Aug 2008 00:21:10 -0500 Subject: [PATCH 07/14] add some more utility words like when-empty --- extra/sequences/lib/lib.factor | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index 1167a3b7b4..17f855c264 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -211,8 +211,11 @@ PRIVATE> : insert-nth ( elt n seq -- seq' ) swap cut-slice [ swap 1array ] dip 3append ; -: if-seq ( seq quot1 quot2 -- ) - [ f like ] 2dip if* ; inline +: if-seq ( seq quot1 quot2 -- ) [ f like ] 2dip if* ; inline + +: if-empty ( seq quot1 quot2 -- ) swap if-seq ; inline + +: when-empty ( seq quot1 -- ) [ ] if-empty ; inline + +: unless-empty ( seq quot1 -- ) [ ] swap if-empty ; inline -: if-empty ( seq quot1 quot2 -- ) - swap if-seq ; inline From 7a701c9501735d95aed7ff252ef7cff0b8dd1e2d Mon Sep 17 00:00:00 2001 From: William Schlieper Date: Thu, 14 Aug 2008 01:24:56 -0400 Subject: [PATCH 08/14] irc.ui: Fixed bug in constructor --- extra/irc/ui/ui.factor | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index 5d74c884c4..1aebfcbfcb 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -123,8 +123,11 @@ M: irc-listener-end write-irc M: irc-message write-irc drop ; ! catch all unimplemented writes, THIS WILL CHANGE -: time-happened ( irc-message -- timestamp ) - [ timestamp>> ] [ 2drop now ] recover ; +GENERIC: time-happened ( message -- timestamp ) + +M: irc-message time-happened timestamp>> ; + +M: object time-happened drop now ; : print-irc ( irc-message -- ) [ time-happened timestamp>hms write " " write ] @@ -188,7 +191,7 @@ M: irc-tab ungraft* TUPLE: irc-channel-tab < irc-tab userlist ; : ( listener ui-window -- irc-tab ) - irc-tab new-irc-tab + irc-channel-tab new-irc-tab [ @right grid-add ] keep >>userlist ; : update-participants ( tab -- ) From b06fe6fe9addf0ed54af47255b06f48605cc0f94 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 14 Aug 2008 23:35:35 -0500 Subject: [PATCH 09/14] Fix help lint --- basis/help/lint/lint.factor | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor index 9cbffe2d33..c4f4a46710 100755 --- a/basis/help/lint/lint.factor +++ b/basis/help/lint/lint.factor @@ -3,9 +3,9 @@ USING: accessors sequences parser kernel help help.markup help.topics words strings classes tools.vocabs namespaces io io.streams.string prettyprint definitions arrays vectors -combinators splitting debugger hashtables sorting effects vocabs -vocabs.loader assocs editors continuations classes.predicate -macros math sets eval ; +combinators combinators.short-circuit splitting debugger +hashtables sorting effects vocabs vocabs.loader assocs editors +continuations classes.predicate macros math sets eval ; IN: help.lint : check-example ( element -- ) @@ -43,15 +43,15 @@ IN: help.lint : check-values ( word element -- ) { - { [ over "declared-effect" word-prop ] [ 2drop ] } - { [ dup contains-funky-elements? not ] [ 2drop ] } - { [ over macro? not ] [ 2drop ] } + [ drop "declared-effect" word-prop not ] + [ nip contains-funky-elements? ] + [ drop macro? ] [ [ effect-values >array ] [ extract-values >array ] - bi* assert= + bi* = ] - } cond ; + } 2|| [ "$values don't match stack effect" throw ] unless ; : check-see-also ( word element -- ) nip \ $see-also swap elements [ From 5cc5d347ae80dd81f24d00613b0868ccd8da22f0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 14 Aug 2008 23:44:39 -0500 Subject: [PATCH 10/14] moved serial to io.serial --- extra/io/serial/authors.txt | 1 + extra/io/serial/serial.factor | 23 ++++ extra/io/serial/summary.txt | 1 + extra/io/serial/tags.txt | 1 + extra/io/serial/unix/bsd/bsd.factor | 86 ++++++++++++ extra/io/serial/unix/bsd/tags.txt | 1 + extra/io/serial/unix/linux/linux.factor | 130 ++++++++++++++++++ extra/io/serial/unix/linux/tags.txt | 1 + extra/io/serial/unix/tags.txt | 1 + extra/io/serial/unix/termios/bsd/bsd.factor | 19 +++ extra/io/serial/unix/termios/bsd/tags.txt | 1 + .../io/serial/unix/termios/linux/linux.factor | 20 +++ extra/io/serial/unix/termios/linux/tags.txt | 1 + extra/io/serial/unix/termios/tags.txt | 1 + extra/io/serial/unix/termios/termios.factor | 9 ++ extra/io/serial/unix/unix-tests.factor | 21 +++ extra/io/serial/unix/unix.factor | 63 +++++++++ 17 files changed, 380 insertions(+) create mode 100644 extra/io/serial/authors.txt create mode 100644 extra/io/serial/serial.factor create mode 100644 extra/io/serial/summary.txt create mode 100644 extra/io/serial/tags.txt create mode 100644 extra/io/serial/unix/bsd/bsd.factor create mode 100644 extra/io/serial/unix/bsd/tags.txt create mode 100644 extra/io/serial/unix/linux/linux.factor create mode 100644 extra/io/serial/unix/linux/tags.txt create mode 100644 extra/io/serial/unix/tags.txt create mode 100644 extra/io/serial/unix/termios/bsd/bsd.factor create mode 100644 extra/io/serial/unix/termios/bsd/tags.txt create mode 100644 extra/io/serial/unix/termios/linux/linux.factor create mode 100644 extra/io/serial/unix/termios/linux/tags.txt create mode 100644 extra/io/serial/unix/termios/tags.txt create mode 100644 extra/io/serial/unix/termios/termios.factor create mode 100644 extra/io/serial/unix/unix-tests.factor create mode 100644 extra/io/serial/unix/unix.factor diff --git a/extra/io/serial/authors.txt b/extra/io/serial/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/io/serial/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/io/serial/serial.factor b/extra/io/serial/serial.factor new file mode 100644 index 0000000000..117ae7f80b --- /dev/null +++ b/extra/io/serial/serial.factor @@ -0,0 +1,23 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types assocs combinators destructors +kernel math math.bitfields math.parser sequences summary system +vocabs.loader ; +IN: io.serial + +TUPLE: serial stream path baud + termios iflag oflag cflag lflag ; + +ERROR: invalid-baud baud ; +M: invalid-baud summary ( invalid-baud -- string ) + "Baud rate " + swap baud>> number>string + " not supported" 3append ; + +HOOK: lookup-baud os ( m -- n ) +HOOK: open-serial os ( serial -- serial' ) +M: serial dispose ( serial -- ) stream>> dispose ; + +{ + { [ os unix? ] [ "serial.unix" ] } +} cond require diff --git a/extra/io/serial/summary.txt b/extra/io/serial/summary.txt new file mode 100644 index 0000000000..5ccd99dbaa --- /dev/null +++ b/extra/io/serial/summary.txt @@ -0,0 +1 @@ +Serial port library diff --git a/extra/io/serial/tags.txt b/extra/io/serial/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/io/serial/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/extra/io/serial/unix/bsd/bsd.factor b/extra/io/serial/unix/bsd/bsd.factor new file mode 100644 index 0000000000..915fd8ce08 --- /dev/null +++ b/extra/io/serial/unix/bsd/bsd.factor @@ -0,0 +1,86 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax kernel math.bitfields sequences system serial ; +IN: io.serial.unix + +M: bsd lookup-baud ( m -- n ) + dup { + 0 50 75 110 134 150 200 300 600 1200 1800 2400 4800 + 7200 9600 14400 19200 28800 38400 57600 76800 115200 + 230400 460800 921600 + } member? [ invalid-baud ] unless ; + +: TCSANOW 0 ; inline +: TCSADRAIN 1 ; inline +: TCSAFLUSH 2 ; inline +: TCSASOFT HEX: 10 ; inline + +: TCIFLUSH 1 ; inline +: TCOFLUSH 2 ; inline +: TCIOFLUSH 3 ; inline +: TCOOFF 1 ; inline +: TCOON 2 ; inline +: TCIOFF 3 ; inline +: TCION 4 ; inline + +! iflags +: IGNBRK HEX: 00000001 ; inline +: BRKINT HEX: 00000002 ; inline +: IGNPAR HEX: 00000004 ; inline +: PARMRK HEX: 00000008 ; inline +: INPCK HEX: 00000010 ; inline +: ISTRIP HEX: 00000020 ; inline +: INLCR HEX: 00000040 ; inline +: IGNCR HEX: 00000080 ; inline +: ICRNL HEX: 00000100 ; inline +: IXON HEX: 00000200 ; inline +: IXOFF HEX: 00000400 ; inline +: IXANY HEX: 00000800 ; inline +: IMAXBEL HEX: 00002000 ; inline +: IUTF8 HEX: 00004000 ; inline + +! oflags +: OPOST HEX: 00000001 ; inline +: ONLCR HEX: 00000002 ; inline +: OXTABS HEX: 00000004 ; inline +: ONOEOT HEX: 00000008 ; inline + +! cflags +: CIGNORE HEX: 00000001 ; inline +: CSIZE HEX: 00000300 ; inline +: CS5 HEX: 00000000 ; inline +: CS6 HEX: 00000100 ; inline +: CS7 HEX: 00000200 ; inline +: CS8 HEX: 00000300 ; inline +: CSTOPB HEX: 00000400 ; inline +: CREAD HEX: 00000800 ; inline +: PARENB HEX: 00001000 ; inline +: PARODD HEX: 00002000 ; inline +: HUPCL HEX: 00004000 ; inline +: CLOCAL HEX: 00008000 ; inline +: CCTS_OFLOW HEX: 00010000 ; inline +: CRTS_IFLOW HEX: 00020000 ; inline +: CRTSCTS { CCTS_OFLOW CRTS_IFLOW } flags ; inline +: CDTR_IFLOW HEX: 00040000 ; inline +: CDSR_OFLOW HEX: 00080000 ; inline +: CCAR_OFLOW HEX: 00100000 ; inline +: MDMBUF HEX: 00100000 ; inline + +! lflags +: ECHOKE HEX: 00000001 ; inline +: ECHOE HEX: 00000002 ; inline +: ECHOK HEX: 00000004 ; inline +: ECHO HEX: 00000008 ; inline +: ECHONL HEX: 00000010 ; inline +: ECHOPRT HEX: 00000020 ; inline +: ECHOCTL HEX: 00000040 ; inline +: ISIG HEX: 00000080 ; inline +: ICANON HEX: 00000100 ; inline +: ALTWERASE HEX: 00000200 ; inline +: IEXTEN HEX: 00000400 ; inline +: EXTPROC HEX: 00000800 ; inline +: TOSTOP HEX: 00400000 ; inline +: FLUSHO HEX: 00800000 ; inline +: NOKERNINFO HEX: 02000000 ; inline +: PENDIN HEX: 20000000 ; inline +: NOFLSH HEX: 80000000 ; inline diff --git a/extra/io/serial/unix/bsd/tags.txt b/extra/io/serial/unix/bsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/io/serial/unix/bsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/extra/io/serial/unix/linux/linux.factor b/extra/io/serial/unix/linux/linux.factor new file mode 100644 index 0000000000..d8158ae8bb --- /dev/null +++ b/extra/io/serial/unix/linux/linux.factor @@ -0,0 +1,130 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: assocs alien.syntax kernel serial system unix ; +IN: io.serial.unix + +: TCSANOW 0 ; inline +: TCSADRAIN 1 ; inline +: TCSAFLUSH 2 ; inline + +: TCIFLUSH 0 ; inline +: TCOFLUSH 1 ; inline +: TCIOFLUSH 2 ; inline + +: TCOOFF 0 ; inline +: TCOON 1 ; inline +: TCIOFF 2 ; inline +: TCION 3 ; inline + +! iflag +: IGNBRK OCT: 0000001 ; inline +: BRKINT OCT: 0000002 ; inline +: IGNPAR OCT: 0000004 ; inline +: PARMRK OCT: 0000010 ; inline +: INPCK OCT: 0000020 ; inline +: ISTRIP OCT: 0000040 ; inline +: INLCR OCT: 0000100 ; inline +: IGNCR OCT: 0000200 ; inline +: ICRNL OCT: 0000400 ; inline +: IUCLC OCT: 0001000 ; inline +: IXON OCT: 0002000 ; inline +: IXANY OCT: 0004000 ; inline +: IXOFF OCT: 0010000 ; inline +: IMAXBEL OCT: 0020000 ; inline +: IUTF8 OCT: 0040000 ; inline + +! oflag +: OPOST OCT: 0000001 ; inline +: OLCUC OCT: 0000002 ; inline +: ONLCR OCT: 0000004 ; inline +: OCRNL OCT: 0000010 ; inline +: ONOCR OCT: 0000020 ; inline +: ONLRET OCT: 0000040 ; inline +: OFILL OCT: 0000100 ; inline +: OFDEL OCT: 0000200 ; inline +: NLDLY OCT: 0000400 ; inline +: NL0 OCT: 0000000 ; inline +: NL1 OCT: 0000400 ; inline +: CRDLY OCT: 0003000 ; inline +: CR0 OCT: 0000000 ; inline +: CR1 OCT: 0001000 ; inline +: CR2 OCT: 0002000 ; inline +: CR3 OCT: 0003000 ; inline +: TABDLY OCT: 0014000 ; inline +: TAB0 OCT: 0000000 ; inline +: TAB1 OCT: 0004000 ; inline +: TAB2 OCT: 0010000 ; inline +: TAB3 OCT: 0014000 ; inline +: BSDLY OCT: 0020000 ; inline +: BS0 OCT: 0000000 ; inline +: BS1 OCT: 0020000 ; inline +: FFDLY OCT: 0100000 ; inline +: FF0 OCT: 0000000 ; inline +: FF1 OCT: 0100000 ; inline + +! cflags +: CSIZE OCT: 0000060 ; inline +: CS5 OCT: 0000000 ; inline +: CS6 OCT: 0000020 ; inline +: CS7 OCT: 0000040 ; inline +: CS8 OCT: 0000060 ; inline +: CSTOPB OCT: 0000100 ; inline +: CREAD OCT: 0000200 ; inline +: PARENB OCT: 0000400 ; inline +: PARODD OCT: 0001000 ; inline +: HUPCL OCT: 0002000 ; inline +: CLOCAL OCT: 0004000 ; inline +: CIBAUD OCT: 002003600000 ; inline +: CRTSCTS OCT: 020000000000 ; inline + +! lflags +: ISIG OCT: 0000001 ; inline +: ICANON OCT: 0000002 ; inline +: XCASE OCT: 0000004 ; inline +: ECHO OCT: 0000010 ; inline +: ECHOE OCT: 0000020 ; inline +: ECHOK OCT: 0000040 ; inline +: ECHONL OCT: 0000100 ; inline +: NOFLSH OCT: 0000200 ; inline +: TOSTOP OCT: 0000400 ; inline +: ECHOCTL OCT: 0001000 ; inline +: ECHOPRT OCT: 0002000 ; inline +: ECHOKE OCT: 0004000 ; inline +: FLUSHO OCT: 0010000 ; inline +: PENDIN OCT: 0040000 ; inline +: IEXTEN OCT: 0100000 ; inline + +M: linux lookup-baud ( n -- n ) + dup H{ + { 0 OCT: 0000000 } + { 50 OCT: 0000001 } + { 75 OCT: 0000002 } + { 110 OCT: 0000003 } + { 134 OCT: 0000004 } + { 150 OCT: 0000005 } + { 200 OCT: 0000006 } + { 300 OCT: 0000007 } + { 600 OCT: 0000010 } + { 1200 OCT: 0000011 } + { 1800 OCT: 0000012 } + { 2400 OCT: 0000013 } + { 4800 OCT: 0000014 } + { 9600 OCT: 0000015 } + { 19200 OCT: 0000016 } + { 38400 OCT: 0000017 } + { 57600 OCT: 0010001 } + { 115200 OCT: 0010002 } + { 230400 OCT: 0010003 } + { 460800 OCT: 0010004 } + { 500000 OCT: 0010005 } + { 576000 OCT: 0010006 } + { 921600 OCT: 0010007 } + { 1000000 OCT: 0010010 } + { 1152000 OCT: 0010011 } + { 1500000 OCT: 0010012 } + { 2000000 OCT: 0010013 } + { 2500000 OCT: 0010014 } + { 3000000 OCT: 0010015 } + { 3500000 OCT: 0010016 } + { 4000000 OCT: 0010017 } + } at* [ nip ] [ drop invalid-baud ] if ; diff --git a/extra/io/serial/unix/linux/tags.txt b/extra/io/serial/unix/linux/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/io/serial/unix/linux/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/extra/io/serial/unix/tags.txt b/extra/io/serial/unix/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/io/serial/unix/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/extra/io/serial/unix/termios/bsd/bsd.factor b/extra/io/serial/unix/termios/bsd/bsd.factor new file mode 100644 index 0000000000..414ec98438 --- /dev/null +++ b/extra/io/serial/unix/termios/bsd/bsd.factor @@ -0,0 +1,19 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax kernel sequences system ; +IN: io.serial.unix.termios + +: NCCS 20 ; inline + +TYPEDEF: uint tcflag_t +TYPEDEF: uchar cc_t +TYPEDEF: uint speed_t + +C-STRUCT: termios + { "tcflag_t" "iflag" } ! input mode flags + { "tcflag_t" "oflag" } ! output mode flags + { "tcflag_t" "cflag" } ! control mode flags + { "tcflag_t" "lflag" } ! local mode flags + { { "cc_t" NCCS } "cc" } ! control characters + { "speed_t" "ispeed" } ! input speed + { "speed_t" "ospeed" } ; ! output speed diff --git a/extra/io/serial/unix/termios/bsd/tags.txt b/extra/io/serial/unix/termios/bsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/io/serial/unix/termios/bsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/extra/io/serial/unix/termios/linux/linux.factor b/extra/io/serial/unix/termios/linux/linux.factor new file mode 100644 index 0000000000..c7da10a6f5 --- /dev/null +++ b/extra/io/serial/unix/termios/linux/linux.factor @@ -0,0 +1,20 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax kernel system unix ; +IN: io.serial.unix.termios + +: NCCS 32 ; inline + +TYPEDEF: uchar cc_t +TYPEDEF: uint speed_t +TYPEDEF: uint tcflag_t + +C-STRUCT: termios + { "tcflag_t" "iflag" } ! input mode flags + { "tcflag_t" "oflag" } ! output mode flags + { "tcflag_t" "cflag" } ! control mode flags + { "tcflag_t" "lflag" } ! local mode flags + { "cc_t" "line" } ! line discipline + { { "cc_t" NCCS } "cc" } ! control characters + { "speed_t" "ispeed" } ! input speed + { "speed_t" "ospeed" } ; ! output speed diff --git a/extra/io/serial/unix/termios/linux/tags.txt b/extra/io/serial/unix/termios/linux/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/io/serial/unix/termios/linux/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/extra/io/serial/unix/termios/tags.txt b/extra/io/serial/unix/termios/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/io/serial/unix/termios/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/extra/io/serial/unix/termios/termios.factor b/extra/io/serial/unix/termios/termios.factor new file mode 100644 index 0000000000..440d9114f0 --- /dev/null +++ b/extra/io/serial/unix/termios/termios.factor @@ -0,0 +1,9 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: combinators system vocabs.loader ; +IN: io.serial.unix.termios + +{ + { [ os linux? ] [ "serial.unix.termios.linux" ] } + { [ os bsd? ] [ "serial.unix.termios.bsd" ] } +} cond require diff --git a/extra/io/serial/unix/unix-tests.factor b/extra/io/serial/unix/unix-tests.factor new file mode 100644 index 0000000000..bbfd10b943 --- /dev/null +++ b/extra/io/serial/unix/unix-tests.factor @@ -0,0 +1,21 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors kernel math.bitfields serial serial.unix ; +IN: io.serial.unix + +: serial-obj ( -- obj ) + serial new + "/dev/ttyS0" >>path + 19200 >>baud + { IGNPAR ICRNL } flags >>iflag + { } flags >>oflag + { CS8 CLOCAL CREAD } flags >>cflag + { ICANON } flags >>lflag ; + +: serial-test ( -- serial ) + serial-obj + open-serial + dup get-termios >>termios + dup configure-termios + dup tciflush + dup apply-termios ; diff --git a/extra/io/serial/unix/unix.factor b/extra/io/serial/unix/unix.factor new file mode 100644 index 0000000000..50849c5d36 --- /dev/null +++ b/extra/io/serial/unix/unix.factor @@ -0,0 +1,63 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types alien.syntax combinators io.ports +io.streams.duplex io.unix.backend system kernel math math.bitfields +vocabs.loader unix serial serial.unix.termios ; +IN: io.serial.unix + +<< { + { [ os linux? ] [ "serial.unix.linux" ] } + { [ os bsd? ] [ "serial.unix.bsd" ] } +} cond require >> + +FUNCTION: speed_t cfgetispeed ( termios* t ) ; +FUNCTION: speed_t cfgetospeed ( termios* t ) ; +FUNCTION: int cfsetispeed ( termios* t, speed_t s ) ; +FUNCTION: int cfsetospeed ( termios* t, speed_t s ) ; +FUNCTION: int tcgetattr ( int i1, termios* t ) ; +FUNCTION: int tcsetattr ( int i1, int i2, termios* t ) ; +FUNCTION: int tcdrain ( int i1 ) ; +FUNCTION: int tcflow ( int i1, int i2 ) ; +FUNCTION: int tcflush ( int i1, int i2 ) ; +FUNCTION: int tcsendbreak ( int i1, int i2 ) ; +FUNCTION: void cfmakeraw ( termios* t ) ; +FUNCTION: int cfsetspeed ( termios* t, speed_t s ) ; + +: fd>duplex-stream ( fd -- duplex-stream ) + init-fd + [ ] [ ] bi ; + +: open-rw ( path -- fd ) O_RDWR file-mode open-file ; +: ( path -- stream ) open-rw fd>duplex-stream ; + +M: unix open-serial ( serial -- serial' ) + dup + path>> { O_RDWR O_NOCTTY O_NDELAY } flags file-mode open-file + fd>duplex-stream >>stream ; + +: serial-fd ( serial -- fd ) + stream>> in>> handle>> fd>> ; + +: get-termios ( serial -- termios ) + serial-fd + "termios" [ tcgetattr io-error ] keep ; + +: configure-termios ( serial -- ) + dup termios>> + { + [ [ iflag>> ] dip over [ set-termios-iflag ] [ 2drop ] if ] + [ [ oflag>> ] dip over [ set-termios-oflag ] [ 2drop ] if ] + [ + [ + [ cflag>> 0 or ] [ baud>> lookup-baud ] bi bitor + ] dip set-termios-cflag + ] + [ [ lflag>> ] dip over [ set-termios-lflag ] [ 2drop ] if ] + } 2cleave ; + +: tciflush ( serial -- ) + serial-fd TCIFLUSH tcflush io-error ; + +: apply-termios ( serial -- ) + [ serial-fd TCSANOW ] + [ termios>> ] bi tcsetattr io-error ; From b333583da4401560b6e137cd8131025754d41d1d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 14 Aug 2008 23:54:57 -0500 Subject: [PATCH 11/14] fix usings --- extra/io/serial/serial.factor | 5 ++--- extra/io/serial/unix/bsd/bsd.factor | 2 +- extra/io/serial/unix/linux/linux.factor | 2 +- extra/io/serial/unix/termios/termios.factor | 4 ++-- extra/io/serial/unix/unix.factor | 9 ++++----- 5 files changed, 10 insertions(+), 12 deletions(-) diff --git a/extra/io/serial/serial.factor b/extra/io/serial/serial.factor index 117ae7f80b..c24f08906c 100644 --- a/extra/io/serial/serial.factor +++ b/extra/io/serial/serial.factor @@ -15,9 +15,8 @@ M: invalid-baud summary ( invalid-baud -- string ) " not supported" 3append ; HOOK: lookup-baud os ( m -- n ) -HOOK: open-serial os ( serial -- serial' ) -M: serial dispose ( serial -- ) stream>> dispose ; +HOOK: open-serial os ( serial -- stream ) { - { [ os unix? ] [ "serial.unix" ] } + { [ os unix? ] [ "io.serial.unix" ] } } cond require diff --git a/extra/io/serial/unix/bsd/bsd.factor b/extra/io/serial/unix/bsd/bsd.factor index 915fd8ce08..3c5ce62c63 100644 --- a/extra/io/serial/unix/bsd/bsd.factor +++ b/extra/io/serial/unix/bsd/bsd.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax kernel math.bitfields sequences system serial ; +USING: alien.syntax kernel math.bitfields sequences system io.serial ; IN: io.serial.unix M: bsd lookup-baud ( m -- n ) diff --git a/extra/io/serial/unix/linux/linux.factor b/extra/io/serial/unix/linux/linux.factor index d8158ae8bb..342ff4499f 100644 --- a/extra/io/serial/unix/linux/linux.factor +++ b/extra/io/serial/unix/linux/linux.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs alien.syntax kernel serial system unix ; +USING: assocs alien.syntax kernel io.serial system unix ; IN: io.serial.unix : TCSANOW 0 ; inline diff --git a/extra/io/serial/unix/termios/termios.factor b/extra/io/serial/unix/termios/termios.factor index 440d9114f0..e5ccd37e87 100644 --- a/extra/io/serial/unix/termios/termios.factor +++ b/extra/io/serial/unix/termios/termios.factor @@ -4,6 +4,6 @@ USING: combinators system vocabs.loader ; IN: io.serial.unix.termios { - { [ os linux? ] [ "serial.unix.termios.linux" ] } - { [ os bsd? ] [ "serial.unix.termios.bsd" ] } + { [ os linux? ] [ "io.serial.unix.termios.linux" ] } + { [ os bsd? ] [ "io.serial.unix.termios.bsd" ] } } cond require diff --git a/extra/io/serial/unix/unix.factor b/extra/io/serial/unix/unix.factor index 50849c5d36..ed60d941dd 100644 --- a/extra/io/serial/unix/unix.factor +++ b/extra/io/serial/unix/unix.factor @@ -2,12 +2,12 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types alien.syntax combinators io.ports io.streams.duplex io.unix.backend system kernel math math.bitfields -vocabs.loader unix serial serial.unix.termios ; +vocabs.loader unix io.serial io.serial.unix.termios ; IN: io.serial.unix << { - { [ os linux? ] [ "serial.unix.linux" ] } - { [ os bsd? ] [ "serial.unix.bsd" ] } + { [ os linux? ] [ "io.serial.unix.linux" ] } + { [ os bsd? ] [ "io.serial.unix.bsd" ] } } cond require >> FUNCTION: speed_t cfgetispeed ( termios* t ) ; @@ -31,9 +31,8 @@ FUNCTION: int cfsetspeed ( termios* t, speed_t s ) ; : ( path -- stream ) open-rw fd>duplex-stream ; M: unix open-serial ( serial -- serial' ) - dup path>> { O_RDWR O_NOCTTY O_NDELAY } flags file-mode open-file - fd>duplex-stream >>stream ; + fd>duplex-stream ; : serial-fd ( serial -- fd ) stream>> in>> handle>> fd>> ; From cf556faf6600057530aafc35c7bfcfb3ce469ca4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 15 Aug 2008 04:09:34 -0500 Subject: [PATCH 12/14] Cleanup --- basis/prettyprint/sections/sections.factor | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/basis/prettyprint/sections/sections.factor b/basis/prettyprint/sections/sections.factor index 23a50700b3..168e118d4b 100644 --- a/basis/prettyprint/sections/sections.factor +++ b/basis/prettyprint/sections/sections.factor @@ -171,10 +171,11 @@ M: block section-fits? ( section -- ? ) line-limit? [ drop t ] [ call-next-method ] if ; : pprint-sections ( block advancer -- ) - swap sections>> [ line-break? not ] filter - unclip pprint-section [ - dup rot call pprint-section - ] with each ; inline + [ + sections>> [ line-break? not ] filter + unclip-slice pprint-section + ] dip + [ [ pprint-section ] bi ] curry each ; inline M: block short-section ( block -- ) [ advance ] pprint-sections ; From 713cf91f2a99d4f33e9206053bcbde64ca70f6c5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 15 Aug 2008 16:13:13 -0500 Subject: [PATCH 13/14] Fix memory leak --- basis/io/ports/ports.factor | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor index 26b06dba8b..631f491b18 100755 --- a/basis/io/ports/ports.factor +++ b/basis/io/ports/ports.factor @@ -4,7 +4,7 @@ USING: math kernel io sequences io.buffers io.timeouts generic byte-vectors system io.encodings math.order io.backend continuations debugger classes byte-arrays namespaces splitting grouping dlists assocs io.encodings.binary summary accessors -destructors ; +destructors combinators ; IN: io.ports SYMBOL: default-buffer-size @@ -133,10 +133,12 @@ M: output-port stream-flush ( port -- ) M: output-port dispose* [ - [ handle>> &dispose drop ] - [ port-flush ] - [ handle>> shutdown ] - tri + { + [ handle>> &dispose drop ] + [ port-flush ] + [ handle>> shutdown ] + [ buffer>> dispose ] + } cleave ] with-destructors ; M: buffered-port dispose* From a452dd86f62004b051a7967705d48ed167a397d6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 15 Aug 2008 18:57:00 -0500 Subject: [PATCH 14/14] Better fix --- basis/io/ports/ports.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor index 631f491b18..006e0e7881 100755 --- a/basis/io/ports/ports.factor +++ b/basis/io/ports/ports.factor @@ -135,9 +135,9 @@ M: output-port dispose* [ { [ handle>> &dispose drop ] + [ buffer>> &dispose drop ] [ port-flush ] [ handle>> shutdown ] - [ buffer>> dispose ] } cleave ] with-destructors ;