See Also  edit

curses

Attributes  edit

where

ftp://www.mirrorservice.org/sites/ftp.tcl.tk/pub/tcl/mirror/ftp.procplace.com/sorted/packages-7.6/devel/tcl_curses.shar.gz

where (2)

http://www.filewatcher.com/m/tcl_curses.shar.gz.3293-0.html

current version

unknown

release time

1998-10 (?)

Description  edit

Source  edit

/* curses.c
 * CURSES interface for TcL
 *
 * Poul-Henning Kamp, phk@data.fls.dk
 * 920318 0.00
 * 920319 0.01
 * 920819 0.02 -- NJT
 */

#include <curses.h>
#include "tcl.h"
#include "tclHash.h"

static char *TraceDebug();
static int CursesProc();
static int WinProc();

typedef struct {
    int debug;
    int nl, cbreak, raw, echo;
    WINDOW *stdscr;
} t_cldat;

typedef struct {
    t_cldat *cd;
    int wbox;
    WINDOW *win;
    WINDOW *border;
} t_cldat2;

void
curses_init(Tcl_Interp *interp)
{
    t_cldat *cd;

    cd = (t_cldat *)ckalloc(sizeof *cd);
    memset(cd, 0, sizeof *cd);
    Tcl_CreateCommand(interp, "curses", CursesProc, cd, 0);
    Tcl_SetVar(interp, "curses_debug", "0", 0);
    Tcl_TraceVar(interp, "curses_debug",
            TCL_TRACE_WRITES | TCL_TRACE_UNSETS, TraceDebug, cd);
}

static int
Error(Tcl_Interp *interp, char *win, char *where)
{
    Tcl_AddErrorInfo(interp, "curses ");
    Tcl_AddErrorInfo(interp, win);
    Tcl_AddErrorInfo(interp, " ");
    Tcl_AddErrorInfo(interp, where);
    Tcl_AddErrorInfo(interp, ": failed");
    return TCL_ERROR;
}

static char *
TraceDebug(t_cldat *cd, Tcl_Interp  *interp, char *name1, char *name2,
int flags)
{
    cd->debug = 0;
    if (flags & TCL_TRACE_WRITES) {
        cd->debug =
            atoi(Tcl_GetVar(interp, "curses_debug", flags&TCL_GLOBAL_ONLY));
    }
    if (flags & TCL_TRACE_UNSETS) {
        Tcl_SetVar(interp, "curses_debug", "0", flags&TCL_GLOBAL_ONLY);
    }
    if (flags & TCL_TRACE_DESTROYED) {
        Tcl_TraceVar(interp, "curses_debug",
                TCL_TRACE_WRITES | TCL_TRACE_UNSETS, TraceDebug, cd);
    }
    fprintf(stderr, "CURSES: debug is now %d\n", cd->debug);
    return 0;
}

static int
CursesProc(t_cldat *cd, Tcl_Interp *interp, int argc, char **argv)
{
    int i;
    Tcl_HashEntry *he;
    t_cldat2 *cd2;

    if (cd->debug) {
        fprintf(stderr, "CURSES: CursesProc %d ", argc);
        for (i = 0; i < argc; ++i) {
            fprintf(stderr, "{%s} ", argv[i]);
        }
        fprintf(stderr, "\n");
    }

    if (!cd->stdscr) {   /* Not yet initscr */
        /*XX curses initscr */
        if (argc == 2 && !strcmp(argv[1], "initscr")) {
            WINDOW *w;
            w = initscr();
            if (!w) {
                return Error(interp, "<none>", argv[1]);
            }
            cd2 = (t_cldat2 *)ckalloc(sizeof *cd2);
            memset(cd2, 0, sizeof *cd2);
            cd2->cd = cd;
            cd2->win = w;
            cd2->border = NULL;
            cd2->wbox = 0;
            cd->stdscr = cd2->win;
            cd->nl = 1;
            cd->cbreak = 0;
            cd->echo = 1;
            cd->raw = 1;
            Tcl_CreateCommand(interp, "stdscr", WinProc, cd2, 0);
            return TCL_OK;
        } else {
            Tcl_AddErrorInfo(interp, "curses ");
            Tcl_AddErrorInfo(interp, argv[1]);
            Tcl_AddErrorInfo(interp, ": must start by calling initscr");
            return TCL_ERROR;
        }
    }
    if (argc == 2 && *argv[1] == 'e' && !strcmp(argv[1], "endwin")) {
        /*XX curses endwin */
        if (endwin() == OK) {
            return TCL_OK;
        }
        return Error(interp, "<none>", argv[1]);
    }

    if (argc > 2 && *argv[1] == 'm' && !strcmp(argv[1], "mode")) {
        /*XX curses mode <[no]cbreak> <[no]nl> <[no]echo> <[no]raw> */
        --argc;
        ++argv;
        while (argc > 1) {
            if (*argv[1] == 'c' && !strcmp(argv[1], "cbreak")) {
                if (cd->cbreak || cbreak() == OK) {
                    cd->cbreak = 1;
                } else {
                    return Error(interp, "<none>", argv[1]);
                }
            } else if (*argv[1] == 'n' && !strcmp(argv[1], "nocbreak")) {
                if (!cd->cbreak || nocbreak() == OK) {
                    cd->cbreak = 0;
                } else {
                    return Error(interp, "<none>", argv[1]);
                }
            } else if (*argv[1] == 'e' && !strcmp(argv[1], "echo")) {
                if (cd->echo || echo() == OK) {
                    cd->echo = 1;
                } else {
                    return Error(interp, "<none>", argv[1]);
                }
            } else if (*argv[1] == 'n' && !strcmp(argv[1], "noecho")) {
                if (!cd->echo || noecho() == OK) {
                    cd->echo = 0;
                } else {
                    return Error(interp, "<none>", argv[1]);
                }
            } else if (*argv[1] == 'r' && !strcmp(argv[1], "raw")) {
                if (cd->raw || raw() == OK) {
                    cd->raw = 1;
                } else {
                    return Error(interp, "<none>", argv[1]);
                }
            } else if (*argv[1] == 'n' && !strcmp(argv[1], "noraw")) {
                if (!cd->raw || noraw() == OK) {
                    cd->raw = 0;
                } else {
                    return Error(interp, "<none>", argv[1]);
                }
            } else if (*argv[1] == 'n' && !strcmp(argv[1], "nl")) {
                if (cd->nl || nl() == OK) {
                    cd->nl = 1;
                } else {
                    return Error(interp, "<none>", argv[1]);
                }
            } else if (*argv[1] == 'n' && !strcmp(argv[1], "nonl")) {
                if (!cd->nl || nonl() == OK) {
                    cd->nl = 0;
                } else {
                    return Error(interp, "<none>", argv[1]);
                }
            } else {
                fprintf(stderr, "%s %d\n", argv[1], argc);
                Tcl_AddErrorInfo(interp, "curses ");
                Tcl_AddErrorInfo(interp, argv[1]);
                Tcl_AddErrorInfo(interp, ": Huh ?");
                return TCL_ERROR;
            }

            ++argv;
            --argc;
        }
        if (argc < 2) {
            return TCL_OK;
        }
    }

    if (argc == 2 && *argv[1] == 'i' && !strcmp(argv[1], "info")) {
        /*XX curses info */
        char buf[30];
        sprintf(buf, "%s%s %s%s %s%s %s%s", cd->cbreak ? "" : "no", "cbreak",
                cd->raw ? "" : "no", "raw",
                cd->nl ? "" : "no", "nl",
                cd->echo ? "" : "no", "echo");
        Tcl_SetResult(interp, buf, TCL_STATIC);
        return TCL_OK;
    }

    if (argc == 7 && *argv[1] == 'n' && !strcmp(argv[1], "newwin")) {
        /*XX curses newwin <win> <nlin> <ncol> <begin_y> <begin_x> */
        WINDOW *w;
        w = newwin(atoi(argv[3]), atoi(argv[4]), atoi(argv[5]), atoi(argv[6]));
        if (!w) {
            return Error(interp, argv[1], argv[2]);
        }
        cd2 = (t_cldat2 *)ckalloc(sizeof *cd2);
        memset(cd2, 0, sizeof *cd2);
        cd2->cd = cd;
        cd2->border = NULL;
        cd2->win = w;
        cd2->wbox = 0; /* by default, no border */
        Tcl_CreateCommand(interp, argv[2], WinProc, cd2, 0);
        return TCL_OK;
    }

    Tcl_AddErrorInfo(interp, "curses ");
    Tcl_AddErrorInfo(interp, argv[1]);
    Tcl_AddErrorInfo(interp, ": Huh ?");
    return TCL_ERROR;
}

static int
WinProc(t_cldat2 *cd2, Tcl_Interp *interp, int argc, char **argv)
{
    int i;
    Tcl_HashEntry *he;
    char *win = *argv;

    if (cd2->cd->debug) {
        fprintf(stderr, "CURSES: WinProc %d ", argc);
        for (i = 0 ; i < argc; ++i) {
            fprintf(stderr, "{%s} ", argv[i]);
        }
        fprintf(stderr, "\n");
    }
    if (argc < 2) {
        Tcl_AddErrorInfo(interp, "curses ");
        Tcl_AddErrorInfo(interp, win);
        Tcl_AddErrorInfo(interp, ": no args");
        return TCL_ERROR;
    }

    while (argc > 1 && *argv[1] == '-') {
        if (argc >= 4 && !strcmp(argv[1], "-m")) {
            /*XX <win> [-m <lin> <pos>] */
            if (OK != wmove(cd2->win, atoi(argv[2]), atoi(argv[3]))) {
                Error(interp, win, argv[1]);
            }
            argv += 3;
            argc -= 3;
        } else if (argc >= 3 && !strcmp(argv[1], "-a")) {
            /*XX <win> [-a <{|so|ul|rev|blink|dim|bold}*> ] */
            char *s, *t;

            i = 0;
            for (t = argv[2]; t && *t; t = s) {
                for (s = t; *s && !isspace(*s); ++s);
                if (!*s) {
                    s = 0;
                } else {
                    *s++ = '\0';
                }
                if (!strcmp(t, "so")) {i |= A_STANDOUT;}
                else if (!strcmp(t, "ul")) {i |= A_UNDERLINE;}
                else if (!strcmp(t, "rev")) {i |= A_REVERSE;}
                else if (!strcmp(t, "blink")) {i |= A_BLINK;}
                else if (!strcmp(t, "dim")) {i |= A_DIM;}
                else if (!strcmp(t, "bold")) {i |= A_BOLD;}
                else {
                    Tcl_AddErrorInfo(interp, "curses ");
                    Tcl_AddErrorInfo(interp, win);
                    Tcl_AddErrorInfo(interp, " ");
                    Tcl_AddErrorInfo(interp, argv[1]);
                    Tcl_AddErrorInfo(interp, " ");
                    Tcl_AddErrorInfo(interp, t);
                    Tcl_AddErrorInfo(interp, ": Huh ?");
                    return TCL_ERROR;
                }
            }
            wattrset(cd2->win, i);
            argv += 2;
            argc -= 2;
        } else {
            Tcl_AddErrorInfo(interp, "curses ");
            Tcl_AddErrorInfo(interp, win);
            Tcl_AddErrorInfo(interp, " ");
            Tcl_AddErrorInfo(interp, argv[1]);
            Tcl_AddErrorInfo(interp, ": Huh ?");
            return TCL_ERROR;
        }
    }
    if (argc == 1) {
        return TCL_OK;
    }
    if (argc == 3 && *argv[1] == 'b' && !strcmp(argv[1], "box")) {
        /*XX box [on | off]*/
        int bx, by, ex, ey;

        if (!strcmp(argv[2], "on")) {
            if (cd2->wbox) {
                /* already on! */
                return Error(interp, win, argv[1]);
            }
            /* not on, so make make border on */
            cd2->wbox = 1;
            cd2->border = cd2->win;
            getbegyx(cd2->border, by, bx);
            getmaxyx(cd2->border, ey, ex);
            cd2->win = newwin(ey - 2, ex - 2, by + 1, bx + 1);
            if (!cd2->win) {
                cd2->wbox = 0;
                cd2->win = cd2->border;
                cd2->border = NULL;
                return Error(interp, win, argv[1]);
            }
            overwrite(cd2->border, cd2->win);
            box(cd2->border, 0, 0);
        }
        if (!strcmp(argv[2], "off")) {
            if (!cd2->wbox) {
                return Error(interp, win, argv[1]);
            }
            /* box can be turned off */
            cd2->wbox = 0;
            werase(cd2->border);
            overwrite(cd2->win, cd2->border);
            delwin(cd2->win);
            cd2->win = cd2->border;
            cd2->border = NULL;
        }
        return TCL_OK;
    }
    if (argc == 3 && *argv[1] == 'a' && !strcmp(argv[1], "addstr")) {
        /*XX <win> addstr <string> */
        if (OK == waddstr(cd2->win, argv[2])) {
            return TCL_OK;
        }
        return Error(interp, win, argv[1]);
    }
    if (argc == 2 && *argv[1] == 'c' && !strcmp(argv[1], "clrtoeol")) {
        /*XX <win> clrtoeol */
        wclrtoeol(cd2->win);
        return TCL_OK;
    }
    if (argc == 2 && *argv[1] == 'c' && !strcmp(argv[1], "clrtobot")) {
        /*XX <win> clrtobot */
        wclrtobot(cd2->win);
        return TCL_OK;
    }
    if (argc == 2 && *argv[1] == 'r' && !strcmp(argv[1], "refresh")) {
        /*XX <win> refresh */
        if (cd2->wbox) {
            wrefresh(cd2->border);
            wrefresh(cd2->win);
            return TCL_OK;
        }
    }
    if (argc == 2 && *argv[1] == 'e' && !strcmp(argv[1], "erase")) {
        /*XX <win> erase */
        werase(cd2->win);
        return TCL_OK;
    }
    if (argc == 2 && *argv[1] == 'c' && !strcmp(argv[1], "clear")) {
        /*XX <win> clear */
        wclear(cd2->win);
        return TCL_OK;
    }
    if (argc == 2 && *argv[1] == 'g' && !strcmp(argv[1], "getch")) {
        /*XX <win> getch */
        char buf[2];
        buf[1] = 0;
        buf[0] = wgetch(cd2->win);
        Tcl_SetResult(interp, buf, TCL_STATIC);
        return TCL_OK;
    }
    if (argc == 3 && *argv[1] == 'g' && !strcmp(argv[1], "getstr")) {
        /*XX <win> getstr <maxstrsize>*/
        char *buf;
        buf = malloc(1 + atoi(argv[2]));
        if (!buf) {
            return Error(interp, win, argv[1]);
        }
        memset(buf, 0, 1 + atoi(argv[2]));
        if (OK != wgetstr(cd2->win, buf)) {
            free(buf);
            return Error(interp, win, argv[1]);
        }
        Tcl_SetResult(interp, buf, TCL_STATIC);
        free(buf);
        return TCL_OK;
    }

    Tcl_AddErrorInfo(interp, "curses ");
    Tcl_AddErrorInfo(interp, win);
    Tcl_AddErrorInfo(interp, ": >>");
    Tcl_AddErrorInfo(interp, argv[1]);
    Tcl_AddErrorInfo(interp, "<< Huh ?");
    return TCL_ERROR;
}

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References