Rebol [
    Title: "Desk Password"
    Date: 2-Apr-2011
    Version: 1.0.0
    File: %deskpassword.r
    Author: "Carl Sassenrath"
    Purpose: "A simple but useful address book contact database."
    Email: %carl--rebol--com
    library: [
        level: 'intermediate 
        platform: none 
        type: 'tool 
        domain: [file-handling DB GUI] 
        tested-under: none 
        support: none 
        license: none 
        see-also: none
    ]
]

names-path: %deskpassdat.r ;data file
name-list: none
fields: [number name email identifier password notes updat]

names: either exists? names-path [load names-path][
    [[name "Carl Sassenrath" title "Founder" company "REBOL Technologies"
    email "%carl--rebol--com" web "http://www.rebol.com"]]
]

brws: [
    if not empty? web/text [
        if not find web/text "http://" [insert web/text "http://"]
        error? try [browse web/text]
    ]
]

dial: [request [rejoin ["Dial number for " name/text "?  (Not implemented.)"] "Dial" "Cancel"]]

dex-styles: stylize [
    lab: label 60x20 right bold middle font-size 11
    btn: button 64x20 font-size 11 edge [size: 1x1]
    fld: field 200x20 font-size 11 middle edge [size: 1x1]
    inf: info font-size 11 middle edge [size: 1x1]
    ari: field wrap font-size 11 edge [size: 1x1] with [flags: [field tabbed]]
]

dex-pane1: layout/offset [
    origin 0 space 2x0 across
    styles dex-styles
    lab "Number" number: fld bold return
    lab "Name" name: fld return
    lab "Email" email: fld return
    lab "Uuid" identifier: fld return
    lab "Pwd" password: fld return
    lab "Notes" notes: ari 200x72 return
    lab "Date" updat: inf 200x20 return
] 0x0
updat/flags: none

dex: layout [
    origin 8x8
    space 0x1
    styles dex-styles
    srch: fld 196x20 bold
    across
    rslt: list 180x150 [
        nt: txt 178x15 middle font-size 11 [
            store-entry curr: cnt find-name nt/text update-entry unfocus show dex
        ]
    ]
    supply [
        cnt: count + scroll-off
        face/text: ""
        face/color: snow
        if not n: pick name-list cnt [exit]
        face/text: select n 'name face/font/color: black
        if curr = cnt [face/color: system/view/vid/vid-colors/field-select]
    ]
    sl: slider 16x150 [scroll-list] return
    return
    btn "New" #"^n" [new-name]
    btn "Del" #"^d" [delete-name unfocus update-entry search-all show dex]
    btn "Sort" #"^s" [sort names sort name-list show rslt]
    return
    at srch/offset + (srch/size * 1x0)
    bx1: box dex-pane1/size
    return
]

bx1/pane: dex-pane1/pane
rslt/data: []
this-name: first names
name-list: copy names
curr: none
search-text: ""
scroll-off: 0

srch/feel: make srch/feel [
    redraw: func [face act pos][
        face/color: pick face/colors face <> system/view/focal-face
        if all [face = system/view/focal-face face/text <> search-text] [
            search-text: copy face/text search-all
            if 1 = length? name-list [this-name: first name-list update-entry show dex]
        ]
    ]
]

update-file: func [data] [
    set [path file] split-path names-path
    if not exists? path [make-dir/deep path]
    write names-path data
]

save-file: has [buf] [
    buf: reform [{REBOL [Title: "Name Database" Date:} now "]^/[^/"]
    foreach n names [repend buf [mold n newline]]
    update-file append buf "]"
]

delete-name: does [
    remove find/only names this-name
    if empty? names [append-empty]
    save-file
    new-name
]

clean-names: function [][n][
    forall names [
        if any [empty? first names none? n: select first names 'name empty? n][
            remove names
        ]
    ]
    names: head names
]

search-all: function [] [ent flds] [
    clean-names
    clear name-list
    flds: [name] 
    either empty? search-text [insert name-list names][
        foreach nam names [
            foreach word flds [
                if all [ent: select nam word  find ent search-text][
                    append/only name-list nam
                    break
                ]
            ]
        ]
    ]
    scroll-off: 0
    sl/data: 0
    resize-drag
    scroll-list
    curr: none
    show [rslt sl]
]

new-name: does [
    store-entry
    clear-entry
    search-all
    append-empty
    focus name
]

append-empty: does [append/only names this-name: copy []]

find-name: function [str][] [
    foreach nam names [
        if str = select nam 'name [
            this-name: nam
            break
        ]
    ]
]

store-entry: has [val ent flag] [
    flag: 0
    if not empty? trim name/text [
        foreach word fields [
            val: trim get in get word 'text
            either ent: select this-name word [
                if ent <> val [insert clear ent val  flag: flag + 1]
            ][
                if not empty? val [repend this-name [word copy val] flag: flag + 1]
            ]
            if flag = 1 [flag: 2  updat/text: form now]
        ]
        if not zero? flag [save-file]
    ]
]

update-entry: does [
    foreach word fields [
        insert clear get in get word 'text any [select this-name word ""]
    ]
    show rslt
]

clear-entry: does [
    clear-fields bx1
    updat/text: form now
    unfocus
    show dex
]

show-names: does [
    clear rslt/data
    foreach n name-list [
        if n/name [append rslt/data n/name]
    ]
    show rslt
]

scroll-list: does [
    scroll-off: max 0 to-integer 1 + (length? name-list) - (100 / 16) * sl/data
    show rslt
]

do resize-drag: does [sl/redrag 100 / max 1 (16 * length? name-list)]

center-face dex
new-name
focus srch
show-names
view/new/title dex reform [system/script/header/title system/script/header/version]
insert-event-func [
    either all [event/type = 'close event/face = dex][
        store-entry
        quit
    ][event]
]
do-events