Merge remote-tracking branch 'origin/master' into modern-harvey3

basis/furnace/auth/auth-docs.factor

@@ -1,14 +1,6 @@
 USING: byte-arrays checksums.sha furnace.auth.providers
 furnace.auth.providers.db help.markup help.syntax http kernel
 math strings vocabs words.symbol ;
-"furnace.auth.basic" require
-"furnace.auth.features.deactivate-user" require
-"furnace.auth.features.edit-profile" require
-"furnace.auth.features.recover-password" require
-"furnace.auth.features.registration" require
-"furnace.auth.login" require
-"furnace.auth.providers.assoc" require
-"furnace.auth.providers.null" require
 IN: furnace.auth
 
 HELP: <protected>

basis/ui/backend/cocoa/views/views.factor

@@ -198,6 +198,7 @@ M: send-touchbar-command send-queued-gesture
                 cached-lines get-global clear-assoc
             ] [ drop ] if
 
+            self -> update
         ] when
     ] ;
 

basis/xdg/xdg.factor

@@ -1,29 +1,29 @@
 ! Copyright (C) 2015 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: environment memoize sequences splitting ;
+USING: environment sequences splitting ;
 
 IN: xdg
 
 ! http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
 
-MEMO: xdg-data-home ( -- path )
+: xdg-data-home ( -- path )
     "XDG_DATA_HOME" os-env [ "~/.local/share" ] when-empty ;
 
-MEMO: xdg-config-home ( -- path )
+: xdg-config-home ( -- path )
     "XDG_CONFIG_HOME" os-env [ "~/.config" ] when-empty ;
 
-MEMO: xdg-cache-home ( -- path )
+: xdg-cache-home ( -- path )
     "XDG_CACHE_HOME" os-env [ "~/.cache" ] when-empty ;
 
-MEMO: xdg-data-dirs ( -- paths )
+: xdg-data-dirs ( -- paths )
     "XDG_DATA_DIRS" os-env ":" split harvest
     [ { "/usr/local/share" "/usr/share" } ] when-empty ;
 
-MEMO: xdg-config-dirs ( -- paths )
+: xdg-config-dirs ( -- paths )
     "XDG_CONFIG_DIRS" os-env ":" split harvest
     [ { "/etc/xdg" } ] when-empty ;
 
-MEMO: xdg-runtime-dir ( -- path/f )
+: xdg-runtime-dir ( -- path/f )
     "XDG_RUNTIME_DIR" os-env ;
     ! TODO: check runtime secure permissions

core/stack-checker/stack-checker-docs.factor

@@ -20,7 +20,7 @@ ARTICLE: "inference-combinators" "Combinator stack effects"
   { "The combinator must be called with a quotation that is either literal or built from literal quotations, " { $link curry } ", and " { $link compose } ". (Note that quotations that use " { $vocab-link "fry" } " or " { $vocab-link "locals" } " use " { $link curry } " and " { $link compose } " from the perspective of the stack checker.)" }
   { "If the word is declared " { $link \ inline } ", the combinator may additionally be called on one of the word's input parameters or with quotations built from the word's input parameters, literal quotations, " { $link curry } ", and " { $link compose } ". When inline, a word is itself considered to be a combinator, and its callers must in turn satisfy these conditions." }
 }
-"If neither condition holds, the stack checker throws a " { $link unknown-macro-input } " or " { $link bad-macro-input } " error. To make the code compile, a runtime checking combinator such as " { $link \ \call( } " must be used instead. See " { $link "inference-escape" } " for details. An inline combinator can be called with an unknown quotation by " { $link curry } "ing the quotation onto a literal quotation that uses " { $link \ \call( } "."
+"If neither condition holds, the stack checker throws an " { $link unknown-macro-input } " or " { $link bad-macro-input } " error. To make the code compile, a runtime checking combinator such as " { $link \ \call( } " must be used instead. See " { $link "inference-escape" } " for details. An inline combinator can be called with an unknown quotation by " { $link curry } "ing the quotation onto a literal quotation that uses " { $link \ \call( } "."
 { $heading "Input stack effects" }
 "Inline combinators will verify the stack effect of their input quotations if they are declared in the combinator's stack effect. See " { $link "effects-variables" } " for details."
 { $heading "Examples" }
@@ -61,7 +61,7 @@ $nl
 } ;
 
 ARTICLE: "inference-branches" "Branch stack effects"
-"Conditionals such as " { $link if } " and combinators built on top have the same restrictions as " { $link \ inline } " combinators (see " { $link "inference-combinators" } ") with the additional requirement that all branches leave the stack at the same height. If this is not the case, the stack checker throws a " { $link unbalanced-branches-error } "."
+"Conditionals such as " { $link if } " and combinators built on top have the same restrictions as " { $link \ inline } " combinators (see " { $link "inference-combinators" } ") with the additional requirement that all branches leave the stack at the same height. If this is not the case, the stack checker throws an " { $link unbalanced-branches-error } "."
 $nl
 "If all branches leave the stack at the same height, then the stack effect of the conditional is just the maximum of the stack effect of each branch. For example,"
 { $example "[ [ + ] [ drop ] if ] infer." "( x x x -- x )" }
@@ -72,7 +72,7 @@ ARTICLE: "inference-recursive-combinators" "Recursive combinator stack effects"
 $nl
 "Combinators which are recursive require additional care. In addition to being declared " { $link \ inline } ", they must be declared " { $link \ recursive } ". There are three restrictions that only apply to combinators with this declaration:"
 { $heading "Input quotation declaration" }
-"Input parameters which are quotations must be annotated as much in the stack effect. For example, the following will not infer:"
+"Input parameters which are quotations must be annotated as such in the stack effect. For example, the following will not infer:"
 { $unchecked-example ": bad ( quot -- ) [ call ] keep bad ; inline recursive" "[ [ ] bad ] infer." "Cannot apply “call” to a run-time computed value\nmacro call" }
 "The following is correct:"
 { $example ": good ( quot: ( -- ) -- ) [ call ] keep good ; inline recursive" "[ [ ] good ] infer." "( -- )" }

extra/etc-hosts/etc-hosts.factor

@@ -7,7 +7,7 @@ IN: etc-hosts
 HOOK: hosts-path os ( -- path )
 
 M: windows hosts-path
-    "SystemRoot" os-env "/System32/drivers/etc/hosts" append-path ;
+    "SystemRoot" os-env "System32/drivers/etc/hosts" append-path ;
 
 M: unix hosts-path "/etc/hosts" ;
 

extra/imap/imap.factor

@@ -1,8 +1,10 @@
-USING: accessors arrays assocs calendar calendar.english calendar.format
+USING: accessors arrays assocs calendar calendar.english
-calendar.parser formatting fry grouping io io.crlf io.encodings.ascii
+calendar.format calendar.parser formatting fry grouping io
-io.encodings.binary io.encodings.string io.encodings.utf7 io.encodings.utf8
+io.crlf io.encodings.ascii io.encodings.binary
-io.sockets io.sockets.secure io.streams.duplex io.streams.string kernel math
+io.encodings.string io.encodings.utf7 io.encodings.utf8
-math.parser sequences splitting strings ;
+io.sockets io.sockets.secure io.streams.duplex io.streams.string
+kernel math math.parser multiline pcre sequences
+sequences.extras strings ;
 QUALIFIED: pcre
 IN: imap
 
@@ -46,9 +48,9 @@ CONSTANT: IMAP4_SSL_PORT 993
 : read-response-chunk ( stop-expr -- item ? )
     read-?crlf ascii decode swap dupd pcre:findall
     [
-        dup "^.*{(\\d+)}$" pcre:findall
+        dup [[ ^.*{(\d+)}$]] pcre:findall
         [
-            dup "^\\* (\\d+) [A-Z-]+ (.*)$" pcre:findall
+            dup [[ ^\* (\d+) [A-Z-]+ (.*)$]] pcre:findall
             [ ] [ nip first third second ] if-empty
         ]
         [
@@ -61,7 +63,7 @@ CONSTANT: IMAP4_SSL_PORT 993
 
 : read-response ( tag -- lines )
     "^%s (BAD|NO|OK) (.*)$" sprintf
-    '[ _ read-response-chunk [ suffix ] dip ] { } swap loop
+    '[ _ read-response-chunk ] loop>array*
     unclip-last first2 [ check-status ] keep suffix ;
 
 : write-command ( command literal tag -- )
@@ -80,24 +82,24 @@ CONSTANT: IMAP4_SSL_PORT 993
     first " " split 2 tail ;
 
 : parse-list-folders ( str -- folder )
-    "\\* LIST \\(([^\\)]+)\\) \"([^\"]+)\" \"([^\"]+)\"" pcre:findall
+    [[ \* LIST \(([^\)]+)\) "([^"]+)" "?([^"]+)"?]] pcre:findall
     first rest values [ utf7imap4 decode ] map ;
 
 : parse-select-folder ( seq -- count )
-    [ "\\* (\\d+) EXISTS" pcre:findall ] map harvest
+    [ [[ \* (\d+) EXISTS]] pcre:findall ] map harvest
     [ f ] [ first first last last string>number ] if-empty ;
 
 ! Returns uid if the server supports the UIDPLUS extension.
 : parse-append-mail ( seq -- uid/f )
-    [ "\\[APPENDUID (\\d+) \\d+\\]" pcre:findall ] map harvest
+    [ [=[ \[APPENDUID (\d+) \d+\]]=] pcre:findall ] map harvest
     [ f ] [ first first last last string>number ] if-empty ;
 
 : parse-status ( seq -- assoc )
-    first "\\* STATUS \"[^\"]+\" \\(([^\\)]+)\\)" pcre:findall first last last
+    first [[ \* STATUS "[^"]+" \(([^\)]+)\)]] pcre:findall first last last
     " " split 2 group [ string>number ] assoc-map ;
 
 : parse-store-mail-line ( str -- pair/f )
-    "\\(FLAGS \\(([^\\)]+)\\) UID (\\d+)\\)" pcre:findall [ f ] [
+    [[ \(FLAGS \(([^\)]+)\) UID (\d+)\)]] pcre:findall [ f ] [
         first rest values first2 [ " " split ] dip string>number swap 2array
     ] if-empty ;
 
@@ -124,6 +126,8 @@ PRIVATE>
     "LIST \"%s\" *" sprintf "" command-response
     but-last [ parse-list-folders ] map ;
 
+: list-all-folders ( -- folders ) "" list-folders ;
+
 : select-folder ( mailbox -- count )
     >utf7imap4 "SELECT \"%s\"" sprintf "" command-response
     parse-select-folder ;
@@ -168,7 +172,8 @@ PRIVATE>
     ] dip utf8 encode command-response parse-append-mail ;
 
 : store-mail ( uids command flags -- mail-flags )
-    [ comma-list ] 2dip "UID STORE %s %s %s" sprintf "" command-response
+    [ comma-list ] 2dip "UID STORE %s %s %s" sprintf
+    "" command-response
     parse-store-mail ;
 
 ! High level API

extra/metar/metar.factor

@@ -141,7 +141,11 @@ MEMO: glossary ( -- assoc )
 : parse-timestamp ( str -- str' )
     [ now [ year>> ] [ month>> ] bi ] dip
     2 cut 2 cut 2 cut drop [ string>number ] tri@
-    0 instant <timestamp> timestamp>rfc822 ;
+    over 24 = [
+        [ drop 0 ] dip 0 instant <timestamp> 1 days time+
+    ] [
+        0 instant <timestamp>
+    ] if timestamp>rfc822 ;
 
 CONSTANT: compass-directions H{
     { 0.0 "N" }

extra/notifications/macos/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/notifications/macos/macos.factor

@@ -0,0 +1,19 @@
+! Copyright (C) 2018 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: cocoa cocoa.application cocoa.classes kernel locals ;
+IN: notifications.macos
+
+IMPORT: NSUserNotification
+IMPORT: NSUserNotificationCenter
+
+:: make-notification ( title text -- notification )
+    NSUserNotification -> alloc -> init -> autorelease
+    [ title <NSString> -> setTitle: ] keep
+    [ text <NSString> -> setInformativeText: ] keep ;
+
+: send-notification ( title text -- )
+    make-notification
+    [
+        NSUserNotificationCenter -> defaultUserNotificationCenter
+    ] dip
+    -> deliverNotification: ;

extra/notifications/macos/platforms.txt

@@ -0,0 +1 @@
+macosx

extra/sequences/extras/extras.factor

@@ -445,12 +445,18 @@ PRIVATE>
 : last? ( ... seq quot: ( ... elt -- ... ? ) -- ... ? ) [ last ] dip call ; inline
 : nth? ( ... n seq quot: ( ... elt -- ... ? ) -- ... ? ) [ nth ] dip call ; inline
 
-: loop>sequence ( quot exemplar -- seq )
+: loop>sequence ( quot: ( -- obj/f ) exemplar -- seq )
    [ '[ [ @ [ [ , ] when* ] keep ] loop ] ] dip make ; inline
 
-: loop>array ( quot -- seq )
+: loop>array ( quot: ( -- obj/f ) -- seq )
    { } loop>sequence ; inline
 
+: loop>sequence* ( quot: ( -- obj ? ) exemplar -- seq )
+    [ '[ [ @ [ [ , ] when* ] [ ] bi* ] loop ] ] dip make ; inline
+
+: loop>array* ( quot: ( -- obj ? ) -- seq )
+   { } loop>sequence* ; inline
+
 <PRIVATE
 
 : (reverse) ( seq -- newseq )