Rebol [
    Title: "Desk Tracker"
    Author: ["Carl Sassenrath" "Sean C. Johnson"]
    File: %desktracker.r
    Version: 0.1.0
    Date: 11-Jul-2001
    Type: 'link-app
    History: [
         1-Nov-2000 Carl {Created bug report application.}
        25-Feb-2001 Carl {Major changes to file handling.}
         1-Mar-2001 Bo   {Changed LINKED? to LINK-APP?, changed date to 2001.}
         1-Mar-2001 Carl {Closed bugs not shown any longer.}
        11-Jul-2001 Sean {Modified to internal ECR application.}
    ]
    Help-text: {
                New and modified issues are refreshed when the application is restarted.
                Issues are not deleted; instead, when the status is changed and
                saved as "closed" that issue no longer shows in the application.
                Closed issues are therefore archived.
}
]

ctx-bug: context [

;--------------------------------------------------------------------------
;--- Try to figure out where this script is run from to find the database
;--------------------------------------------------------------------------
where-am-i?: func [/local a b][
            a: read dns://
            b: what-dir change-dir %.
            return reduce [a b]
]

issues-path: switch/default first where-am-i? [
                "tim" [%/c/xitami/webpages/reb/issues/]
                "heather" [%/t/xitami/webpages/reb/issues/]
                "sean" [either error? try [read %/t/][%.][%/t/xitami/webpages/reb/issues/]]
][%.]

;--- Original file
this-file: none
f-cat: f-area: f-originator: f-originator-email: f-actionedto: f-actionedto-email: f-reroutedto: f-reroutedto-email: f-date:  f-subject: f-descrp: f-status: f-need: f-response: f-file: f-attachments: none
txt-fields: [f-cat f-area f-originator f-originator-email f-actionedto  f-actioned-email f-rerouted-email f-date f-subject f-descrp f-status f-need f-response f-file]

bug-obj: context [
    cat: area: originator: originator-email: actionedto:  actionedto-email: reroutedto: reroutedto-email: date: subject: descrp:
    status: need: response: file: attachments:
        none
]

bug-app: 'issues
bug-dir: %apps/issues/
bug-path: either link-app? [link-root][issues-path]
bug-data: [] ; full bug database

;--- No connection to the database
if not exists? bug-path [request/ok {No connection to network, unable to reach database. Check that you have a networked drive mapped to Tim's computer and try again.} quit]

;--- Simple help system
give-help: does [request/ok system/script/header/help-text]

;--- Original funcs
load-bug: func [file /local bug b] [
    if not find file "eit-" [exit]
    bug: make bug-obj load/all bug-path/:file
    if any [none? bug/date bug/status = "closed"] [exit]
    bug/file: copy find file "eit-"
    forall bug-data [
        b: first bug-data
        if b/file = bug/file [change bug-data bug break]
    ]
    if tail? bug-data [append bug-data bug]
    bug-data: head bug-data
]

make-index: does [
    clear bl/data
    foreach bug bug-data [append bl/data bug/subject]
    bl/sld/redrag bl/lc / max 1 length? bl/data  ; whew! make it a function!
]

sort-bugs: does [
    sort/compare bug-data func [a b] [(to-date a/date) > (to-date b/date)]
]

load-local: has [bug-files] [
    bug-files: load bug-path
    while [not tail? bug-files] [
        either find/match first bug-files "eit-" [bug-files: next bug-files] [remove bug-files]
    ]
    head bug-files
]

load-bugs: func [files] [
    foreach file files [load-bug file]
    sort-bugs
    make-index
    show bl
]

sp2: func [n] [n: form n  if none? pick n 2 [insert n "0"]  n]

submit: has [out dt t file] [
    out: copy ""
    foreach f txt-fields [
        repend out [skip form f 2 ": " mold get in get f 'text newline]
    ]
    if none? this-file [
        dt: now
        t: dt/time
        this-file: rejoin ["eit-" dt/1 sp2 dt/2 sp2 dt/3 sp2 t/1 sp2 t/2 sp2 t/3 ".r"]
    ]
    either link-app? [
        either connected? [
            send-server add-file reduce [bug-app bug-dir/:this-file compress out]
            reset-fields
            show txt-fields
        ][
            request/ok reform ["Cannot be actioned while working offline. Saved your data to:" bug-path/saved.r]
            write bug-path/saved.r out
        ]
    ][
        if not exists? bug-path [make-dir/deep bug-path]
        write bug-path/:this-file out
        reset-fields
        show txt-fields
    ]
]

clear-field: func [f] [clear f/text f/line-list: none f/para/scroll: 0x0]

reset-fields: does [
    this-file: none
    unfocus
    clear-field f-subject
    clear-field f-descrp
    clear-field f-response
    f-originator/text: system/user/name
    f-originator-email/text: form system/user/email
    f-date/text: form now
    f-status/data: head f-status/data
    f-need/data: head f-need/data
    f-cat/text: first f-cat/data
    f-area/text: first f-area/data
]

pick-bug: func [n /local bug word] [
    bug: bug-data/:n
    reset-fields
    this-file: bug/file
    foreach f txt-fields [
        word: to-word skip form f 2 ""
        set in get f 'text copy any [bug/:word]
    ]
    f-status/data: find head f-status/data f-status/text
    f-need/data: any [find head f-need/data f-need/text head f-need/data]
    show txt-fields
]

;--------------------------------------------------------------------------
;--- Functions add by Sean
;--------------------------------------------------------------------------
attach-file: func [f][
        data: compress read/binary f
        append archive data

compress read/binary f]

dummy: does [flash "Dummy stub... enter code here" wait 2 unview]
archive: make binary! 32000

;--------------------------------------------------------------------------
;--- Main Layout
;--------------------------------------------------------------------------
f-originator-email: layout [field]
ra: bl: none
lo: layout/offset [
    origin 5x5
    ;styles link-styles backdrop
    style tx txt 100x24 middle right bold
    style fld field 400x24
    across
    h1 reform [system/script/header/title system/script/header/version] return
    box 730x2 maroon return
    space 0
    txt 220 bold white coal "Issue Reports (New to Old)" return
    bl: text-list 220x300 [pick-bug index? find face/data value]
    space 3x3
    guide
    tx "Originator:" f-originator: fld 196
    f-status: rotary 94 40.40.180 "Submitted" 200.120.20 "Reviewed" 200.0.0 "Pending" leaf "Done" 100.100.100 "Closed"
    f-need: rotary 94 leaf "A - today" 200.0.0 "Critical" 40.40.180 "B - week" brown "C - 90days" 100.100.100 "Reminder" return
    tx "Actioned To:" f-actionto: fld 196
    f-actioned-email: fld 196 return
    tx "Rerouted To:" f-rerouteto: fld 196
    f-rerouted-email: fld 196 return
    tx "Date/Time:" f-date: fld 196x24 form now f-file: info 196 return
    tx "Categories:" f-cat: choice 196x24 "Pending File" "Prospect" "Computers" "Policy" "General Question"
    f-area: choice 196x24 "Buyer" "Seller" "Documentation" "Command Decision" "General"  return
    tx "Subject:" f-subject: fld return
    tx "Description:" f-descrp: area wrap 400x72 return
    ra: tx 100x40 "Response to Action Item:" f-response: area 400x72 wrap return
    at ra/offset + (ra/size * 0x1)
    here: at
    pad 32
    button 65 "Add File" [dummy] return
    tx
    button "New"  #"^N" [reset-fields show txt-fields]
    button "Save" leaf #"^S" [submit]
    button "Help" [give-help]
    button 85 "Quit" #"^Q" [unview/only lo  if link-app? [quit-app]]
    return
    key keycode escape [quit]
    key keycode [f1][give-help]
] 0x20

on-new-file: func [event files] [load-bugs files]

on-file-list: func [event files] [
    remove-notify 'get none
    load-bugs files
    insert-notify 'fileset-downloaded 'bugs :on-new-file
]

reset-fields

either link-app? [
    view/new lo
    insert-notify 'get none :on-file-list
    send-link 'get 'app-files 'bugs
][
    load-bugs load bug-path
    view lo
]

];--- end context

comment {
VISION:
    Be able to add files to responses
}