Archive version of: dict-scheme.r ... version: 1 ... btiffin 17-Jul-2007

Amendment note: new script || Publicly available? Yes

REBOL [
    Title: "dict protocol from dict.org"
    Date: 17-Jul-2007
    File: %dict-scheme.r
    Author: "Brian Tiffin"
    Comment: "Based on work by Jeff Kreis"
    Purpose: {Implements a dict:// protocol based on RFC2229}
    Version: 0.9.0
    Rights: "Copyright (c) 2007 Brian Tiffin"
    History: [
        0.9.0 17-Jul-2007 btiffin "First cut - mistakes non-zero probable"
        0.9.1 17-Jul-2007 btiffin "Added demo, inclusion may be overkill"
    ]
    Library: [
        level: 'advanced
        platform: 'all
        type: [protocol]
        domain: [text-processing scheme]
        tested-under: [
            view 1.3.2.4.2 and 2.7.5.4.2
            core 2.6.2.4.2 and 2.7.5.4.2
            Debian GNU/Linux 4.0
        ]
        support: none
        license: 'MIT
        see-also: {http://www.dict.org
                   ftp://ftp.dict.org/pub/dict/contrib/dict.rebol}
    ]
    Usage:   {
        The url scheme defined in RFC2229 is:

        dict://<user>;<auth>@<host>:<port>/d:<word>:<database>
        dict://<user>;<auth>@<host>:<port>/m:<word>:<database>:<strat>

        For instance:

            read dict://dict.org/d:rebel

        returns definitions of "rebel" or:

            read dict://dict.org/m:reb

        returns words that may match "reb", in the same manner as a
        spell-checker. Other strategies can be specified. See the RFC
        for details, or use strat: as the query type for a list.

            read dict://dict.org/

        returns the available databases.

        This port handler will also accept urls of this form:

            read dict://dict.org/word

        which will return definitions for the word in question.

        Some port handler "extensions" from the RFC
        This handler is coded to return a block! of string!
           or a block! of blocks for definitions

        Also:
            default host is set to all.dict.org, See http://www.dict.org
            read dict:///d:word or
            read dict:///define:word for definitions
            read dict:///m:word or
            read dict:///match:word for matches and translations
            read dict:///help: will return a block of help
            read dict:///strat: will return the strategies for all.dict.org
            read dict:///info:db for database source and copyright info
            read dict:///server: system administrator server information
            read dict:///status: server status and timings
        without the colon, they are just words for definition

        Demo: To try out the samples, instead of just do %dict-scheme.r
           Use dict: do %dict-scheme.r  as the information hiding context
           is returned by do.  Then you can evaluate dict/demo
    }
]

comment {
This code is based on the work of Jeff Kreis,
held at ftp://ftp.dict.org/pub/dict/contrib/dict.rebol
Jeff has coded his handler for direct port access, didn't
work properly under 2.7.5.4.2
REBOL [
    Title:  "REBOL dict Protocol $Revision: 1.0 $"
    Date:   19-Aug-1999
    File:   %dict.r
    Author: "Jeff Kreis"
    Email:  jeff@rebol.com
    Purpose: {
        Implements the dict protocol as per RFC2229.
        See www.dict.org for details.
    }
    ...
]
}

;; hide everything
context [
dict-protocol: make Root-Protocol [
    Scheme: 'dict
    Port-id: 2628
    Port-flags: system/standard/port-flags/pass-thru

    open-check: [none "220" "CLIENT REBOL" "250"]

    ;; dict servers send out CRLF (period) CRLF for each entry
    read-def: func [
        "Read a definition from the DICT server"
        port [port!]
        /local line buf
    ][
        buf: make string! 1024
        while ["." <> line: system/words/pick port 1][
            ; net-utils/confirm chews the whole line, just skip status
            line: any [find/match line "151 " line]
            foreach item (reduce [line newline]) [
                system/words/insert tail buf item
            ]
        ] buf
    ]

    query-dict: func [
        port [port!]   "The port object"
        data [block!] "A buffer"
        /local type word db strat response
        match-check define-check showdb-check
    ][
        ;; Some responses have no data, some are status
        response-msg: does [
            append data skip response 4
        ]
        no-response: does [
            append data system/words/copy ""
        ]

        define-check: [
            reform ["DEFINE" any [db "!"] word]
            ["150" "151" "250" "552"]
        ]
        match-check: [
            reform ["MATCH" any [db "!"] any [strat "."] word]
            ["152" "250" "552"]
        ]
        ;; certain status values could be confirmed, but some are errors
        showdb-check: ["SHOW DB" ["110" "554"]]
        strat-check: ["SHOW STRAT" ["111" "555"]]
        info-check: [reform ["SHOW INFO" word] "112"]
        help-check: ["HELP" ["113"]]
        server-check: ["SHOW SERVER" ["114"]]
        status-check: ["STATUS" "210"]

        ;; parse the target
        set [type word db strat] either all [port/target find port/target ":"][
            parse/all port/target ":"
        ][
            either port/target [reduce ["d" port/target]][none]
        ]

        response: net-utils/confirm port/sub-port any [
            all [type = "d" reduce define-check]
            all [type = "m" reduce match-check]
            all [type = "define" reduce define-check]
            all [type = "match" reduce match-check]
            all [type = "strat" reduce strat-check]
            all [type = "info" reduce info-check]
            all [type = "help" reduce help-check]
            all [type = "server" reduce server-check]
            all [type = "status" reduce status-check]
            showdb-check
        ]
        ;; some confirmed reponses will have no other data 
        switch system/words/copy/part response 3 [
            "210" [return response-msg]
            "220" [return response-msg]
            "250" [return response-msg]
            "554" [return no-response]
            "555" [return no-response]
        ]
        ;; get a match or database list or loop over defines
        ;;   if return code isn't 150, 151 or 152 add empty
        ;; most of this code could be refactored
        any [
            all [
                any [type = "d" type = "define" type = "m" type = "match"]
                either none? find/match response "15" [
                    either any [type = "d" type = "define"] [
                        append/only data []
                    ][
                        append/only data system/words/copy ""
                    ]
                ][
                    either find/match response "150" [
                        loop to integer! second parse response none [
                            append/only data compose [(read-def port/sub-port)]
                        ]
                    ][
                        append/only data read-def port/sub-port
                    ]
                ]
            ]
            append/only data read-def port/sub-port
        ]
    ]
    ; Define the port handler version of copy...a little bit arcane
    copy: func [
        "Copy dict query into a block"
        port "The port object"
        /local msgs n
    ][
        msgs: make block! 1024
        query-dict port msgs
    ]
    ;; Install the dict port handler
    net-utils/net-install dict self 2628
] ;; end protocol handler
;;
;; Demo code
;;
tell: out: none   ;; for hiding the gui fields - Thanks Anton
dp: none          ;; for hiding the dict port
demo: has [showtell code] [
    showtell: func [str] [
        tell/text: str  show tell
        out/text: do tell/text
        show out  print out/text
    ]
    either all [value? 'view?  view?] [
        view layout compose [
            style bt btn 100
            across
            h2 "dict:// port handler, see"
            h1 "http://dict.org" h2 "for details"
            below
            (to set-word! in self 'tell) field 426
            (to set-word! in self 'out) area 426x140
            across
            bt "Show DB" [showtell "read dict:///"]
            bt "Match Strategies" [showtell "read dict:///strat:"]
            bt "foldoc Info" [showtell "read dict:///info:foldoc"]
            bt "Server Summary" [showtell "read dict:///server:"]
            return
            bt "Define TCPIP" [showtell "read dict://dict.org/d:tcpip"]
            bt "Translate SERVER" [
                showtell "read dict://dict.org/m:server:trans"
            ]
            bt "re Match c?rl" [
                showtell "read dict:///match:c?rl:*:re"
            ]
            bt red "Canada" [showtell "read dict:///d:Canada:world95"]
            return
            btn "Close" [unview/all]
            btn "dict.org" [browse http://dict.org]
        ]
    ][  ;; no view tricks, just a sample
        do code: {
            print read dict:///match:hello:trans
            print read dict:///define:oxygen:elements
            print read dict:///define:corpus:bouvier
            print read dict:///match:Noah:hitchcock
            print read dict:///info:easton
            print read dict://dict.org/d:AI:jargon
            print read [scheme: 'dict  host: "dict.org" target: "define:UTF:foldoc"]
            trace/net on
            print read dict:///server:
            print read [scheme: 'dict target: {match:^^^^c[a|u]rl$:*:re}]
            trace/net off
        }
        print ["Those queries look like this:" newline code]
        print ["Fun with words and the internet" newline "Please visit http://dict.org"]
    ]
]
;;
;; Set default dict server
;;
system/schemes/dict/host: "all.dict.org"
] ;; end context