Browse with TCL interface (part 01/02)
Peter da Silva
peter at ficc.uu.net
Mon Mar 5 04:12:40 AEST 1990
Archive-name: browse-tcl/Part01
this is accompanied with a patch that should be applied to TCL to allow NULL
variables. Currently TCL doesn't distinguish between NULL variables and unset
ones, so if you say:
set a {}
print $a\n
You will abort because it thinks 'a' is not set. The default browse key
bindings depend on the ability to have null variables, so you need to apply
this patch to your copy of TCL. See 'tcl.pat.vars'.
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 1 (of 2)."
# Contents: MANIFEST Makefile browse.1 browse.rc message.c sample.rc
# screen.c system.h tcl.pat.vars tcl_browse.c tcl_browse.h tcl_get.c
# tcl_glue.c
# Wrapped by peter at ficc.uu.net on Sun Mar 4 12:07:08 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'MANIFEST' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'MANIFEST'\"
else
echo shar: Extracting \"'MANIFEST'\" \(886 characters\)
sed "s/^X//" >'MANIFEST' <<'END_OF_FILE'
X File Name Archive # Description
X-----------------------------------------------------------
X MANIFEST 1 This shipping list
X Makefile 1 Makefile
X browse.1 1 Documentation on browse
X browse.c 2 Main source for browse
X browse.rc 1 Default key bindings (/etc/browse.rc)
X message.c 1 Varargs printf-to-command-line
X sample.rc 1 Sample .browserc
X screen.c 1 Termcap handling functions
X system.h 1 Define host operating system
X tcl.pat.vars 1 Patch TCL for NULL vars.
X tcl_browse.c 1 TCL extensions: browse command
X tcl_browse.h 1 Common header file for TCL support code
X tcl_get.c 1 TCL extensions: set command
X tcl_glue.c 1 Glue Browse and TCL together
END_OF_FILE
if test 886 -ne `wc -c <'MANIFEST'`; then
echo shar: \"'MANIFEST'\" unpacked with wrong size!
fi
# end of 'MANIFEST'
fi
if test -f 'Makefile' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'Makefile'\"
else
echo shar: Extracting \"'Makefile'\" \(1039 characters\)
sed "s/^X//" >'Makefile' <<'END_OF_FILE'
XSHELL=/bin/sh
X
XCFILES=browse.c screen.c message.c tcl_glue.c tcl_browse.c tcl_get.c
XOFILES=$(CFILES:.c=.o)
XHFILES=system.h tcl_browse.h
XTFILES=browse.1 Makefile browse.rc sample.rc $(CFILES) $(HFILES) tcl.pat.vars
XTCLDIR=../tcl
X#
X# Standard USG flags
X#
X#USG# CFLAGS=-g -O -DUSG=1 -I$(TCLDIR)
X#USG# LFLAGS=-g -O
X#USG# LIBS= $(TCLDIR)/tcl.a -ltermlib
X#
X# Standard Xenix flags
X#
XCFLAGS=-O -Ml -DUSG=1 -I$(TCLDIR) -DVOID=int
XLFLAGS=-O -Ml -F 8000
XLIBS= $(TCLDIR)/tcl.a -ltermlib -lx
X#
X# BSD flags
X#
X#BSD# CFLAGS=-g -DBSD=1
X#BSD# LFLAGS=-g -Bstatic
X#BSD# LIBS=-ltermlib
X
Xbrowse: $(OFILES) $(TCLDIR)/tcl.a
X $(CC) $(LFLAGS) $(OFILES) -o browse $(LIBS)
X
X$(TCLDIR)/tcl.a:
X cd $(TCLDIR) ; make tcl.a
X
Xbrowse.shar: $(TFILES)
X shar $(TFILES) > browse.shar
X
Xprint: $(TFILES)
X cpr -r0 $(TFILES) | npr
X
Xtags:
X ctags $(CFILES) $(HFILES)
X
Xclean:
X rm -f $(OFILES) browse core tags
X rm -f MANIFEST~ Part??
X
Xlint:
X lint -I$(TCLDIR) $(CFILES)
X
XMANIFEST: $(TFILES)
X sh -c 'if [ -r MANIFEST ] ;\
X then makekit -m ;\
X else makekit -oMANIFEST $(TFILES) ;\
X fi'
END_OF_FILE
if test 1039 -ne `wc -c <'Makefile'`; then
echo shar: \"'Makefile'\" unpacked with wrong size!
fi
# end of 'Makefile'
fi
if test -f 'browse.1' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'browse.1'\"
else
echo shar: Extracting \"'browse.1'\" \(7866 characters\)
sed "s/^X//" >'browse.1' <<'END_OF_FILE'
X.TH BROWSE 1
X.SH NAME
Xbrowse \- Directory browser for UNIX (BROWSE 2.0)
X.SH SYNOPSIS
X.B browse
X[
X.I directory
X]
X.SH DESCRIPTION
X.PP
X.B Browse
Xis a directory browser: it puts up an 'ls -l' listing on the screen and
Xallows you to examine it and the files within it. The default key binding
Xis reminiscent of 'vi'. The core of the program is John Ousterhout's "TCL"
Xcommand language, and you need this library to build this release of
X"browse". Two families of commands have been added to the TCL core command
Xset for this release, as well as a "browse.rc" file that emulates the
Xoriginal browse.
X.PP
XThere are two sets of modes that browse may be in: narrow/wide mode and
Xpage/line mode. In narrow mode the 'ls -l' listing is suppressed, and the
Xentire names of files are displayed. In wide mode only the first 14
Xcharacters of the last component of the file name is displayed. Page mode
Xis like "visual" mode in vi: a full screen display of the directory is used.
XLine mode is like "open" mode in vi: only a single line is available. In
Xthe default bindings, line mode is entered whenever a "browse shell" command
Xis executed or when a long message forces the screen to scroll.
X.PP
XTo bind a key to a browse command, define a function with the name
X"func_'key'", where 'key' is the name of the key you want to bind.
XYou can use "get keyname \key" to find the name. For most keys the
Xname is something like 'x' or '^y' or meta_'z', but to avoid conflicts
Xwith TCL metacharacters, there are some special cases:
X.B backslash,
X.B close_brace,
X.B close_bracket,
X.B ctrl_backslash,
X.B ctrl_close_bracket,
X.B delete,
X.B dollar_sign,
X.B double_quote,
X.B escape,
X.B open_brace,
X.B open_bracket,
X.B quote,
X.B semicolon,
Xand
X.B space.
X.PP
XIf an error occurs during execution of these functions, the TCL error
Xmessage will be displayed in the status/command line.
X.PP
XWhen entering a string, a second set of bindings is used. These are
Xmade the same way, with the prefix "macro_" rather than "key_". The
Xstring returned from thses commands is included literally in the input
Xstring.
X.SH COMMANDS
X.PP
XThe commands are divided into two families: "browse" and "get". The former
Xset perform actions and (if appropriate) return a 0 or 1 for success or
Xfailure. The latter set return a value. None of these commands will "fail"
Xin the tcl sense except for syntax errors:
X.IP "\fBbrowse commands\fR"
XReturns a list of functions available through the "browse" command.
X.IP "\fBbrowse chdir\fR directory"
XChange to, and scan, a new directory.
X.IP "\fBbrowse exit\fR [code]"
XExit from "browse", returning the exit code indicated.
X.IP "\fBbrowse delete\fR file..."
XDelete a file or files, updating the display if required.
X.IP "\fBbrowse rename\fR from to"
XRename a file, updating the display if required.
X.IP "\fBbrowse move\fR line"
XChange the current entry, updating the display to keep it in the screen.
X.IP "\fBbrowse message\fR [text]..."
XPrint a message in the status line. If you are in page mode, control
Xcharacters are displayed in inverse video, and meta characters are under-
Xlines. In line mode, no such transformations are done.
X.IP "\fBbrowse print\fR [text]..."
XPrint text, subject to the same conditions. This is like "browse message",
Xexcept that the status line is not erased before the message comes out.
X.IP "\fBbrowse tag\fR action file..."
XAction is \fB+\fR, \fB-\fR, or \fB/\fR followed by \fBP\fR or \fBT\fR.
XSet (+), clear (-), or toggle (/) the Permanent or Tag bits on the file,
Xupdating the display if necessary. Permanent files remain on the display
Xwhen you change directories. Tagged file names or ids may be found with
Xthe "get files *" command.
X.IP "\fBbrowse bell\fR"
XRing the bell (or flash the display).
X.IP "\fBbrowse redraw\fR"
XRepaint the display.
X.IP "\fBbrowse rescan\fR"
XReload the current directory, attempting to maintain the same current
Xentry.
X.IP "\fBbrowse shell\fR command"
XExecute a shell command interactively, after moving the cursor to the end
Xof the page. Browser is put in line mode after this operation.
X.IP "\fBbrowse mode\fR mode"
XMode may be
X\fBline\fR,
X\fBpage\fR,
X\fBwide\fR,
Xor
X\fBnarrow\fR.
XPut browser into a given mode.
X.IP "\fBbrowse add\fR file..."
XAdd a named file to the display.
X.IP "\fBget commands\fR"
XLike "browse commands", this returns a list of the functions available
Xwith the "get" command.
X.IP "\fBget response\fR [prompt [default [term]]]"
XGet a string response from the user, optionally prompted with "prompt".
XIf necessary, a default value may be included, and an optional terminator
Xcan be used.
X.IP "\fBget key\fR [prompt]"
XGet a single key response from the user, optionally prompted with "prompt".
X.IP "\fBget keyname\fR key"
XGet the name of a key for constructing key_ and macro_ procs.
X.IP "\fBget line\fR id"
XId is \fBhome\fR, \fBlast\fR, \fBend\fR, \fB"*"\fR, or \fB"."\fR.
XGet a line number. home is the first line displayed on the screen, last
Xis the last. End is the last line in the directory (num files - 1). Asterisk is
Xa list of all tagged lines, and dot is the current line.
X.IP "\fBget file\fR id"
XId is a line number, \fB"*"\fR, or \fB"."\fR.
XGet a file name. If you provide a decimal line number it will return the
Xfile name on that line. An asterisk returns a list of all tagged
Xfiles, and dot is the current file.
X.IP "\fBget env\fR name"
XGet an environement variable.
X.IP "\fBget error\fR"
XGet the last error returned from a system call in the "browse" or "get"
Xcommands, in perror format, or an indication of the error. This is used
Xwhen a "browse" command returns 0, to see why. It was done this way to avoid
Xthe complexity of having calls to "catch" liberally sprinkled through your
Xcode... which would be the usual case in an application like this.
X.IP "\fBget mode\fR"
XGets the current valuse of the narrow/wide and line/page modes.
X.IP "\fBget cwd\fR"
XGet current working directory.
X.SH DEFAULT BINDINGS
X.IP "\fB!\fR"
XPrompt for and execute a shell command.
X.IP "\fB+\fR"
XPrompt for a file name and add it to the display.
X.IP "\fB.\fR"
XPrompt for a directory name beginning with '.' and change to that directory.
X.IP "\fB/\fR"
XPrompt for a directory name beginning with '/' and change to that directory.
X.IP "\fB:\fR"
XPrompt for and execute a TCL command.
X.IP "\fB<\fR"
XSwitch to narrow mode.
X.IP "\fB=\fR"
XPrompt for a directory name and change to it.
X.IP "\fB>\fR"
XSwitch to wide mode.
X.IP "\fBH\fR"
XMove to the top line of the screen.
X.IP "\fBJ\fR"
XMove to the top of the directory.
X.IP "\fBK\fR"
XMove to the bottom of the directory.
X.IP "\fBL\fR"
XMove to the last line on the screen.
X.IP "\fBM\fR"
XMove to the middle of the screen.
X.IP "\fBR\fR"
XPrompt for a directory and move (rename) a group of files to that directory.
X.IP "\fB^\fR"
XMove to the top of the directory.
X.IP "\fB^B\fR"
XMove up half a page.
X.IP "\fB^F\fR"
XMove down half a page.
X.IP "\fB^J\fR"
XIf in line mode, switch to page mode.
X.IP "\fB^L\fR"
XRepaint the screen.
X.IP "\fB^R\fR"
XRescan the current directory.
X.IP "\fBdd\fR"
XDelete a file or a group of tagged files, after prompting for verification.
X.IP "\fBj\fR"
XMove down 1 line.
X.IP "\fBk\fR"
XMove up 1 line.
X.IP "\fBp\fR"
XToggle the 'permanent' bit on a file.
X.IP "\fBqq\fR"
XExit from browse.
X.IP "\fBr\fR"
XRename a single file.
X.IP "\fBt\fR"
XToggle the 'tag' bit on a file.
X.IP "\fBv\fR"
XEdit te current file with 'vi'.
X.IP "\fB~\fR"
XPrompt for a directory name beginning with your home directory, then change
Xto the directory.
X.IP "\fB$\fR"
XMove to the end of the directory.
X.IP "\fBspace\fR"
XIf the current file is a directory, go to it. Otherwise, call more (or your
Xstandard pager) on the file.
X.SH SEE ALSO
XTCL(1), John Ousterhout.
X.SH BUGS
X.PP
XIf there are more than 1024 files in a directory, not all will be seen.
X.PP
XNot all commands of the original 'browse' can be implemented.
X.PP
XMore of the input processing could be performed by macros.
END_OF_FILE
if test 7866 -ne `wc -c <'browse.1'`; then
echo shar: \"'browse.1'\" unpacked with wrong size!
fi
# end of 'browse.1'
fi
if test -f 'browse.rc' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'browse.rc'\"
else
echo shar: Extracting \"'browse.rc'\" \(3334 characters\)
sed "s/^X//" >'browse.rc' <<'END_OF_FILE'
Xset more [get env PAGER]
Xif { [length $more chars] == 0 } { set more more }
X
Xproc perror {} {
X browse message [get error]
X browse bell
X}
X
Xproc target {} {
X set file [get file *]
X if {[length $file chars]==0} {set file [get file .]}
X return $file
X}
X
Xproc key_'j' {} {
X if { ![browse move +1] } { browse bell }
X}
Xproc key_'k' {} {
X if { ![browse move -1] } { browse bell }
X}
Xproc key_':' {} {
X set command [get response :]
X if { [length $command chars] > 0 } {
X if { [catch {eval $command} response] != 0 } {
X browse message Error: $response
X } else {
X if { [length $response chars] > 0 } {
X browse message Response: $response
X }
X }
X }
X}
Xproc key_'!' {} {
X global shellcmd
X set command [get response ! shellcmd]
X if { [length $command chars] > 0 } {
X browse shell $command
X set shellcmd $command
X }
X}
Xproc key_space {} {
X global more
X set file [get file .]
X if { ![browse chdir $file] } {
X set file [target]
X eval [concat browse tag - $file]
X browse message !$more $file
X browse shell [concat $more $file]
X }
X}
Xproc key_'q' {} {
X if { [string compare q [get key -q-]] == 0 } {
X browse exit
X } else {
X browse message
X }
X}
Xproc key_'^J' {} {
X if { [string match *line [get mode]] } { browse redraw }
X}
Xproc key_'d' {} {
X if { [string compare d [get key -d-]] == 0 } {
X set file [target]
X set prompt [concat Delete $file {? }]
X if { [string match {[yY]} [get key $prompt]] } {
X if { ![eval [concat browse delete $file]] } {
X perror
X }
X }
X }
X}
Xproc cdhelp {name def} {
X set dir $name[get response [concat chdir $name] $def]
X if { ![browse chdir $dir] } { perror }
X}
Xproc key_'=' {} { cdhelp {} [get file .] }
Xproc key_'.' {} { cdhelp . {} }
Xproc key_'/' {} { cdhelp / {} }
Xproc key_'~' {} { cdhelp [get env HOME] {} }
Xproc key_'t' {} { eval [concat browse tag / [get file .]] }
Xproc key_'H' {} { browse move [get line home] }
Xproc key_'L' {} { browse move [get line last] }
Xproc key_dollar_sign {} { browse move [get line end] }
Xproc key_'J' {} { browse move [get line end] }
Xproc key_'^' {} { browse move 0 }
Xproc key_'K' {} { browse move 0 }
Xproc key_'M' {} { browse move [expr ([get line home]+[get line last])/2] }
Xproc key_'<' {} { browse mode narrow }
Xproc key_'>' {} { browse mode wide }
Xproc key_'^R' {} { browse rescan }
Xproc key_'^L' {} { browse redraw }
X
Xproc key_'r' {} {
X set file [get file .]
X set prompt [concat Rename $file {to }]
X set new_file [get response $prompt $file]
X if { ![browse rename $file $new_file] } {
X perror
X }
X}
X
Xproc key_'R' {} {
X set files [get file *]
X if { [length files] == 0 } {
X key_'r'
X } else {
X set dir [get response {Move tagged files to }]
X foreach file $files {
X if { ![browse rename $file $dir/$file] } {
X perror
X return
X }
X }
X }
X}
X
Xproc key_'v' {} {
X set command [concat vi [get file .]]
X browse message !$command
X browse shell $command
X}
X
Xproc macro_'#' {} { return [get cwd] }
Xproc macro_'%' {} { return [get file .] }
Xproc macro_'~' {} { return [get env HOME] }
X
Xproc key_'^F' {} {
X browse move [expr {[get line .]+10}]
X}
X
Xproc key_'^B' {} {
X browse move [expr {[get line .]-10}]
X}
X
Xproc key_'+' {} {
X set file [get response {Add file: }]
X if { [length $file chars] > 0 } {
X if { ![browse add $file] } {
X perror
X }
X }
X}
X
Xproc key_'p' {} {
X set files [target]
X eval [concat browse tag /P [target]]
X eval [concat browse tag -T [target]]
X}
END_OF_FILE
if test 3334 -ne `wc -c <'browse.rc'`; then
echo shar: \"'browse.rc'\" unpacked with wrong size!
fi
# end of 'browse.rc'
fi
if test -f 'message.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'message.c'\"
else
echo shar: Extracting \"'message.c'\" \(1438 characters\)
sed "s/^X//" >'message.c' <<'END_OF_FILE'
X/*
X * message.c, based on the TCL panic.c
X *
X * Source code for the "panic" library procedure.
X *
X * Copyright 1988 Regents of the University of California
X * Permission to use, copy, modify, and distribute this
X * software and its documentation for any purpose and without
X * fee is hereby granted, provided that the above copyright
X * notice appear in all copies. The University of California
X * makes no representations about the suitability of this
X * software for any purpose. It is provided "as is" without
X * express or implied warranty.
X */
X
X#include <stdio.h>
X#include <stdlib.h>
X#include <varargs.h>
X
X/*
X *----------------------------------------------------------------------
X *
X * message --
X *
X * Print a message on the browse command line.
X *
X * Results:
X * None.
X *
X *----------------------------------------------------------------------
X */
X
X#ifndef lint
Xvoid
Xmessage(va_alist)
X va_dcl /* char *format, then any number of additional
X * values to be printed under the control of
X * format. This is all just the same as you'd
X * pass to printf. */
X{
X char *format;
X va_list args;
X extern int display_up;
X
X cmdline();
X va_start(args);
X format = va_arg(args, char *);
X (void) vfprintf(stdout, format, args);
X if(!display_up) putchar('\n');
X (void) fflush(stdout);
X}
X#else
X/* VARARGS1 */
X/* ARGSUSED */
Xvoid
Xmessage(format)
X char *format;
X{
X return;
X}
X#endif /* lint */
X
END_OF_FILE
if test 1438 -ne `wc -c <'message.c'`; then
echo shar: \"'message.c'\" unpacked with wrong size!
fi
# end of 'message.c'
fi
if test -f 'sample.rc' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'sample.rc'\"
else
echo shar: Extracting \"'sample.rc'\" \(1147 characters\)
sed "s/^X//" >'sample.rc' <<'END_OF_FILE'
Xproc key_'^K' {} {
X browse message {Edit key }
X set key [get key]
X set func key_[get keyname $key]
X set file [get env HOME]/.function
X if { [length [info procs $func] ] != 0 } {
X set def [list proc $func {} [info body $func]]
X } else {
X set def [list proc $func {} { ... }]
X }
X print $def\n $file
X browse message !vi $file
X browse shell [concat vi $file]
X source $file
X}
X
Xproc save {file args} {
X if { [length $args chars] == 0 } {
X print "# *** all procs ***" $file
X print \n $file append
X set args [info procs]
X } else {
X print [concat {#} $args] $file
X print \n $file append
X }
X foreach proc $args {
X set def [list proc $proc [info args $proc] [info body $proc]]
X print \n$def\n $file append
X }
X}
X
Xset helpfile [get env HOME]browse.help
X
Xproc key_'?' {} {
X global helpfile more
X set key [get keyname [get key {Help on what key (? for all)? }]]
X if { [string compare '?' $key] == 0 } {
X browse message !$more $helpfile
X browse shell [concat $more $helpfile]
X } else {
X set line [exec grep ^$key $helpfile]
X if { [length $line chars] > 0 } {
X browse message $line
X } else {
X browse message {No help available on} $key
X }
X }
X}
X
END_OF_FILE
if test 1147 -ne `wc -c <'sample.rc'`; then
echo shar: \"'sample.rc'\" unpacked with wrong size!
fi
# end of 'sample.rc'
fi
if test -f 'screen.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'screen.c'\"
else
echo shar: Extracting \"'screen.c'\" \(5617 characters\)
sed "s/^X//" >'screen.c' <<'END_OF_FILE'
X#include <stdio.h>
X
X#include "system.h"
X
X#ifdef USG
X# ifdef M_XENIX
X# include <sys/types.h>
X# include <sys/ioctl.h>
X# endif
X# include <termio.h>
Xstruct termio rawbuf;
Xstruct termio cookedbuf;
X#else
X# include <sgtty.h> /* terminal modes for tinit(), tend() */
Xstruct sgttyb sgbuf; /* buffer for terminal mode info */
Xint rawflags, cookflags; /* flags for raw & cooked tty mode */
X#endif
X#include <signal.h>
X
X#define TERMBUF 1024 /* Size of term buf for termcap */
X
Xextern int nlines;
X
Xextern char *tgetstr(), *tgoto();
Xextern int display_up;
Xextern int intrup; /* Have we been interrupted? */
X
Xchar *tent; /* Pointer to tbuf */
Xchar PC; /* Pad character */
Xchar *UP, *BC; /* Upline, backsapce character */
Xshort ospeed; /* Terminal output speed */
Xchar termbuf[TERMBUF]; /* Place to put term info */
X
Xchar *cm, /* Cursor motion */
X *cs, /* Change scrolling region */
X *sf, /* - scroll forward */
X *sr, /* - scroll backwards */
X *ce, /* Clear to end of line */
X *cl, /* Clear screen */
X *al, /* Insert line */
X *dl, /* delete ditto */
X *so, /* standout */
X *se, /* standout end */
X *us, /* underline */
X *ue, /* underline end */
X *ti, /* Init terminal */
X *te; /* Reset terminal */
Xint li, /* lines on screen */
X co; /* columns ditto */
Xchar xn; /* Magic cookie kludge */
X
X/* Screen manipulation primitives: dumb set for smart terminals */
Xat(x, y)
Xint x, y;
X{
X outs(tgoto(cm, x, y));
X}
X
Xnl()
X{
X outs(ce);
X outc('\n');
X}
X
X/* Scroll lines in window (from:to) n lines */
Xscroll(from, to, n)
Xint from, to, n;
X{
X if(cs && sf && sr) {
X outs(tgoto(cs, from, to-1));
X if(n<0) {
X at(0, from);
X while(n++)
X outs(sr);
X }
X else {
X at(0, to-1);
X while(n--)
X outs(sf);
X }
X outs(tgoto(cs, 0, li-1));
X }
X else if(al && dl) {
X if(n<0) {
X int i=n;
X outs(tgoto(cm, 0, to+n));
X while(i++)
X outs(dl);
X outs(tgoto(cm, 0, from));
X while(n++)
X outs(al);
X }
X else {
X int i=n;
X outs(tgoto(cm, 0, from));
X while(i--)
X outs(dl);
X outs(tgoto(cm, 0, to-n));
X while(n--)
X outs(al);
X }
X }
X}
X
Xtinit(name)
Xchar *name;
X{
X char *termptr;
X char tbuf[TERMBUF], *tmp;
X SIGNAL intr();
X SIGNAL term();
X#ifdef BSD
X SIGNAL stop();
X#endif
X
X termptr = termbuf;
X
X tgetent(tbuf, name);
X
X tmp = tgetstr("pc", &termptr);
X if(tmp) PC = *tmp;
X UP = tgetstr("up", &termptr);
X BC = tgetstr("bc", &termptr);
X cm = tgetstr("cm", &termptr);
X cs = tgetstr("cs", &termptr);
X sf = tgetstr("sf", &termptr);
X sr = tgetstr("sr", &termptr);
X ce = tgetstr("ce", &termptr);
X cl = tgetstr("cl", &termptr);
X al = tgetstr("al", &termptr);
X dl = tgetstr("dl", &termptr);
X us = tgetstr("us", &termptr);
X ue = tgetstr("ue", &termptr);
X so = tgetstr("so", &termptr);
X se = tgetstr("se", &termptr);
X ti = tgetstr("ti", &termptr);
X te = tgetstr("te", &termptr);
X li = tgetnum("li");
X co = tgetnum("co");
X xn = tgetflag("xn");
X
X nlines=li-3;
X
X#ifdef USG
X ioctl(1, TCGETA, &rawbuf);
X cookedbuf = rawbuf;
X rawbuf.c_lflag &= ~(ICANON|ECHO|ECHOE|ECHOK|ECHONL);
X rawbuf.c_cc[VMIN] = 1;
X rawbuf.c_cc[VTIME] = 0;
X#else
X gtty(1, &sgbuf);
X ospeed=sgbuf.sg_ospeed;
X quickmode=ospeed<10;
X cookflags=sgbuf.sg_flags;
X sgbuf.sg_flags = (sgbuf.sg_flags&~ECHO)|CBREAK;
X rawflags=sgbuf.sg_flags;
X#endif
X signal(SIGINT, intr);
X signal(SIGTERM, term);
X#ifdef BSD
X signal(SIGTSTP, stop);
X#endif
X rawtty();
X}
X
Xint tmode=0;
X
Xentty()
X{
X if(!tmode)
X outs(ti);
X tmode=1;
X}
X
Xextty()
X{
X if(tmode)
X outs(te);
X tmode=0;
X}
X
Xrawtty()
X{
X#ifdef USG
X ioctl(1, TCSETA, &rawbuf);
X#else
X sgbuf.sg_flags=rawflags;
X stty(1, &sgbuf);
X#endif
X entty();
X}
X
Xcooktty()
X{
X#ifdef USG
X ioctl(1, TCSETA, &cookedbuf);
X#else
X sgbuf.sg_flags=cookflags;
X stty(1, &sgbuf);
X#endif
X extty();
X}
X
XSIGNAL intr()
X{
X signal(SIGINT, intr);
X intrup=1;
X}
X
XSIGNAL term()
X{
X tend();
X tcl_end();
X exit(0);
X}
X
X#ifdef BSD
XSIGNAL stop()
X{
X signal(SIGTSTP, stop);
X intrup=1;
X tend();
X kill(getpid(), SIGSTOP);
X rawtty();
X display_up=0;
X}
X#endif
X
Xtend()
X{
X end_screenmode();
X cooktty();
X fflush(stdout);
X}
X
Xouts(s)
Xchar *s;
X{
X int outc();
X
X if(s)
X tputs(s, 0, outc);
X}
X
Xoutc(c)
Xchar c;
X{
X putchar(c);
X}
X
Xint somode = 0;
Xint ulmode = 0;
X
Xstandout()
X{
X if(!somode) {
X outs(so);
X somode = 1;
X if(xn) return 1;
X }
X return 0;
X}
X
Xunderline()
X{
X if(!ulmode) {
X outs(us);
X ulmode = 1;
X if(xn) return 1;
X }
X return 0;
X}
X
Xstandend()
X{
X int cnt = 0;
X
X if(somode) {
X outs(se);
X somode = 0;
X if(xn) cnt++;
X }
X if(ulmode) {
X outs(ue);
X ulmode = 0;
X if(xn) cnt++;
X }
X return cnt;
X}
X
Xcmdline()
X{
X at(0, li-1);
X outs(ce);
X}
X
Xend_screenmode()
X{
X if(display_up) {
X at(0, li-1);
X outc('\n');
X display_up = 0;
X }
X}
X
Xend_linemode()
X{
X if(!display_up) {
X redraw();
X display_up = 1;
X }
X}
X
Xclear_screen()
X{
X outs(cl);
X}
X
END_OF_FILE
if test 5617 -ne `wc -c <'screen.c'`; then
echo shar: \"'screen.c'\" unpacked with wrong size!
fi
# end of 'screen.c'
fi
if test -f 'system.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'system.h'\"
else
echo shar: Extracting \"'system.h'\" \(526 characters\)
sed "s/^X//" >'system.h' <<'END_OF_FILE'
X/* system type */
X
X#ifndef BSD
X# if defined(sun) || defined(sun3)
X# define BSD 1
X# endif
X#endif
X
X#ifndef USG
X# ifdef L_ctermid
X# define USG 1
X# endif
X# ifdef M_XENIX
X# define USG 1
X# endif
X#endif
X
X#ifdef BSD
X# undef USG
X#endif
X
X#ifdef USG
X# define rindex strrchr
X# ifdef M_XENIX
X# define GETCWD
X# define SIGNAL int
X# else
X# define minor(i) ((i)&0xFF)
X# define major(i) minor((i)>>8)
X# define SIGNAL void
X# endif
X#else
X# ifdef BSD
X# define SIGNAL void
X# else
X# define SIGNAL int
X# include <whoami.h>
X# endif
X#endif
X
END_OF_FILE
if test 526 -ne `wc -c <'system.h'`; then
echo shar: \"'system.h'\" unpacked with wrong size!
fi
# end of 'system.h'
fi
if test -f 'tcl.pat.vars' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl.pat.vars'\"
else
echo shar: Extracting \"'tcl.pat.vars'\" \(4733 characters\)
sed "s/^X//" >'tcl.pat.vars' <<'END_OF_FILE'
XFrom ficc%sugar!texbell!allspice.Berkeley.EDU!ouster Sat Mar 3 18:12:05 1990
XReceived: by sugar.hackercorp.com (smail2.5)
X id AA26093; 3 Mar 90 17:54:45 CST (Sat)
XReceived: by sugar.hackercorp.com (smail2.5)
X id AA19332; 3 Mar 90 01:11:29 CST (Sat)
XReceived: by texbell (/\=-/\ Smail3.1.16.1 #16.6)
X id <m0h4R8G-0000uOC at texbell>; Fri, 2 Mar 90 22:54 CST
XPosted-Date: Fri, 2 Mar 90 08:43:20 PST
XReceived: from tyranny.Berkeley.EDU by cs.utexas.edu (5.59/1.50)
X id AA10952; Fri, 2 Mar 90 10:45:46 CST
XReceived: by sprite.Berkeley.EDU (5.59/1.29)
X id AA412483; Fri, 2 Mar 90 08:43:20 PST
XDate: Fri, 2 Mar 90 08:43:20 PST
XFrom: ouster at allspice.Berkeley.EDU (John Ousterhout)
XMessage-Id: <9003021643.AA412483 at sprite.Berkeley.EDU>
XTo: ficc!peter at uunet.uu.net
XSubject: Re: Variables fix
XCc: peter at sugar.lonestar.org
XStatus: O
X
XI hope to have the non-existent-variable patches complete in the
Xnext week or two. In case that's not soon enough for you, I'm
Xreturning a copy of your patches at the end of this message.
X>From ficc!peter at uunet.UU.NET Thu Feb 22 21:14:42 1990
XFrom: ficc!peter at uunet.UU.NET
XTo: ouster at sprite.Berkeley.EDU
XSubject: Patches for empty variables.
XCc: karl at uunet.UU.NET
XDate: Wed Feb 21 16:29:46 1990
X
XThe following patches let you differentiate between empty variables
Xand non-existant ones.
X
X*** old/tclBasic.c
X--- tcl/tclBasic.c
X***************
X*** 686,692 ****
X */
X
X value = Tcl_ParseVar(interp, src, &tmp);
X! if (*value == 0) {
X result = TCL_ERROR;
X goto done;
X }
X--- 686,692 ----
X */
X
X value = Tcl_ParseVar(interp, src, &tmp);
X! if (value == 0) {
X result = TCL_ERROR;
X goto done;
X }
X***************
X*** 1211,1216 ****
X--- 1211,1217 ----
X char *buffer, *oldVar;
X
X oldVar = Tcl_GetVar(interp, "errorInfo", 1);
X+ if(!oldVar) oldVar = "";
X length = strlen(oldVar);
X buffer = (char *)ckalloc((unsigned) (length + strlen(message) + 1));
X strcpy(buffer, oldVar);
X*** old/tclExpr.c
X--- tcl/tclExpr.c
X***************
X*** 250,256 ****
X case '$':
X infoPtr->token = NUMBER;
X var = Tcl_ParseVar(infoPtr->interp, p, &infoPtr->expr);
X! if (*var == '\0') {
X return TCL_ERROR;
X }
X if (((Interp *) infoPtr->interp)->noEval) {
X--- 250,256 ----
X case '$':
X infoPtr->token = NUMBER;
X var = Tcl_ParseVar(infoPtr->interp, p, &infoPtr->expr);
X! if (var == 0) {
X return TCL_ERROR;
X }
X if (((Interp *) infoPtr->interp)->noEval) {
X*** old/tclProc.c
X--- tcl/tclProc.c
X***************
X*** 158,164 ****
X * Results:
X * The return value points to the current value of varName. If
X * the variable is not defined in interp, either as a local or
X! * global variable, then a pointer to an empty string is returned.
X * Note: the return value is only valid up until the next call to
X * Tcl_SetVar; if you depend on the value lasting longer than that,
X * then make yourself a private copy.
X--- 158,165 ----
X * Results:
X * The return value points to the current value of varName. If
X * the variable is not defined in interp, either as a local or
X! * global variable, then a NULL pointer is returned.
X! *
X * Note: the return value is only valid up until the next call to
X * Tcl_SetVar; if you depend on the value lasting longer than that,
X * then make yourself a private copy.
X***************
X*** 185,191 ****
X varPtr = FindVar(&iPtr->varFramePtr->varPtr, varName);
X }
X if (varPtr == NULL) {
X! return "";
X }
X if (varPtr->flags & VAR_GLOBAL) {
X varPtr = varPtr->globalPtr;
X--- 186,192 ----
X varPtr = FindVar(&iPtr->varFramePtr->varPtr, varName);
X }
X if (varPtr == NULL) {
X! return NULL;
X }
X if (varPtr->flags & VAR_GLOBAL) {
X varPtr = varPtr->globalPtr;
X***************
X*** 323,329 ****
X c = *string;
X *string = 0;
X result = Tcl_GetVar(interp, name, 0);
X! if (*result == '\0') {
X Tcl_Return(interp, (char *) NULL, TCL_STATIC);
X sprintf(interp->result, "couldn't find variable \"%.50s\"", name);
X }
X--- 324,330 ----
X c = *string;
X *string = 0;
X result = Tcl_GetVar(interp, name, 0);
X! if (!result) {
X Tcl_Return(interp, (char *) NULL, TCL_STATIC);
X sprintf(interp->result, "couldn't find variable \"%.50s\"", name);
X }
X***************
X*** 360,366 ****
X char *value;
X
X value = Tcl_GetVar(interp, argv[1], 0);
X! if (*value == 0) {
X sprintf(interp->result, "couldn't find variable \"%.50s\"",
X argv[1]);
X return TCL_ERROR;
X--- 361,367 ----
X char *value;
X
X value = Tcl_GetVar(interp, argv[1], 0);
X! if (value == 0) {
X sprintf(interp->result, "couldn't find variable \"%.50s\"",
X argv[1]);
X return TCL_ERROR;
X
X
END_OF_FILE
if test 4733 -ne `wc -c <'tcl.pat.vars'`; then
echo shar: \"'tcl.pat.vars'\" unpacked with wrong size!
fi
# end of 'tcl.pat.vars'
fi
if test -f 'tcl_browse.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl_browse.c'\"
else
echo shar: Extracting \"'tcl_browse.c'\" \(5712 characters\)
sed "s/^X//" >'tcl_browse.c' <<'END_OF_FILE'
X/* Subcommands for tcl "browse" command */
X#include <stdio.h>
X#include <tcl.h>
X#include "tcl_browse.h"
X
Xint browseRescan();
Xint browseRedraw();
Xint browseCmds();
Xint browseChdir();
Xint browseQuit();
Xint browseDelete();
Xint browseRename();
Xint browseMessage();
Xint browsePrint();
Xint browseMove();
Xint browseBell();
Xint browseShell();
Xint browseTag();
Xint browseAdd();
Xint browseMode();
X
Xstruct subcmd browsecmds[] = {
X { browseCmds, "commands", 0, 0, "" },
X { browseChdir, "chdir", 1, 1, "directory" },
X { browseQuit, "exit", 0, 1, "[code]" },
X { browseDelete, "delete", 1, -1, "file..." },
X { browseRename, "rename", 2, 2, "from to" },
X { browseMove, "move", 1, 1, "entry" },
X { browseMessage, "message", 0, -1, "[text]..." },
X { browsePrint, "print", 0, -1, "[text]..." },
X { browseTag, "tag", 2, -1, "{+,-,/}[PT] file..." },
X { browseBell, "bell", 0, 0, "" },
X { browseRedraw, "redraw", 0, 0, "" },
X { browseRescan, "rescan", 0, 0, "" },
X { browseShell, "shell", 1, 1, "command" },
X { browseMode, "mode", 1, 1, "[line|page|wide|narrow]" },
X { browseAdd, "add", 1, -1, "file..." },
X};
Xint browsecnt = sizeof browsecmds / sizeof *browsecmds;
X
Xint
XcmdBrowse(clientData, interp, argc, argv)
XClientData clientData;
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X return Handle(browsecnt, browsecmds, interp, argc, argv);
X}
X
XbrowseDelete(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X int i;
X int result;
X char *file_name();
X
X while(*argv) {
X i = get_index(*argv);
X result = 0;
X
X if(i==-1) {
X if(unlink(*argv) == 0)
X result = 1;
X else
X save_errno(*argv);
X } else {
X if(unlink(file_name(i)) == 0) {
X result = 1;
X delete_entry(i);
X }
X else
X save_errno(*argv);
X }
X if(result==0)
X break;
X ++argv;
X }
X sprintf(interp->result, "%d", result);
X return TCL_OK;
X}
X
XbrowseRename(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X int i;
X int result;
X
X i = get_index(*argv);
X result = 0;
X
X if(i == -1) {
X if(link(argv[0], argv[1]) == 0) {
X if(unlink(argv[0]) == 0)
X result = 1;
X else
X save_errno(*argv);
X }
X else
X save_errno(*argv);
X } else {
X if(domove(i, argv[1]))
X result = 1;
X }
X sprintf(interp->result, "%d", result);
X return TCL_OK;
X}
X
XbrowseChdir(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X strcpy(interp->result, enter(*argv)?"1":"0");
X return TCL_OK;
X}
X
XbrowseQuit(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X int i;
X
X if(argc)
X i = atoi(*argv);
X else
X i = 0;
X
X tcl_end();
X tend();
X
X exit(i);
X}
X
XbrowseMessage(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X int result;
X extern int display_up;
X
X cmdline();
X result = browsePrint(interp, argc, argv);
X if(atoi(interp->result) >= 80)
X end_screenmode();
X else
X if(!display_up) putchar('\n');
X return result;
X}
X
XbrowseCmds(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X return Format(browsecnt, browsecmds, interp);
X}
X
XbrowsePrint(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X extern int display_up;
X int count = 0;
X
X while(*argv) {
X count += strlen(*argv)+1;
X if(display_up)
X ctlouts(*argv);
X else
X outs(*argv);
X ++argv;
X if(*argv)
X putchar(' ');
X }
X
X sprintf(interp->result, "%d", count);
X
X return TCL_OK;
X}
X
XbrowseMove(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X extern int curr, nentries;
X int new;
X
X switch(**argv) {
X case '*': new = nentries-1; break;
X case '-': new = curr - atoi(*argv+1); break;
X case '+': new = curr + atoi(*argv+1); break;
X default: new = atoi(*argv); break;
X }
X if(new >= 0 && new < nentries) {
X curr = new;
X strcpy(interp->result, "1");
X } else {
X save_errmsg("entry out of range");
X strcpy(interp->result, "0");
X }
X return TCL_OK;
X}
X
XbrowseBell(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X putchar(7);
X return TCL_OK;
X}
X
XbrowseShell(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X sprintf(interp->result, "%d", system(*argv, 1));
X return TCL_OK;
X}
X
XbrowseRedraw(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X redraw();
X return TCL_OK;
X}
X
XbrowseRescan(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X sprintf(interp->result, "%d", newdir());
X return TCL_OK;
X}
X
XbrowseTag(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X int i;
X int result;
X int mode;
X int tagbit;
X
X switch(**argv) {
X case '+': mode = 1; break;
X case '-': mode = -1; break;
X case '/': mode = 0; break;
X default: goto tcl_error;
X }
X
X ++*argv;
X
X switch(**argv) {
X case 'p': case 'P': tagbit = 'P'; break;
X case 't': case 'T': tagbit = 'T'; break;
X case 0: tagbit = 'T'; break; /* default */
X default: goto tcl_error;
X }
X
X result = 1;
X while(*++argv) {
X i = get_index(*argv);
X if(i == -1) {
X result = 0;
X break;
X }
X tag(i, mode, tagbit);
X }
X sprintf(interp->result, "%d", result);
X return TCL_OK;
X
Xtcl_error:
X Tcl_Return(interp,
X "invalid tag option: should be \"tag {+,-,/}[PT] file...\"",
X TCL_STATIC);
X return TCL_ERROR;
X}
X
XbrowseMode(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X if(strcmp(*argv, "line") == 0) {
X end_screenmode();
X } else if(strcmp(*argv, "page") == 0) {
X end_linemode();
X } else if(strcmp(*argv, "narrow") == 0) {
X set_quickmode(1);
X } else if(strcmp(*argv, "wide") == 0) {
X set_quickmode(0);
X } else {
X Tcl_Return(interp,
X "invalid mode name: should be \"mode [page|line|wide|narrow]\"",
X TCL_STATIC);
X return TCL_ERROR;
X }
X return TCL_OK;
X}
X
XbrowseAdd(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X int result;
X
X result = 1;
X while(*argv) {
X if(!addfile(*argv)) {
X result = 0;
X break;
X }
X argv++;
X }
X sprintf(interp->result, "%d", result);
X return TCL_OK;
X}
END_OF_FILE
if test 5712 -ne `wc -c <'tcl_browse.c'`; then
echo shar: \"'tcl_browse.c'\" unpacked with wrong size!
fi
# end of 'tcl_browse.c'
fi
if test -f 'tcl_browse.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl_browse.h'\"
else
echo shar: Extracting \"'tcl_browse.h'\" \(139 characters\)
sed "s/^X//" >'tcl_browse.h' <<'END_OF_FILE'
X/* Browser-defined stuff */
X
Xextern Tcl_Interp *interp;
X
Xstruct subcmd {
X int (*func)();
X char *name;
X int min;
X int max;
X char *args;
X};
X
END_OF_FILE
if test 139 -ne `wc -c <'tcl_browse.h'`; then
echo shar: \"'tcl_browse.h'\" unpacked with wrong size!
fi
# end of 'tcl_browse.h'
fi
if test -f 'tcl_get.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl_get.c'\"
else
echo shar: Extracting \"'tcl_get.c'\" \(5209 characters\)
sed "s/^X//" >'tcl_get.c' <<'END_OF_FILE'
X/* Subcommands for tcl "get" command */
X#include <stdio.h>
X#include <ctype.h>
X#include <tcl.h>
X#include "tcl_browse.h"
X
Xint getCmds();
Xint getResponse();
Xint getKey();
Xint getKeyname();
Xint getLine();
Xint getEnv();
Xint getFile();
Xint getError();
Xint getMode();
Xint getCwd();
X
Xstruct subcmd getcmds[] = {
X { getCmds, "commands", 0, 0, "" },
X { getResponse, "response", 0, 3, "[prompt [default [term]]]" },
X { getKey, "key", 0, 1, "[prompt]" },
X { getKeyname, "keyname", 1, 1, "key" },
X { getLine, "line", 1, 1, "{home,last,end,*,.}" },
X { getFile, "file", 1, 1, "{file,*,.}" },
X { getEnv, "env", 1, 1, "name" },
X { getError, "error", 0, 0, "" },
X { getMode, "mode", 0, 0, "" },
X { getCwd, "cwd", 0, 0, "" },
X};
Xint getcnt = sizeof getcmds / sizeof *getcmds;
X
Xint
XcmdGet(clientData, interp, argc, argv)
XClientData clientData;
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X return Handle(getcnt, getcmds, interp, argc, argv);
X}
X
XgetCmds(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X return Format(getcnt, getcmds, interp);
X}
X
Xchar *StrToList(s)
Xchar *s;
X{
X char *argv[2];
X argv[0] = s;
X argv[1] = 0;
X return Tcl_Merge(1, argv);
X}
X
XgetEnv(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X char *getenv();
X char *s = getenv(*argv);
X if(!s)
X Tcl_Return(interp, NULL, TCL_STATIC);
X else
X Tcl_Return(interp, s, TCL_STATIC);
X return TCL_OK;
X}
X
XgetKeyname(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X char *name_of();
X strcpy(interp->result, name_of(**argv));
X return TCL_OK;
X}
X
XgetCwd(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X extern char *dot;
X strcpy(interp->result, dot);
X return TCL_OK;
X}
X
Xextern int getFile(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X extern char *file_name();
X extern int curr;
X
X if(strcmp(*argv, ".") == 0) {
X Tcl_Return(interp, StrToList(file_name(curr)), TCL_DYNAMIC);
X } else if(strcmp(*argv, "*") == 0) {
X extern int nentries;
X char **argv = (char **)ckalloc(sizeof (char *) * nentries);
X int argc = 0;
X int i;
X
X for(i = 0; i < nentries; i++) {
X if(tagged(i))
X argv[argc++] = file_name(i);
X }
X argv[argc] = 0;
X if(argv)
X Tcl_Return(interp, Tcl_Merge(argc, argv), TCL_DYNAMIC);
X else
X Tcl_Return(interp, NULL, TCL_STATIC);
X ckfree(argv);
X } else if(isdigit(**argv)) {
X Tcl_Return(interp,
X StrToList(file_name(atoi(*argv))),
X TCL_DYNAMIC);
X } else {
X sprintf(interp->result, "bad line number: should be \"get file {line,*,.}\"");
X return TCL_ERROR;
X }
X return TCL_OK;
X}
X
XgetResponse(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X char buffer[256];
X char *def = "";
X char term = 0;
X extern int display_up;
X
X if(argc >= 1 && argv[0][0]) {
X cmdline();
X outs(argv[0]);
X } if(argc >= 2)
X def = argv[1];
X if(argc >= 3)
X term = argv[2][0];
X if(inps(buffer, def, term) == '\033') {
X Tcl_Return(interp, "Command Killed", TCL_STATIC);
X return TCL_ERROR;
X } else {
X Tcl_Return(interp, buffer, TCL_VOLATILE);
X if(display_up == 0)
X outc('\n');
X return TCL_OK;
X }
X}
X
XgetLine(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X int line;
X
X extern int curr;
X extern int top;
X extern int nlines;
X extern int nentries;
X
X if(strcmp(*argv, "home") == 0) line = top;
X else if(strcmp(*argv, "last") == 0) line = top+nlines-1;
X else if(strcmp(*argv, "end") == 0) line = nentries-1;
X else if(strcmp(*argv, ".") == 0) line = curr;
X else if(strcmp(*argv, "*") == 0) {
X extern int nentries;
X char *string = (char *)ckalloc(8 * nentries);
X char *p = string;
X int i;
X
X for(i = 0; i < nentries; i++) {
X if(tagged(i)) {
X sprintf(p, "%d ", i);
X p += strlen(p) - 1;
X }
X }
X if(p > string) {
X *--p = 0;
X Tcl_Return(interp, string, TCL_DYNAMIC);
X } else {
X ckfree(string);
X Tcl_Return(interp, NULL, TCL_STATIC);
X }
X } else {
X sprintf(interp->result,
X "invalid line type: should be \"get line {home,last,end,*,.}\"");
X return TCL_ERROR;
X }
X
X sprintf(interp->result, "%d", line);
X return TCL_OK;
X}
X
XgetKey(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X extern int display_up;
X
X if(*argv) {
X cmdline();
X outs(*argv);
X }
X interp->result[0] = getch();
X interp->result[1] = 0;
X if(*argv && !display_up)
X outc('\n');
X return TCL_OK;
X}
X
Xstatic char *last_errmsg = "No Error";
Xstatic char *last_errfile = NULL;
Xstatic char filename[BUFSIZ];
X
Xsave_errmsg(s)
Xchar *s;
X{
X last_errfile = 0;
X last_errmsg = s;
X}
X
Xsave_errno(file)
Xchar *file;
X{
X extern char *strerror();
X extern int errno;
X last_errmsg = strerror(errno);
X last_errfile = filename;
X strncpy(filename, file, BUFSIZ);
X}
X
XgetError(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X static char buffer[BUFSIZ];
X
X if(last_errfile)
X sprintf(buffer, "%s: %s", last_errfile, last_errmsg);
X else
X strcpy(buffer, last_errmsg);
X Tcl_Return(interp, buffer, TCL_VOLATILE);
X return TCL_OK;
X}
X
XgetMode(interp, argc, argv)
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X extern int display_up;
X extern int quickmode;
X char buffer[32];
X
X if(quickmode)
X strcpy(buffer, "narrow");
X else
X strcpy(buffer, "wide");
X if(display_up)
X strcat(buffer, " page");
X else
X strcat(buffer, " line");
X Tcl_Return(interp, buffer, TCL_VOLATILE);
X return TCL_OK;
X}
X
END_OF_FILE
if test 5209 -ne `wc -c <'tcl_get.c'`; then
echo shar: \"'tcl_get.c'\" unpacked with wrong size!
fi
# end of 'tcl_get.c'
fi
if test -f 'tcl_glue.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tcl_glue.c'\"
else
echo shar: Extracting \"'tcl_glue.c'\" \(2533 characters\)
sed "s/^X//" >'tcl_glue.c' <<'END_OF_FILE'
X/* TCL stuff for Browse */
X#include <stdio.h>
X#include <setjmp.h>
X#include <tcl.h>
X#include "tcl_browse.h"
X
XTcl_Interp *interp = NULL;
X
Xextern int cmdBrowse();
Xextern int cmdGet();
X
XFormat(cmdc, cmdv, interp)
Xint cmdc;
Xstruct subcmd *cmdv;
XTcl_Interp *interp;
X{
X char buffer[256];
X
X strcpy(buffer, cmdv->name);
X while(--cmdc) {
X ++cmdv;
X strcat(buffer, " ");
X strcat(buffer, cmdv->name);
X }
X Tcl_Return(interp, buffer, TCL_VOLATILE);
X return TCL_OK;
X}
X
XHandle(cmdc, cmdv, interp, argc, argv)
Xint cmdc;
Xstruct subcmd *cmdv;
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X char *err;
X char *name;
X char *args;
X
X err = "wrong # args";
X name = "subcommand";
X args = "args";
X
X if(argc < 2)
X goto error;
X
X while(cmdc > 0) {
X if(strcmp(argv[1], cmdv->name) == 0) {
X int result;
X extern int intrup;
X
X name = cmdv->name;
X args = cmdv->args;
X if(argc < cmdv->min+2
X || (cmdv->max != -1 && argc > cmdv->max+2))
X goto error;
X result = (*cmdv->func)(interp, argc-2, argv+2);
X if(intrup) {
X result = TCL_ERROR;
X Tcl_Return(interp, "Interrupted", TCL_STATIC);
X }
X return result;
X }
X cmdv++;
X cmdc--;
X }
X err = "unknown subcommand";
Xerror:
X sprintf(interp->result, "%s: should be \"%.50s %s %s\"",
X err, argv[0], name, args);
X return TCL_ERROR;
X}
X
Xtcl_panic(bytes)
Xint bytes;
X{
X cmdline();
X printf("Out of memory allocating %d bytes\n", bytes);
X tcl_end();
X tend();
X exit(1);
X}
X
X#define BACKUP "proc key_'^Z' {} {browse exit 0}"
X
Xtcl_init()
X{
X int read_browse_rc = 0;
X
X setalloc(tcl_panic);
X
X interp = Tcl_CreateInterp();
X Tcl_CreateCommand(interp, "browse",
X cmdBrowse, (ClientData) "browse", NULL);
X Tcl_CreateCommand(interp, "get",
X cmdGet, (ClientData) "get", NULL);
X
X if(Tcl_Eval(interp, BACKUP, 0, 0) != TCL_OK) {
X fprintf(stderr, "%s\n", interp->result);
X fprintf(stderr, "(error evaluating %s)\n", BACKUP);
X return 0;
X }
X
X if(Tcl_Eval(interp, "source /etc/browse.rc", 0, 0) == TCL_OK)
X read_browse_rc = 1;
X
X if(Tcl_Eval(interp, "source [get env BROWSERC]", 0, 0) == TCL_OK)
X read_browse_rc = 1;
X else if(Tcl_Eval(interp, "source [get env HOME]/.browserc", 0, 0) == TCL_OK)
X read_browse_rc = 1;
X
X if(!read_browse_rc) {
X fprintf(stderr,
X "Could not read /etc/browse.rc, $HOME/.browserc, or $BROWSERC!");
X return 0;
X }
X
X return 1;
X}
X
Xtcl_end()
X{
X if(interp)
X Tcl_DeleteInterp(interp);
X}
X
Xtcl_call(buffer, size)
Xchar *buffer;
X{
X int result;
X
X result = Tcl_Eval(interp, buffer, 0, (char **)0) == TCL_OK;
X strncpy(buffer, interp->result, size);
X buffer[size-1] = 0;
X return result;
X}
END_OF_FILE
if test 2533 -ne `wc -c <'tcl_glue.c'`; then
echo shar: \"'tcl_glue.c'\" unpacked with wrong size!
fi
# end of 'tcl_glue.c'
fi
echo shar: End of archive 1 \(of 2\).
cp /dev/null ark1isdone
MISSING=""
for I in 1 2 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked both archives.
rm -f ark[1-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0
--
_--_|\ Peter da Silva. +1 713 274 5180. <peter at ficc.uu.net>.
/ \
\_.--._/ Xenix Support -- it's not just a job, it's an adventure!
v "Have you hugged your wolf today?" `-_-'
More information about the Alt.sources
mailing list