Changeset 02ea263 in tol


Ignore:
Timestamp:
Dec 14, 2011, 7:12:29 PM (15 years ago)
Author:
Jorge Pérez <josp.jorge@…>
Branches:
1941-docker-image-to-test, devel, master
Children:
5b6b63c
Parents:
b7a4f8b
Message:

refs #1347, factoring MarkupHelper in order to use it from MMS (outside tolbase)

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@3925 be4846ae-f051-483a-831f-b64e7d08527f

Location:
tolbase/lib/toltk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • tolbase/lib/toltk/markuphelper.tcl

    rb7a4f8b r02ea263  
    125125  }
    126126
    127   proc BuildTolbaseInfo { args } {
    128     foreach {icon grammar name content path desc objRef} $args {}
     127  # esto deberia recibir un ObjectAddress
     128  proc BuildTolbaseInfo {icon grammar name content path desc args } {
     129    array set opts $args
    129130
    130     if {$grammar eq "NameBlock" && [string length $objRef]} {
    131       set classOf [Tol_ClassOfFromReference $objRef]
    132       set insInfo [Tol_InstanceInfoFromReference $objRef]
    133       set insCont [Tol_InstanceContentFromReference $objRef]
    134     } else {
    135       set classOf ""
    136       set insInfo ""
    137       set insCont ""
     131    foreach {classOf insInfo insCont} {{} {} {}} break
     132    if { $grammar eq "NameBlock" } {
     133      if { [ info exists opts(-objref) ] } {
     134        set objRef $opts(-objref)
     135        set classOf [Tol_ClassOfFromReference $objRef]
     136        set insInfo [Tol_InstanceInfoFromReference $objRef]
     137        set insCont [Tol_InstanceContentFromReference $objRef]
     138      } elseif { [ info exists opts(-objaddr) ] } {
     139        set objAddr $opts(-objaddr)
     140        set classOf [Tol_ClassOf $objAddr]
     141        set insInfo [Tol_InstanceInfo $objAddr]
     142        set insCont [Tol_InstanceContent $objAddr]
     143      }
    138144    }
    139145    Text "Grammar: " -tags b

  • tolbase/lib/toltk/tolbase.tcl

    rb7a4f8b r02ea263  
    5656  source [file join $toltk_script_path "panedw.tcl"]
    5757}
     58
     59source [file join $toltk_script_path "markuphelper.tcl"]
     60source [file join $toltk_script_path "tolpkg.tcl"]
     61source [file join $toltk_script_path "tolpkg_gui.tcl"]
    5862
    5963#source [file join $toltk_script_path "scrollw.tcl"]
    … …  
    489493}
    490494
    491 namespace eval ::MarkupHelper {
    492   variable markup
    493 
    494   proc Init { } {
    495     variable markup {}
    496   }
    497 
    498   proc Verbatim { text } {
    499     return [ string map {\n \n<br>} $text ]
    500   }
    501 
    502   proc Escape { text } {
    503     set specialChars {
    504       [  &lb;
    505       ]  &rb;
    506       <  &lt;
    507       >  &gt;
    508     }
    509     return [ string map $specialChars $text ]
    510   }
    511 
    512   proc Preprocess { text } {
    513     set idx [ string first ";" $text ]
    514     set ismarkup 0
    515     if { $idx != -1 } {
    516       set header [ string range $text 0 [ expr { $idx -1 } ] ]
    517       if { [ string range [ string trimleft $header ] 0 3 ] eq "#!NB" } {
    518         set ismarkup 1
    519         set body [ string range $text [ expr { $idx +1 } ] end ]
    520       } else {
    521         set body $text
    522       }
    523     } else {
    524       set body $text
    525     }
    526     if { $ismarkup } {
    527       return $body
    528     } else {
    529       return [ Verbatim [ Escape $body ] ]
    530     }
    531   }
    532 
    533   proc GetText { } {
    534     variable markup
    535 
    536     return $markup
    537   }
    538 
    539   proc Text { text args } {
    540     variable markup
    541 
    542     array set opts { -tags {} -br 0 }
    543     array set opts $args
    544     foreach t $opts(-tags) {
    545       append markup "<$t>"
    546     }
    547     append markup $text
    548     foreach t [ lreverse $opts(-tags) ] {
    549       append markup "</$t>"
    550     }
    551     BR $opts(-br)
    552   }
    553 
    554   proc Image { image {br 0} } {
    555     variable markup
    556 
    557     append markup "\[!image $image !\]"
    558     BR $br
    559   }
    560 
    561   proc LabelValue { name value {br 0}} {
    562     variable markup
    563 
    564     append markup "<b>$name:</b> "
    565     append markup "$value"
    566     BR $br
    567   }
    568  
    569   proc InlineHeader { text } {
    570     Text $text -tags h
    571   }
    572 
    573   proc Header1 { text } {
    574     variable markup
    575    
    576     NeedNewLine
    577     append markup "= $text =\n"
    578   }
    579 
    580   proc Header2 { text } {
    581     variable markup
    582    
    583     append markup "\n\n== $text ==\n"
    584   }
    585 
    586   proc Header3 { text } {
    587     variable markup
    588    
    589     append markup "\n\n=== $text ===\n"
    590   }
    591 
    592   proc BR { { br 1 } } {
    593     variable markup
    594 
    595     if { $br } {
    596       append markup " <br>"
    597     }
    598   }
    599 
    600   proc NeedNewLine { } {
    601     variable markup
    602 
    603     if { [ string index $markup end ] ne "\n" } {
    604       append markup "\n"
    605     }
    606   }
    607    
    608   proc Line { } {
    609     variable markup
    610 
    611     if { [ string index $markup end ] ne "\n" } {
    612       append markup "\n"
    613     }
    614     append markup "#---\n"
    615   }
    616 }
    617 
    618495#/////////////////////////////////////////////////////////////////////////////     
    619496proc ::TolConsole::OnInfo { args } {
    … …  
    650527    }
    651528    default {
    652       #(pgea) se modifica el mecanismo de escritura de la informacion
    653       #(pgea) en tolbase incluyendo la informacion de instancia
    654       proc w_insert {w_info w_text w_token w_tag} {
    655         set idx_start [$w_info index "end -1 chars"]
    656         $w_info insert end $w_text
    657         $w_info insert end $w_token
    658         set idx_end   [$w_info index "end -1 chars"]
    659         $w_info tag add $w_tag $idx_start $idx_end
    660       }
    661 
    662       #$w_info configure -wrap none
    663529      foreach {icon grammar name content path desc objRef} $args {}
    664       set w_info $widgets(info,text)
    665530
    666531      if { $grammar eq "Anything" } {
    … …  
    673538        }
    674539      }
     540      MarkupHelper::Init
     541      $data(notebookdb) set "info" \
     542          [ MarkupHelper::BuildTolbaseInfo \
     543                $icon $grammar $name $content $path $desc -objref $objRef ]
     544      $widgets(info,markupviewer) showpage "info"
    675545      ActivateInfoWidget "markup"
    676       if { 0 } {
    677         $widgets(tabset,info) setwidget $widgets(info,text)
    678       }
    679       #(pgea) Si es NameBlock busco su clase e información de instancia
    680       if {$grammar eq "NameBlock" && [string length $objRef]} {
    681         set classOf [Tol_ClassOfFromReference $objRef]
    682         set insInfo [Tol_InstanceInfoFromReference $objRef]
    683         set insCont [Tol_InstanceContentFromReference $objRef]
    684       } else {
    685         set classOf ""
    686         set insInfo ""
    687         set insCont ""
    688       }
    689       MarkupHelper::Init
    690       MarkupHelper::Text "Grammar: " -tags b
    691       MarkupHelper::Image $icon
    692       if {$classOf eq ""} {
    693         MarkupHelper::Text " $grammar"
    694       } else {
    695         MarkupHelper::Text " $classOf"
    696       }
    697       MarkupHelper::BR
    698       MarkupHelper::LabelValue "Name" $name
    699       if {$insCont ne ""} {
    700         set _content $insCont
    701       } elseif {$classOf ne ""} {
    702         set _content $classOf
    703       } else {
    704         set _content $content
    705       }
    706       MarkupHelper::BR
    707       MarkupHelper::LabelValue "Content" [ MarkupHelper::Escape $_content ]
    708       if {$path ne ""} {
    709         MarkupHelper::BR
    710         MarkupHelper::LabelValue "Path" $path
    711       }
    712       if {$desc ne ""} {
    713         MarkupHelper::BR
    714         MarkupHelper::Text "Description:" -tags b -br 1
    715         MarkupHelper::Text \
    716             [ MarkupHelper::Preprocess [ string trimright $desc ] ]
    717       }
    718       if { $insInfo ne "" } {
    719         MarkupHelper::Header2 "Instance's Info"
    720         foreach line [ split $insInfo \n ] {
    721           set s [ string index $line 0 ]
    722           set e [ string index $line end ]
    723           if { $s eq "\[" && $e eq "\]" } {
    724             MarkupHelper::Text "[ string range $line 1 end-1 ]:" \
    725                 -tags {b i} -br 1
    726           } elseif { $s eq "{" && $e eq "}" } {
    727             MarkupHelper::Text "[ string range $line 1 end-1 ]: " -tags {b i}
    728           } else {
    729             MarkupHelper::Text \
    730                 [ MarkupHelper::Preprocess [ string trimright $line ] ] -br 1
    731           }
    732         }
    733       }
    734       $data(notebookdb) set "info" [ MarkupHelper::GetText ]
    735       $widgets(info,markupviewer) showpage "info"
    736       return
    737       if { 0 } {
    738       if {$classOf eq ""} {
    739         w_insert $w_info Grammar ": " tagLabel
    740         $w_info image create end -image $icon
    741         $w_info insert end " "
    742         w_insert $w_info $grammar "\n" tagValue
    743       } else {
    744         w_insert $w_info Class ": " tagLabel
    745         $w_info image create end -image $icon
    746         $w_info insert end " "
    747         w_insert $w_info $classOf "\n" tagValue
    748       }
    749 
    750       w_insert $w_info Name ": " tagLabel
    751       w_insert $w_info $name "\n" tagValue
    752       w_insert $w_info Content ": " tagLabel
    753       if {$insCont ne ""} {
    754         w_insert $w_info $insCont "\n" tagValue
    755       } elseif {$classOf ne ""} {
    756         w_insert $w_info $classOf "\n" tagValue
    757       } else {
    758         w_insert $w_info $content "\n" tagValue
    759       }
    760       if {$path ne ""} {
    761         w_insert $w_info Path ": " tagLabel
    762         w_insert $w_info $path "\n" tagValue
    763       }
    764       if {$desc ne ""} {
    765         w_insert $w_info Description ":\n" tagLabel
    766         w_insert $w_info $desc "\n" tagValue
    767       }
    768       }
    769       #(pgea) se añade la información de instancia (si hay)
    770       if { [string length $insInfo] } {
    771         set brNeed 0
    772         set attr 0
    773         set lines [split $insInfo \n]
    774         foreach line $lines {
    775           set lineLen [string length $line]
    776           set lineIni [string index $line 0]
    777           set lineFin [string index $line [expr $lineLen-1]]
    778           set lineIF "$lineIni$lineFin"
    779           if { [string eq $lineIF {[]}] } {
    780             set lineLabel [string range $line 1 [expr $lineLen-2]]
    781             w_insert $w_info $lineLabel ":\n" tagLabelB
    782           } elseif { [string eq $lineIF {{}}] } {
    783             set lineLabel [string range $line 1 [expr $lineLen-2]]
    784             w_insert $w_info $lineLabel ": " tagLabelB
    785           } else {
    786             w_insert $w_info $line "\n" tagValue
    787           }
    788         }
    789       }
    790       $w_info tag configure tagLabel -font fnBold
    791       $w_info tag configure tagValue -wrap none
    792       $w_info tag configure tagLabelB -font fnBold -foreground navy
    793       $w_tabset select 2
    794       $w_info configure -state disabled
    795546    }
    796547  }
    … …  
    25692320 
    25702321  $md add $id separator
     2322  $md add $id command -label "[mc {Manage Packages}]..." \
     2323      -command ::TolPkgGUI::Show
    25712324  set cid [$md add $id cascade -label [mc "Analysis Tools"]]
    25722325  set cid2 [$md add $cid cascade -label [mc "ARIMA"]]
Note: See TracChangeset for help on using the changeset viewer.