| [4721b73] | 1 | package require BWidget |
|---|
| 2 | package require snit |
|---|
| 3 | package require mimetex |
|---|
| 4 | package require notebookdb |
|---|
| 5 | package require trycatch |
|---|
| 6 | |
|---|
| 7 | if { [ info commands "try" ] eq "" } { |
|---|
| 8 | namespace import ::trycatch::* |
|---|
| 9 | } |
|---|
| 10 | |
|---|
| 11 | |
|---|
| 12 | snit::type nbdbmanagerType { |
|---|
| 13 | |
|---|
| 14 | #------------------------------------------------------------------- |
|---|
| 15 | # Instance Variables |
|---|
| 16 | |
|---|
| 17 | # This is an array, indexed by normalized notebook filename. |
|---|
| 18 | # The elements are lists: db <notebookdb> ref <refcount> |
|---|
| 19 | variable registry |
|---|
| 20 | |
|---|
| 21 | method create { name } { |
|---|
| 22 | # FIRST, put the file name into canonical form as an index key. |
|---|
| 23 | set canonicalName [file normalize $name] |
|---|
| 24 | |
|---|
| 25 | # NEXT, do we have a notebookdb for this name? |
|---|
| 26 | if {[info exists registry($canonicalName)]} { |
|---|
| 27 | |
|---|
| 28 | # We do. Increment its reference count. |
|---|
| 29 | array set data $registry($canonicalName) |
|---|
| 30 | incr data(ref) |
|---|
| 31 | set registry($canonicalName) [array get data] |
|---|
| 32 | |
|---|
| 33 | # Return the object. |
|---|
| 34 | return $data(db) |
|---|
| 35 | } |
|---|
| 36 | # NEXT, try to open a file with this name. It might fail with |
|---|
| 37 | # an error, which we won't bother catching; we'd just need to |
|---|
| 38 | # rethrow it. |
|---|
| 39 | set data(db) [ ::notebookdb::notebookdb create %AUTO% -dbfile $name ] |
|---|
| 40 | |
|---|
| 41 | # NEXT, it succeeded. Add it to the registry with a reference |
|---|
| 42 | # count of 1. |
|---|
| 43 | set data(ref) 1 |
|---|
| 44 | set registry($canonicalName) [array get data] |
|---|
| 45 | |
|---|
| 46 | # NEXT, define the Notebook Commands and the required pages |
|---|
| 47 | $self InitializeCommands $data(db) |
|---|
| 48 | |
|---|
| 49 | # FINALLY, return the new notebookdb. |
|---|
| 50 | return $data(db) |
|---|
| 51 | } |
|---|
| 52 | |
|---|
| 53 | method InitializeCommands { db } { |
|---|
| 54 | # FIRST, define a private namespace for Notebook's use |
|---|
| 55 | $db eval "namespace eval ::__notebook:: { }" |
|---|
| 56 | |
|---|
| 57 | # FIRST, alias "kernel" commands defined elsewhere in the |
|---|
| 58 | # application. |
|---|
| 59 | $db alias parse ::markupparser::parse |
|---|
| 60 | $db alias image image |
|---|
| 61 | $db alias GetImage Bitmap::get |
|---|
| 62 | $db alias mimetexRender mimetex::RenderImage |
|---|
| 63 | $db eval { |
|---|
| 64 | ::db::PageExpander evalcmd escapemime |
|---|
| 65 | ::db::PageExpander errmode error |
|---|
| 66 | |
|---|
| 67 | proc escapemime { macro } { |
|---|
| 68 | #puts "escapeeval = '$macro'" |
|---|
| 69 | if { [ string range [ string trimleft $macro ] 0 6 ] eq "mimetex" } { |
|---|
| 70 | set latex [ string range $macro 7 end ] |
|---|
| 71 | return [ mimetex $latex ] |
|---|
| 72 | } else { |
|---|
| 73 | eval $macro |
|---|
| 74 | } |
|---|
| 75 | } |
|---|
| 76 | |
|---|
| 77 | proc img { imageORfile } { |
|---|
| 78 | if { [ lsearch [ image names ] $imageORfile ] == -1 } { |
|---|
| 79 | set img [ GetImage $imageORfile ] |
|---|
| 80 | } else { |
|---|
| 81 | set img $imageORfile |
|---|
| 82 | } |
|---|
| 83 | return "\[!image $img !\]" |
|---|
| 84 | } |
|---|
| 85 | |
|---|
| 86 | proc mimetex { latex } { |
|---|
| 87 | set img [ mimetexRender $latex ] |
|---|
| 88 | return "\[!image $img !\]" |
|---|
| 89 | } |
|---|
| 90 | |
|---|
| 91 | array set urlConf { |
|---|
| 92 | tol,root https://www.tol-project.org |
|---|
| 93 | tol,wiki https://www.tol-project.org/wiki |
|---|
| 94 | tol,milestone https://www.tol-project.org/milestone |
|---|
| 95 | tol,ticket https://www.tol-project.org/ticket |
|---|
| 96 | mms,root https://trac.localbayes.es/mms |
|---|
| 97 | mms,wiki https://trac.localbayes.es/mms/wiki |
|---|
| 98 | mms,milestone https://www.tol-project.org/mms/milestone |
|---|
| 99 | mms,ticket https://www.tol-project.org/mms/ticket |
|---|
| [0da9dfe] | 100 | tol,browser https://www.tol-project.org/browser/tolp |
|---|
| 101 | tol,browser,default trunk |
|---|
| 102 | mms,browser https://trac.localbayes.es/mms/browser |
|---|
| 103 | mms,browser,default trunk |
|---|
| [4721b73] | 104 | } |
|---|
| 105 | |
|---|
| 106 | # [@url mms howto/5 "HOWTO 5" wiki @] |
|---|
| 107 | # [@url mms howto/5 "HOWTO 5" @] |
|---|
| 108 | # [@url mms howto/5 @] |
|---|
| 109 | proc url { where path args } { |
|---|
| 110 | foreach { label section } {"" ""} break |
|---|
| 111 | foreach { label section } $args break |
|---|
| 112 | if { $section eq "" } { |
|---|
| 113 | set section "wiki" |
|---|
| 114 | } |
|---|
| 115 | set urlroot $::urlConf(${where},root) |
|---|
| 116 | set url "$::urlConf(${where},root)/$section/$path" |
|---|
| 117 | if { $label eq "" } { |
|---|
| 118 | return "\[${url}\]" |
|---|
| 119 | } else { |
|---|
| 120 | return "\[$label | ${url}\]" |
|---|
| 121 | } |
|---|
| 122 | } |
|---|
| 123 | |
|---|
| 124 | # [@mms howto/5 "HOWTO 5" wiki @] |
|---|
| 125 | # [@mms howto/5 "HOWTO 5" @] |
|---|
| 126 | # [@mms howto/5 @] |
|---|
| 127 | proc mms { path args } { |
|---|
| 128 | return [ eval url mms $path $args ] |
|---|
| 129 | } |
|---|
| 130 | |
|---|
| 131 | proc tol { path args } { |
|---|
| 132 | return [ eval url tol $path $args ] |
|---|
| 133 | } |
|---|
| [0da9dfe] | 134 | |
|---|
| 135 | # [@src tol tol/init.cpp init.cpp trunk@] |
|---|
| 136 | # [@src tol tol/init.cpp init.cpp@] |
|---|
| 137 | # [@src tol tol/init.cpp@] |
|---|
| 138 | # [@src mms MMS/definition/01_variable/def_variable.tol def_variable.tol@] |
|---|
| 139 | proc src { where path args } { |
|---|
| 140 | foreach { label release } {"" ""} break |
|---|
| 141 | foreach { label release } $args break |
|---|
| 142 | if { $release eq "" } { |
|---|
| 143 | set release "trunk" |
|---|
| 144 | } |
|---|
| 145 | set urlroot $::urlConf(${where},browser) |
|---|
| 146 | set url "${urlroot}/${release}/${path}" |
|---|
| 147 | if { $label eq "" } { |
|---|
| 148 | return "\[${url}\]" |
|---|
| 149 | } else { |
|---|
| 150 | return "\[$label | ${url}\]" |
|---|
| 151 | } |
|---|
| 152 | } |
|---|
| [4721b73] | 153 | } |
|---|
| 154 | } |
|---|
| 155 | } |
|---|
| 156 | |
|---|
| 157 | package provide nbdbmanager 1.0 |
|---|