pkg://jstools-0.1998.11.04-1.src.rpm:681702/jstools-1998.11.04.tar.gz
info downloads
jstools-1998.11.04/ 40775 764 764 0 6620232373 11040 5 ustar js js jstools-1998.11.04/bin/ 40775 764 764 0 6601066426 11613 5 ustar js js jstools-1998.11.04/bin/jabbrevs 100755 764 764 30444 6614404774 13465 0 ustar js js #!/usr/bin/wish8.0
# jabbrevs - abbreviation manager for jedit (and vi and Emacs)
#
######################################################################
# Copyright 1992-1998 by Jay Sekora. This file may be freely distributed,
# modified or unmodified, for any purpose, provided that this copyright
# notice is retained verbatim in all copies and no attempt is made to
# obscure the authorship of this file. If you distribute any modified
# versions, I ask, but do not require, that you clearly mark any changes
# you make as such and that you provide your users with instructions for
# getting the original sources.
######################################################################
## begin boiler_header
if {[info exists env(JSTOOLS_LIB)]} {
set jstools_library $env(JSTOOLS_LIB)
set jstools_pkg [file join $env(JSTOOLS_LIB) pkg]
} else {
set jstools_library /usr/lib/jstools
set jstools_pkg [file join $jstools_library pkg]
}
# add the jstools library to the library search path:
set auto_path [concat [list $jstools_pkg] [list $jstools_library] $auto_path]
# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the jstools libraries.
if {[file isdirectory ~/.tk]} then {
set auto_path [concat [list [glob ~/.tk]] $auto_path]
}
## end boiler_header
# the import IS A BIG PROBLEM until this whole file gets wrapped in its own
# namespace:
catch {
package require jldb
::jldb::load_pkg ;# so proc names available
# following likely to fail, because done by other libraries too
namespace import ::jldb::shortcuts::*
}
catch {
package require jstools
namespace eval ::jstools { } ;# so namespace is defined
}
::jldb::set_defaults {
{Abbrevs Abbrevs 0}
{File File 0}
{Help Help 0}
{{Help on jabbrevs} {Help on jabbrevs} 0}
{{Help on Using Abbreviations in jedit}
{Help on Using Abbreviations in jedit} 8}
{{Help on jstools} {Help on jstools} 10}
{jabbrevs:cmd:about {About the Abbrevs Manager...} 0 <Meta-Key-A> {[h]}}
{jabbrevs:cmd:help {Help} 0 <Meta-Key-h> {[H]}}
{jabbrevs:cmd:quit {Quit} 0 <Meta-Key-q> {[q]}}
{jabbrevs:cmd:add {Add}}
{jabbrevs:cmd:delete {Delete}}
{jabbrevs:cmd:reload {Reload} 2 <Meta-Key-l> {[l]}}
{jabbrevs:cmd:save {Save} 0 <Meta-Key-s> {[s]}}
}
######################################################################
global HOME env
set HOME $env(HOME)
global ABBREVPREFS
set ABBREVPREFS(filename) "$HOME/.tk/abbrevs.tcl"
set ABBREVPREFS(vi_filename) "$HOME/vi-abbrevs"
set ABBREVPREFS(emacs_filename) "$HOME/.abbrev_defs"
######################################################################
# jabbrevs:init - basic initialisation
######################################################################
proc jabbrevs:init {} {
global J_PREFS ;# cross-application prefs
global THIS_ABBREV ;# abbrev being entered
global THIS_EXPANSION ;# expansion being entered
j:jstools_init jabbrevs ;# prefs, libraries, bindings...
global ABBREVS ;# text-indexed array of expansions
set ABBREVS(0) {0} ;# to make sure it's an array
}
######################################################################
# jabbrevs:userinit - user customisation
######################################################################
proc jabbrevs:userinit {} {
global J_PREFS ;# cross-application prefs
global NAME
global HOME
# read in user's .tk/jabbrevsrc.tcl
j:source_config jabbrevsrc.tcl
}
######################################################################
# jabbrevs:apply_prefs
######################################################################
proc jabbrevs:apply_prefs {} {
global J_PREFS ;# cross-application prefs
global NAME
global HOME
global tk_strictMotif
# set user's text bindings:
switch -exact $J_PREFS(bindings) {
basic {
j:eb:basic_bind Entry
}
emacs {
j:eb:emacs_bind Entry
}
vi {
j:eb:vi_bind Entry
}
}
if {$J_PREFS(tk_strictMotif)} {
set tk_strictMotif 1
} else {
set tk_strictMotif 0
}
}
######################################################################
# abbrev - set an abbreviation (used by .tk/abbrevs.tcl
######################################################################
proc abbrev {{abbrev} {expansion}} {
global ABBREVS
set ABBREVS($abbrev) $expansion
}
######################################################################
# jabbrevs:mkmenus - make menu bar
######################################################################
proc jabbrevs:mkmenus { mb w } {
frame $mb -borderwidth 2 -relief raised
j:menu:menubutton $mb.abbrevs $mb.abbrevs.m Abbrevs
j:menu:commands $mb.abbrevs.m $w {
jabbrevs:cmd:about
j:cmd:global_pref_panel
-
j:cmd:prompt_tcl
j:cmd:prompt_unix
}
j:menu:menubutton $mb.file $mb.file.m File
j:menu:commands $mb.file.m $w {
jabbrevs:cmd:reload
jabbrevs:cmd:save
-
jabbrevs:cmd:quit
}
j:menu:menubutton $mb.help $mb.help.m Help
j:menu:docs $mb.help.m {
{{Help on jabbrevs} {jabbrevs.jdoc}}
{{Help on Using Abbreviations in jedit} {jedit.jdoc#Abbreviations}}
-
{{Help on jstools} {jstools.jdoc}}
}
pack $mb.abbrevs $mb.file -side left
pack $mb.help -side right
pack $mb -side top -fill x
tk_menuBar $mb $mb.abbrevs $mb.file $mb.help
}
######################################################################
# jabbrevs:mkmain - make main body with fields and buttons
######################################################################
proc jabbrevs:mkmain {} {
global J_PREFS ;# cross-application prefs
global THIS_ABBREV ;# abbrev being entered
global THIS_EXPANSION ;# expansion being entered
frame .main
frame .main.abbrev
label .main.abbrev.l \
-width 15 \
-text [::jldb::long_text "Abbreviation:"] \
-anchor w \
-relief flat
entry .main.abbrev.e -width 40 -textvariable THIS_ABBREV
frame .main.expn
label .main.expn.l \
-width 15 \
-text [::jldb::long_text "Expansion:"] \
-anchor w \
-relief flat
entry .main.expn.e -width 40 -textvariable THIS_EXPANSION
pack .main.abbrev.l .main.abbrev.e -side left
pack .main.expn.l .main.expn.e -side left
pack \
[j:filler .main]\
.main.abbrev \
[j:filler .main] \
.main.expn \
[j:filler .main] \
-side top -fill x
j:command:buttonbar .b . {
jabbrevs:cmd:add
jabbrevs:cmd:delete
jabbrevs:cmd:save
jabbrevs:cmd:quit
} -default jabbrevs:cmd:add
j:default_button .b.jabbrevs:cmd:add .main.abbrev.e .main.expn.e
j:cancel_button .b.jabbrevs:cmd:quit .main.abbrev.e .main.expn.e
pack .b [j:rule .] -side bottom -fill x
pack [j:filler .] .main [j:filler .] -side left -fill y
focus .main.abbrev.e
catch {focus default .main.abbrev.e} ;# caught for Tk 4.0
}
######################################################################
####
# OUTPUT PROCEDURES
####
######################################################################
proc jabbrevs:write_native {} {
global ABBREVS THIS_ABBREV THIS_EXPANSION ABBREVPREFS
set file [open $ABBREVPREFS(filename) w]
foreach abbrev [lsort [array names ABBREVS]] {
puts $file "abbrev [list $abbrev] [list $ABBREVS($abbrev)]"
}
close $file
return 0
}
### THIS DOESN'T WORK YET
###
proc jabbrevs:write_emacs {} {
global ABBREVS THIS_ABBREV THIS_EXPANSION ABBREVPREFS
set file [open $ABBREVPREFS(emacs_filename) w]
puts $file {(define-abbrev-table 'c-mode-abbrev-table '( ))}
puts $file {(define-abbrev-table 'text-mode-abbrev-table '(}
foreach abbrev [lsort [array names ABBREVS]] {
if {! [regexp -- {"} $abbrev] && ! [regexp -- {"} $ABBREVS($abbrev)]} {
puts $file [format \
{ ("%s" "%s" nil 0)} \
$abbrev $ABBREVS($abbrev)]
}
}
puts $file { ))}
puts $file {(define-abbrev-table 'lisp-mode-abbrev-table '( ))}
puts $file {(define-abbrev-table 'fundamental-mode-abbrev-table '( ))}
puts $file {(define-abbrev-table 'global-abbrev-table '( ))}
close $file
return 0
}
proc jabbrevs:write_vi {} {
global ABBREVS THIS_ABBREV THIS_EXPANSION ABBREVPREFS
set file [open $ABBREVPREFS(vi_filename) w]
foreach abbrev [lsort [array names ABBREVS]] {
puts $file "ab $abbrev $ABBREVS($abbrev)"
}
close $file
return 0
}
######################################################################
####
# COMMAND PROCEDURES
####
######################################################################
j:command:register jabbrevs:cmd:about {About the Abbrevs Manager...}
proc jabbrevs:cmd:about { w args } {
global JSTOOLS_VERSION
set about_jabbrevs [format {
j:rt:hl "jabbrevs"
j:rt:cr
j:rt:rm "by Jay Sekora, "
j:rt:tt "js@aq.org"
j:rt:par
j:rt:rm "An X Windows tool for managing abbreviations."
j:rt:cr
j:rt:rm "Version %s."
j:rt:par
j:rt:rm "Copyright \251 1994-1995 by Jay Sekora. "
j:rt:rm "All rights reserved, except that this file may be freely "
j:rt:rm "redistributed in whole or in part for non\255profit, "
j:rt:rm "noncommercial use."
j:rt:par
j:rt:rm "If you find bugs or have suggestions for improvement, "
j:rt:rm "please let me know. "
j:rt:rm "Feel free to use bits of this code in your own "
j:rt:tt "wish"
j:rt:rm " scripts."
} $JSTOOLS_VERSION]
j:about .about $about_jabbrevs
j:about:button .about {About jabbrevs} $about_jabbrevs
j:about:button .about {About the Author} [j:about_jay]
j:about:button .about {About Tk and Tcl} [j:about_tktcl]
tkwait window .about
}
######################################################################
j:command:register jabbrevs:cmd:quit {Quit}
proc jabbrevs:cmd:quit { w args } {
if [j:confirm -text [::jldb::long_text "Are you sure you want to quit?"]] {
exit 0
}
return 0
}
######################################################################
j:command:register jabbrevs:cmd:add {Add}
proc jabbrevs:cmd:add { w args } {
global ABBREVS THIS_ABBREV THIS_EXPANSION
set THIS_ABBREV [string trim $THIS_ABBREV]
set THIS_EXPANSION [string trim $THIS_EXPANSION]
if {"x$THIS_ABBREV" == "x"} {
j:alert -text "No abbreviation specified."
focus .main.abbrev.e
return 1
}
if {"x$THIS_EXPANSION" == "x"} {
if {[lsearch -exact [array names ABBREVS] $THIS_ABBREV] != -1} {
set THIS_EXPANSION $ABBREVS($THIS_ABBREV)
focus .main.expn.e
return 0
} else {
j:alert -text \
"No expansion given, and no abbreviation `$THIS_ABBREV' is defined."
}
focus .main.abbrev.e
return 1
}
set ABBREVS($THIS_ABBREV) $THIS_EXPANSION
set THIS_ABBREV {}
set THIS_EXPANSION {}
focus .main.abbrev.e
return 0
}
######################################################################
j:command:register jabbrevs:cmd:delete {Delete}
proc jabbrevs:cmd:delete { w args } {
global ABBREVS THIS_ABBREV THIS_EXPANSION
set THIS_ABBREV [string trim $THIS_ABBREV]
if {"x$THIS_ABBREV" == "x"} {
j:alert -text "No abbreviation specified."
focus .main.abbrev.e
return 1
}
if {"x$THIS_EXPANSION" == "x"} {
j:alert -text "No expansion specified."
focus .main.abbrev.e
return 1
}
unset ABBREVS($THIS_ABBREV)
set THIS_ABBREV {}
set THIS_EXPANSION {}
focus .main.abbrev.e
return 0
}
######################################################################
j:command:register jabbrevs:cmd:reload {Reload}
proc jabbrevs:cmd:reload { w args } {
global ABBREVS ABBREVPREFS
catch {unset ABBREVS}
set ABBREVS(0) {0}
if [file exists $ABBREVPREFS(filename)] {
uplevel #0 {catch {source $ABBREVPREFS(filename)}}
}
catch {focus .main.abbrev.e}
return 0
}
######################################################################
j:command:register jabbrevs:cmd:save {Save}
proc jabbrevs:cmd:save { w args } {
jabbrevs:write_native
# jabbrevs:write_emacs
# jabbrevs:write_vi
# tell all the jedit applications to re-read the abbrevs file:
foreach interp [winfo interps] {
switch -glob -- $interp {
{jedit} -
{jedit #*} {
catch {send $interp {after 1 jedit:cmd:read_abbrevs}}
}
}
}
focus .main.abbrev.e
return 0
}
######################################################################
jabbrevs:init
jabbrevs:userinit
jabbrevs:mkmenus .menu .
jabbrevs:mkmain
tk_bindForTraversal all
j:command:bind all . [j:command:list]
jabbrevs:cmd:reload .
jabbrevs:apply_prefs
jstools-1998.11.04/bin/jalert 100755 764 764 2535 6563577765 13146 0 ustar js js #!/usr/bin/wish8.0
# jalert - wrapper around j:alert
#
######################################################################
# Copyright 1992-1998 by Jay Sekora. This file may be freely distributed,
# modified or unmodified, for any purpose, provided that this copyright
# notice is retained verbatim in all copies and no attempt is made to
# obscure the authorship of this file. If you distribute any modified
# versions, I ask, but do not require, that you clearly mark any changes
# you make as such and that you provide your users with instructions for
# getting the original sources.
######################################################################
## begin boiler_header
if {[info exists env(JSTOOLS_LIB)]} {
set jstools_library $env(JSTOOLS_LIB)
set jstools_pkg [file join $env(JSTOOLS_LIB) pkg]
} else {
set jstools_library /usr/lib/jstools
set jstools_pkg [file join $jstools_library pkg]
}
# add the jstools library to the library search path:
set auto_path [concat [list $jstools_pkg] [list $jstools_library] $auto_path]
# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the jstools libraries.
if {[file isdirectory ~/.tk]} then {
set auto_path [concat [list [glob ~/.tk]] $auto_path]
}
## end boiler_header
wm withdraw .
j:jstools_init jfs
eval j:alert $argv
exit 0
jstools-1998.11.04/bin/jcolname 100755 764 764 2614 6563577765 13453 0 ustar js js #!/usr/bin/wish8.0
# jcolname - wrapper around j:prompt_colour_name
#
######################################################################
# Copyright 1992-1998 by Jay Sekora. This file may be freely distributed,
# modified or unmodified, for any purpose, provided that this copyright
# notice is retained verbatim in all copies and no attempt is made to
# obscure the authorship of this file. If you distribute any modified
# versions, I ask, but do not require, that you clearly mark any changes
# you make as such and that you provide your users with instructions for
# getting the original sources.
######################################################################
## begin boiler_header
if {[info exists env(JSTOOLS_LIB)]} {
set jstools_library $env(JSTOOLS_LIB)
set jstools_pkg [file join $env(JSTOOLS_LIB) pkg]
} else {
set jstools_library /usr/lib/jstools
set jstools_pkg [file join $jstools_library pkg]
}
# add the jstools library to the library search path:
set auto_path [concat [list $jstools_pkg] [list $jstools_library] $auto_path]
# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the jstools libraries.
if {[file isdirectory ~/.tk]} then {
set auto_path [concat [list [glob ~/.tk]] $auto_path]
}
## end boiler_header
wm withdraw .
j:jstools_init jcolname
puts stdout [eval j:prompt_colour_name $argv]
exit 0
jstools-1998.11.04/bin/jcolrgb 100755 764 764 2610 6563577765 13301 0 ustar js js #!/usr/bin/wish8.0
# jcolrgb - wrapper around j:prompt_colour_rgb
#
######################################################################
# Copyright 1992-1998 by Jay Sekora. This file may be freely distributed,
# modified or unmodified, for any purpose, provided that this copyright
# notice is retained verbatim in all copies and no attempt is made to
# obscure the authorship of this file. If you distribute any modified
# versions, I ask, but do not require, that you clearly mark any changes
# you make as such and that you provide your users with instructions for
# getting the original sources.
######################################################################
## begin boiler_header
if {[info exists env(JSTOOLS_LIB)]} {
set jstools_library $env(JSTOOLS_LIB)
set jstools_pkg [file join $env(JSTOOLS_LIB) pkg]
} else {
set jstools_library /usr/lib/jstools
set jstools_pkg [file join $jstools_library pkg]
}
# add the jstools library to the library search path:
set auto_path [concat [list $jstools_pkg] [list $jstools_library] $auto_path]
# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the jstools libraries.
if {[file isdirectory ~/.tk]} then {
set auto_path [concat [list [glob ~/.tk]] $auto_path]
}
## end boiler_header
wm withdraw .
j:jstools_init jcolrgb
puts stdout [eval j:prompt_colour_rgb $argv]
exit 0
jstools-1998.11.04/bin/jconfirm 100755 764 764 2571 6563577765 13474 0 ustar js js #!/usr/bin/wish8.0
# jconfirm - wrapper around j:confirm
#
######################################################################
# Copyright 1992-1998 by Jay Sekora. This file may be freely distributed,
# modified or unmodified, for any purpose, provided that this copyright
# notice is retained verbatim in all copies and no attempt is made to
# obscure the authorship of this file. If you distribute any modified
# versions, I ask, but do not require, that you clearly mark any changes
# you make as such and that you provide your users with instructions for
# getting the original sources.
######################################################################
## begin boiler_header
if {[info exists env(JSTOOLS_LIB)]} {
set jstools_library $env(JSTOOLS_LIB)
set jstools_pkg [file join $env(JSTOOLS_LIB) pkg]
} else {
set jstools_library /usr/lib/jstools
set jstools_pkg [file join $jstools_library pkg]
}
# add the jstools library to the library search path:
set auto_path [concat [list $jstools_pkg] [list $jstools_library] $auto_path]
# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the jstools libraries.
if {[file isdirectory ~/.tk]} then {
set auto_path [concat [list [glob ~/.tk]] $auto_path]
}
## end boiler_header
wm withdraw .
j:jstools_init jfs
exit [expr ! [eval j:confirm -priority 100 $argv]]
jstools-1998.11.04/bin/jdoc 100755 764 764 5465 6563577765 12611 0 ustar js js #!/usr/bin/wish8.0
# jdoc - multi-font document display
#
######################################################################
# Copyright 1992-1998 by Jay Sekora. This file may be freely distributed,
# modified or unmodified, for any purpose, provided that this copyright
# notice is retained verbatim in all copies and no attempt is made to
# obscure the authorship of this file. If you distribute any modified
# versions, I ask, but do not require, that you clearly mark any changes
# you make as such and that you provide your users with instructions for
# getting the original sources.
######################################################################
## begin boiler_header
if {[info exists env(JSTOOLS_LIB)]} {
set jstools_library $env(JSTOOLS_LIB)
set jstools_pkg [file join $env(JSTOOLS_LIB) pkg]
} else {
set jstools_library /usr/lib/jstools
set jstools_pkg [file join $jstools_library pkg]
}
# add the jstools library to the library search path:
set auto_path [concat [list $jstools_pkg] [list $jstools_library] $auto_path]
# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the jstools libraries.
if {[file isdirectory ~/.tk]} then {
set auto_path [concat [list [glob ~/.tk]] $auto_path]
}
## end boiler_header
##############################################################################
# FINAL SETUP
##############################################################################
jdoc:init
######################################################################
######################################################################
### WHY DOES THIS HAVE TO BE HERE? IT'S CALLED IN j:jstools_init! ###
######################################################################
######################################################################
# set user's text bindings:
global J_PREFS
switch -exact $J_PREFS(bindings) {
basic {
j:eb:basic_bind Entry
}
emacs {
j:eb:emacs_bind Entry
}
vi {
j:eb:vi_bind Entry
}
}
# read in user's .tk/jdocrc.tcl and .tk/jdoc-defaults files:
#
j:source_config jdocrc.tcl ;# just source the file, if any
j:read_global_prefs ;# get defaults from ~/.tk/defaults
j:read_prefs -array JDOC_PREFS -file jdoc-defaults {
{textwidth 70}
{textheight 24}
{textwrap char}
{textbg white}
{textfg black}
{textsb black}
{textsf white}
{textbw 2}
{textsbw 2}
{tkman 0}
}
jdoc:mkmenus
jdoc:mkbuttons
jdoc:mktext ;# (sets focus)
jdoc:first_doc_file ;# read in first help file
jstools-1998.11.04/bin/jedit 100755 764 764 5437 6600777500 12745 0 ustar js js #!/usr/bin/wish8.0
# jedit - Tk-based text editor
#
######################################################################
# Copyright 1992-1998 by Jay Sekora. This file may be freely distributed,
# modified or unmodified, for any purpose, provided that this copyright
# notice is retained verbatim in all copies and no attempt is made to
# obscure the authorship of this file. If you distribute any modified
# versions, I ask, but do not require, that you clearly mark any changes
# you make as such and that you provide your users with instructions for
# getting the original sources.
######################################################################
## begin boiler_header
if {[info exists env(JSTOOLS_LIB)]} {
set jstools_library $env(JSTOOLS_LIB)
set jstools_pkg [file join $env(JSTOOLS_LIB) pkg]
} else {
set jstools_library /usr/lib/jstools
set jstools_pkg [file join $jstools_library pkg]
}
# add the jstools library to the library search path:
set auto_path [concat [list $jstools_pkg] [list $jstools_library] $auto_path]
# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the jstools libraries.
if {[file isdirectory ~/.tk]} then {
set auto_path [concat [list [glob ~/.tk]] $auto_path]
}
## end boiler_header
# the import IS A BIG PROBLEM until this whole file gets wrapped in its own
# namespace:
catch {
package require jldb
::jldb::load_pkg ;# so proc names available
# following likely to fail, because done by other libraries too
namespace import ::jldb::shortcuts::*
}
catch {
package require jstools
namespace eval ::jstools { } ;# so namespace is defined
}
######################################################################
# all procedure definitions are autoloaded
######################################################################
# we're not using the main window
#
wm withdraw .
# process arguments, if any
::jstools::parse_argv {
{mode default}
{for NONE}
{width {}}
{height {}}
}
set JEDIT_CALLER $for ;# used if we use send to communicate
;# with a calling application
# open windows---note that the name of the first window will end up
# being ".jedit0" (subsequent windows ".jedit1" etc.)
#
set line {} ;# this tells jedit:jedit not to jump
;# (may be different from specifying 0
;# if tags/marks are saved)
if {$argc > 0} { ;# multiple filenames specified
foreach file $argv {
if [string match +* $file] { ;# then it's really a position instead
set line [string trimleft $file +]
} else {
jedit:jedit -width $width -height $height -mode $mode -line $line \
-file $file
set line {} ;# reset for following files
}
}
} else { ;# argc <= 0; no filenames specified
jedit:jedit -width $width -height $height -mode $mode
}
jstools-1998.11.04/bin/jfs 100755 764 764 2544 6563577765 12447 0 ustar js js #!/usr/bin/wish8.0
# jfs - wrapper around j:fs
#
######################################################################
# Copyright 1992-1998 by Jay Sekora. This file may be freely distributed,
# modified or unmodified, for any purpose, provided that this copyright
# notice is retained verbatim in all copies and no attempt is made to
# obscure the authorship of this file. If you distribute any modified
# versions, I ask, but do not require, that you clearly mark any changes
# you make as such and that you provide your users with instructions for
# getting the original sources.
######################################################################
## begin boiler_header
if {[info exists env(JSTOOLS_LIB)]} {
set jstools_library $env(JSTOOLS_LIB)
set jstools_pkg [file join $env(JSTOOLS_LIB) pkg]
} else {
set jstools_library /usr/lib/jstools
set jstools_pkg [file join $jstools_library pkg]
}
# add the jstools library to the library search path:
set auto_path [concat [list $jstools_pkg] [list $jstools_library] $auto_path]
# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the jstools libraries.
if {[file isdirectory ~/.tk]} then {
set auto_path [concat [list [glob ~/.tk]] $auto_path]
}
## end boiler_header
wm withdraw .
j:jstools_init jfs
puts stdout [eval j:fs $argv]
exit 0
jstools-1998.11.04/bin/jmore 100755 764 764 21133 6601066425 12767 0 ustar js js #!/usr/bin/wish8.0
# jmore - a tk-based analogue to the more(1) command
#
######################################################################
# Copyright 1992-1998 by Jay Sekora. This file may be freely distributed,
# modified or unmodified, for any purpose, provided that this copyright
# notice is retained verbatim in all copies and no attempt is made to
# obscure the authorship of this file. If you distribute any modified
# versions, I ask, but do not require, that you clearly mark any changes
# you make as such and that you provide your users with instructions for
# getting the original sources.
######################################################################
## begin boiler_header
if {[info exists env(JSTOOLS_LIB)]} {
set jstools_library $env(JSTOOLS_LIB)
set jstools_pkg [file join $env(JSTOOLS_LIB) pkg]
} else {
set jstools_library /usr/lib/jstools
set jstools_pkg [file join $jstools_library pkg]
}
# add the jstools library to the library search path:
set auto_path [concat [list $jstools_pkg] [list $jstools_library] $auto_path]
# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the jstools libraries.
if {[file isdirectory ~/.tk]} then {
set auto_path [concat [list [glob ~/.tk]] $auto_path]
}
## end boiler_header
######################################################################
global NAME ;# user's login name
global HOME ;# user's home directory
global J_PREFS MOREPREFS ;# user preferences
j:jstools_init jmore ;# prefs, libraries, bindings...
######################################################################
# jmore:cmd:prefs - preferences panel
######################################################################
proc jmore:cmd:prefs {} {
global J_PREFS MOREPREFS env tk_strictMotif
::jldb::set_defaults {
{JMtitle:more_prefs {More Preferences}}
{JMpref:dont_wrap {Don't wrap lines}}
{JMpref:char_wrap {Wrap lines on character boundaries}}
{JMpref:word_wrap {Wrap lines at word boundaries}}
{{Font:} {Font:}}
{JMpref:font_default {Default}}
{JMpref:font_choose {Choose...}}
{{Width:} {Width:}}
{{Height:} {Height:}}
{{Save} {Save}}
{{Global Preferences} {Global Preferences}}
}
toplevel .more_prefs
wm title .more_prefs [::jldb::long_text JMtitle:more_prefs]
frame .more_prefs.wrap
radiobutton .more_prefs.wrap.none -anchor w \
-text [::jldb::long_text JMpref:dont_wrap] \
-variable MOREPREFS(textwrap) -value none
radiobutton .more_prefs.wrap.char -anchor w \
-text [::jldb::long_text JMpref:char_wrap] \
-variable MOREPREFS(textwrap) -value char
radiobutton .more_prefs.wrap.word -anchor w \
-text [::jldb::long_text JMpref:word_wrap] \
-variable MOREPREFS(textwrap) -value word
frame .more_prefs.font
frame .more_prefs.font.top
label .more_prefs.font.top.l -text [::jldb::long_text {Font:}]
button .more_prefs.font.top.default -width 8 \
-text [::jldb::long_text JMpref:font_default] -command {
set MOREPREFS(textfont) {default}
}
button .more_prefs.font.top.choose -width 8\
-text [::jldb::long_text JMpref:font_choose] -command {
set MOREPREFS(textfont) [j:prompt_font]
}
frame .more_prefs.font.bot
entry .more_prefs.font.bot.e -width 50 \
-textvariable MOREPREFS(textfont)
frame .more_prefs.size
label .more_prefs.size.wl -text [::jldb::long_text {Width:}]
entry .more_prefs.size.we -width 5 \
-textvariable MOREPREFS(textwidth)
label .more_prefs.size.hl -text [::jldb::long_text {Height:}]
entry .more_prefs.size.he -width 5 \
-textvariable MOREPREFS(textheight)
j:buttonbar .more_prefs.b -default save -buttons {
{
save Save {
if {$MOREPREFS(textwidth) < 20} {set MOREPREFS(textwidth) 20}
if {$MOREPREFS(textheight) < 4} {set MOREPREFS(textheight) 4}
j:write_prefs -array MOREPREFS -file jmore-defaults
exit 0
}
} {
global "Global Preferences" {j:global_pref_panel}
}
}
pack append .more_prefs.wrap \
.more_prefs.wrap.none {top expand fillx} \
.more_prefs.wrap.char {top expand fillx} \
.more_prefs.wrap.word {top expand fillx}
pack append .more_prefs.font.top \
.more_prefs.font.top.l {left} \
.more_prefs.font.top.choose {right padx 10 pady 5} \
.more_prefs.font.top.default {right pady 5}
pack append .more_prefs.font.bot \
.more_prefs.font.bot.e {left padx 10 pady 5}
pack append .more_prefs.font \
.more_prefs.font.top {top expand fillx} \
.more_prefs.font.bot {top expand fillx}
pack append .more_prefs.size \
.more_prefs.size.wl {left fillx} \
.more_prefs.size.we {left} \
.more_prefs.size.hl {left fillx} \
.more_prefs.size.he {left}
pack append .more_prefs \
.more_prefs.wrap {top fillx} \
[j:rule .more_prefs] {top fillx} \
.more_prefs.font {top fillx} \
[j:rule .more_prefs] {top fillx} \
.more_prefs.size {top fillx} \
[j:rule .more_prefs] {top fillx} \
.more_prefs.b {top fillx}
j:dialogue .more_prefs ;# position in centre of screen
focus .more_prefs
j:default_button .more_prefs.b.save \
.more_prefs.font.bot.e \
.more_prefs.size.we \
.more_prefs.size.he \
.more_prefs
bind .more_prefs <Key-Tab> {focus .more_prefs.font.bot.e}
grab .more_prefs
tkwait window .more_prefs
}
######################################################################
# FINAL SETUP
######################################################################
# read in user's .tk/jmorerc.tcl and .tk/jmore-defaults
#
j:source_config jmorerc.tcl ;# just source the file, if any
j:read_prefs -array MOREPREFS -file jmore-defaults {
{textfont default}
{textwidth 80}
{textheight 30}
{textwrap char}
}
::jldb::set_defaults {
{JMerror:cant_read... {Unable to open `$filename' for reading.}}
{JMerror:...is_directory {`$filename' is a directory, not a regular file.}}
{JMtitle:file... {File `$filename'}}
{JMtitle:stdin {Standard Input}}
}
######################################################################
######################################################################
### WHY DOES THIS HAVE TO BE HERE? IT'S CALLED IN j:jstools_init! ###
######################################################################
######################################################################
# set user's text bindings:
global J_PREFS
switch -exact $J_PREFS(bindings) {
basic {
j:eb:basic_bind Entry
}
emacs {
j:eb:emacs_bind Entry
}
vi {
j:eb:vi_bind Entry
}
}
wm withdraw .
if [string match "-pref*" $argv] {
jmore:cmd:prefs
exit 0
}
if {$argc > 0} {
global JMORE_COUNT
set JMORE_COUNT 0
foreach filename $argv {
set rich 0 ;# not a rich-text file
if [catch {open $filename r} file_or_error] {
set text [::jldb::long_text JMerror:cant_read...]
} else {
set file $file_or_error
if [file isdirectory $filename] {
set text [::jldb::long_text JMerror:...is_directory]
} else {
if {[string match *.jrt $filename] ||
[string match *.jdoc $filename] ||
[string match *.jhtml $filename]} { ;# SHOULDN'T BE HARDCODED
set rich 1
set contents [read $file]
set text [lindex $contents 0]
set annotation [lindex $contents 1]
set wrap word
} else {
set text [read $file]
set annotation ""
set wrap $MOREPREFS(textwrap)
}
}
close $file
}
set t [j:more \
-height $MOREPREFS(textheight) \
-width $MOREPREFS(textwidth) \
-font $MOREPREFS(textfont) \
-wrap $wrap \
-title [::jldb::long_text JMtitle:file...] \
-text $text \
-annotation $annotation]
incr JMORE_COUNT
bind $t <Destroy> {jmore:close_window}
if {$rich} {
jedit:format:configure_all_list_tags $t ;# NEEDS TO MOVE TO GENERAL LIB.
}
}
} else {
global JMORE_COUNT
set JMORE_COUNT 1
set t [j:more \
-height $MOREPREFS(textheight) \
-width $MOREPREFS(textwidth) \
-font $MOREPREFS(textfont) \
-wrap $MOREPREFS(textwrap) \
-title [::jldb::long_text JMtitle:stdin] \
-text [read stdin]]
bind $t <Destroy> {jmore:close_window}
}
proc jmore:close_window {} {
global JMORE_COUNT
incr JMORE_COUNT -1
if {$JMORE_COUNT == 0} {
j:tk4 {
exit 0
}
j:tk3 {
after 1000 {exit 0}
}
}
}
jstools-1998.11.04/bin/jprefs 100755 764 764 2625 6563577765 13156 0 ustar js js #!/usr/bin/wish8.0
# jprefs - stand-alone application to set global preferences
#
######################################################################
# Copyright 1992-1998 by Jay Sekora. This file may be freely distributed,
# modified or unmodified, for any purpose, provided that this copyright
# notice is retained verbatim in all copies and no attempt is made to
# obscure the authorship of this file. If you distribute any modified
# versions, I ask, but do not require, that you clearly mark any changes
# you make as such and that you provide your users with instructions for
# getting the original sources.
######################################################################
## begin boiler_header
if {[info exists env(JSTOOLS_LIB)]} {
set jstools_library $env(JSTOOLS_LIB)
set jstools_pkg [file join $env(JSTOOLS_LIB) pkg]
} else {
set jstools_library /usr/lib/jstools
set jstools_pkg [file join $jstools_library pkg]
}
# add the jstools library to the library search path:
set auto_path [concat [list $jstools_pkg] [list $jstools_library] $auto_path]
# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the jstools libraries.
if {[file isdirectory ~/.tk]} then {
set auto_path [concat [list [glob ~/.tk]] $auto_path]
}
## end boiler_header
j:jstools_init ;# prefs, libraries, bindings...
wm withdraw .
j:global_pref_panel
exit 0
jstools-1998.11.04/bin/jprompt 100755 764 764 2562 6563577765 13360 0 ustar js js #!/usr/bin/wish8.0
# jprompt - wrapper around j:prompt
#
######################################################################
# Copyright 1992-1998 by Jay Sekora. This file may be freely distributed,
# modified or unmodified, for any purpose, provided that this copyright
# notice is retained verbatim in all copies and no attempt is made to
# obscure the authorship of this file. If you distribute any modified
# versions, I ask, but do not require, that you clearly mark any changes
# you make as such and that you provide your users with instructions for
# getting the original sources.
######################################################################
## begin boiler_header
if {[info exists env(JSTOOLS_LIB)]} {
set jstools_library $env(JSTOOLS_LIB)
set jstools_pkg [file join $env(JSTOOLS_LIB) pkg]
} else {
set jstools_library /usr/lib/jstools
set jstools_pkg [file join $jstools_library pkg]
}
# add the jstools library to the library search path:
set auto_path [concat [list $jstools_pkg] [list $jstools_library] $auto_path]
# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the jstools libraries.
if {[file isdirectory ~/.tk]} then {
set auto_path [concat [list [glob ~/.tk]] $auto_path]
}
## end boiler_header
wm withdraw .
j:jstools_init jprompt
puts stdout [eval j:prompt $argv]
exit 0
jstools-1998.11.04/lib/ 40775 764 764 0 6601066235 11607 5 ustar js js jstools-1998.11.04/lib/jabout.tcl 100644 764 764 14104 6600774707 13723 0 ustar js js # jabout.tcl - procedures for dealing with rich text
#
######################################################################
# Copyright 1992-1998 by Jay Sekora. This file may be freely #
# distributed, modified or unmodified, for any purpose, provided #
# that this copyright notice is retained verbatim in all copies and #
# no attempt is made to obscure the authorship of this file. If you #
# distribute any modified versions, I ask, but do not require, that #
# you clearly mark any changes you make as such and that you provide #
# your users with instructions for getting the original sources. #
######################################################################
# THIS IS A BIG PROBLEM until this whole file gets wrapped in its own
# namespace:
catch {
package require jldb
::jldb::load_pkg ;# so proc names available
# following likely to fail, because done by other libraries too
namespace import ::jldb::shortcuts::*
}
catch {
package require jstools
namespace eval ::jstools { } ;# so namespace is defined
}
######################################################################
# j:about name richtext - create an about box containing richtext
######################################################################
proc j:about { name args } {
::jstools::parse_args {
{title "About"}
}
set w $name ;# name of toplevel
set richtext [lindex $args 0]
set old_focus [focus] ;# so we can restore original focus
if {[winfo exists $w]} {destroy $w}
toplevel $w
wm title $w $title
text $w.t -width 65 -height 15 -borderwidth 20 -relief flat
j:rt text $w.t
eval $richtext
j:rt:done
frame $w.b
button $w.b.ok -text OK -width 8 -command "
focus -force $old_focus ;# can't figure out a better way...
destroy $w
"
frame $w.b.ok-border -relief sunken -borderwidth 1
raise $w.b.ok
pack $w.b.ok -in $w.b.ok-border -padx 2 -pady 2
pack [j:filler $w.b] -in $w.b -side left
pack [j:filler $w.b] -in $w.b -side right
pack $w.b.ok-border -side right -pady 10
pack $w.t -in $w -side top -fill both
pack [j:rule $w -width 200] -in $w -side top -fill x
pack $w.b -in $w -side top -fill x
j:dialogue $w ;# position in centre of screen
focus $w
bind $w <Key-Return> "$w.b.ok invoke"
}
######################################################################
# j:about:button aboutbox label richtext - add a button to an about box
######################################################################
proc j:about:button { aboutbox label richtext } {
set label $label
global j:about:button:count
if {[info exists j:about:button:count]} then {
set j:about:button:count [expr {${j:about:button:count} + 1}]
} else {
set j:about:button:count 0
}
set parent $aboutbox.b ;# name of frame with buttons
set button $parent.${j:about:button:count}
set border $button-border
set min_width [expr {[string length $label] + 2}]
set width [expr {$min_width > 8 ? $min_width : 8}]
button $button -text $label -width $width \
-command "j:rt text $aboutbox.t; $richtext; j:rt:done"
frame $border
raise $button
pack $button -in $border -padx 2 -pady 2
pack [j:filler $parent] $border -in $parent -side right
}
######################################################################
# j:about_jay - talk about myself
######################################################################
proc j:about_jay {} {
return [= about:about_jay {
j:rt:hl "Jay Sekora"
j:rt:cr
j:rt:tt "js@aq.org"
j:rt:cr
j:rt:rm "URL "
j:rt:tt "http://www.aq.org/~js/"
j:rt:par
j:rt:rm "I'm a Unix systems administrator at the World Wide Web "
j:rt:rm "Consortium, the U.S. part of which is based "
j:rt:rm "at MIT."
j:rt:par
j:rt:rm "I was a linguistics major in college. "
j:rt:rm "I like spicy food, Celtic folk music, bad puns, New England "
j:rt:rm "contra dancing, and "
j:rt:it "Winnie the Pooh."
}]
}
######################################################################
# j:about_tktcl - describe tk and tcl
######################################################################
proc j:about_tktcl {} {
return [= about:about_tktcl {
j:rt:hl "Tk and Tcl"
j:rt:par
j:rt:rm "This application is written in "
j:rt:tt "wish"
j:rt:rm ", a scripting shell for X Windows applications based on the "
j:rt:rm "Tk toolkit, which in turn is based on the Tcl"
j:rt:rm " language and scripting library, all amazingly useful tools "
j:rt:rm "by John Ousterhout of Scriptics."
j:rt:par
j:rt:rm "The Internet newsgroup "
j:rt:tt "comp.lang.tcl"
j:rt:rm " is devoted to Tcl and related tools, and a Tk/Tcl FAQ "
j:rt:rm "(`Frequently Asked Questions') is periodically posted. "
j:rt:rm "The latest distributions are available on the FTP site "
j:rt:tt "sunscript.sun.com"
j:rt:rm ", and "
j:rt:tt "ftp.neosoft.com"
j:rt:rm " has the FAQ and user-contributed scripts."
}]
}
######################################################################
# j:about_donations - describe money :-)
######################################################################
proc j:about_donations {} {
return [= about:about_donations {
j:rt:hl "Donations"
j:rt:cr
j:rt:rm "This application is completely free-of-charge for any "
j:rt:rm "purpose. However, if you feel like expressing your "
j:rt:rm "gratitude in a tangible way, I would like to encourage "
j:rt:rm "you to make a donation to one of the following non-profit "
j:rt:rm "groups. Both groups are grateful for even "
j:rt:rm "very small donations."
j:rt:cr
j:rt:tab
j:rt:rm "Acorn Farm"
j:rt:cr
j:rt:tab
j:rt:rm "Rte. 3, Box 486A"
j:rt:cr
j:rt:tab
j:rt:rm "Mineral, VA 23117 USA"
j:rt:cr
j:rt:tab
j:rt:tt "http://www.well.com/user/cmty/acorn/"
j:rt:par
j:rt:tab
j:rt:rm "Bisexual Resource Center"
j:rt:cr
j:rt:tab
j:rt:rm "P.O. Box 639"
j:rt:cr
j:rt:tab
j:rt:rm "Cambridge, MA 02139 USA"
j:rt:cr
j:rt:tab
j:rt:tt "http://www.biresource.org"
}]
}
jstools-1998.11.04/lib/jprompts.tcl 100644 764 764 36735 6601015573 14321 0 ustar js js # jprompts.tcl - various panels to ask the user for something
#
######################################################################
# Copyright 1992-1998 by Jay Sekora. This file may be freely #
# distributed, modified or unmodified, for any purpose, provided #
# that this copyright notice is retained verbatim in all copies and #
# no attempt is made to obscure the authorship of this file. If you #
# distribute any modified versions, I ask, but do not require, that #
# you clearly mark any changes you make as such and that you provide #
# your users with instructions for getting the original sources. #
######################################################################
### TO DO
### checkbox to display output of unix or tcl command
# the import IS A BIG PROBLEM until this whole file gets wrapped in its own
# namespace:
catch {
package require jldb
::jldb::load_pkg ;# so proc names available
# following likely to fail, because done by other libraries too
namespace import ::jldb::shortcuts::*
}
catch {
package require jstools
namespace eval ::jstools { } ;# so namespace is defined
}
######################################################################
# global variables:
#
global J_PREFS env
j:default J_PREFS(autoposition) 0
j:default J_PREFS(confirm) 1
#
######################################################################
######################################################################
# j:prompt ?options? - prompt the user for information
# if $file, then the Tab key will do filename completion
######################################################################
proc j:prompt { args } {
::jstools::parse_args {
{text "Enter a value:"}
{default ""}
{cancelvalue ""}
{file 0}
{show {}}
{title title:prompt}
{history ""}
}
set text [= $text]
set title [= $title]
global j_prompt
global jstools_library
set doing_history ![string match "" $history]
set old_focus [focus] ;# so we can restore original focus
toplevel .pr
wm withdraw .pr ;# lets us "update" without flashing
;# will be undone by j:dialogue
wm title .pr $title
message .pr.msg -width 300 -anchor w -text $text
frame .pr.mid ;# has entry, history buttons if any
entry .pr.mid.e -width 40
pack .pr.mid.e -in .pr.mid -side left -fill x
if $doing_history {
update idletasks
set h [winfo reqheight .pr.mid]
set ht 0
j:tk4 {
set ht [.pr.mid.e cget -highlightthickness]
}
set h [expr {$h - ( $ht * 2 ) - 6}] ;# um, derived empirically. :-) ######
button .pr.mid.down -width $h -height $h -padx 0 -pady 0 \
-bitmap @[file join $jstools_library bitmaps down.xbm] -command "
.pr.mid.e delete 0 end
.pr.mid.e insert end \[j:history:down $history\]
.pr.mid.e xview end
"
button .pr.mid.up -width $h -height $h -padx 0 -pady 0 \
-bitmap @[file join $jstools_library bitmaps up.xbm] -command "
.pr.mid.e delete 0 end
.pr.mid.e insert end \[j:history:up $history\]
.pr.mid.e xview end
"
pack .pr.mid.down .pr.mid.up -side left
}
catch {.pr.mid.e configure -show $show} ;# ### NEEDS ERROR CHECKING (tk3) ###
j:buttonbar .pr.b -default ok -buttons [format {
{ok OK {set j_prompt(result) [.pr.mid.e get]; destroy .pr}}
{clear Clear {.pr.mid.e delete 0 end}}
{cancel Cancel {set j_prompt(result) {%s}; destroy .pr}}
} $cancelvalue]
pack .pr.msg -side top -fill both -expand yes -padx 10
pack .pr.mid -side top -padx 10 -pady 10
pack .pr.b -side bottom -fill x
pack [j:rule .pr -width 200] -side bottom -fill x
.pr.mid.e delete 0 end
.pr.mid.e insert end $default
j:dialogue .pr ;# position in centre of screen
if $file {
bind .pr.mid.e <Tab> {
set f [%W get]
%W delete 0 end
%W insert end [j:expand_filename $f]
%W xview end
focus %W ;# work around Tk4 "all" binding
break
}
}
j:default_button .pr.b.ok .pr.mid.e
j:cancel_button .pr.b.cancel .pr.mid.e
if $doing_history {
j:history:begin $history
bind .pr.mid.e <Up> "
%W delete 0 end
%W insert end \[j:history:up $history\]
%W xview end
catch {break}
"
bind .pr.mid.e <Down> "
%W delete 0 end
%W insert end \[j:history:down $history\]
%W xview end
catch {break}
"
}
focus .pr.mid.e
update
grab .pr
tkwait window .pr
focus -force $old_focus ;# can't figure out a better way...
if $doing_history {
if {"x$j_prompt(result)" != "x$cancelvalue"} {
j:history:append $history $j_prompt(result)
}
}
return $j_prompt(result)
}
######################################################################
# j:prompt_font ?options? - prompt for a font (via xfontsel)
# options are:
# -prompt (default "Font:", but currently ignored)
# -pattern (default "*")
# usage of xfontsel (`quit' button) not obvious!
######################################################################
proc j:prompt_font { args } {
::jstools::parse_args {
{prompt "Font:"}
{pattern "*"}
}
global j_prompt
global jfont_size jfont_family jfont_bold jfont_italic
set jfont_size 12
set jfont_bold 0
set jfont_italic 0
toplevel .pr
wm title .pr $prompt
wm withdraw .pr ;# lets us "update" without flashing
;# will be undone by j:dialogue
message .pr.msg -width 300 -text $prompt -anchor w
frame .pr.mid
j:option .pr.mid.fam -list [font families] -variable jfont_family -width 30
entry .pr.mid.size -width 5 -textvariable jfont_size
checkbutton .pr.mid.bold -text bold -variable jfont_bold
checkbutton .pr.mid.italic -text italic -variable jfont_italic
pack \
[j:filler .pr.mid] \
.pr.mid.fam \
.pr.mid.size \
.pr.mid.bold \
.pr.mid.italic \
[j:filler .pr.mid] \
-side left -fill x
j:buttonbar .pr.b -default ok -buttons {
{ok OK
{
set j_prompt(result) [list $jfont_family $jfont_size]
if $jfont_bold {lappend j_prompt(result) bold}
if $jfont_italic {lappend j_prompt(result) italic}
destroy .pr
}
}
}
pack \
[j:filler .pr] \
.pr.msg \
-side top -padx 10 -fill x
pack \
[j:filler .pr] \
.pr.mid \
[j:filler .pr] \
[j:rule .pr] \
.pr.b \
-side top -fill x
focus .pr.mid.size
update
j:dialogue .pr
grab .pr
tkwait window .pr
return $j_prompt(result)
}
######################################################################
# j:prompt_tcl - prompt for a tcl command and execute it
######################################################################
proc j:prompt_tcl { args } {
::jstools::parse_args {
{history j_tcl}
}
global j_prompt_tcl
append j_prompt_tcl(RESULT) {}
set prompt [= prompt:tcl "Tcl Command:"]
set title_short [= title:tcl:result_short "Tcl result"]
set title [= title:tcl:result "Result of Tcl command"]
set prompt_result [j:prompt \
-history $history -text $prompt]
if {$prompt_result != {}} then {
set j_prompt_tcl(RESULT) $prompt_result
set result [uplevel #0 $j_prompt_tcl(RESULT)]
set length [string length $result]
if {$length == 0} {
return
}
if {$length < 40 && ! [string match "*\[\t\r\]*" $result]} {
j:alert -title $title_short -text $result
return
} else {
j:more -title $title -text $result
return
}
}
}
######################################################################
# j:prompt_unix - prompt for a unix command and execute it
######################################################################
proc j:prompt_unix { args } {
::jstools::parse_args {
{history j_unix}
}
global j_prompt_unix
append j_prompt_unix(RESULT) {}
set prompt [= prompt:unix {Unix Command:}]
set title_short [= title:unix:result_short {Command output}]
set prompt_result [j:prompt \
-history $history -text $prompt]
if {$prompt_result != {}} then {
set j_prompt_unix(RESULT) $prompt_result
set command $prompt_result
set result [uplevel #0 exec $command < /dev/null]
set length [string length $result]
if {$length == 0} {
j:alert -text "No output from $command."
return
}
if {$length < 40 && ! [string match "*\[\t\r\]*" $result]} {
j:alert -title $title_short -text $result
return
} else {
set title [= title:unix:result "Output of Unix command"]
j:more -title $title -text $result
return
}
}
}
######################################################################
# j:prompt_colour_name - prompt for a colour name
######################################################################
### PROBLEM: LOCATION OF /usr/lib/X11/rgb.txt IS HARDCODED!
### Also, should open and process without forking off an awk
### Also, getting $w into strings is done in an ugly manner
::jldb::set_defaults {
{prompt:colour_name {Choose a colour:}}
{title:colour_name {Colour Name Selector}}
}
proc j:prompt_colour_name { args } {
::jstools::parse_args {
{prompt prompt:colour_name}
{title title:colour_name}
{default magenta}
}
set prompt [= $prompt]
set title [= $title]
global j_prompt
global J_PREFS
if {[lsearch [array names J_PREFS] {scrollbarside}] == -1} {
set J_PREFS(scrollbarside) right ;# make sure it's defined
}
set old_focus [focus] ;# so we can restore original focus
set w ".prompt_colour_name"
toplevel $w
wm title $w $title
set rgbfile /usr/lib/X11/rgb.txt
if [file isfile $rgbfile] {
set colourlist [lsort [exec awk { NF == 4 { print $4 } } $rgbfile]]
} else {
set colourlist {
aquamarine bisque black blue brown burlywood coral crimson cyan
firebrick gold goldenrod green grey grey25 grey33 grey50 grey66
grey75 khaki lavender magenta maroon navy orange orchid pink plum
purple red salmon tan tomato turquoise white yellow
}
}
set j_prompt(colour) {}
label $w.l -text $prompt
j:buttonbar $w.b -default ok -orient vertical -buttons [list \
[list ok OK [format {
catch {set j_prompt(colour) [%s.list get [%s.list curselection]]}
destroy %s
} $w $w $w] \
] \
]
frame $w.frame -width 100 -height 100 \
-background $default -relief raised -borderwidth 2
frame $w.list
scrollbar $w.list.sb -command "$w.list.lb yview"
listbox $w.list.lb -yscroll "$w.list.sb set" -relief flat -setgrid true
####### following supports both tk3.6 and 4.0:
if [catch {$w.list.lb configure -geometry 20x20}] {
$w.list.lb configure -width 20 -height 20
}
pack $w.list.sb [j:rule $w.list] \
-side $J_PREFS(scrollbarside) -fill y
pack $w.list.lb -in $w.list -side left -expand yes -fill both
pack $w.l [j:rule $w] -side top -fill x
pack $w.list [j:rule $w] -side left -expand yes -fill both
pack $w.frame -side top -fill both -expand yes -padx 10 -pady 10
pack $w.b -side bottom -fill x
pack [j:rule $w] -side bottom -fill x
# Fill the listbox with a list of several useful colours:
foreach i $colourlist {
$w.list.lb insert end $i
}
# Set up bindings for the browser.
bind $w.list.lb <Control-q> "destroy $w"
bind $w.list.lb <Control-c> "destroy $w"
focus $w.list.lb
j:tk3 {
bind $w.list.lb <Button-1> "
$w.list.lb select from \[$w.list.lb nearest %y\]
catch {
set j_prompt(colour) \[$w.list.lb get \[$w.list.lb curselection\]\]
}
$w.frame config -background \$j_prompt(colour)
"
}
j:tk4 {
bind $w.list.lb <Button-1> "
$w.list.lb selection clear 0 end
$w.list.lb selection set \[$w.list.lb nearest %y\]
catch {
set j_prompt(colour) \[$w.list.lb get \[$w.list.lb curselection\]\]
}
$w.frame config -background \$j_prompt(colour)
"
}
bind $w.list.lb <Double-Button-1> "
$w.b.ok invoke
"
j:tk4 {
bind $w.list.lb <Double-Button-1> "+\nbreak\n"
}
j:default_button $w.b.ok $w
focus $w
j:dialogue $w
tkwait window $w
j:tk3 {focus $old_focus}
j:tk4 {focus -force $old_focus} ;# can't figure out a better way...
if {$j_prompt(colour) == ""} {set j_prompt(colour) $default}
return $j_prompt(colour)
}
proc j:prompt_color_name \
[info args j:prompt_colour_name] \
[info body j:prompt_colour_name]
######################################################################
# j:prompt_colour_rgb - prompt for a colour RGB value
# An eviscerated version of selcol.tcl by Sam Shen <sls@aero.org>,
# which also let you choose HSV values
######################################################################
::jldb::set_defaults {
{prompt:colour_rgb {Choose a colour:}}
{title:colour_rgb {Colour Colour Selector}}
}
proc j:prompt_colour_rgb { args } {
::jstools::parse_args {
{prompt prompt:colour_rgb}
{title title:colour_rgb}
{default {#ff80ff}}
}
set hexbyte {[0-9a-fA-F][0-9a-fA-F]}
if ![string match #$hexbyte$hexbyte$hexbyte $default] {
error "illegal RGB colour $default"
}
set prompt [= $prompt]
set title [= $title]
global j_prompt
# extract hex values of default/current colour as decimal numbers
scan $default "#%2x%2x%2x" j_prompt(red) j_prompt(green) j_prompt(blue)
set j_prompt(flag) 0
set old_focus [focus] ;# so we can restore original focus
set w .prompt_rgb
toplevel $w
wm title $w $title
wm minsize $w 100 100
wm maxsize $w [winfo screenwidth $w] [winfo screenheight $w]
label $w.l -text $prompt
frame $w.patch -width 100 -height 100 -relief raised -borderwidth 2
entry $w.value -width 12
bind $w.value <1> {%W select from @0; %W select to end}
frame $w.scales
set j_prompt(flag) 1
j:prompt_colour_rgb:make_scale $w $w.scales.red red 255 \
[= colour_name:red Red]
j:prompt_colour_rgb:make_scale $w $w.scales.green green 255 \
[= colour_name:green Green]
j:prompt_colour_rgb:make_scale $w $w.scales.blue blue 255 \
[= colour_name:blue Blue]
pack $w.scales.red $w.scales.green $w.scales.blue \
-side left -fill y -expand yes
set j_prompt(flag) 0
j:buttonbar $w.b -default ok -orient vertical -buttons {
{
ok OK { }
}
}
$w.b.ok configure -command "
set j_prompt(return) \[$w.value get\]
destroy $w
"
pack $w.l
pack [j:rule $w] -fill x
pack $w.scales -expand yes -side left -fill y
pack [j:rule $w] -side left -fill y
pack $w.value -fill both
pack $w.patch -expand yes -fill both -padx 10 -pady 10
pack [j:rule $w] -fill x
pack $w.b -fill x
j:prompt_colour_rgb:update_colour $w red $j_prompt(red)
j:default_button $w.b.ok $w $w.value
focus $w
j:dialogue $w
tkwait window $w
j:tk3 {focus $old_focus}
j:tk4 {focus -force $old_focus} ;# can't figure out a better way...
return $j_prompt(return)
}
proc j:prompt_colour_rgb:make_scale {w name var to title} {
global j_prompt
frame $name
scale $name.scale -to $to \
-command "j:prompt_colour_rgb:update_colour $w $var"
if {$to >= 100} {
$name.scale configure -length $to
}
$name.scale set [set j_prompt($var)]
label $name.label -text $title
pack $name.label -in $name
pack $name.scale -in $name -expand yes -fill y
}
proc j:prompt_colour_rgb:update_colour {w var value} {
global j_prompt
if {$j_prompt(flag) == 1} {return}
set j_prompt(flag) 1
set j_prompt($var) $value
set colour [format "#%02x%02x%02x" \
$j_prompt(red) $j_prompt(green) $j_prompt(blue)]
catch {}
$w.patch configure -background $colour
$w.value delete @0 end
$w.value insert 0 $colour
set j_prompt(flag) 0
}
######################################################################
proc j:prompt_color_rgb \
[info args j:prompt_colour_rgb] \
[info body j:prompt_colour_rgb]
jstools-1998.11.04/lib/jrichtext.tcl 100644 764 764 22133 6600474757 14446 0 ustar js js # jrichtext.tcl - procedures for dealing with rich text
#
######################################################################
# Copyright 1992-1998 by Jay Sekora. This file may be freely #
# distributed, modified or unmodified, for any purpose, provided #
# that this copyright notice is retained verbatim in all copies and #
# no attempt is made to obscure the authorship of this file. If you #
# distribute any modified versions, I ask, but do not require, that #
# you clearly mark any changes you make as such and that you provide #
# your users with instructions for getting the original sources. #
######################################################################
# the import IS A BIG PROBLEM until this whole file gets wrapped in its own
# namespace:
catch {
package require jldb
::jldb::load_pkg ;# so namespace is defined
namespace import ::jldb::shortcuts::*
}
# CHANGES:
# dual usage; j:rt:textfonts with a text widget vs. full rich-text
# j:tagged_insert w text args - insert tagged text into a text widget
# j:rt text dest - prepare to write rich text to text widget dest
# j:rt:type - return type of current rich text destination (text, TeX)
# j:rt:destination - return current rich text destination (widget, file)
# j:rt:textfonts {style font}... - set fonts for text widget
# j:rt:done - finish writing rich text (clear vars, close files)
# j:rt:rm text - write rich text (roman)
# j:rt:it text - write rich text (italic)
# j:rt:bf text - write rich text (bold face)
# j:rt:bi text - write rich text (bisexual)
# j:rt:tt text - write rich text (typewriter - monospaced)
# j:rt:hl text - write rich text (`headline' - larger bold)
# j:rt:tab - tab in rich text
# j:rt:cr - line break in rich text
# j:rt:par - paragraph break in rich text
# j:rt:mkabbrevs - make shorter convenience procs, for text-intensive apps
# rm - dummy do-nothing procedure to prevent unknown from calling /bin/rm
# if you forget to j:rt:mkabbrevs
catch {
package require jldb
}
######################################################################
# j:tagged_insert - append to a text widget with a particular tag
# (lifted from mkStyles.tcl demo, where it was insertWithTags)
######################################################################
# The procedure below inserts text into a given text widget and
# applies one or more tags to that text. The arguments are:
#
# w Window in which to insert
# text Text to insert (it's inserted at the "insert" mark)
# args One or more tags to apply to text. If this is empty
# then all tags are removed from the text.
proc j:tagged_insert {w text args} {
set start [$w index insert]
$w insert insert $text
foreach tag [$w tag names $start] {
$w tag remove $tag $start insert
}
foreach i $args {
$w tag add $i $start insert
}
}
######################################################################
# j:rt text dest - prepare to write rich text to text widget dest
# future versions will support PostScript, TeX, maybe canvas, etc.
######################################################################
proc j:rt { {type {}} {destination stdout} } {
global j_rt
case $type in {
{text} { ;# output to a text widget
set j_rt(type) $type
set j_rt(destination) $destination
$j_rt(destination) delete 0.0 end
$j_rt(destination) configure -wrap word
catch {
$j_rt(destination) configure -font \
-adobe-helvetica-medium-r-normal--*-120-*
$j_rt(destination) tag configure richtext:font:roman -font \
-adobe-helvetica-medium-r-normal--*-120-*
$j_rt(destination) tag configure richtext:font:italic -font \
-adobe-helvetica-medium-o-normal--*-120-*
$j_rt(destination) tag configure richtext:font:bold -font \
-adobe-helvetica-bold-r-normal--*-120-*
$j_rt(destination) tag configure richtext:font:bolditalic -font \
-adobe-helvetica-bold-o-normal--*-120-*
$j_rt(destination) tag configure richtext:font:typewriter -font \
-adobe-courier-medium-r-normal--*-120-*
$j_rt(destination) tag configure richtext:font:heading0 -font \
-adobe-helvetica-bold-o-normal--*-240-*
$j_rt(destination) tag configure richtext:font:heading1 -font \
-adobe-helvetica-bold-o-normal--*-180-*
$j_rt(destination) tag configure richtext:font:heading2 -font \
-adobe-helvetica-bold-o-normal--*-140-*
$j_rt(destination) tag configure richtext:font:heading3 -font \
-adobe-helvetica-bold-o-normal--*-120-*
$j_rt(destination) tag configure richtext:font:heading4 -font \
-adobe-helvetica-bold-o-normal--*-100-*
$j_rt(destination) tag configure richtext:font:heading5 -font \
-adobe-helvetica-bold-o-normal--*-80-*
}
}
default {
error [= richtext:unsupportedtype \
"j:rt type \"$type\" is not supported."]
}
}
}
######################################################################
# j:rt:textfonts w {{style fontlist}...} - set fonts for text widget w
# style is one of {roman italic bold bolditalic typewriter} or
# {heading0, ..., heading5}; font is list of X fonts, in order of
# decreasing preference (cf j:configure_tag_font in jtkutils.tcl).
######################################################################
proc j:rt:textfonts { w list } {
foreach pair $list {
set tag "richtext:font:[lindex $pair 0]"
set fontlist [lindex $pair 1]
j:configure_tag_font $w $tag $fontlist
}
}
######################################################################
# j:rt:type - return type of current rich text destination (text, TeX)
######################################################################
proc j:rt:type {} {
global j_rt
if { (! [info exists j_rt(type)])} {
# this might be considered an error
return {}
} else {
return $j_rt(type)
}
}
######################################################################
# j:rt:destination - return current rich text destination (widget, file)
######################################################################
proc j:rt:destination {} {
global j_rt
if { (! [info exists j_rt(destination)]) } {
# this might be considered an error
return {}
} else {
return $j_rt(destination)
}
}
######################################################################
# j:rt:done - finish writing rich text (clear vars, close files)
######################################################################
proc j:rt:done {} {
global j_rt
# to start, would close files if appropriate
set j_rt(type) {}
set j_rt(destination) {}
}
######################################################################
# CREATE PROCEDURES FOR:
# j:rt:rm text - write rich text (roman)
# j:rt:it text - write rich text (italic)
# j:rt:bf text - write rich text (bold face)
# j:rt:bi text - write rich text (bold italic)
# j:rt:tt text - write rich text (typewriter - monospaced)
# j:rt:hl text - write rich text (`headline' - larger bold)
######################################################################
set tmp_body {
set type [j:rt:type]
case $type in {
{text} { ;# output to a text widget
j:tagged_insert [j:rt:destination] $text $tag
}
default {
error [subst [= richtext:unsupportedtype \
{j:rt type "$type" is not supported.}]]
}
}
}
foreach pair {
{rm roman}
{it italic}
{bf bold}
{bi bolditalic}
{tt typewriter}
{hl heading1}
{h0 heading0}
{h1 heading1}
{h2 heading2}
{h3 heading3}
{h4 heading4}
{h5 heading5}
} {
set command [lindex $pair 0]
set style [lindex $pair 1]
proc j:rt:$command {text} " set tag richtext:font:$style\n$tmp_body"
}
######################################################################
# j:rt:tab - tab in rich text
######################################################################
proc j:rt:tab {} {
j:rt:rm "\t"
}
######################################################################
# j:rt:cr - line break in rich text
######################################################################
proc j:rt:cr {} {
j:rt:rm "\n"
}
######################################################################
# j:rt:par - paragraph break in rich text
######################################################################
proc j:rt:par {} {
j:rt:rm "\n\n"
}
######################################################################
# j:rt:mkabbrevs - make shorter convenience procs, for text-intensive apps
######################################################################
# this creates shorter aliases rm, it, bf, bi, tt, hl, tab, cr, and
# par identical to the corresponding procedures starting with "j:rt:"
proc j:rt:mkabbrevs {} {
foreach proc {rm it bf bi tt hl tab cr par} {
proc $proc [info args j:rt:$proc] [info body j:rt:$proc]
}
}
######################################################################
# rm - dummy do-nothing procedure to prevent unknown from calling /bin/rm
# if you forget to j:rt:mkabbrevs
######################################################################
proc rm {args} {
error [= richtext:rm \
"Called `rm' without calling `j:rt:mkabbrevs'."]
}
jstools-1998.11.04/lib/jeditmodes/ 40755 764 764 0 6577740166 13752 5 ustar js js jstools-1998.11.04/lib/jeditmodes/code-mode.tcl 100644 764 764 1747 6577737617 16427 0 ustar js js # ~/.tk/edittkmodes/code-mode.tcl - mode for editing code
######################################################################
::jldb::set_defaults {
{{Help on code Mode} {Help on `code' Mode}}
}
proc mode:code:init { t } {
global JEDIT_MODEPREFS
j:read_prefs -array JEDIT_MODEPREFS -prefix code \
-directory ~/.tk/jeditmodes -file code-defaults {
{textfont default}
{textwidth 80}
{textheight 24}
{textwrap char}
{sabbrev 0}
{dabbrev 0}
{autobreak 0}
{autoindent 1}
{parenflash 1}
{savestate 0}
{buttonbar 1}
{buttons {
jedit:cmd:done
jedit:cmd:save
jedit:cmd:load
jedit:cmd:print
}}
{docs {
-
{{Help on code Mode} {jeditmodes/code-mode.jdoc}}
}}
{menu,editor 1}
{menu,file 1}
{menu,edit 1}
{menu,prefs 1}
{menu,abbrev 1}
{menu,filter 1}
{menu,format 0}
{menu,font 0}
{menu,display 0}
{menu,mode1 1}
{menu,mode2 1}
{menu,user 1}
}
}
jstools-1998.11.04/lib/jeditmodes/mail-mode.tcl 100644 764 764 4201 6577737707 16423 0 ustar js js # ~/.tk/edittkmodes/mail-mode.tcl - mode for composing mail
######################################################################
::jldb::set_defaults {
{menu:mail {Mail} 0}
{mode:mail:insert_sig {Append Signature} 7}
{SHORT-mode:mail:insert_sig {Sign}}
{mode:mail:delete_sig {Delete Signature} 1}
{SHORT-mode:mail:delete_sig {Unsign}}
{{Help on mail Mode} {Help on `mail' Mode}}
}
proc mode:mail:init { t } {
global JEDIT_MODEPREFS
j:read_prefs -array JEDIT_MODEPREFS -prefix mail \
-directory ~/.tk/jeditmodes -file mail-defaults {
{textfont default}
{textwidth 80}
{textheight 24}
{textwrap char}
{sabbrev 0}
{dabbrev 0}
{autobreak 1}
{autoindent 0}
{savestate 0}
{buttonbar 1}
{buttons {
jedit:cmd:done
mode:mail:delete_sig
mode:mail:insert_sig
}}
{docs {
-
{{Help on mail Mode} {jeditmodes/mail-mode.jdoc}}
}}
{menu,editor 1}
{menu,file 1}
{menu,edit 1}
{menu,prefs 0}
{menu,abbrev 1}
{menu,filter 1}
{menu,format 0}
{menu,font 0}
{menu,display 0}
{menu,mode1 1}
{menu,mode2 1}
{menu,user 1}
}
}
######################################################################
# more procedures:
# delete the signature if it exists (and is tagged so):
j:command:register mode:mail:delete_sig {Remove Signature}
proc mode:mail:delete_sig { t } {
catch {
$t delete sig.first end
}
}
j:command:register mode:mail:insert_sig {Append Signature}
proc mode:mail:insert_sig { t } {
global env
mode:mail:delete_sig $t
set end [$t index end]
$t insert end "\n"
$t insert end [exec cat $env(HOME)/.signature]
$t insert end "\n"
$t tag add sig $end end
$t tag configure sig -font {-*-courier-bold-r-normal--10-100-*}
$t tag lower sig
}
######################################################################
# define the Mail menu:
######################################################################
proc mode:mail:mkmenu1 { menu t } {
j:menu:menubutton $menu $menu.m menu:mail
j:menu:commands $menu.m $t {
mode:mail:insert_sig
mode:mail:delete_sig
jedit:cmd:done
}
}
jstools-1998.11.04/lib/jeditmodes/mh-mode.tcl 100644 764 764 12103 6577740155 16114 0 ustar js js # mh-mode.tcl - mode for composing mail in MH
######################################################################
::jldb::set_defaults {
{menu:mh {MH} 0}
{mode:mh:start_reply {Start MH Reply} 6 <Meta-Key-2>}
{SHORT-mode:mh:start_reply {Insert @}}
{mode:mh:insert_sig {Append Signature}}
{SHORT-mode:mh:insert_sig {Sign}}
{mode:mh:delete_sig {Delete Signature}}
{SHORT-mode:mh:delete_sig {Unsign}}
{mode:mh:whom {List Recipients} 0 <Meta-Key-7>}
{SHORT-mode:mh:whom {Whom}}
{mode:mh:border {Insert Border} 7 <Meta-Key-8>}
{SHORT-mode:mh:border {Border}}
{mh_pref:mh_tab_headers {Tab to Headers}}
{{Recipients} {Recipients}}
{{Help on mh Mode} {Help on `mh' Mode}}
}
proc mode:mh:init { t } {
global JEDIT_MODEPREFS
j:read_prefs -array JEDIT_MODEPREFS -prefix mh \
-directory ~/.tk/jeditmodes -file mh-defaults {
{textfont default}
{textwidth 80}
{textheight 24}
{textwrap char}
{sabbrev 0}
{dabbrev 0}
{autobreak 1}
{autoindent 0}
{savestate 0}
{buttonbar 1}
{buttons {
jedit:cmd:done
mode:mh:border
mode:mh:whom
mode:mh:insert_sig
mode:mh:start_reply
}}
{docs {
-
{{Help on mh Mode} {jeditmodes/mh-mode.jdoc}}
}}
{menu,editor 1}
{menu,file 1}
{menu,edit 1}
{menu,prefs 0}
{menu,abbrev 1}
{menu,filter 1}
{menu,format 0}
{menu,font 0}
{menu,display 0}
{menu,mode1 1}
{menu,mode2 1}
{menu,user 1}
{mh_tab_headers 1}
}
# catch {$t tag configure header -background LemonChiffon}
$t tag configure header -relief flat ;# just to create it
$t tag lower header
catch {$t tag configure sig -font {-*-courier-bold-r-normal--10-100-*}}
$t tag lower sig
j:tk3 {
bind $t <Double-Tab> "mode:mh:to_body $t"
bind $t <Tab> "mode:mh:next_header $t"
}
j:tk4 {
bind $t <Double-Tab> "mode:mh:to_body $t; break"
bind $t <Tab> "mode:mh:next_header $t; break"
}
}
######################################################################
# special hooks:
proc mode:mh:post_read_hook { filename t } {
set separator {}
if [regexp -indices "\n-*\n" [$t get 0.0 end] separator] {
set headerend [lindex $separator 0]
$t tag add header 0.0 "0.0 + $headerend chars + 1 char"
}
}
proc mode:mh:to_body { t } {
global JEDIT_MODEPREFS
if $JEDIT_MODEPREFS(mh,mh_tab_headers) {
$t mark set insert end
$t yview -pickplace insert
} else {
jedit:tabkey $t
}
}
# BUG - doesn't handle multi-line headers.
proc mode:mh:next_header { t } {
global JEDIT_MODEPREFS
if $JEDIT_MODEPREFS(mh,mh_tab_headers) {
if [$t compare header.last <= insert] {
$t mark set insert 1.0
}
set headpart [$t get insert header.last]
set regex [format {(^|%s)[A-Za-z-]*:[ %s]*} "\n" "\t"]
if [regexp -indices -- $regex $headpart indices] {
$t tag remove sel 1.0 end
set valuestart [expr [lindex $indices 1] + 1]
$t mark set hdrfrom "insert + $valuestart chars"
$t tag add sel hdrfrom {hdrfrom lineend}
$t mark set insert {hdrfrom lineend}
$t yview -pickplace insert
} else {
# assume we're in the last header field, so jump to body
mode:mh:to_body $t
}
} else {
jedit:tabkey $t
}
}
######################################################################
# define the MH menu:
######################################################################
proc mode:mh:mkmenu1 { menu t } {
j:menu:menubutton $menu $menu.m menu:mh
j:menu:checkbuttons $menu.m [list \
[list mh_pref:mh_tab_headers JEDIT_MODEPREFS(mh,mh_tab_headers)] \
]
j:menu:commands $menu.m $t {
-
mode:mh:start_reply
mode:mh:insert_sig
mode:mh:delete_sig
mode:mh:whom
mode:mh:border
-
jedit:cmd:done
}
bind $t <Meta-Key-2> "mode:mh:start_reply $t"
bind $t <Meta-Key-7> "mode:mh:whom $t"
bind $t <Meta-Key-8> "mode:mh:border $t"
}
######################################################################
# command procedures:
j:command:register mode:mh:border {Insert Border}
proc mode:mh:border { t args } {
j:text:insert_string $t \
" * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n"
}
# delete the signature if it exists (and is tagged so):
j:command:register mode:mh:delete_sig {Remove Signature}
proc mode:mh:delete_sig { t args } {
catch {
$t delete sig.first end
}
}
j:command:register mode:mh:insert_sig {Append Signature}
proc mode:mh:insert_sig { t args } {
global env
mode:mh:delete_sig $t
set end [$t index end]
$t insert end "\n"
$t insert end [exec cat $env(HOME)/.signature]
$t insert end "\n"
$t tag add sig $end end
}
j:command:register mode:mh:start_reply {Start MH Reply}
proc mode:mh:start_reply { t args } {
set reply [exec cat "@" | sed {1,/^$/d} | \
sed {s/^>/ /} | sed {s/^/ /}]
$t insert end $reply
}
j:command:register mode:mh:whom {List Recipients}
proc mode:mh:whom { t args} {
jedit:cmd:save $t
set filename [jedit:get_filename $t]
j:more -height 10 -width 60 -title [::jldb::long_text {Recipients}] \
-text [exec whom -check $filename]
}
jstools-1998.11.04/lib/jeditmodes/hook-mode.tcl 100644 764 764 5411 6577737672 16446 0 ustar js js proc mode:hook:init { t } {
global JEDIT_MODEPREFS
j:read_prefs -array JEDIT_MODEPREFS -prefix hook \
-directory ~/.tk/jeditmodes -file hook-defaults {
{textfont default}
{textwidth 80}
{textheight 30}
{textwrap char}
{sabbrev 0}
{dabbrev 0}
{autobreak 1}
{autoindent 0}
{savestate 0}
{buttonbar 1}
{buttons {
jedit:cmd:done
jedit:cmd:save
jedit:cmd:load
jedit:cmd:print
}}
{menu,editor 1}
{menu,file 1}
{menu,edit 1}
{menu,prefs 1}
{menu,abbrev 1}
{menu,filter 1}
{menu,format 0}
{menu,font 0}
{menu,display 1}
{menu,mode1 1}
{menu,mode2 1}
{menu,user 1}
}
set toplevel [jedit:text_to_top $t]
label $toplevel.blue -bg blue -fg white -bd 2 -relief raised \
-text {hook mode test}
pack $toplevel.blue -fill both
}
proc mode:hook:cleanup { t } {
set toplevel [jedit:text_to_top $t]
destroy $toplevel.blue
}
### proc mode:hook:pre_returnkey_hook t {
### $t insert insert { [CR]}
### }
###
### proc mode:hook:post_returnkey_hook t {
### $t tag add sel {insert -1 line linestart} {insert -1 line lineend}
### }
###
### proc mode:hook:pre_tabkey_hook t {
### $t tag add sel {insert -1 char wordstart}
### }
###
### proc mode:hook:post_tabkey_hook t {
### $t tag remove sel {insert -1 char}
### }
###
### proc mode:hook:pre_spacebar_hook t {
### $t tag add sel {insert -1 char wordstart} {insert}
### }
###
### proc mode:hook:post_spacebar_hook t {
### $t tag remove sel {insert -1 char}
### }
### proc mode:hook:spacebar t {
### jedit:sabbrev_hook $t
### j:tb:insert_nondigit "\\ " $t
### jedit:autobreak_hook $t
### }
###
### proc mode:hook:returnkey t {
### j:tb:insert_nondigit "\\\n" $t
### }
###
### proc mode:hook:tabkey t {
### j:tb:insert_nondigit {^I} $t
### }
proc mode:hook:post_returnkey_hook t {
$t tag configure proc-start -foreground red \
-font "-*-lucidatypewriter-bold-r-normal-sans-18-*-*-*-*-*-*-*"
set line [$t get {insert -1 line linestart} {insert -1 line lineend}]
if [string match {proc *\{} $line] {
$t tag add proc-start {insert -1 line linestart} {insert -1 line lineend}
}
}
proc mode:hook:pre_quit_hook t {
j:alert -text {Oh, sure, just quit and leave me all by myself!}
}
proc mode:hook:quit t {
if [j:confirm -priority 100 \
-text "Êtes vous sûr(e)?" \
-yesbutton Oui -nobutton Non] {
if [j:confirm -priority 100 \
-text "Êtes vous vraiment sûr(e)?" \
-yesbutton Oui -nobutton Non] {
exit 0
}
}
}
proc mode:hook:done t {
if [j:confirm -priority 100 \
-text "Are you COMPLETELY sure you're done?"\
-yesbutton Yuppers -nobutton Nope] {
jedit:cmd:save $t
jedit:cmd:quit $t
} else {
j:alert -text "Saving..."
jedit:cmd:save $t
}
}
jstools-1998.11.04/lib/jeditmodes/note-mode.tcl 100644 764 764 1477 6577737717 16463 0 ustar js js # ~/.tk/edittkmodes/note-mode.tcl - mode for short yellow-sticky-style notes
######################################################################
proc mode:note:init { t } {
global JEDIT_MODEPREFS
j:read_prefs -array JEDIT_MODEPREFS -prefix note \
-directory ~/.tk/jeditmodes -file note-defaults {
{textfont -*-lucida-medium-r-*-*-10-*-*-*-*-*-*-*}
{textwidth 40}
{textheight 24}
{textwrap word}
{sabbrev 0}
{dabbrev 0}
{autobreak 0}
{autoindent 1}
{savestate 1}
{buttonbar 1}
{buttons {
jedit:cmd:done
jedit:cmd:quit
}}
{menu,editor 1}
{menu,file 1}
{menu,edit 1}
{menu,prefs 0}
{menu,abbrev 1}
{menu,filter 1}
{menu,format 1}
{menu,font 1}
{menu,display 1}
{menu,mode1 0}
{menu,mode2 0}
{menu,user 1}
}
}
jstools-1998.11.04/lib/jeditmodes/tcl-mode.tcl 100644 764 764 24316 6577737741 16312 0 ustar js js ######################################################################
# ~/.tk/edittkmodes/tcl-mode.tcl - mode for editing Tcl code
######################################################################
# things it handles well:
#
# frame .foo \
# -width 10 -height 20 \
# -background blue
#
# proc foo {} {
# global bar
# if $bar { ; # comment
# baz
# } else { }
# }
#
# format {
# %d dollars,
# %d cents.
# } $dollars $cents
#
# things it handles badly:
#
# proc foo {} { global bar
# if $bar {
# baz
# } else {
# } ;# nothing but newline between open and close braces
# }
#
# set foo {
# bar
# baz} ;# close brace not at beginning of line
#
# catch {
# $t tag configure comment -foreground grey50 \
# -font -*-lucida-medium-r-normal-sans-10-100-*
# } ;# last line before close brace is a continuation
::jldb::set_defaults {
{menu:tcl_mode1 {Tcl} 0}
{menu:tcl_mode2 {Procs} 2}
{mode:tcl:hash {Comment with #} 0}
{SHORT-mode:tcl:hash {#}}
{mode:tcl:hashes {Comment with ###} 1}
{SHORT-mode:tcl:hashes {###}}
{mode:tcl:uncomment {Un-#} 0}
{mode:tcl:border {Make Border} 5 <Meta-Key-3>}
{SHORT-mode:tcl:border {Border}}
{tcl_pref:hilight_comments {Hilight Comments}}
{{Help on tcl Mode} {Help on `tcl' Mode}}
}
proc mode:tcl:init { t } {
global JEDIT_MODEPREFS
j:read_prefs -array JEDIT_MODEPREFS -prefix tcl \
-directory ~/.tk/jeditmodes -file tcl-defaults {
{textfont default}
{textwidth 80}
{textheight 24}
{textwrap char}
{sabbrev 0}
{dabbrev 0}
{autobreak 0}
{autoindent 1}
{parenflash 1}
{savestate 0}
{buttonbar 1}
{buttons {
jedit:cmd:save
mode:tcl:hash
mode:tcl:hashes
mode:tcl:uncomment
mode:tcl:border
}}
{docs {
-
{{Help on tcl Mode} {jeditmodes/tcl-mode.jdoc}}
}}
{menu,editor 1}
{menu,file 1}
{menu,edit 1}
{menu,prefs 0}
{menu,abbrev 1}
{menu,filter 1}
{menu,format 0}
{menu,font 0}
{menu,display 0}
{menu,mode1 1}
{menu,mode2 1}
{menu,user 1}
{tcl_hilight_comments 0}
}
# There should be a mode-specific preferences panel for this:
global TCL_MODE
set TCL_MODE(indent) 2 ;# number of chars per nesting level
######################################################################
# tags
catch {
$t tag configure comment \
-foreground {#4000ff} \
-font -*-lucida-medium-r-normal-sans-10-100-*
}
}
######################################################################
# make Tcl menu
######################################################################
proc mode:tcl:mkmenu1 { menu t } {
global JEDIT_MODEPREFS
j:menu:menubutton $menu $menu.m menu:tcl_mode1
j:menu:checkbuttons $menu.m [list \
[list tcl_pref:hilight_comments JEDIT_MODEPREFS(tcl,tcl_hilight_comments)] \
]
j:menu:commands $menu.m $t {
-
mode:tcl:hash
mode:tcl:hashes
mode:tcl:uncomment
mode:tcl:border
}
bind $t <Meta-Key-3> "mode:tcl:border $t"
}
######################################################################
# make Procs menu (mostly done by mode:tcl:mkprocsmenu)
######################################################################
proc mode:tcl:mkmenu2 {menu t} {
j:menu:menubutton $menu $menu.m menu:tcl_mode2
$menu.m configure -postcommand "mode:tcl:mkprocsmenu $menu $t"
}
######################################################################
# adjust indentation based on nesting
######################################################################
proc mode:tcl:autoindent { t } {
global TCL_MODE
set indentlevel 0
set current [$t get {insert linestart} {insert}]
set prevline [$t get {insert -1lines linestart} {insert -1lines lineend}]
set antepenult [$t get {insert -2lines linestart} {insert -2lines lineend}]
set indent ""
regexp "^ *" $prevline indent
set indentlevel [string length $indent]
set anteindent ""
regexp "^ *" $antepenult anteindent
set antelevel [string length $anteindent]
set close "^\[ \t\]*\}" ;# brace at beginning of line
if {[regexp $close $prevline]} {
if {$indentlevel == $antelevel && $indentlevel >= $TCL_MODE(indent)} {
# change current indentation level:
incr indentlevel -$TCL_MODE(indent)
# and adjust previous line's indentation:
$t delete {insert -1lines linestart} \
"insert -1lines linestart +$TCL_MODE(indent)chars"
}
}
set comment "\{\[ \t;\]*#\[^\}\]*$" ;# brace followed by comment
if {[regexp "\{$" $prevline] || [regexp $comment $prevline]} {
incr indentlevel $TCL_MODE(indent)
}
if {[string match {*[\]} $prevline]} { ;# line continued
if {![string match {*[\]} $antepenult]} {
incr indentlevel $TCL_MODE(indent)
}
} else {
if {[string match {*[\]} $antepenult]} {
# last line was a continuation, but this one isn't
incr indentlevel -$TCL_MODE(indent)
}
}
if {$indentlevel < 0} {set indentlevel 0}
for {set i 0} {$i < $indentlevel} {incr i} {
$t insert insert " "
}
}
######################################################################
# highlight comments in previous line
######################################################################
proc mode:tcl:post_returnkey_hook { t } {
set lineno [lindex [split [$t index insert] .] 0]
if {$lineno == 1} {return 0}
mode:tcl:tag_line [expr {$lineno - 1}] $t
}
######################################################################
# parse/tag all lines
######################################################################
proc mode:tcl:post_read_hook { filename t } {
set lastline [lindex [split [$t index end] .] 0]
for {set i 1} {$i < $lastline} {incr i} {
mode:tcl:tag_line $i $t
}
}
######################################################################
# remember insert so we can scan pasted lines
######################################################################
proc mode:tcl:pre_paste_hook { t } {
global pre_paste_line
set pre_paste_line [lindex [split [$t index insert] .] 0]
}
######################################################################
# scan all the pasted lines
######################################################################
proc mode:tcl:post_paste_hook { t } {
global pre_paste_line
set post_paste_line [lindex [split [$t index insert] .] 0]
for {set i $pre_paste_line} {$i < $post_paste_line} {incr i} {
mode:tcl:tag_line $i $t
}
}
######################################################################
# remember insert so we can scan pasted lines
######################################################################
proc mode:tcl:pre_xpaste_hook { t } {
global pre_paste_line
set pre_paste_line [lindex [split [$t index insert] .] 0]
}
######################################################################
# scan all the pasted lines
######################################################################
proc mode:tcl:post_xpaste_hook { t } {
global pre_paste_line
set post_paste_line [lindex [split [$t index insert] .] 0]
for {set i $pre_paste_line} {$i < $post_paste_line} {incr i} {
mode:tcl:tag_line $i $t
}
}
######################################################################
# find all the procedures and add them to mode2 menu
# this is the -command parameter for .menu.mode2
######################################################################
proc mode:tcl:mkprocsmenu {menu t} {
set lines [lindex [split [$t index end] .] 0]
set linelist {}
for {set line 0} {$line <= $lines} {incr line} {
if [string match "proc\[ \t\]" [$t get $line.0 "$line.0 +5chars"]] {
lappend linelist $line
}
}
$menu.m delete 0 last
$menu.m add command -label "Top" -command "
$t mark set insert 0.0
$t yview -pickplace insert
"
$menu.m add separator
foreach line $linelist {
set text [$t get $line.0 "$line.0 lineend"]
regsub "^proc\[ \t]*(\[^ \t\]*).*" $text {\1} text
$menu.m add command -label "$text" -command "
$t mark set insert $line.0
$t yview -pickplace insert
"
}
$menu.m add separator
$menu.m add command -label "End" -command "
$t mark set insert end
$t yview -pickplace insert
"
update
}
######################################################################
# highlight comments
######################################################################
#### THIS IS TOO SLOW!
proc mode:tcl:tag_line { lineno t } {
global JEDIT_MODEPREFS
if {!$JEDIT_MODEPREFS(tcl,tcl_hilight_comments)} {return 0}
# make sure there's no highlighting already:
$t tag remove comment "$lineno.0" "$lineno.0 lineend"
set line [$t get "$lineno.0" "$lineno.0 lineend"]
# if entire line is comment:
if [regexp -indices "^\[ ;\t]*(#.*)" $line foo indices] {
set first "$lineno.0 +[lindex $indices 0]chars"
set last "$lineno.0 lineend"
$t tag add comment $first $last
return 0
}
# if comment immediately follows a semicolon:
if [regexp -indices "(;#.*)" $line foo indices] {
set first "$lineno.0 +[lindex $indices 0]chars"
set last "$lineno.0 lineend"
$t tag add comment $first $last
return 0
}
}
######################################################################
# apply a prefix to selected lines (or current line)
######################################################################
proc mode:tcl:prefix { prefix t } {
jedit:guarantee_selection $t
jedit:text_regsub $t \
[format {(^|%s)} "\n"] \
[format {\1%s} $prefix]
}
######################################################################
### command procedures:
######################################################################
j:command:register mode:tcl:hashes {Comment with ###}
proc mode:tcl:hashes { t args } {
jedit:guarantee_selection $t
mode:tcl:prefix "### " $t
}
j:command:register mode:tcl:hash {Comment with #}
proc mode:tcl:hash { t args } {
jedit:guarantee_selection $t
mode:tcl:prefix "# " $t
}
j:command:register mode:tcl:uncomment {Uncomment}
proc mode:tcl:uncomment { t args } {
jedit:guarantee_selection $t
jedit:text_regsub $t \
[format {(^|%s)#* } "\n"] \
{\1}
}
j:command:register mode:tcl:border {Make Border}
proc mode:tcl:border { t } {
j:text:insert_string $t \
"######################################################################\n"
}
jstools-1998.11.04/lib/jeditmodes/exmh-mode.tcl 100644 764 764 12653 6577740074 16463 0 ustar js js # exmh-mode.tcl - mode for composing mail in exmh
#
# To use this, set your editor in exmh to "jedit -mode exmh -for &"
######################################################################
::jldb::set_defaults {
{menu:mh {MH} 0}
{mode:exmh:start_reply {Start MH Reply} 6 <Meta-Key-2>}
{SHORT-mode:exmh:start_reply {Insert @}}
{mode:exmh:insert_sig {Append Signature}}
{SHORT-mode:exmh:insert_sig {Sign}}
{mode:exmh:delete_sig {Delete Signature}}
{SHORT-mode:exmh:delete_sig {Unsign}}
{mode:exmh:whom {List Recipients} 0 <Meta-Key-7>}
{SHORT-mode:exmh:whom {Whom}}
{mode:exmh:border {Insert Border} 7 <Meta-Key-8>}
{SHORT-mode:exmh:border {Border}}
{mh_pref:mh_tab_headers {Tab to Headers}}
{{Recipients} {Recipients}}
{{Help on exmh Mode} {Help on `exmh' Mode}}
}
proc mode:exmh:init { t } {
global JEDIT_MODEPREFS
j:read_prefs -array JEDIT_MODEPREFS -prefix exmh \
-directory ~/.tk/jeditmodes -file exmh-defaults {
{textfont default}
{textwidth 80}
{textheight 24}
{textwrap char}
{sabbrev 0}
{dabbrev 0}
{autobreak 1}
{autoindent 0}
{savestate 0}
{buttonbar 1}
{buttons {
jedit:cmd:done
mode:exmh:border
mode:exmh:whom
mode:exmh:insert_sig
mode:exmh:start_reply
}}
{docs {
-
{{Help on exmh Mode} {jeditmodes/exmh-mode.jdoc}}
}}
{menu,editor 1}
{menu,file 1}
{menu,edit 1}
{menu,prefs 0}
{menu,abbrev 1}
{menu,filter 1}
{menu,format 0}
{menu,font 0}
{menu,display 0}
{menu,mode1 1}
{menu,mode2 1}
{menu,user 1}
{mh_tab_headers 1}
}
# catch {$t tag configure header -background LemonChiffon}
$t tag configure header -relief flat ;# just to create it
$t tag lower header
catch {$t tag configure sig -font {-*-courier-bold-r-normal--10-100-*}}
$t tag lower sig
j:tk3 {
bind $t <Double-Tab> "mode:exmh:to_body $t"
bind $t <Tab> "mode:exmh:next_header $t"
}
j:tk4 {
bind $t <Double-Tab> "mode:exmh:to_body $t; break"
bind $t <Tab> "mode:exmh:next_header $t; break"
}
}
######################################################################
# special hooks:
proc mode:exmh:post_read_hook { filename t } {
set separator {}
if [regexp -indices "\n-*\n" [$t get 0.0 end] separator] {
set headerend [lindex $separator 0]
$t tag add header 0.0 "0.0 + $headerend chars + 1 char"
}
}
proc mode:exmh:pre_quit_hook { t } {
global JEDIT_CALLER
set filename [jedit:get_filename $t]
set draft_id [file tail $filename]
send $JEDIT_CALLER "EditDialog $draft_id"
}
proc mode:exmh:to_body { t } {
global JEDIT_MODEPREFS
if $JEDIT_MODEPREFS(exmh,mh_tab_headers) {
$t mark set insert end
$t yview -pickplace insert
} else {
jedit:tabkey $t
}
}
# BUG - doesn't handle multi-line headers.
proc mode:exmh:next_header { t } {
global JEDIT_MODEPREFS
if $JEDIT_MODEPREFS(exmh,mh_tab_headers) {
if [$t compare header.last <= insert] {
$t mark set insert 1.0
}
set headpart [$t get insert header.last]
set regex [format {(^|%s)[A-Za-z-]*:[ %s]*} "\n" "\t"]
if [regexp -indices -- $regex $headpart indices] {
$t tag remove sel 1.0 end
set valuestart [expr [lindex $indices 1] + 1]
$t mark set hdrfrom "insert + $valuestart chars"
$t tag add sel hdrfrom {hdrfrom lineend}
$t mark set insert {hdrfrom lineend}
$t yview -pickplace insert
} else {
# assume we're in the last header field, so jump to body
mode:exmh:to_body $t
}
} else {
jedit:tabkey $t
}
}
######################################################################
# define the MH menu:
######################################################################
proc mode:exmh:mkmenu1 { menu t } {
j:menu:menubutton $menu $menu.m menu:mh
j:menu:checkbuttons $menu.m [list \
[list mh_pref:mh_tab_headers JEDIT_MODEPREFS(exmh,mh_tab_headers)] \
]
j:menu:commands $menu.m $t {
-
mode:exmh:start_reply
mode:exmh:insert_sig
mode:exmh:delete_sig
mode:exmh:whom
mode:exmh:border
-
jedit:cmd:done
}
bind $t <Meta-Key-2> "mode:exmh:start_reply $t"
bind $t <Meta-Key-7> "mode:exmh:whom $t"
bind $t <Meta-Key-8> "mode:exmh:border $t"
}
######################################################################
# command procedures:
j:command:register mode:exmh:border {Insert Border}
proc mode:exmh:border { t args } {
j:text:insert_string $t \
" * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n"
}
# delete the signature if it exists (and is tagged so):
j:command:register mode:exmh:delete_sig {Remove Signature}
proc mode:exmh:delete_sig { t args } {
catch {
$t delete sig.first end
}
}
j:command:register mode:exmh:insert_sig {Append Signature}
proc mode:exmh:insert_sig { t args } {
global env
mode:exmh:delete_sig $t
set end [$t index end]
$t insert end "\n"
$t insert end [exec cat $env(HOME)/.signature]
$t insert end "\n"
$t tag add sig $end end
}
j:command:register mode:exmh:start_reply {Start MH Reply}
proc mode:exmh:start_reply { t args } {
set reply [exec cat "@" | sed {1,/^$/d} | \
sed {s/^>/ /} | sed {s/^/ /}]
$t insert end $reply
}
j:command:register mode:exmh:whom {List Recipients}
proc mode:exmh:whom { t args} {
jedit:cmd:save $t
set filename [jedit:get_filename $t]
j:more -height 10 -width 60 -title [::jldb::long_text {Recipients}] \
-text [exec whom -check $filename]
}
jstools-1998.11.04/lib/jeditmodes/richtext-mode.tcl 100644 764 764 4070 6577740164 17326 0 ustar js js # ~/.tk/edittkmodes/richtext-mode.tcl - mode for styled text
######################################################################
::jldb::set_defaults {
{{(new file)} {(new file)}}
{{Help on richtext Mode} {Help on `richtext' Mode}}
}
proc mode:richtext:init { t } {
global JEDIT_MODEPREFS
j:read_prefs -array JEDIT_MODEPREFS -prefix richtext \
-directory ~/.tk/jeditmodes -file richtext-defaults {
{textfont default}
{textwidth 80}
{textheight 24}
{textwrap word}
{sabbrev 0}
{dabbrev 0}
{autobreak 0}
{autoindent 0}
{savestate 0}
{buttonbar 1}
{buttons {
jedit:cmd:done
jedit:cmd:save
jedit:cmd:print_postscript
}}
{docs {
-
{{Help on richtext Mode} {jeditmodes/richtext-mode.jdoc}}
}}
{menu,editor 1}
{menu,file 1}
{menu,edit 1}
{menu,prefs 0}
{menu,abbrev 1}
{menu,filter 1}
{menu,format 1}
{menu,font 1}
{menu,display 1}
{menu,mode1 0}
{menu,mode2 0}
{menu,user 1}
}
}
######################################################################
# save entire contents of text widget, including tags and marks
# (overrides normal write procedure)
######################################################################
proc mode:richtext:write { filename t } {
j:tag:archive_text_widget $t $filename
}
######################################################################
# read in archive of text widget, including tags and marks
# (overrides normal read procedure)
######################################################################
proc mode:richtext:read { filename t } {
jedit:font:roman $t ;# start tagging as roman
if { ! [file exists $filename] } then {
$t delete 1.0 end
$t mark set insert 1.0
jedit:set_label $t "$filename [::jldb::long_text {(new file)}]"
} else { ;# file exists
j:tag:restore_text_widget $t $filename
global JEDIT_MODEPREFS
if { ! $JEDIT_MODEPREFS(richtext,savestate) } {
$t tag remove sel 1.0 end
$t mark set insert 1.0
$t yview 1.0
}
}
}
jstools-1998.11.04/lib/jeditmodes/jdoc-mode.tcl 100644 764 764 21753 6601606724 16431 0 ustar js js # jdoc-mode.tcl - mode for rich-text hypertext documents
######################################################################
::jldb::set_defaults {
{menu:jdoc {jdoc} 1}
{menu:sections {Sections} 0}
{mode:jdoc:show_tags {Show Tags at Insert...} 5 {} {[5]}}
{mode:jdoc:mkx_anchor {Anchor Name...} 7 {} {[6]}}
{mode:jdoc:mkx_anchor_link {Local Cross Reference...} 0 {} {[7]}}
{mode:jdoc:mkx_link {Cross Reference...} 0 {} {[8]}}
{mode:jdoc:mkx_manpage {Man Page Reference...} 0 {} {[9]}}
{mode:jdoc:hr {Horizontal Rule} 11}
{{(new file)} {(new file)}}
{{Link Name} {Link Name}}
{{Link to:} {Link to:}}
{{Anchor Name} {Anchor Name}}
{{Anchor name:} {Anchor name:}}
{{Manual page:} {Manual page:}}
{{Top} {Top}}
{{Bottom} {Bottom}}
{{Help on jdoc Mode} {Help on `jdoc' Mode}}
}
proc mode:jdoc:init { t } {
global JEDIT_MODEPREFS
j:read_prefs -array JEDIT_MODEPREFS -prefix jdoc \
-directory ~/.tk/jeditmodes -file jdoc-defaults {
{textfont default}
{textwidth 80}
{textheight 24}
{textwrap word}
{sabbrev 0}
{dabbrev 0}
{autobreak 0}
{autoindent 0}
{savestate 0}
{buttonbar 1}
{buttons {
jedit:cmd:save
jedit:cmd:done
jedit:cmd:print_postscript
}}
{docs {
-
{{Help on jdoc Mode} {jeditmodes/jdoc-mode.jdoc}}
}}
{menu,editor 1}
{menu,file 1}
{menu,edit 1}
{menu,prefs 0}
{menu,abbrev 1}
{menu,filter 1}
{menu,format 1}
{menu,font 1}
{menu,display 1}
{menu,mode1 1}
{menu,mode2 1}
{menu,user 1}
}
$t tag bind jdoc:xref:link <Control-ButtonRelease-1> \
{jdoc:x_link %W %x %y}
$t tag bind jdoc:xref:manpage <Control-ButtonRelease-1> \
{jdoc:x_manpage %W %x %y}
$t tag configure jdoc:xref:link -underline 1
$t tag configure jdoc:xref:manpage -underline 1
$t tag configure special:hr:normal -font nil2 -background black
# need to wait until normal font tags have been created for following:
after idle [list $t tag raise special:hr:normal]
# not marked in browsers, but marked here so you get visual feedback
# when you create them:
$t tag configure jdoc:anchor:anchorname -background grey75 -bgstipple gray25
$t tag lower jdoc:anchor:anchorname
# (and list tags are set after loading a file or when invoking list commands)
}
######################################################################
# save entire contents of text widget, including tags and marks
# (overrides normal write procedure)
######################################################################
proc mode:jdoc:write { filename t } {
j:tag:archive_text_widget $t $filename
}
######################################################################
# read in archive of text widget, including tags and marks
# (overrides normal read procedure)
######################################################################
proc mode:jdoc:read { filename t } {
jedit:font:roman $t ;# start tagging as roman
if { ! [file exists $filename] } then {
$t delete 1.0 end
$t mark set insert 1.0
jedit:set_label $t "$filename [::jldb::long_text {(new file)}]"
} else { ;# file exists
j:tag:restore_text_widget $t $filename
global JEDIT_MODEPREFS
if { ! $JEDIT_MODEPREFS(jdoc,savestate) } {
$t tag remove sel 1.0 end
$t mark set insert 1.0
$t yview 1.0
}
}
jedit:format:configure_all_list_tags $t
}
######################################################################
# show tags at insert point (useful for seeing anchor names, etc.)
######################################################################
### THIS SHOULD BE ADDED TO BASE JEDIT FUNCTIONALITY
j:command:register mode:jdoc:show_tags {}
proc mode:jdoc:show_tags { t } {
set tags [$t tag names insert]
j:more -title "Current Tags" -width 40 -height 10 \
-text [join [lsort $tags] "\n"]
}
######################################################################
# horizontal rule
######################################################################
j:command:register mode:jdoc:hr {}
proc mode:jdoc:hr { t } {
set start [$t index insert]
j:text:insert_string $t "\n" ;# coloured newline for rule
$t tag add special:hr:normal $start ;# list item at level 1
}
######################################################################
proc mode:jdoc:mkx_anchor { t } {
set from [$t index sel.first]
set to [$t index sel.last]
set anchor [string trim [$t get $from $to]]
regsub -all -- {[ +-]} $anchor {_} anchor
set anchor [j:prompt -title "Anchor Name" -text "Anchor name:" \
-default $anchor]
if {"x$anchor" == "x"} {
return 1
}
foreach tag [list \
jdoc:anchor:anchorname \
jdoc:anchorname:$anchor \
] {
j:tag:tag_text $t $tag $from $to
}
return 0
}
proc mode:jdoc:mkx_link { t } {
set from [$t index sel.first]
set to [$t index sel.last]
set link "[string trim [$t get $from $to]].jdoc"
regsub -all -- {[ +-]} $link {_} link
set link [j:prompt -file 1 -title "Link Name" -text "Link to:" \
-default $link -file 1]
if {"x$link" == "x"} {
return 1
}
foreach tag [list \
jdoc:xref:link \
jdoc:link:$link \
] {
j:tag:tag_text $t $tag $from $to
}
return 0
}
proc mode:jdoc:mkx_anchor_link { t } {
set from [$t index sel.first]
set to [$t index sel.last]
set link "#[string trim [$t get $from $to]]"
regsub -all -- {[ +-]} $link {_} link
set link [j:prompt -title "Link Name" -text "Link to:" \
-default $link -file 1]
if {"x$link" == "x"} {
return 1
}
foreach tag [list \
jdoc:xref:link \
jdoc:link:$link \
] {
j:tag:tag_text $t $tag $from $to
}
return 0
}
proc mode:jdoc:mkx_manpage { t } {
set from [$t index sel.first]
set to [$t index sel.last]
set manpage [string trim [$t get $from $to]]
set manpage [j:prompt -title "Link Name" -text "Manual page:" \
-default $manpage]
if {"x$manpage" == "x"} {
return 1
}
foreach tag [list \
jdoc:xref:manpage \
jdoc:manpage:$manpage \
richtext:font:typewriter \
] {
j:tag:tag_text $t $tag $from $to
}
return 0
}
######################################################################
# mode:jdoc:mksectionsmenu menu t - find all level 1 headings in text
######################################################################
proc mode:jdoc:mksectionsmenu { menu t } {
set ranges [$t tag ranges richtext:font:heading1]
set sections {}
;# step through ranges two-at-a-time (start and end)
while { [llength $ranges] > 0 } {
set start [lindex $ranges 0]
set end [lindex $ranges 1]
set ranges [lreplace $ranges 0 1] ;# with nothing, ie shift
set section_name [string trim [$t get $start $end]]
set section_name [lindex [split $section_name "\n"] 0]
lappend sections [list $section_name $start]
}
$menu delete 0 last
$menu add command -label [::jldb::long_text "Top"] -command \
"$t mark set insert 1.0; $t yview -pickplace insert"
$menu add separator
foreach pair $sections {
set section [lindex $pair 0]
set location [lindex $pair 1]
$menu add command -label $section \
-command "$t mark set insert $location; $t yview insert"
}
$menu add separator
$menu add command -label [::jldb::long_text "Bottom"] -command \
"$t mark set insert end; $t yview -pickplace insert"
}
######################################################################
proc mode:jdoc:mkmenu1 { menu t } {
j:menu:menubutton $menu $menu.m menu:jdoc
$menu.m add command \
-label [::jldb::long_text jedit:font:heading1 {Make Section Title}] \
-underline [::jldb::underline jedit:font:heading1] \
-accelerator {[1]} \
