Tk-Workspace
view release on metacpan or search on metacpan
Workspace.pm view on Meta::CPAN
Options:
-background | -bg <color> Menu and dialog background color.
-textbackground <color> Background color of text.
-foreground | -fg <color> Menu and dialog text color.
-textforeground <color> Foreground color of text.
-font | -fn <Xfontdesc> X11 font for menus and dialogs.
-importfile <filename> Read <filename> into workspace at
startup.
-exportfile <filename> Write workspace text to <filename>.
-dump Display text on console.
-class <Classname> Resource class name.
-xrm <pattern> Load X resources containing <pattern>.
-display | -screen <displayname> Name of X display.
-title <workspacename> Name of workspace.
-help Display this message.
-iconic Iconify window on startup.
-motif Use Motif look-and-feel.
-synchronous Synchronous communication with X
server. For debugging.
-write Write workspace to disk.
-quit Exit without saving workspace.
Options can begin with either one (`-'), or two (`--') dashes.
end-of-cmd-help
my @Workspaceobject =
('#!/usr/local/bin/perl',
'my $text=\'\';',
'my $geometry=\'565x351+100+100\';',
'my $wrap=\'word\';',
'my $fg=\'black\';',
'my $bg=\'white\';',
'my $name=\'\';',
'my $menuvisible=\'1\';',
'my $scrollbars=\'\';',
'my $insert=\'1.0\';',
'my $font=\'*-courier-medium-r-*-*-12-*"\';',
'use Tk;',
'use Tk::Workspace;',
'use strict;',
'use FileHandle;',
'use Env qw(HOME);',
'my $workspace = Tk::Workspace -> new ( menubarvisible => $menuvisible, ',
'scroll => $scrollbars );',
'$workspace -> name($name);',
'$workspace -> textfont($font);',
'$workspace -> text -> insert ( \'end\', $text );',
'$workspace -> text -> configure( -foreground => $fg, -background => $bg, -font => $font, -insertbackground => $fg );',
'$workspace -> text -> pack( -fill => \'both\', -expand => \'1\');',
'bless($workspace,\'Tk::Workspace\');',
'$workspace -> wrap( $wrap );',
'$workspace -> geometry( $geometry, $insert );',
'$workspace -> commandline;',
'MainLoop;' );
my $defaultbackgroundcolor="white";
my $defaultforegroundcolor="black";
my $defaulttextfont="*-courier-medium-r-*-*-12-*";
my $menufont="*-helvetica-medium-r-*-*-12-*";
my $clipboard; # Internal clipboard.
sub new {
my $proto = shift;
my $class = ref( $proto ) || $proto;
my @construct_args = @_;
my @cmd_args = &custom_args( @ARGV );
my $self = {
window => new MainWindow,
name => 'workspace',
textfont => undef,
# default is approximate width and height of 80x24 char. text widget
width => undef,
height => undef,
# x and y origin are not defined until the workspace is
# saved again.
x => undef,
y => undef,
foreground => $defaultforegroundcolor,
background => $defaultbackgroundcolor,
textfont => '*-courier-medium-r-*-*-12-*',
filemenu => undef,
editmenu => undef,
optionsmenu => undef,
wrapmenu => undef,
scrollmenu => undef,
modemenu => undef,
helpmenu => undef,
exportmenu => undef,
encodingmenu => undef,
menubar => undef,
popupmenu => undef,
menubarvisible => undef,
scroll => undef,
scrollbuttons => undef,
insertionpoint => undef,
hasnet => undef,
importfile => undef,
outputmode => undef,
outputfile => undef,
filter => undef,
text => [],
cmdargs => (),
searchopts => (), # Flattened hash returned from SearchDialog widget.
unicode => undef,
encoding => undef,
filepath => undef
};
bless($self, $class);
my $i;
for( $i = 0; $i < $#construct_args; ) {
$self -> {$construct_args[$i]} = $construct_args[$i + 1];
$i += 2;
}
push @{$self -> {cmdargs}}, @cmd_args;
if( &requirecond( "Net::FTP" ) ) { $self -> hasnet('1') }
$self -> {window} -> {parent} = $self;
$self -> filepath;
$self -> {text} =
$self -> {window} -> Scrolled( 'WorkspaceText',
-font => $defaulttextfont,
-background => $defaultbackgroundcolor,
-exportselection => 'true',
-borderwidth => 0,
Name => 'workspaceText' );
if( &requirecond("Unicode::Map") ) {
if( &requirecond("Unicode::String") ) {
$self -> {hasunicode} = '1';
}
}
if( -f $iconpath ) {
my $icon =
$self -> {text} -> toplevel -> Pixmap(-file => $iconpath);
$self -> {window} -> toplevel -> iconimage($icon);
}
&menus( $self );
&set_scroll( $self );
my $t = $self -> text;
$t -> Subwidget('yscrollbar') -> configure(-width=>10);
$t -> Subwidget('xscrollbar') -> configure(-width=>10);
$t -> setFixedTabs ( 5 );
$self -> window -> protocol( WM_TAKE_FOCUS, sub{ $self -> wmgeometry});
# Prevents errors when trying to paste from an empty clipboard.
$t -> clipboardAppend( '' );
$self -> focusFollowsMouse;
$self -> {encoding} = 'iso88591';
$t -> focus;
$t -> markGravity( 'insert', 'right' );
return $self;
}
# Standard X11 toolkit arguments:
# Refer to the Tk::CmdLine manual page.
# one parameter each
my @std_parm_args = ( '-background', '-bg,', '-class', '-display',
'-screen', '-font', '-fn', '-foreground',
'-fg', '-title', '-xrm' );
# no parameters
my @std_bool_args = ( '-iconic', '-motif', '-synchronous' );
sub custom_args {
my (@args) = @_;
my( @newargs, $i, $need_parm );
$need_parm = 0;
LOOP:
foreach $i ( @args ) {
# POSIX-ly correct.
$i =~ s/--/-/;
if ( grep /$i/, @std_parm_args ) {
die "Missing required parameter for argument $prev_arg.\n"
if $need_parm == 1;
$need_parm = 1;
$prev_arg = $i;
next LOOP;
} elsif ( grep /$i/, @std_bool_args ) {
die "Missing required parameter for argument $prev_arg.\n"
if $need_parm == 1;
$prev_arg = $i;
next LOOP;
} else {
if( $need_parm == 1 ) {
$need_parm = 0;
next LOOP;
}
push @newargs, ($i);
}
}
return @newargs;
}
# Class-specific arguments.
# Args that require a parameter.
my @parm_args = ( '-importfile', '-textforeground', '-textbackground',
'-exportfile' );
# Boolean -- No parameter.
my @bool_args = ('-help', '-write', '-quit', '-dump' );
sub commandline {
my ($self) = @_;
my ($need_parm, $i, $prev_arg, $arg, @workargs, $nargs);
$nargs = @{$self -> {cmdargs}};
for( $i = $nargs; $i >= 0; $i-- ) {
push @workargs, (${$self -> {cmdargs}}[$i]);
}
Workspace.pm view on Meta::CPAN
grep { s/bg\=\'.*\'/bg=\'$bg\'/ } @tmpobject;
grep { s/font\=\'.*\'/font=\'$f\'/ } @tmpobject;
grep { s/menuvisible\=\'.*\'/menuvisible=\'$mb\'/ } @tmpobject;
grep { s/scrollbars\=\'.*\'/scrollbars=\'$sb\'/ } @tmpobject;
grep { s/insert\=\'.*\'/insert=\'$ip\'/ } @tmpobject;
grep { s/#!\/usr\/bin\/perl// } @tmpobject;
grep { s/my \$text=\'\'\;// } @tmpobject;
foreach $line ( @tmpobject ) { print FILE $line . "\n"; };
close FILE;
{
my @remove_old = ( 'mv', $tmppath, $self -> filepath );
system( @remove_old );
}
{
# set restrictive perms, umask() seems to lock up
chmod 0700, $self -> filepath;
}
$self -> defaultcursor;
$t->{SubWidget}{workspacetext}{modified} = '';
EXIT: if ( $quit ) { $self -> window -> WmDeleteWindow; }
}
# Create a new Workspace executable if one doesn't exist.
sub create {
my ($workspacename) = ((@_)?@_:'Workspace');
my $Source;
my $directory = ''; # Where are we.
# Make sure a workspace executable of the same basename
# doesn't exist already. If it does, make the old workspace
# a backup.
if ( -e $workspacename ) {
rename $workspacename, $workspacename . '.bak';
}
#Name the workspace...
my @tmpobject = @Workspaceobject;
grep { s/name\=\'\'/name\=\'$workspacename\'/ } @tmpobject;
grep
{ s/Construct Tk::Workspace/Construct Tk::Workspace \'$workspacename\'\;/ }
@tmpobject;
open FILE, ">" . $workspacename
or die "Can't open Workspace " . $workspacename;
# This creates on the default workspace object.
foreach $line ( @tmpobject ) { print FILE $line . "\n"; }
close FILE;
# Havn't figured out a way to use the umask function w/o
# locking up... until then, set perms to rwx for owner only.
chmod 0700, $workspacename;
utime time, time, ($workspacename);
return( $workspacename );
}
sub ws_copy {
my $self = shift;
my $selection;
if ( ! (($self -> {text}) -> tagRanges('sel')) ) { return; }
# per clipboard.txt, this asserts workspace text widget's
# ownership of X display clipboard, and clears it.
($self -> {text}) -> clipboardClear;
$selection = ($self -> {text})
-> SelectionGet(-selection => 'PRIMARY',
-type => 'STRING' );
# Appends PRIMARY selection to X display clipboard.
($self -> {text}) -> clipboardAppend($selection);
$clipboard = $selection; # our clipboard, not X's.
return $selection;
}
sub ws_cut {
my $self = shift;
my $selection;
if ( ! (($self -> {text}) -> tagRanges('sel')) ) { return; }
# per clipboard.txt, this asserts workspace text widget's
# ownership of X display clipboard, and clears it.
($self -> {text}) -> clipboardClear;
$selection = ($self -> {text})
-> SelectionGet(-selection => 'PRIMARY',
-type => 'STRING' );
# Appends PRIMARY selection to X display clipboard.
($self -> {text}) -> clipboardAppend($selection);
($self ->{text}) ->
delete(($self -> {text}) -> tagRanges('sel'));
$clipboard = $selection; # our clipboard, not X's.
$self -> {text} -> {SubWidget}{workspacetext}{modified} = '1';
return $selection;
}
sub ws_paste {
my $self = shift;
my $selection;
my $point;
# Don't use CLIPBOARD because of a bug? in PerlTk...
#
# Checks PRIMARY selection, then X display clipboard,
# and returns if neither is defined.
# ($self -> {text}) ->
# selectionOwn(-selection => 'CLIPBOARD');
# if ( ! (($self -> {text}) -> tagRanges('sel'))
# or (($selection = ($self -> {text})
# -> SelectionGet(-selection => 'PRIMARY',
# -type => 'STRING')) == '') ) {
# return;
# }
# if ($self -> {text} -> tagRanges('sel')) {
# $selection = ($self -> {text})
# -> SelectionGet(-selection => 'PRIMARY',
# -type => 'STRING');
# } else {
# $selection = $clipboard;
# }
$selection = ($self -> {text}) -> clipboardGet;
$point = ($self -> {text}) -> index("insert");
($self -> {text}) -> insert( $point,
$selection);
($self -> {text}) -> see( 'insert' );
$self -> {text} -> {SubWidget}{workspacetext}{modified} = '1';
return $selection;
}
sub ws_undo {
my $self = shift;
my $undo;
$undo = ($self -> {text}) -> undo;
$self ->{text}->{SubWidget}{workspacetext}{modified} = '1';
return $self
}
sub evalselection {
my $self = shift;
my $s;
my $result;
$s = ($self -> {text})
-> SelectionGet( -selection => 'PRIMARY',
-type => 'STRING' );
$result = eval $s;
($self -> {text}) ->
insert( ( ( $self -> {text} ) ->
tagNextrange( 'sel', '1.0', 'end' ))[1], $result );
}
sub about {
my $self = shift;
my $aboutdialog;
my $title_text;
my $version_text;
my $name_text;
my $mod_time;
my $line_space; # blank label as separator.
my @filestats = { $device,
$inode,
$nlink,
$uid,
$gid,
$raw_device,
$size,
$atime,
$mtime,
$ctime,
$blksize,
$blocks };
@filestats = stat ($self -> {name});
$aboutdialog =
($self -> {window}) ->
DialogBox( -buttons => ["Ok"],
-title => 'About' );
$title_text = $aboutdialog -> add ('Label');
$version_text = $aboutdialog -> add ('Label');
$name_text = $aboutdialog -> add ('Label');
$mod_time = $aboutdialog -> add ('Label');
Workspace.pm view on Meta::CPAN
Import Text -- Insert the contents of a selected text file at the
insertion point.
Export Text -- Write the contents of the workspace to a text file.
The Import and Export Text functions allow saving to files on remote
hosts using FTP, if the Perl Net::FTP module is installed. Please
refer to the file INSTALL in the distribution archive and the
Tk::RemoteFileSelect manual page.
System Command -- Prompts for the name of a command to be executed
by the shell, /bin/sh. The output is inserted into the workspace.
For example, to insert a manual page into the workspace, enter:
man <programname> | colcrt - | col -b
Shell -- Starts an interactive shell. The prompt is the PS1 prompt of
the environment where the workspace was started. At present the
workspace shell recognizes only a subset of the bash prompt variables,
and does not implement command history or setting of environment
variables in the subshell.
Due to I/O blocking, results can be unpredictable, especially if the
called program causes an eof condition on STDERR. For details refer
to the Tk::Shell POD documentation.
Refer to the bash(1) manual page for further information.
Typing 'exit' leaves the shell and returns the workspace to normal
text editing mode.
Filter -- Specify a filter and output destination for the text in the
Workspace. A ``filter'' is defined as a program that takes its input
from standard input, STDIN, and sends its output to standard output,
STDOUT. By default, output is inserted into the Workspace at the
cursor position. Other destinations are:
- File--Write output to the file name specified.
- Terminal--Write output to the Workspace's STDOUT or to a
character device specified as the output file.
- New Workspace--Write output to a new Workspace with the
name specified.
If the Perl Net::FTP module is installed, filter output can be
sent to a remote host, using the pathname syntax,
hostname:/filepathname .
Save -- Save the workspace to disk.
Quit -- Close the workspace window, optionally saving to disk.
Workspaces are saved with file mode permissions 0700 (read, write, and
execute for the owner of the file).
=head2 Edit Menu
Undo -- Reverse the next previous change to the text.
Cut -- Delete the selected text and place it on the X clipboard.
Copy -- Copy the selected text to the X clipboard.
Paste -- Insert text from the X clipboard at the insertion point.
Evaluate Selection -- Interpret the selected text as Perl code.
Search & Replace -- Open a dialog box to enter search and/or replace
strings. Users can select options for exact upper/lower case
matching, regular expression searches, forward or backward searches,
and no query on replace. If "Replace without Asking" is selected,
then all search matches will be replaced. The default is to prompt
before the replacement. Replacements for regular expression matches
are not supported.
Goto Line -- Go to the line entered by the user.
Which Line -- Report the line and column position of the
insertion point.
=head2 Options Menu
Wrap -- Select how the text should wrap at the right margin.
Scroll Bars -- Select from scroll bars at right or left, top or bottom of
the text area.
Encoding -- Select the encoding to use when exporting text. Does not
affect the Workspace text itself. When importing, the text is mapped
into ISO-8859-1, regardless of encoding. This option is only
available if the UTF16 libraries are installed on the system. If they
aren't, then the Workspace uses the default ISO 8859-1 encoding.
Refer to the file INSTALL in the distribution archive for information
about the required libraries.
Show/Hide Menubar -- Toggle whether the menubar is visible. A popup
version of the menus is always available by pressing the right
mouse button (Button 3) over the text area.
Color Editor -- Pops up a Color Editor window. You can select the
text attribute that you want to change from the Colors -> Color
Attributes menu. If your system libraries have an rgb.txt file, a
list of the available colors is displayed on the left-hand side of the
window. Double-clicking on a color name, or selecting its color space
parameters from the sliders in the middle of the ColorEditor, displays
that color in the swatch on the right-hand side of the window.
Pressing the Apply... button at the bottom of the Color Editor applies
the color selection to the text. The most useful attributes for
Workspace text are foreground, background, and insertBackground.
Text Font -- Select text font from list of system fonts.
=head2 Help Menu
About -- Report name of workspace and modification time, and
version of Workspace.pm library.
Help -- Display the Workspace.pm POD documentation in a text window
formatted by pod2text.
=head1 KEY BINDINGS
For further information, please refer to the Tk::Text
and Tk::bind man pages.
( run in 3.028 seconds using v1.01-cache-2.11-cpan-84e82930d8c )