tk app to track expenses with receipts

expenses.tcl

package require Tk 8.6
package require sqlite3

sqlite3 db expenses.db

db eval {
  PRAGMA auto_vacuum='incremental';
}

db eval {
  CREATE TABLE IF NOT EXISTS expenses (
    id INTEGER PRIMARY KEY,
    vendor TEXT,
    date TEXT,
    reimbursement TEXT,
    amount REAL,
    paid INTEGER,
    receipt BLOB,
    receipt_extension TEXT
  )
}

proc db-update {} {
  event generate . <<DbUpdate>>
}

proc save-entry {input existing} {
  set vendor [$input.place get]
  set amount [$input.amount get]
  set reimbursement [$input.txn get]
  set date [$input.date get]

  if {$existing == ""} {
    db eval {
      INSERT INTO expenses (vendor, amount, reimbursement, date) VALUES
      (:vendor, :amount, :reimbursement, :date)
    }
  } else {
    db eval {
      UPDATE expenses SET
        vendor = :vendor,
        amount = :amount,
        reimbursement = :reimbursement,
        date = :date
      WHERE id == :existing
    }
  }

  if {[info commands $input.file] != {}} {
    set infile [$input.file get]
  } else {
    set infile ""
  }
  if {$infile != ""} {
    set inhandle [open $infile]
    fconfigure $inhandle -translation binary
    set receipt [read $inhandle]
    set receipt_extension [file extension $infile]
    if {$existing != ""} {
      set row $existing
    } else {
      set row [db last_insert_rowid]
    }
    db eval {
      UPDATE expenses SET
       receipt = :receipt,
       receipt_extension = :receipt_extension
      WHERE id == :row
    }
    set continued " with receipt"
  } else {
    set continued ""
  }
  db-update
  tk_messageBox -type ok -message "Saved payment to $vendor on $date$continued"
  destroy [winfo parent $input]
}

proc render-input {existing} {
  set parent [toplevel .inputparent]
  wm title $parent "Expense Input"
  set input [
    ttk::labelframe $parent.inputs -labelanchor n -text "Expense input"
  ]

  set row 1

  ttk::label $input.placelabel -text "Location"
  grid $input.placelabel -row $row -column 0 -sticky e
  ttk::entry $input.place
  grid $input.place -row $row -column 1 -columnspan 2

  incr row

  ttk::label $input.amountlabel -text "Amount"
  grid $input.amountlabel -row $row -column 0 -sticky e
  ttk::entry $input.amount
  grid $input.amount -row $row -column 1 -columnspan 2

  incr row

  ttk::label $input.datelabel -text "Date"
  grid $input.datelabel -row $row -column 0 -sticky e
  ttk::entry $input.date
  $input.date insert 0 [
    clock format [clock seconds] -format {%G-%m-%d}
  ]
  grid $input.date -row $row -column 1 -columnspan 2

  incr row

  ttk::label $input.txnlabel -text "Payment ID"
  grid $input.txnlabel -row $row -column 0 -sticky e
  ttk::entry $input.txn
  grid $input.txn -row $row -column 1 -columnspan 2

  incr row

  ttk::label $input.filelabel -text "Receipt image"
  grid $input.filelabel -row $row -column 0 -sticky e
  ttk::entry $input.file -textvariable receiptfile_in
  grid $input.file -row $row -column 1 -columnspan 2
  ttk::button $input.filepick -text "Select" -command {
    set ::receiptfile_in [tk_getOpenFile]
  }
  grid $input.filepick -row $row -column 3

  incr row

  ttk::button $input.save -text "Save" -command [list save-entry $input $existing]
  grid $input.save -row $row -columnspan 4

  if {$existing != {}} {
    $input.date delete 0 end
    foreach column {vendor amount date reimbursement} \
            field {place amount date txn} {
      $input.$field insert 0 [
        db onecolumn "
          SELECT $column FROM expenses WHERE id == :existing
        "
      ]
    }
  }

  pack $input
}

proc update-table {expense_table} {
  foreach id [db eval {SELECT id FROM expenses}] {
    lassign [db eval {
        SELECT date, vendor, amount, reimbursement, (receipt IS NOT NULL)
        FROM expenses WHERE id == :id
      }] date vendor amount reimbursement has_receipt
    set has_receipt [expr {$has_receipt?"Yes":"No"}]
    if {[$expense_table exists $id]} {
      $expense_table item $id -text $date -values [
        list $vendor $amount $reimbursement $has_receipt
      ]
    } else {
      $expense_table insert {} end -id $id -text $date -values [
        list $vendor $amount $reimbursement $has_receipt
      ]
    }
  }
  foreach id [$expense_table children {}] {
    if {![db exists {SELECT 1 FROM expenses WHERE id == :id}]} {
      $expense_table delete $id
    }
  }
}

proc edit-entry {expense_table} {
  render-input [lindex [$expense_table selection] 0]
}

proc delete-entry {expense_table} {
  set rowid [lindex [$expense_table selection] 0]
  db eval {
    DELETE FROM expenses WHERE id == :rowid
  }
  db-update
}

proc selected-dl {expense_table dl_button} {
  set rowid [lindex [$expense_table selection] 0]
  set receipt [db onecolumn {
    SELECT (receipt IS NOT NULL) FROM expenses WHERE id == :rowid
  }]
  set state [expr {$receipt?"normal":"disabled"}]
  $dl_button configure -state $state
}

proc dl-image {expense_table} {
  set rowid [lindex [$expense_table selection] 0]
  set extension [db onecolumn {
    SELECT receipt_extension FROM expenses WHERE id == :rowid
  }]
  set save_file [tk_getSaveFile -initialfile receipt$extension]
  set outhandle [open $save_file w]
  fconfigure $outhandle -translation binary
  set blobhandle [db incrblob -readonly expenses receipt $rowid]
  fconfigure $blobhandle -translation binary
  set bytes [fcopy $blobhandle $outhandle]
  close $outhandle
  close $blobhandle
  tk_messageBox -type ok -message "Saved receipt image to $save_file ($bytes bytes)"
}

proc quit-app {} {
  db eval {PRAGMA incremental_vacuum}
  destroy .
}

set top [
  ttk::labelframe .top -labelanchor n -text "Expense management"
]
wm title . "Expense Management"
pack $top -anchor n -fill x

set tablecols {vendor amount reimbursement has_reciept}
set tablelabel {Date Vendor Amount {Reimbursement Txn} {Has Receipt?}}
set expense_table [
  ttk::treeview $top.table -columns $tablecols -selectmode browse
]
foreach column [linsert $tablecols 0 {#0}] label $tablelabel {
  $expense_table heading $column -text $label
}
pack $expense_table

update-table $expense_table
bind . <<DbUpdate>> [list update-table $expense_table]

set buttons [ttk::frame $top.buttons]
ttk::button $buttons.new -text "New" -command [list render-input {}]
ttk::button $buttons.edit -text "Edit" -command [list edit-entry $expense_table]
ttk::button $buttons.download -text "Download Receipt" \
  -command [list dl-image $expense_table] -state disabled
ttk::button $buttons.delete -text "Delete" -command [list delete-entry $expense_table]
ttk::button $buttons.quit -text "Quit" -command quit-app
pack $buttons.new $buttons.edit $buttons.download \
  $buttons.delete $buttons.quit -side left
pack $buttons -anchor s

bind all <<TreeviewSelect>> [list selected-dl $expense_table $buttons.download]