home *** CD-ROM | disk | FTP | other *** search
- # ~/.tk/edittkmodes/help-init.tcl - set up to edit jhelp help files
- ######################################################################
-
- proc mode:help:init { t } {
- global JEDIT_MODEPREFS TEXTWIDGET CURRENTSECTION
-
- j:read_prefs -array JEDIT_MODEPREFS -prefix help \
- -directory ~/.tk/jeditmodes -file help-defaults {
- {textfont default}
- {textwidth 70}
- {textheight 24}
- {textwrap word}
- {sabbrev 0}
- {dabbrev 0}
- {autobreak 0}
- {autoindent 1}
- {savestate 0}
- {buttonbar 1}
- {menu,editor 1}
- {menu,file 1}
- {menu,edit 1}
- {menu,prefs 0}
- {menu,abbrev 1}
- {menu,filter 1}
- {menu,format 1}
- {menu,display 1}
- {menu,mode1 0}
- {menu,mode2 0}
- {menu,user 1}
- }
-
- global TEXTWIDGET; set TEXTWIDGET $t
- global CURRENTSECTION; set CURRENTSECTION {}
- toplevel .l
- label .l.section -textvariable CURRENTSECTION
- pack .l -expand yes
-
- j:rt:mkabbrevs
-
- $TEXTWIDGET tag configure xref-topic \
- -underline 1
- $TEXTWIDGET tag configure xref-section \
- -underline 1
- $TEXTWIDGET tag configure xref-manpage \
- -underline 1
-
- $TEXTWIDGET tag bind xref-topic <ButtonRelease-1> {x_topic %W %x %y}
- $TEXTWIDGET tag bind xref-section <ButtonRelease-1> {x_section %W %x %y}
- $TEXTWIDGET tag bind xref-manpage <ButtonRelease-1> {x_manpage %W %x %y}
- }
-
- proc configure_widget {{w .main.t}} {
- $w tag configure j:rt:rm -font *-helvetica-medium-r-normal--*-120-*
- $w configure -font *-helvetica-medium-r-normal--*-120-*
- $w tag configure j:rt:it -font *-helvetica-medium-o-normal--*-120-* \
- -background grey66 -borderwidth 2 -relief raised
- $w tag configure j:rt:bf -font *-helvetica-bold-r-normal--*-120-* \
- -background grey66 -borderwidth 2 -relief raised
- $w tag configure j:rt:bi -font *-helvetica-bold-o-normal--*-120-* \
- -background grey66 -borderwidth 2 -relief raised
- $w tag configure j:rt:tt -font *-courier-medium-r-normal--*-120-* \
- -background grey66 -borderwidth 2 -relief raised
- $w tag configure j:rt:hl -font *-helvetica-bold-o-normal--*-140-* \
- -background grey66 -borderwidth 2 -relief raised
-
- $w configure -state normal
- }
-
- ######################################################################
-
- proc section {title body} {
- global TEXTWIDGET
-
- if {![winfo exists .menu.sections]} {
- menubutton .menu.sections -text {Sections} -menu .menu.sections.m
- menu .menu.sections.m
- pack append .menu .menu.sections left
- }
-
- .menu.sections.m add command -label $title -command [format {
- global CURRENTSECTION
- set CURRENTSECTION {%s}
- $TEXTWIDGET configure -state normal
- $TEXTWIDGET delete 1.0 end
- j:rt text $TEXTWIDGET
- eval {%s}
- configure_widget $TEXTWIDGET
- focus $TEXTWIDGET
- } $title $body]
- }
-
- ######################################################################
-
- proc qsection {title text state} {
- global TEXTWIDGET
-
- if {![winfo exists .menu.sections]} {
- menubutton .menu.sections -text {Sections} -menu .menu.sections.m
- menu .menu.sections.m
- pack append .menu .menu.sections left
- }
-
- .menu.sections.m add command -label $title -command [format {
- global CURRENTSECTION
- set CURRENTSECTION {%s}
- $TEXTWIDGET configure -state normal
- $TEXTWIDGET delete 1.0 end
- j:rt text $TEXTWIDGET
- $TEXTWIDGET insert 1.0 %s
- j:tag:set_state $TEXTWIDGET {%s}
- configure_widget $TEXTWIDGET
- focus $TEXTWIDGET
- } $title $text $state]
- }
-
- ######################################################################
-
- proc tagsel {{tag {}}} {
- set first [.main.t index sel.first]
- set last [.main.t index sel.last]
- set alltags [.main.t tag names]
-
- foreach oldtag $alltags {
- .main.t tag remove $oldtag $first $last
- }
-
- if {$tag != {}} {
- .main.t tag add $tag $first $last
- }
- }
-
- ######################################################################
-
- proc mkx_topic {} {
- set from [.main.t index sel.first]
- set to [.main.t index sel.last]
- set topic [.main.t get $from $to]
-
- .main.t tag add xref-topic $from $to ;# triggers tag binding
- .main.t tag add TOPIC:$topic $from $to ;# used to figure out what
- ;# to show
- }
-
- proc mkx_section {} {
- set from [.main.t index sel.first]
- set to [.main.t index sel.last]
- set section [.main.t get $from $to]
-
- .main.t tag add xref-section $from $to ;# triggers tag binding
- .main.t tag add SECTION:$section $from $to ;# used to figure out
- ;# where to go
- }
-
- proc mkx_manpage {} {
- set from [.main.t index sel.first]
- set to [.main.t index sel.last]
- set manpage [.main.t get $from $to]
-
- .main.t tag add xref-manpage $from $to ;# triggers tag binding
- .main.t tag add MANPAGE:$manpage $from $to ;# used to figure out
- ;# where to go
- }
-
- ######################################################################
- # x_topic w x y - view help topic clicked on (hypertext)
- ######################################################################
-
- proc x_topic { {w} {x} {y} } {
- set tags [$w tag names @$x,$y]
-
- foreach tag $tags { ;# find "TOPIC:..." tag
- if [string match "TOPIC:*" $tag] {
- set topic [lindex [split $tag ":"] 1] ;# get topic name
- if [j:confirm -priority 100 -text "View help for `$topic'?"] {
- exec jhelp $topic &
- }
- break
- }
- }
- }
-
- ######################################################################
- # x_section w x y - go to section name clicked on (hypertext)
- ######################################################################
-
- proc x_section { {w} {x} {y} } {
- set tags [$w tag names @$x,$y]
-
- foreach tag $tags { ;# find "SECTION:..." tag
- if [string match "SECTION:*" $tag] {
- set section [lindex [split $tag ":"] 1] ;# get section name
- if [j:confirm -priority 100 -text "View `$section'?"] {
- .menu.sections.m invoke $section
- }
- break
- }
- }
- }
-
- ######################################################################
- # x_manpage w x y - go to section name clicked on (hypertext)
- ######################################################################
-
- proc x_manpage { {w} {x} {y} } {
- set tags [$w tag names @$x,$y]
-
- foreach tag $tags { ;# find "SECTION:..." tag
- if [string match "MANPAGE:*" $tag] {
- set manpage [lindex [split $tag ":"] 1] ;# get section name
- if [j:confirm -priority 100 -text "View `$manpage'?"] {
- j:more -height 30 \
- -title "Manual page for `$manpage'" \
- -text [exec man $manpage |& ul -Tdumb 2>@ stdout]
- }
- break
- }
- }
- }
-
- ######################################################################
-
- proc write_section {{section_name {No Name}}} {
- global FILENAME ;# so it can be default
- append FILENAME {} ;# make sure it's defined
-
- set prompt_result [j:fs -prompt "Save as:"]
- if {$prompt_result != {} && \
- ( ! [file exists $prompt_result] || \
- [j:confirm \
- -text "File \"$prompt_result\" exists; replace it?"] )} then {
- set FILENAME $prompt_result
- } else {
- return 1
- }
- write_section_to_file $section_name $FILENAME
- }
-
- proc write_section_to_file {{section_name} {filename}} {
- set file [open $filename w]
- output_one_section $section_name $file
- close $file
- }
-
- proc output_one_section {section_name file} {
- puts $file [list "qsection" "$section_name" \
- [list [.main.t get 1.0 end]] \
- [j:tag:get_state .main.t] \
- ]
- puts $file ""
- }
-
- ######################################################################
-
- proc compare_indices {i1 i2} {
- set i1split [split $i1 .]
- set i2split [split $i2 .]
- set i1line [lindex $i1split 0]
- set i1column [lindex $i1split 1]
- set i2line [lindex $i2split 0]
- set i2column [lindex $i2split 1]
-
- if {$i1line < $i2line} {
- return -1
- }
- if {$i1line > $i2line} {
- return 1
- }
- if {$i1column < $i2column} {
- return -1
- }
- if {$i1column > $i2column} {
- return 1
- }
- return 0
- }
-
- ######################################################################
-
- proc get_section_as_richtext {} {
- # needs to handle hypertext
- set w .main.t
-
- set result ""
- set indices [get_indices $w]
- set length [expr {[llength $indices] - 1}]
-
- for {set i 0} {$i < $length} {incr i} {
- set first [lindex $indices $i]
- set last [lindex $indices [expr {$i + 1}]]
- set string [$w get $first $last]
- switch -glob [$w tag names $first] {
- *j:rt:rm* {
- set style rm
- }
- *j:rt:it* {
- set style it
- }
- *j:rt:bf* {
- set style bf
- }
- *j:rt:tt* {
- set style tt
- }
- *j:rt:hl* {
- set style hl
- }
- default {
- set style rm
- }
- }
- append result "$style [list $string]\n"
- }
- return $result
- }
-
- ######################################################################
-
- proc get_indices {w} {
- catch {unset places}
-
- # get a list of unique places in the text where the tagging changes
- set places(1.0) {}
- set places([$w index end]) {}
- foreach tag [$w tag names] {
- foreach index [$w tag ranges $tag] {
- set places($index) {}
- }
- }
-
- set indices [array names places]
- set indices [lsort -command compare_indices $indices]
- return $indices
- }
-
- ######################################################################
-
- proc jedit:mode_read_proc {filename args} {
- if {[winfo exists .menu.sections]} {
- destroy .menu.sections
- }
- source $filename
- # display the first section of help:
- .menu.sections.m invoke 0
- focus .main.t
- }
-
- ######################################################################
- # define the help menu:
-
- if [winfo exists .menu.help] {
- destroy .menu.help
- }
-
- menubutton .menu.help -text {Help} -menu .menu.help.m
-
- menu .menu.help.m
- ####
- .menu.help.m add command -label {View Richtext} -command {
- j:more -text [get_section_as_richtext]
- }
- .menu.help.m add separator
- .menu.help.m add command -label {Roman} -command {tagsel {}}
- .menu.help.m add command -label {Italic} -command {tagsel j:rt:it}
- .menu.help.m add command -label {Bold} -command {tagsel j:rt:bf}
- .menu.help.m add command -label {Bold Italic} -command {tagsel j:rt:bi}
- .menu.help.m add command -label {Typewriter} -command {tagsel j:rt:tt}
- .menu.help.m add command -label {Headline} -command {tagsel j:rt:hl}
- .menu.help.m add separator
- .menu.help.m add command -label {Section Cross Reference} \
- -command {mkx_section}
- .menu.help.m add command -label {Topic Cross Reference} \
- -command {mkx_topic}
- .menu.help.m add command -label {Man Page Cross Reference} \
- -command {mkx_manpage}
- .menu.help.m add separator
- .menu.help.m add command -label {New Section . . .} -command {
- set title [j:prompt -prompt {Section Title:}]
- section $title {}
- .menu.sections.m invoke $title
- }
-
- pack append .menu .menu.help left
-
- j:buttonbar .main.actions -padx 0 -pady 0 -buttons {
- {
- done Done {
- apply_changes_to_section
- jedit:cmd:save
- exit 0
- }
- }
- {
- apply Apply {
- apply_changes_to_section
- }
- }
- {
- topic Topic {
- mkx_topic
- }
- }
- {
- section Section {
- mkx_section
- }
- }
- {
- manpage "Man" {
- mkx_manpage
- }
- }
- }
-
- j:buttonbar .main.styles -padx 0 -pady 0 -buttons {
- {roman Roman {tagsel {}}}
- {italic Italic {tagsel j:rt:it}}
- {bold Bold {tagsel j:rt:bf}}
- {bi "BI" {tagsel j:rt:bi}}
- {fixed Fixed {tagsel j:rt:tt}}
- {head "Head" {tagsel j:rt:hl}}
- {newsect "New Section" {
- set title [j:prompt -prompt {Section Title:}]
- section $title {}
- .menu.sections.m invoke $title
- }
- }
- }
-
- bind .main.t <Meta-minus> {.main.t insert insert "\255"}
-
- pack .main.actions .main.styles -after .main.status -side top -fill x
-
- proc jedit:mode_cleanup { t } {
- pack unpack .menu.help
- destroy .menu.help
- pack unpack .menu.sections
- destroy .menu.sections
- pack unpack .main.actions
- destroy .main.actions
- pack unpack .main.styles
- destroy .main.styles
- pack unpack .main.status.section
- destroy .main.status.section
- rename configure_widget {}
- rename section {}
- rename qsection {}
- rename tagsel {}
- rename mkx_topic {}
- rename mkx_section {}
- rename x_topic {}
- rename x_section {}
- rename write_section {}
- rename write_section_to_file {}
- rename output_one_section {}
- rename apply_changes_to_section {}
- }
-
-