Add version 0.7 alpha
This commit is contained in:
parent
cb09f79dd7
commit
a3e7784ed6
|
|
@ -0,0 +1,16 @@
|
|||
# Cozy Catalog news
|
||||
|
||||
## [0.7] - 2023-01-26
|
||||
|
||||
### Added
|
||||
|
||||
* App icon
|
||||
|
||||
### Fixed
|
||||
|
||||
* Keep Item button broken after the last refactor
|
||||
* Only try to set the Modify window type to "dialog" on X11.
|
||||
|
||||
## [0.6] - 2023-01-24
|
||||
|
||||
Initial release
|
||||
26
README.md
26
README.md
|
|
@ -1,3 +1,25 @@
|
|||
# cozy-catalog
|
||||
# About Cozy Catalog
|
||||
|
||||
A little personal database for media libraries
|
||||
It started with a simple problem: keeping a list of favorite webcomics, each with the same information about it, such as category, title, link, description, tags and so on. In other words, a table. For a while it existed as a spreadsheet, but that was hard to update, for several reasons. A dedicated user interface was needed, but that took some time to figure out.
|
||||
|
||||
Cozy Catalog is a little personal database, mainly for media libraries and the like. It's plain and doesn't do anything special except for making it easier to locate and update information. Its data files can also be opened with pretty much any office suite or programming language, to avoid lock-in. Main features:
|
||||
|
||||
- fixed yet generic set of fields, whose exact meaning can be reinterpreted;
|
||||
- quickly browse by category, or else run a free-form search across all fields;
|
||||
- store data in ordinary CSV files, self-documented with headings in line #1.
|
||||
|
||||
The user interface should be fairly obvious.
|
||||
|
||||
As of 26 January 2023, the code has been used in production for a week or two without issues. Please back up your data.
|
||||
|
||||
## System requirements
|
||||
|
||||
Running Cozy Catalog from source requires Tcl/Tk 8.5 or newer, with Tcllib. Both are available on most Linux distributions, or else from the tcl-lang.org website.
|
||||
|
||||
Recommended screen resolution: 1024x768.
|
||||
|
||||
## License and support
|
||||
|
||||
Cozy Catalog is open source under the MIT license. See source code for details.
|
||||
|
||||
You can usually find me on IRC, in the #ctrl-c channel of tilde.chat, or else as @notimetoplay on the elekk.xyz Mastodon instance. Would love to hear from you.
|
||||
|
|
|
|||
Binary file not shown.
|
After Width: | Height: | Size: 180 B |
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
|
|
@ -0,0 +1,852 @@
|
|||
#!/usr/bin/env tclsh
|
||||
#
|
||||
# Cozy Catalog: a little personal database for media libraries.
|
||||
# Copyright 2023 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.7 (26 Jan 2023)\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
|
||||
|
||||
set icon_data "
|
||||
R0lGODdhIAAgALEAAAAAAP8AAMzMAP/MzCH5BAEAAAEALAAAAAAgACAAAAKFjI+py+0Po5y0VoCz
|
||||
xjYAAYYiCFzjGZbSdw4Dqj7s6LqwfGL1gOXOlxGwNCRhL7aYFWEjZGLYE+ZIUedBicqmGFht1mro
|
||||
en3J8RjsyXWjInQ6tVwq3W95Oy78NddYN4BnlsPD5SKm9TeYVGMoWEi4aIboqLizYSk5qWAJsdnh
|
||||
+QkaKmpQAAA7
|
||||
"
|
||||
image create photo app_icon -data $icon_data
|
||||
wm iconphoto . app_icon
|
||||
|
||||
if {[tk windowingsystem] eq "x11"} {
|
||||
ttk::style theme use "clam"
|
||||
}
|
||||
|
||||
pack [ttk::frame .toolbar] -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
|
||||
|
||||
ttk::button .toolbar.new -text "New" -width 8 -under 0 -command do_new
|
||||
ttk::button .toolbar.bOpen -text "Open" -width 8 -under 0 -command do_open
|
||||
ttk::button .toolbar.save -text "Save" -width 8 -under 0 -command do_save
|
||||
|
||||
ttk::separator .toolbar.sep1 -orient vertical
|
||||
|
||||
ttk::button .toolbar.reload -text "Reload" -width 8 -under 0 -command do_reload
|
||||
ttk::button .toolbar.stats -text "Stats" -width 8 -under 1 -command show_stats
|
||||
|
||||
ttk::separator .toolbar.sep2 -orient vertical
|
||||
|
||||
ttk::button .toolbar.ins -text "Insert" -width 8 -under 3 -command do_insert
|
||||
ttk::button .toolbar.ren -text "Modify" -width 8 -under 0 -command do_modify
|
||||
ttk::button .toolbar.del -text "Delete" -width 8 -under 0 -command do_delete
|
||||
|
||||
pack .toolbar.new -side left
|
||||
pack .toolbar.bOpen -side left
|
||||
pack .toolbar.save -side left
|
||||
|
||||
pack .toolbar.sep1 -side left -padx 4 -pady 4 -fill y
|
||||
|
||||
pack .toolbar.reload -side left
|
||||
pack .toolbar.stats -side left
|
||||
|
||||
pack .toolbar.sep2 -side left -padx 4 -pady 4 -fill y
|
||||
|
||||
pack .toolbar.ins -side left
|
||||
pack .toolbar.ren -side left
|
||||
pack .toolbar.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_reload -under 0 -accel "Ctrl-R"
|
||||
$m add command -label "Statistics" -command show_stats -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 "Modify" -command do_modify -under 4 -accel "Ctrl-M"
|
||||
$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_reload
|
||||
bind . <Control-t> show_stats
|
||||
bind . <Control-q> do_quit
|
||||
|
||||
bind . <Command-n> do_new
|
||||
bind . <Command-o> do_open
|
||||
bind . <Command-s> do_save
|
||||
bind . <Command-r> do_reload
|
||||
bind . <Command-t> show_stats
|
||||
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
|
||||
}
|
||||
}
|
||||
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 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
|
||||
|
||||
set choice [tk_getSaveFile -parent . \
|
||||
-title "Save file 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_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_reload {} {
|
||||
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 show_stats {} {
|
||||
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
|
||||
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]
|
||||
}
|
||||
}
|
||||
Loading…
Reference in New Issue