936 lines
25 KiB
Tcl
936 lines
25 KiB
Tcl
#!/usr/bin/env tclsh
|
|
#
|
|
# Cozy Catalog: a little personal database for media libraries.
|
|
# Copyright 2023, 2024 Felix Pleșoianu <https://felix.plesoianu.ro/>
|
|
#
|
|
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
|
# of this software and associated documentation files (the "Software"), to deal
|
|
# in the Software without restriction, including without limitation the rights
|
|
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
|
# copies of the Software, and to permit persons to whom the Software is
|
|
# furnished to do so, subject to the following conditions:
|
|
#
|
|
# The above copyright notice and this permission notice shall be included in
|
|
# all copies or substantial portions of the Software.
|
|
#
|
|
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
|
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
|
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
|
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
|
|
# THE SOFTWARE.
|
|
|
|
package require Tcl 8.5
|
|
package require Tk 8.5
|
|
|
|
package require try
|
|
package require csv
|
|
|
|
set about_text "A personal database\nVersion 0.8 (4 Feb 2024)\nMIT License"
|
|
set credits_text "Made by No Time To Play\nbased on knowledge\nfrom TkDocs.com"
|
|
set site_link "https://ctrl-c.club/~nttp/toys/catalog/"
|
|
|
|
set file_types {
|
|
{"All files" ".*"}
|
|
{"CSV files" ".csv"}
|
|
}
|
|
|
|
set columns {
|
|
Category Title Link Source Description
|
|
Comments Tags Status Date Notes
|
|
}
|
|
|
|
set file_name ""
|
|
set modified 0
|
|
|
|
set cat_name ""
|
|
set item_name ""
|
|
set search_term ""
|
|
|
|
set form(cat) ""
|
|
set form(title) ""
|
|
set form(link) ""
|
|
set form(src) ""
|
|
set form(desc) ""
|
|
set form(comm) ""
|
|
set form(tags) ""
|
|
set form(status) ""
|
|
set form(date) ""
|
|
set form(notes) ""
|
|
|
|
set editing -1
|
|
|
|
namespace eval db {
|
|
variable records [list]
|
|
variable status [list]
|
|
variable index [dict create]
|
|
|
|
proc reindex {} {
|
|
variable records [lsort $records]
|
|
variable status [list]
|
|
variable index [dict create]
|
|
|
|
for {set i 0} {$i < [llength $records]} {incr i} {
|
|
set category [lindex $records $i 0]
|
|
set title [lindex $records $i 1]
|
|
dict set index $category $title $i
|
|
|
|
lappend status [lindex $records $i 7]
|
|
}
|
|
set status [lsort $status]
|
|
}
|
|
|
|
proc clear {} {
|
|
variable records [list]
|
|
variable status [list]
|
|
variable index [dict create]
|
|
}
|
|
}
|
|
|
|
namespace eval tk_util {
|
|
proc pack_scrolled widget {
|
|
set parent [winfo parent $widget]
|
|
if {$parent == "."} {
|
|
set scroll .scroll
|
|
} else {
|
|
set scroll $parent.scroll
|
|
}
|
|
ttk::scrollbar $scroll -orient "vertical" \
|
|
-command "$widget yview"
|
|
pack $widget -side "left" -fill "both" -expand 1
|
|
$widget configure -yscrollcommand "$scroll set"
|
|
pack $scroll -side "right" -fill y
|
|
}
|
|
|
|
proc full_screen window {
|
|
if {[wm attributes $window -fullscreen]} {
|
|
wm attributes $window -fullscreen 0
|
|
} else {
|
|
wm attributes $window -fullscreen 1
|
|
}
|
|
}
|
|
}
|
|
|
|
wm title . "Cozy Catalog"
|
|
option add *tearOff 0
|
|
. configure -padx 4
|
|
|
|
image create photo app_icon -data "
|
|
R0lGODdhIAAgALEAAAAAAP8AAMzMAP/MzCH5BAEAAAEALAAAAAAgACAAAAKFjI+py+0Po5y0VoCz
|
|
xjYAAYYiCFzjGZbSdw4Dqj7s6LqwfGL1gOXOlxGwNCRhL7aYFWEjZGLYE+ZIUedBicqmGFht1mro
|
|
en3J8RjsyXWjInQ6tVwq3W95Oy78NddYN4BnlsPD5SKm9TeYVGMoWEi4aIboqLizYSk5qWAJsdnh
|
|
+QkaKmpQAAA7
|
|
"
|
|
wm iconphoto . app_icon
|
|
|
|
if {[tk windowingsystem] eq "x11"} {
|
|
ttk::style theme use "clam"
|
|
}
|
|
|
|
pack [ttk::frame .tools] -side top -pady 4
|
|
|
|
ttk::frame .status
|
|
ttk::label .status.line -relief sunken -textvar status
|
|
ttk::sizegrip .status.grip
|
|
|
|
pack .status -side bottom -fill x -pady 4
|
|
pack .status.line -side left -fill x -expand 1
|
|
pack .status.grip -side right -anchor s
|
|
|
|
ttk::notebook .tabs
|
|
pack .tabs -side top -fill both -expand 1
|
|
|
|
ttk::panedwindow .tabs.browse -orient horizontal
|
|
.tabs add .tabs.browse -text "Browse" -under 0 -sticky "nsew" -padding 4
|
|
|
|
.tabs.browse add [ttk::frame .tabs.browse.cats] -weight 2
|
|
.tabs.browse add [ttk::frame .tabs.browse.items] -weight 3
|
|
.tabs.browse add [ttk::frame .tabs.browse.detail] -weight 5
|
|
|
|
ttk::treeview .tabs.browse.cats.pane -selectmode browse -height 20
|
|
.tabs.browse.cats.pane heading "#0" -text "Categories"
|
|
tk_util::pack_scrolled .tabs.browse.cats.pane
|
|
|
|
ttk::treeview .tabs.browse.items.pane -selectmode browse -height 20
|
|
.tabs.browse.items.pane heading "#0" -text "Items"
|
|
tk_util::pack_scrolled .tabs.browse.items.pane
|
|
|
|
text .tabs.browse.detail.text -width 42 -height 24 -wrap word -state disabled
|
|
tk_util::pack_scrolled .tabs.browse.detail.text
|
|
|
|
ttk::frame .tabs.search
|
|
.tabs add .tabs.search -text "Search" -under 1 -sticky "nsew" -padding 4
|
|
|
|
ttk::entry .tabs.search.term -textvar search_term
|
|
pack .tabs.search.term -side top -pady 4 -ipady 4 -fill x
|
|
|
|
ttk::treeview .tabs.search.results -selectmode browse -height 20 \
|
|
-columns "cat title tags" -display "cat title tags" -show headings
|
|
.tabs.search.results heading "cat" -text "Category"
|
|
.tabs.search.results heading "title" -text "Title"
|
|
.tabs.search.results heading "tags" -text "Tags"
|
|
tk_util::pack_scrolled .tabs.search.results
|
|
|
|
image create photo i_new -data "
|
|
R0lGODdhEAAQALEAAAAAAP8AAP//////ACH5BAEAAAEALAAAAAAQABAAAAItjI+JwK0romDPADkH
|
|
qFeCoT1d1FDJiE0Kim1n6q0wKc8uZNfwfbDxWQpWhoYCADs=
|
|
"
|
|
image create photo i_open -data "
|
|
R0lGODdhEAAQALEAAAAAAP8AAP//////ACH5BAEAAAEALAAAAAAQABAAAAIwjI+pu+CMgJiuKjlz
|
|
Bgnr3W3VyBkYMKSqWp7r2wroyx7STA9l4OTpbiKNIMSikVgAADs=
|
|
"
|
|
image create photo i_props -data "
|
|
R0lGODdhEAAQALEAAAAAAP8AAP//////ACH5BAEAAAEALAAAAAAQABAAAAIzjI9pwO0KhJwSQOEY
|
|
vnTaFGUh122gF1UcMAwis3jtPH8pRtN21b57dfsgbh3hwQdTKJUFADs=
|
|
"
|
|
image create photo i_rev -data "
|
|
R0lGODdhEAAQALEAAAAAAP8AAP//////ACH5BAEAAAEALAAAAAAQABAAAAI2jI9pwK0IhBTsrUkH
|
|
sHGCoT2d1FTJiFEKOm6np5VO0H3gfbs1zuuwDPJ5PDZhilJayJKW5qEAADs=
|
|
"
|
|
image create photo i_save -data "
|
|
R0lGODdhEAAQALEAAAAAAP8AAP//////ACH5BAEAAAEALAAAAAAQABAAAAI+jI95wOLOEhvgVUAR
|
|
plZssAzc44lZsFHMZIKoCcduuq6t8ZGQOPN6ecrpPjjfkFfE1CZKXCrGc6GWVIU1UQAAOw==
|
|
"
|
|
image create photo i_ch -data "
|
|
R0lGODdhEAAQALEAAAAAAP8AAP//////ACH5BAEAAAEALAAAAAAQABAAAAIsjI+pywrfDhgDtlnr
|
|
pRiwzn1cuIBaOZ5O6pXCQ7qvWgLCG1C6bjyQD2xFFAUAOw==
|
|
"
|
|
image create photo i_del -data "
|
|
R0lGODdhEAAQALEAAAAAAP8AAP////+A/yH5BAEAAAEALAAAAAAQABAAAAI4jI+pMT17nHzKiStc
|
|
arhnanBANzbRgI2C+oVoyrbMewGxOac1hudxCcp5Lj0X7RM8TZIbDeSJKAAAOw==
|
|
"
|
|
image create photo i_ins -data "
|
|
R0lGODdhEAAQALEAAAAAAP8AAP//////ACH5BAEAAAEALAAAAAAQABAAAAIvjI+pAe29zJh0rgej
|
|
rENjp3GUxmQJtnUKIAhACSJs+wbcMbv11bqMRyMZYsLioQAAOw==
|
|
"
|
|
|
|
ttk::button .tools.new -text "New" -w 7 -im i_new -comp left -comm do_new
|
|
ttk::button .tools.bOpen -text "Open" -w 7 -im i_open -comp left -comm do_open
|
|
ttk::button .tools.save -text "Save" -w 7 -im i_save -comp left -comm do_save
|
|
|
|
ttk::separator .tools.sep1 -orient vertical
|
|
|
|
ttk::button .tools.reload -text "Reload" -w 7 -im i_rev -comp left -comm do_rev
|
|
ttk::button .tools.stat -text "Stats" -w 7 -im i_props -comp left -comm do_stat
|
|
|
|
ttk::separator .tools.sep2 -orient vertical
|
|
|
|
ttk::button .tools.ins -text "Insert" -w 7 -im i_ins -comp left -comm do_insert
|
|
ttk::button .tools.ren -text "Update" -w 7 -im i_ch -comp left -comm do_modify
|
|
ttk::button .tools.del -text "Delete" -w 7 -im i_del -comp left -comm do_delete
|
|
|
|
pack .tools.new -side left
|
|
pack .tools.bOpen -side left
|
|
pack .tools.save -side left
|
|
|
|
pack .tools.sep1 -side left -padx 4 -pady 4 -fill y
|
|
|
|
pack .tools.reload -side left
|
|
pack .tools.stat -side left
|
|
|
|
pack .tools.sep2 -side left -padx 4 -pady 4 -fill y
|
|
|
|
pack .tools.ins -side left
|
|
pack .tools.ren -side left
|
|
pack .tools.del -side left
|
|
|
|
. configure -menu [menu .menubar]
|
|
|
|
set m [menu .menubar.mFile]
|
|
$m add command -label "New" -command do_new -under 0 -accel "Ctrl-N"
|
|
$m add command -label "Open..." -command do_open -under 0 -accel "Ctrl-O"
|
|
$m add command -label "Save" -command do_save -under 0 -accel "Ctrl-S"
|
|
$m add separator
|
|
$m add command -label "Save as..." -command do_save_as -under 5
|
|
$m add command -label "Reload" -command do_rev -under 0 -accel "Ctrl-R"
|
|
$m add command -label "Statistics" -command do_stat -under 1 -accel "Ctrl-T"
|
|
$m add separator
|
|
$m add command -label "Quit" -command do_quit -under 0 -accel "Ctrl-Q"
|
|
.menubar add cascade -menu .menubar.mFile -label "File" -underline 0
|
|
|
|
set m [menu .menubar.item]
|
|
$m add command -label "Insert" -command do_insert -under 0 -accel "Ctrl-I"
|
|
$m add command -label "Update" -command do_modify -under 4 -accel "Ctrl-U"
|
|
$m add command -label "Delete" -command do_delete -under 4 -accel "Ctrl-D"
|
|
$m add separator
|
|
$m add command -label "Copy details" -under 0 -accel "Ctrl-C" \
|
|
-command copy_details
|
|
$m add command -label "See website" -under 4 -accel "Ctrl-H" \
|
|
-command see_website
|
|
.menubar add cascade -menu .menubar.item -label "Item" -underline 0
|
|
|
|
set m [menu .menubar.window]
|
|
$m add checkbutton -label "Full screen" -command {tk_util::full_screen .} \
|
|
-underline 10 -accelerator "F11" -var _full_screen
|
|
if {[llength [info commands "console"]] > 0} {
|
|
$m add separator
|
|
$m add command -label "Console" -command {console show} \
|
|
-underline 5 -accelerator "Ctrl-L"
|
|
}
|
|
.menubar add cascade -menu .menubar.window -label "Window" -underline 0
|
|
|
|
set m [menu .menubar.help]
|
|
$m add command -label "About" -command {alert $about_text} -under 0
|
|
$m add command -label "Credits" -command {alert $credits_text} -under 0
|
|
$m add command -label "Website" -command {open_in_app $site_link} -under 0
|
|
.menubar add cascade -menu .menubar.help -label "Help" -underline 0
|
|
|
|
wm protocol . WM_DELETE_WINDOW do_quit
|
|
|
|
bind .tabs.browse.cats.pane <<TreeviewSelect>> select_cat
|
|
bind .tabs.browse.items.pane <<TreeviewSelect>> select_item
|
|
bind .tabs.search.term <Return> {search_for $search_term}
|
|
|
|
bind . <Control-n> do_new
|
|
bind . <Control-o> do_open
|
|
bind . <Control-s> do_save
|
|
bind . <Control-r> do_rev
|
|
bind . <Control-t> do_stat
|
|
bind . <Control-q> do_quit
|
|
|
|
bind . <Command-n> do_new
|
|
bind . <Command-o> do_open
|
|
bind . <Command-s> do_save
|
|
bind . <Command-r> do_rev
|
|
bind . <Command-t> do_stat
|
|
bind . <Command-q> do_quit
|
|
|
|
bind . <Control-i> do_insert
|
|
bind . <Control-m> do_modify
|
|
bind . <Control-d> do_delete
|
|
bind . <Control-c> copy_details
|
|
bind . <Control-h> see_website
|
|
|
|
bind . <Command-i> do_insert
|
|
bind . <Command-m> do_modify
|
|
bind . <Command-d> do_delete
|
|
bind . <Command-c> copy_details
|
|
bind . <Command-h> see_website
|
|
|
|
bind . <F11> {tk_util::full_screen .}
|
|
|
|
if {[llength [info commands "console"]] > 0} {
|
|
bind . <Control-l> {console show}
|
|
bind . <Command-l> {console show}
|
|
}
|
|
|
|
proc select_cat {} {
|
|
global cat_name
|
|
|
|
set sel [.tabs.browse.cats.pane focus]
|
|
if {$sel ne ""} {
|
|
set cat_name [.tabs.browse.cats.pane item $sel -text]
|
|
set items [dict get $db::index $cat_name]
|
|
.tabs.browse.items.pane children "" {}
|
|
foreach i [dict keys $items] {
|
|
.tabs.browse.items.pane insert "" end -text $i
|
|
}
|
|
}
|
|
}
|
|
|
|
proc select_item {} {
|
|
global cat_name item_name
|
|
|
|
.tabs.browse.detail.text configure -state normal
|
|
.tabs.browse.detail.text delete 1.0 end
|
|
|
|
set sel [.tabs.browse.items.pane focus]
|
|
if {$sel ne ""} {
|
|
set item_name [.tabs.browse.items.pane item $sel -text]
|
|
set id [dict get $db::index $cat_name $item_name]
|
|
set details [lindex $db::records $id]
|
|
|
|
.tabs.browse.detail.text insert end [render_item $details]
|
|
}
|
|
.tabs.browse.detail.text configure -state disabled
|
|
}
|
|
|
|
proc render_item data {
|
|
append result "[lindex $data 0] -> [lindex $data 1]\n\n"
|
|
append result "[lindex $data 2]\n"
|
|
if {[lindex $data 3] ne ""} {
|
|
append result "Source: [lindex $data 3]\n\n"
|
|
} else {
|
|
append result "\n"
|
|
}
|
|
append result "[lindex $data 4]"
|
|
if {[lindex $data 5] ne ""} {
|
|
append result " ([lindex $data 5])\n\n"
|
|
} else {
|
|
append result "\n\n"
|
|
}
|
|
append result "Tags: [lindex $data 6]\n"
|
|
append result "Status: [lindex $data 7]\n"
|
|
append result "Date: [lindex $data 8]\n"
|
|
append result "Notes: [lindex $data 9]"
|
|
}
|
|
|
|
proc search_for term {
|
|
global status
|
|
|
|
.tabs.search.results children "" {}
|
|
|
|
if {$term eq ""} {
|
|
set status "No search entered."
|
|
return
|
|
}
|
|
set count [llength $db::records]
|
|
for {set i 0} {$i < $count} {incr i} {
|
|
set rec [lindex $db::records $i]
|
|
for {set j 0} {$j < 10} {incr j} {
|
|
set field [lindex $rec $j]
|
|
if {[string first $term $field] > -1} {
|
|
add_result .tabs.search.results $i $rec
|
|
break
|
|
}
|
|
}
|
|
}
|
|
set status "Search complete."
|
|
}
|
|
|
|
proc add_result {widget index data} {
|
|
lappend cols [lindex $data 0] [lindex $data 1] [lindex $data 6]
|
|
$widget insert "" end -text $index -values $cols
|
|
}
|
|
|
|
proc do_new {} {
|
|
global modified status file_name
|
|
|
|
if {$modified} {
|
|
set answer [tk_messageBox -parent . \
|
|
-type "yesno" -icon "question" \
|
|
-title "Cozy Catalog" \
|
|
-message "New database?" \
|
|
-detail "Database is unsaved.\nStart another?"]
|
|
if {!$answer} {
|
|
set status "New database canceled."
|
|
return
|
|
}
|
|
}
|
|
db::clear
|
|
clear_browser
|
|
wm title . "Cozy Catalog"
|
|
set file_name ""
|
|
set modified 0
|
|
set status [clock format [clock seconds]]
|
|
}
|
|
|
|
proc clear_browser {} {
|
|
.tabs.browse.cats.pane children "" {}
|
|
.tabs.browse.items.pane children "" {}
|
|
.tabs.browse.detail.text configure -state normal
|
|
.tabs.browse.detail.text delete 1.0 end
|
|
.tabs.browse.detail.text configure -state disabled
|
|
}
|
|
|
|
proc do_open {} {
|
|
global modified status file_types file_name
|
|
|
|
if {$modified} {
|
|
set answer [tk_messageBox -parent . \
|
|
-type "yesno" -icon "question" \
|
|
-title "Cozy Catalog" \
|
|
-message "Open another database?" \
|
|
-detail "Database is unsaved.\nOpen another?"]
|
|
if {!$answer} {
|
|
set status "Opening canceled."
|
|
return
|
|
}
|
|
}
|
|
|
|
if {[tk windowingsystem] == "x11" && [auto_execok "zenity"] ne ""} {
|
|
set choice [open_with_zenity $file_name]
|
|
} else {
|
|
set choice [tk_getOpenFile -parent . \
|
|
-title "Open existing database" \
|
|
-initialdir [file_dir $file_name] \
|
|
-filetypes $file_types]
|
|
}
|
|
|
|
if {[string length $choice] == 0} {
|
|
set status "Opening canceled."
|
|
} elseif {![file isfile $choice]} {
|
|
tk_messageBox -parent . \
|
|
-type "ok" -icon "error" \
|
|
-title "Cozy Catalog" \
|
|
-message "Error opening file" \
|
|
-detail "File not found: $choice"
|
|
} elseif {[load_file $choice]} {
|
|
set file_name $choice
|
|
}
|
|
}
|
|
|
|
proc open_with_zenity file_name {
|
|
try {
|
|
if {$file_name ne ""} {
|
|
return [exec zenity --file-selection \
|
|
--title "Open existing database" \
|
|
--filename $file_name \
|
|
--file-filter "All files | *" \
|
|
--file-filter "CSV files | *.csv"]
|
|
} else {
|
|
return [exec zenity --file-selection \
|
|
--title "Open existing database" \
|
|
--file-filter "All files | *" \
|
|
--file-filter "CSV files | *.csv"]
|
|
}
|
|
} trap CHILDSTATUS {results options} {
|
|
return ""
|
|
}
|
|
}
|
|
|
|
proc load_file full_path {
|
|
global status modified
|
|
|
|
set fn [file tail $full_path]
|
|
try {
|
|
set f [open $full_path]
|
|
parse_file $f
|
|
db::reindex
|
|
load_lists
|
|
set modified 0
|
|
set status "Opened $fn"
|
|
wm title . "$fn | Cozy Catalog"
|
|
return 1
|
|
} on break e {
|
|
tk_messageBox -parent . \
|
|
-type "ok" -icon "warning" \
|
|
-title "Cozy Catalog" \
|
|
-message "Error parsing file" \
|
|
-detail $e
|
|
return 0
|
|
} on error e {
|
|
tk_messageBox -parent . \
|
|
-type "ok" -icon "error" \
|
|
-title "Cozy Catalog" \
|
|
-message "Error opening file" \
|
|
-detail $e
|
|
return 0
|
|
} finally {
|
|
close $f
|
|
}
|
|
}
|
|
|
|
proc load_lists {} {
|
|
clear_browser
|
|
foreach i [dict keys $db::index] {
|
|
.tabs.browse.cats.pane insert "" end -text $i
|
|
}
|
|
}
|
|
|
|
proc parse_file f {
|
|
set db::records [list]
|
|
set heading [csv::split [gets $f]]
|
|
if {[llength $heading] < 10} {
|
|
return -code break "Not enough columns in database."
|
|
}
|
|
while {![eof $f]} {
|
|
set line [gets $f]
|
|
if {$line ne ""} {
|
|
lappend db::records [csv::split $line]
|
|
}
|
|
}
|
|
}
|
|
|
|
proc file_dir name {
|
|
if {$name ne ""} {
|
|
return [file dirname $name]
|
|
} else {
|
|
return [pwd]
|
|
}
|
|
}
|
|
|
|
proc do_save {} {
|
|
global file_name
|
|
if {$file_name eq ""} {
|
|
do_save_as
|
|
} else {
|
|
save_file $file_name
|
|
}
|
|
}
|
|
|
|
proc do_save_as {} {
|
|
global file_name file_types status
|
|
|
|
if {[tk windowingsystem] == "x11" && [auto_execok "zenity"] ne ""} {
|
|
set choice [save_with_zenity $file_name]
|
|
} else {
|
|
set choice [tk_getSaveFile -parent . \
|
|
-title "Save database as..." \
|
|
-initialdir [file_dir $file_name] \
|
|
-filetypes $file_types]
|
|
}
|
|
|
|
if {[string length $choice] == 0} {
|
|
set status "Save canceled."
|
|
} elseif {[save_file $choice]} {
|
|
set file_name $choice
|
|
}
|
|
}
|
|
|
|
proc save_with_zenity file_name {
|
|
try {
|
|
if {$file_name ne ""} {
|
|
return [exec zenity --file-selection \
|
|
--title "Save database as..." \
|
|
--save --confirm-overwrite \
|
|
--filename $file_name \
|
|
--file-filter "All files | *" \
|
|
--file-filter "CSV files | *.csv"]
|
|
} else {
|
|
return [exec zenity --file-selection \
|
|
--title "Save database as..." \
|
|
--save --confirm-overwrite \
|
|
--file-filter "All files | *" \
|
|
--file-filter "CSV files | *.csv"]
|
|
}
|
|
} trap CHILDSTATUS {results options} {
|
|
return ""
|
|
}
|
|
}
|
|
|
|
proc save_file full_path {
|
|
global columns modified status
|
|
|
|
set fn [file tail $full_path]
|
|
try {
|
|
set f [open $full_path "w"]
|
|
puts $f [csv::join $columns]
|
|
puts -nonewline $f [csv::joinlist $db::records]
|
|
flush $f
|
|
set modified 0
|
|
set status "Saved $fn"
|
|
wm title . "$fn | Cozy Catalog"
|
|
return 1
|
|
} on error e {
|
|
tk_messageBox -parent . \
|
|
-type "ok" -icon "error" \
|
|
-title "Cozy Catalog" \
|
|
-message "Error saving file" \
|
|
-detail $e
|
|
return 0
|
|
} finally {
|
|
close $f
|
|
}
|
|
}
|
|
|
|
proc do_rev {} {
|
|
global file_name status
|
|
if {$file_name eq ""} {
|
|
tk_messageBox -parent . \
|
|
-type "ok" -icon "warning" \
|
|
-title "Cozy Catalog" \
|
|
-message "Can't reload." \
|
|
-detail "The database was never saved."
|
|
} else {
|
|
set answer [tk_messageBox -parent . \
|
|
-type "yesno" -icon "question" \
|
|
-title "Cozy Catalog" \
|
|
-message "Reload database?" \
|
|
-detail "Reload last save?"]
|
|
if {$answer eq "yes"} {
|
|
load_file $file_name
|
|
} else {
|
|
set status "Reloading canceled."
|
|
}
|
|
}
|
|
}
|
|
|
|
proc do_stat {} {
|
|
set cats [llength [dict keys $db::index]]
|
|
set items [llength $db::records]
|
|
set average [expr {$items / $cats}]
|
|
set stats "Categories: $cats\nItems: $items\nAverage: $average"
|
|
tk_messageBox -parent . \
|
|
-type "ok" -icon "info" \
|
|
-title "Cozy Catalog" \
|
|
-message "Database statistics" \
|
|
-detail $stats
|
|
}
|
|
|
|
proc do_quit {} {
|
|
global modified
|
|
|
|
if {$modified} {
|
|
set answer [tk_messageBox -parent . \
|
|
-type "yesno" -icon "question" \
|
|
-title "Cozy Catalog" \
|
|
-message "Quit Cozy Catalog?" \
|
|
-detail "Database is unsaved.\nQuit anyway?"]
|
|
} else {
|
|
set answer "yes"
|
|
}
|
|
if {$answer eq "yes"} {
|
|
destroy .
|
|
}
|
|
}
|
|
|
|
proc selected_item {} {
|
|
global cat_name item_name
|
|
if {[.tabs select] eq ".tabs.browse"} {
|
|
if {$cat_name eq "" || $item_name eq ""} {
|
|
return -1
|
|
} else {
|
|
return [dict get $db::index $cat_name $item_name]
|
|
}
|
|
} else {
|
|
set sel [.tabs.search.results focus]
|
|
if {$sel eq ""} {
|
|
return -1
|
|
} else {
|
|
return [.tabs.search.results item $sel -text]
|
|
}
|
|
}
|
|
}
|
|
|
|
proc do_insert {} {
|
|
global form editing
|
|
|
|
set form(cat) ""
|
|
set form(title) ""
|
|
set form(link) ""
|
|
set form(src) ""
|
|
set form(desc) ""
|
|
set form(comm) ""
|
|
set form(tags) ""
|
|
set form(status) ""
|
|
set form(date) ""
|
|
set form(notes) ""
|
|
|
|
set editing -1
|
|
|
|
.form.cat configure -values [dict keys $db::index]
|
|
.form.stat configure -values [lsort -unique $db::status]
|
|
wm deiconify .form
|
|
}
|
|
|
|
proc do_modify {} {
|
|
global status form editing
|
|
|
|
set id [selected_item]
|
|
if {$id < 0} {
|
|
set status "Nothing selected."
|
|
return
|
|
}
|
|
set form(cat) [lindex $db::records $id 0]
|
|
set form(title) [lindex $db::records $id 1]
|
|
set form(link) [lindex $db::records $id 2]
|
|
set form(src) [lindex $db::records $id 3]
|
|
set form(desc) [lindex $db::records $id 4]
|
|
set form(comm) [lindex $db::records $id 5]
|
|
set form(tags) [lindex $db::records $id 6]
|
|
set form(status) [lindex $db::records $id 7]
|
|
set form(date) [lindex $db::records $id 8]
|
|
set form(notes) [lindex $db::records $id 9]
|
|
set editing $id
|
|
|
|
.form.cat configure -values [dict keys $db::index]
|
|
.form.stat configure -values [lsort -unique $db::status]
|
|
wm deiconify .form
|
|
}
|
|
|
|
proc do_delete {} {
|
|
global status search_term modified
|
|
|
|
set id [selected_item]
|
|
if {$id < 0} {
|
|
set status "Nothing selected."
|
|
return
|
|
}
|
|
set title [lindex $db::records $id 1]
|
|
set answer [tk_messageBox -parent . \
|
|
-type "yesno" -icon "question" \
|
|
-title "Cozy Catalog" \
|
|
-message "Delete item?" \
|
|
-detail "You'll delete\n$title.\nOkay?"]
|
|
if {$answer} {
|
|
set db::records [lreplace $db::records $id $id]
|
|
db::reindex
|
|
load_lists
|
|
if {$search_term ne ""} {search_for $search_term}
|
|
set modified 1
|
|
set status "Item deleted."
|
|
}
|
|
}
|
|
|
|
proc copy_details {} {
|
|
global status
|
|
set id [selected_item]
|
|
if {$id < 0} {
|
|
set status "Nothing selected."
|
|
return
|
|
}
|
|
set details [lindex $db::records $id]
|
|
clipboard clear
|
|
clipboard append [render_item $details]
|
|
}
|
|
|
|
proc see_website {} {
|
|
global status
|
|
set id [selected_item]
|
|
if {$id < 0} {
|
|
set status "Nothing selected."
|
|
return
|
|
}
|
|
set details [lindex $db::records $id]
|
|
if {[lindex $details 2] eq ""} {
|
|
set status "Link not added."
|
|
} else {
|
|
open_in_app [lindex $details 2]
|
|
}
|
|
}
|
|
|
|
proc alert message {
|
|
tk_messageBox -parent . \
|
|
-type "ok" -icon "info" \
|
|
-title "Cozy Catalog" \
|
|
-message $message
|
|
}
|
|
|
|
proc open_in_app link {
|
|
global status
|
|
if {[auto_execok "xdg-open"] ne ""} {
|
|
catch {exec "xdg-open" $link &}
|
|
} elseif {[auto_execok "open"] ne ""} {
|
|
catch {exec "open" $link &}
|
|
} elseif {[auto_execok "start"] ne ""} {
|
|
catch {exec "start" $link &}
|
|
} else {
|
|
set status "Can't open website."
|
|
}
|
|
}
|
|
|
|
toplevel .form
|
|
wm title .form "Cozy Catalog"
|
|
wm resizable .form 0 0
|
|
wm transient .form .
|
|
if {[tk windowingsystem] eq "x11"} {
|
|
wm attributes .form -type dialog
|
|
}
|
|
wm protocol .form WM_DELETE_WINDOW {wm withdraw .form}
|
|
wm withdraw .form
|
|
|
|
ttk::label .form.l_cat -text "Category"
|
|
ttk::combobox .form.cat -textvar form(cat)
|
|
ttk::label .form.l_title -text "Title"
|
|
ttk::entry .form.title -textvar form(title)
|
|
|
|
grid .form.l_cat .form.cat .form.l_title .form.title \
|
|
-padx 4 -pady 4 -ipadx 4 -ipady 4 -sticky w
|
|
|
|
ttk::label .form.l_link -text "Link"
|
|
ttk::entry .form.link -textvar form(link)
|
|
ttk::label .form.l_src -text "Source"
|
|
ttk::entry .form.src -textvar form(src)
|
|
|
|
grid .form.l_link .form.link .form.l_src .form.src \
|
|
-padx 4 -pady 4 -ipadx 4 -ipady 4 -sticky w
|
|
|
|
ttk::label .form.l_desc -text "Description"
|
|
ttk::entry .form.desc -textvar form(desc)
|
|
|
|
grid .form.l_desc .form.desc - - -padx 4 -pady 4 -ipadx 4 -ipady 4 -sticky ew
|
|
|
|
ttk::label .form.l_comm -text "Comments"
|
|
ttk::entry .form.comm -textvar form(comm)
|
|
|
|
grid .form.l_comm .form.comm - - -padx 4 -pady 4 -ipadx 4 -ipady 4 -sticky ew
|
|
|
|
ttk::label .form.l_tags -text "Tags"
|
|
ttk::entry .form.tags -textvar form(tags)
|
|
|
|
grid .form.l_tags .form.tags - - -padx 4 -pady 4 -ipadx 4 -ipady 4 -sticky ew
|
|
|
|
ttk::label .form.l_stat -text "Status"
|
|
ttk::combobox .form.stat -textvar form(status)
|
|
ttk::label .form.l_date -text "Date"
|
|
ttk::entry .form.date -textvar form(date)
|
|
|
|
grid .form.l_stat .form.stat .form.l_date .form.date \
|
|
-padx 4 -pady 4 -ipadx 4 -ipady 4 -sticky w
|
|
|
|
ttk::label .form.l_notes -text "Notes"
|
|
ttk::entry .form.notes -textvar form(notes)
|
|
|
|
grid .form.l_notes .form.notes - - -padx 4 -pady 4 -ipadx 4 -ipady 4 -sticky ew
|
|
|
|
grid [ttk::frame .form.buttons] - - - -padx 2 -pady 2 -sticky ew
|
|
|
|
ttk::button .form.buttons.bKeep -text "Keep item" -under 0 -command keep_item
|
|
ttk::button .form.buttons.bClose -text "Close" -under 0 \
|
|
-command {wm withdraw .form}
|
|
ttk::button .form.buttons.bToday -text "Today" -under 0 -command show_today
|
|
|
|
pack .form.buttons.bKeep .form.buttons.bClose -side left -padx 2 -pady 2
|
|
pack .form.buttons.bToday -side right -padx 2 -pady 2
|
|
|
|
proc keep_item {} {
|
|
global editing form modified status search_term
|
|
if {$editing > -1} {
|
|
set reindex 0
|
|
|
|
if {[lindex $db::records $editing 0] ne $form(cat)} {
|
|
set reindex 1
|
|
}
|
|
if {[lindex $db::records $editing 1] ne $form(title)} {
|
|
set reindex 1
|
|
}
|
|
if {[lindex $db::records $editing 7] ne $form(status)} {
|
|
set reindex 1
|
|
}
|
|
lset db::records $editing 0 $form(cat)
|
|
lset db::records $editing 1 $form(title)
|
|
lset db::records $editing 2 $form(link)
|
|
lset db::records $editing 3 $form(src)
|
|
lset db::records $editing 4 $form(desc)
|
|
lset db::records $editing 5 $form(comm)
|
|
lset db::records $editing 6 $form(tags)
|
|
lset db::records $editing 7 $form(status)
|
|
lset db::records $editing 8 $form(date)
|
|
lset db::records $editing 9 $form(notes)
|
|
|
|
if {$reindex} {
|
|
db::reindex
|
|
load_lists
|
|
if {$search_term ne ""} {search_for $search_term}
|
|
} else {
|
|
set details [lindex $db::records $editing]
|
|
set render [render_item $details]
|
|
.tabs.browse.detail.text configure -state normal
|
|
.tabs.browse.detail.text delete 1.0 end
|
|
.tabs.browse.detail.text insert end $render
|
|
.tabs.browse.detail.text configure -state disabled
|
|
}
|
|
} else {
|
|
lappend new $form(cat) $form(title) $form(link)
|
|
lappend new $form(src) $form(desc) $form(comm)
|
|
lappend new $form(tags) $form(status)
|
|
lappend new $form(date) $form(notes)
|
|
lappend db::records $new
|
|
db::reindex
|
|
load_lists
|
|
}
|
|
set modified 1
|
|
set status "(modified)"
|
|
wm withdraw .form
|
|
}
|
|
|
|
proc show_today {} {
|
|
global form
|
|
set form(date) [clock format [clock seconds] -format "%Y-%m-%d"]
|
|
}
|
|
|
|
set status [clock format [clock seconds]]
|
|
|
|
if {[llength $argv] > 0} {
|
|
set fn [lindex $argv 0]
|
|
if {![file exists $fn]} {
|
|
set file_name [file normalize $fn]
|
|
set fn [file tail $file_name]
|
|
wm title . "$fn | Cozy Catalog"
|
|
} elseif {[load_file $fn]} {
|
|
set file_name [file normalize $fn]
|
|
}
|
|
}
|