Changeset 194f817 in tol for tolbase/lib/toltk/tolbase.tcl


Ignore:
Timestamp:
Dec 4, 2011, 2:52:49 PM (15 years ago)
Author:
Jorge Pérez <josp.jorge@…>
Branches:
1941-docker-image-to-test, devel, master
Children:
16cf245
Parents:
ef17027
Message:

refs #1347, using markupviewer to show hipertext documentation on info tab, for now, in order to keep backward compatibility, the documentation following the markup style should include #!NB; in its first 4 characters of the text.

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

File:
1 edited

Legend:

Unmodified
Added
Removed

  • tolbase/lib/toltk/tolbase.tcl

    ref17027 r194f817  
    4747}
    4848
     49package require nbdbmanager
     50package require markupviewer
     51
    4952global tcl_platform
    5053if { [string equal $tcl_platform(platform) "unix"] } {
    … …  
    7881}
    7982
     83proc ::TolConsole::CGetFont { font } {
     84  if { [lsearch -exact [font names] $font ] != -1 } {
     85    set family [ font configure $font -family ]
     86    set size [ font configure $font -size ]
     87  } else {
     88    foreach { family size } $font break
     89  }
     90  return [ list -family $family -size $size ]
     91}
    8092
    8193#/////////////////////////////////////////////////////////////////////////////
    … …  
    91103#
    92104#/////////////////////////////////////////////////////////////////////////////
     105
    93106  variable widgets
    94107  variable data
     108
     109  set data(nbdbmanager) [ nbdbmanagerType create %AUTO% ]
     110  set data(notebookdb) [ $data(nbdbmanager) create "__tmp_info__" ]
    95111
    96112  # connection BODBC
    … …  
    134150  set widgets(tabset) $pane2.ts
    135151  set w_tabset [::blt::tabset $widgets(tabset) -side top -relief flat \
    136                     -bd 0 -outerpad 0 -tier 2 -slant right -textside right \
    137                     -highlightthickness 0]
     152                    -bd 0 -outerpad 0 -tearoff 0 -slant right -textside right \
     153                    -highlightthickness 0 ]
    138154  set sw2 [ScrolledWindow $w_tabset.sw2 -auto both]
    139155  set sw3 [ScrolledWindow $w_tabset.sw3 -auto both]
    … …  
    185201  set widgets(info) $widgets(info,text)
    186202
     203  set widgets(info,markupviewer) [ markupviewer $w_tabset.mv \
     204                                       -db $data(notebookdb) -showtitle 0 ]
     205
    187206  set def_font [$w_info cget -font]
    188207  if { [lsearch -exact [font names] fnBold] == -1 } {
    … …  
    194213    }
    195214  }
     215 
     216  # force renderpane to use the same or similar font
     217  if { [lsearch -exact [font names] "ctfnNormal"] != -1 } {
     218    array set normalProps [ CGetFont "ctfnNormal" ]
     219  } else {
     220    array set normalProps [ CGetFont [ $widgets(output) cget -font ] ]
     221  }
     222  if { $normalProps(-size) == 9 } {
     223    # { Times 9 } does not look good on Linux
     224    set normalProps(-size) 10
     225  }
     226  prefs set bodytext "Times $normalProps(-size)"
     227  prefs set monotext "Courier $normalProps(-size)"
     228  foreach {f ds p} {header1 4 bold header2 2 bold header3 0 bold title 8 {} small -4 {}} {
     229    prefs set ${f}text  "Helvetica [ expr {$normalProps(-size) + $ds} ] $p"
     230  }
     231  prefs NotifyObservers
    196232
    197233  # teclas acceso rapido solapas de Informacion
    … …  
    437473}
    438474
     475proc ::TolConsole::ActivateInfoWidget { id } {
     476  variable widgets
     477
     478  if { $id eq "text" } {
     479    set w $widgets(tabset,info)
     480  } elseif { $id eq "markup" } {
     481    set w $widgets(info,markupviewer)
     482  } else {
     483    error "unknown id '$id' in ::TolConsole::ActivateInfoWidget"
     484  }
     485  if { [ $widgets(tabset) tab cget Info -window ] ne $w } {
     486    $widgets(tabset) tab configure Info  -window $w -fill both -padx 0
     487  }
     488  $widgets(tabset) select 2
     489}
     490
     491namespace 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
    439618#/////////////////////////////////////////////////////////////////////////////     
    440619proc ::TolConsole::OnInfo { args } {
    441620# 
    442621#/////////////////////////////////////////////////////////////////////////////       
     622  variable data
    443623  variable widgets
    444624 
    … …  
    452632    0 -
    453633    1 {
    454       $widgets(tabset,info) setwidget $widgets(info,text)
     634      if { 0 } {
     635        $widgets(tabset,info) setwidget $widgets(info,text)
     636        if { $ll == 1 } {
     637          #$w_info configure -wrap word
     638          $widgets(tabset,info) setwidget $widgets(info,text)
     639          $widgets(info,text) insert end [lindex $args 0]
     640          $widgets(tabset) select 2
     641        }
     642        $widgets(info,text) configure -state disabled
     643      }
     644      ActivateInfoWidget "markup"
     645      $data(notebookdb) set "info" \
     646          [ MarkupHelper::Preprocess [ lindex $args 0 ] ]
     647      $widgets(info,markupviewer) showpage "info"
    455648      if { $ll == 1 } {
    456         #$w_info configure -wrap word
    457         $widgets(tabset,info) setwidget $widgets(info,text)
    458         $widgets(info,text) insert end [lindex $args 0]
    459649        $widgets(tabset) select 2
    460650      }
    461       $widgets(info,text) configure -state disabled
    462651    }
    463652    default {
    … …  
    478667      if { $grammar eq "Anything" } {
    479668        if { [ regexp {/+\sClass\s} $content ] } {
     669          ActivateInfoWidget "text"
    480670          $widgets(tabset,info) setwidget $widgets(info,hltext)
    481671          $widgets(info,hltext) insert end $content
    482           $widgets(tabset) select 2
    483672          $widgets(info,hltext) configure -state disabled
    484673          return
    485674        }
    486675      }
    487 
    488       $widgets(tabset,info) setwidget $widgets(info,text)
     676      ActivateInfoWidget "markup"
     677      if { 0 } {
     678        $widgets(tabset,info) setwidget $widgets(info,text)
     679      }
    489680      #(pgea) Si es NameBlock busco su clase e información de instancia
    490681      if {$grammar eq "NameBlock" && [string length $objRef]} {
    … …  
    497688        set insCont ""
    498689      }
     690      MarkupHelper::Init
     691      MarkupHelper::Text "Grammar: " -tags b
     692      MarkupHelper::Image $icon
     693      if {$classOf eq ""} {
     694        MarkupHelper::Text " $grammar"
     695      } else {
     696        MarkupHelper::Text " $classOf"
     697      }
     698      MarkupHelper::BR
     699      MarkupHelper::LabelValue "Name" $name
     700      if {$insCont ne ""} {
     701        set _content $insCont
     702      } elseif {$classOf ne ""} {
     703        set _content $classOf
     704      } else {
     705        set _content $content
     706      }
     707      MarkupHelper::BR
     708      MarkupHelper::LabelValue "Content" [ MarkupHelper::Escape $_content ]
     709      if {$path ne ""} {
     710        MarkupHelper::BR
     711        MarkupHelper::LabelValue "Path" $path
     712      }
     713      if {$desc ne ""} {
     714        MarkupHelper::BR
     715        MarkupHelper::Text "Description:" -tags b -br 1
     716        MarkupHelper::Text \
     717            [ MarkupHelper::Preprocess [ string trimright $desc ] ]
     718      }
     719      if { $insInfo ne "" } {
     720        MarkupHelper::Header2 "Instance's Info"
     721        foreach line [ split $insInfo \n ] {
     722          set s [ string index $line 0 ]
     723          set e [ string index $line end ]
     724          if { $s eq "\[" && $e eq "\]" } {
     725            MarkupHelper::Text "[ string range $line 1 end-1 ]:" \
     726                -tags {b i} -br 1
     727          } elseif { $s eq "{" && $e eq "}" } {
     728            MarkupHelper::Text "[ string range $line 1 end-1 ]: " -tags {b i}
     729          } else {
     730            MarkupHelper::Text \
     731                [ MarkupHelper::Preprocess [ string trimright $line ] ] -br 1
     732          }
     733        }
     734      }
     735      $data(notebookdb) set "info" [ MarkupHelper::GetText ]
     736      $widgets(info,markupviewer) showpage "info"
     737      return
     738      if { 0 } {
    499739      if {$classOf eq ""} {
    500740        w_insert $w_info Grammar ": " tagLabel
    … …  
    508748        w_insert $w_info $classOf "\n" tagValue
    509749      }
     750
    510751      w_insert $w_info Name ": " tagLabel
    511752      w_insert $w_info $name "\n" tagValue
    … …  
    525766        w_insert $w_info Description ":\n" tagLabel
    526767        w_insert $w_info $desc "\n" tagValue
     768      }
    527769      }
    528770      #(pgea) se añade la información de instancia (si hay)
Note: See TracChangeset for help on using the changeset viewer.