Article View: comp.sources.mac
Article #38UW v4.2 (part 5 of 9)
From: John Bruner
Date: Wed, 06 Apr 1988 14:09
Date: Wed, 06 Apr 1988 14:09
1395 lines
40091 bytes
40091 bytes
[UW v4.2 - part 5 of 9]
---
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# lib/uw_optfn.c
# lib/uw_options.c
# lib/uw_perror.c
# lib/uw_rsetopt.c
# lib/uw_shell.c
# lib/uw_ttype.c
# misc/README
# misc/getopt.c
# misc/macmouse.el
# misc/macmouse.ml
# This archive created: Mon Apr 4 07:51:58 1988
# By: Roger L. Long (macintosh@dhw68k.cts.com)
export PATH; PATH=/bin:$PATH
if test ! -d lib
then
echo shar: mkdir lib
mkdir lib
fi
echo shar: extracting "'lib/uw_optfn.c'" '(853 characters)'
if test -f 'lib/uw_optfn.c'
then
echo shar: will not over-write existing file "'lib/uw_optfn.c'"
else
sed 's/^X//' << \SHAR_EOF > 'lib/uw_optfn.c'
X/*
X * uw library - uw_optfn
X *
X * Copyright 1986 by John D. Bruner. All rights reserved. Permission to
X * copy this program is given provided that the copy is not sold and that
X * this copyright notice is included.
X */
X#include "uwlib.h"
X
Xuwfnptr_t
Xuw_optfn(uwin, optnum, optfn)
XUWIN uwin;
Xuwopt_t optnum;
Xuwfnptr_t optfn;
X{
X uwfnptr_t oldfn;
X
X /*
X * Establish an option-processing function (defined by the host).
X * The specified function will be called whenever an option message
X * is received from the server. The previous function is returned.
X */
X oldfn = (uwfnptr_t)0;
X if (uwin != (UWIN)0) {
X if (optnum < UW_NUMOPTS) {
X oldfn = uwin->uwi_options[optnum].uwi_optfn;
X uwin->uwi_options[optnum].uwi_optfn = optfn;
X uwin->uwi_uwerr = UWE_NONE;
X } else
X uwin->uwi_uwerr = UWE_INVAL;
X }
X uwerrno = uwin->uwi_uwerr;
X return(oldfn);
X}
SHAR_EOF
if test 853 -ne "`wc -c < 'lib/uw_optfn.c'`"
then
echo shar: error transmitting "'lib/uw_optfn.c'" '(should have been 853 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'lib/uw_options.c'" '(6733 characters)'
if test -f 'lib/uw_options.c'
then
echo shar: will not over-write existing file "'lib/uw_options.c'"
else
sed 's/^X//' << \SHAR_EOF > 'lib/uw_options.c'
X/*
X * uw library - uw_options
X *
X * Copyright 1986 by John D. Bruner. All rights reserved. Permission to
X * copy this program is given provided that the copy is not sold and that
X * this copyright notice is included.
X */
X#include <sys/types.h>
X#include <sys/file.h>
X#include <sys/time.h>
X#include <netinet/in.h>
X#include <strings.h>
X#include <signal.h>
X#include <errno.h>
X
X#include "uwlib.h"
X
X#ifndef FD_SET
X#define FD_SET(n,p) ((p)->fds_bits[0] |= (1 << (n)))
X#define FD_CLR(n,p) ((p)->fds_bits[0] &= ~(1 << (n)))
X#define FD_ISSET(n,p) ((p)->fds_bits[0] & (1 << (n)))
X#define FD_ZERO(p) ((p)->fds_bits[0] = 0)
X#define FD_SETSIZE (NBBY*sizeof(long))
X#endif
X
X#ifndef sigmask
X#define sigmask(m) (1 << ((m)-1))
X#endif
X
X#ifndef htons
X/* These should have been defined in <netinet/in.h>, but weren't (in 4.2BSD) */
Xextern unsigned short htons(), ntohs();
Xextern unsigned long htonl(), ntohl();
X#endif
X
Xstatic UWIN *fdmap;
Xstatic int (*oldsigio)();
Xstatic struct fd_set fdmask;
Xstatic int nfds;
X
Xextern char *malloc();
X
Xuw_optinit(fd, uwin)
Xint fd;
XUWIN uwin;
X{
X register int i, flags;
X static int first = 1;
X extern uw_optinput();
X
X /*
X * The first time through, allocate the file descriptor map and
X * bitmask, and cause SIGIO traps to be handled by uw_optinput.
X */
X if (first) {
X first = 0;
X nfds = getdtablesize();
X fdmap = (UWIN *)malloc((unsigned)(sizeof(UWIN)*nfds));
X if (fdmap != (UWIN *)0)
X for (i = 0; i < nfds; i++)
X fdmap[i] = (UWIN)0;
X oldsigio = signal(SIGIO, uw_optinput);
X FD_ZERO(&fdmask);
X }
X
X /*
X * Add the new control fd to the map and mask. Set the owner
X * to this process
X */
X if (fd >= 0 && fd < nfds && uwin != (UWIN)0 && fdmap != (UWIN *)0) {
X fdmap[fd] = uwin;
X FD_SET(fd, &fdmask);
X#ifdef SETOWN_BUG
X (void)fcntl(fd, F_SETOWN, -getpid());
X#else
X (void)fcntl(fd, F_SETOWN, getpid());
X#endif
X if ((flags = fcntl(fd, F_GETFL, 0)) >= 0)
X (void)fcntl(fd, F_SETFL, flags|FASYNC|FNDELAY);
X uwin->uwi_ipclen = 0;
X }
X}
X
Xuw_optdone(fd)
X{
X register int flags;
X
X /*
X * Turn off asynchronous I/O notification and remove the
X * map and mask information for "fd". We do not close the
X * file descriptor, however -- the caller is expected to
X * take care of that.
X */
X if (fd >= 0 && fd < nfds && fdmap != (UWIN *)0) {
X if ((flags = fcntl(fd, F_GETFL, 0)) >= 0)
X (void)fcntl(fd, F_SETFL, flags&~FASYNC);
X else
X (void)fcntl(fd, F_SETFL, 0);
X (void)fcntl(fd, F_SETFL, 0);
X fdmap[fd] = (UWIN)0;
X FD_CLR(fd, &fdmask);
X }
X}
X
Xstatic
Xuw_optinput(sig, code, scp)
Xint sig, code;
Xstruct sigcontext *scp;
X{
X register int k, n, fd;
X register UWIN uwin;
X register struct uwoption *uwop;
X register union uwoptval *uwov;
X uwopt_t optnum;
X uwoptcmd_t optcmd;
X uwfnptr_t userfn;
X int oldmask;
X struct timeval timeo;
X struct fd_set ready;
X extern int errno;
X
X /*
X * This routine is called when input is waiting on a control
X * file descriptor.
X */
X oldmask = sigblock(sigmask(SIGALRM));
X do {
X ready = fdmask;
X timeo.tv_sec = 0;
X timeo.tv_usec = 0;
X n = select(nfds, &ready, (struct fd_set *)0,
X (struct fd_set *)0, &timeo);
X if (n < 0 && errno == EBADF) {
X /*
X * One of the file descriptors that we asked for
X * is no longer valid. This isn't supposed to
X * happen; however, we try to handle it by testing
X * each bit individually and eliminating the bad
X * ones.
X */
X for (fd=0; fd < nfds; fd++) {
X if (FD_ISSET(fd, &fdmask)) {
X do {
X ready = fdmask;
X timeo.tv_sec = 0;
X timeo.tv_usec = 0;
X k = select(nfds, &ready,
X (struct fd_set *)0,
X (struct fd_set *)0, &timeo);
X if (k < 0 && errno == EBADF) {
X fdmap[fd] = (UWIN)0;
X FD_CLR(fd, &fdmask);
X }
X } while (n < 0 && errno == EINTR);
X }
X }
X }
X } while (n < 0 && errno == EINTR);
X
X for (fd=0; n > 0 && fd < nfds; fd++) {
X if (FD_ISSET(fd, &ready)) {
X n--;
X uwin = fdmap[fd];
X while ((k = getmesg(fd, uwin)) > 0) {
X uwin->uwi_ipclen = 0; /* for next time */
X if (uwin->uwi_ipcbuf.uwip_cmd == UWC_OPTION) {
X uwop = &uwin->uwi_ipcbuf.uwip_option;
X uwov = &uwop->uwop_val;
X optnum = ntohs(uwop->uwop_opt);
X optcmd = ntohs(uwop->uwop_cmd);
X if (optcmd == UWOC_SET)
X uw_ntoh(uwin->uwi_type, optnum,
X (char *)uwov);
X if (optcmd == UWOC_SET) switch(optnum) {
X case UWOP_VIS:
X uwin->uwi_vis = !!uwov->uwov_6bit;
X break;
X case UWOP_TYPE:
X if (uwov->uwov_6bit<UW_NWTYPES)
X uwin->uwi_type=uwov->uwov_6bit;
X break;
X case UWOP_POS:
X uwin->uwi_pos.uwp_v = uwov->uwov_point.v;
X uwin->uwi_pos.uwp_h = uwov->uwov_point.h;
X break;
X case UWOP_TITLE:
X (void)strncpy(uwin->uwi_title,
X uwov->uwov_string,
X sizeof uwin->uwi_title);
X break;
X case UWOP_WSIZE:
X uwin->uwi_wsize.uwp_v = uwov->uwov_point.v;
X uwin->uwi_wsize.uwp_h = uwov->uwov_point.h;
X break;
X }
X if (optnum == UWOP_TYPE &&
X optcmd == UWOC_SET &&
X uwov->uwov_6bit < UW_NWTYPES)
X uwin->uwi_type=uwov->uwov_6bit;
X userfn = uwin->uwi_options[optnum].uwi_optfn;
X if (userfn != (uwfnptr_t)0)
X (*userfn)(uwin, optnum,
X optcmd, uwov);
X }
X }
X if (k < 0)
X (void)uw_detach(uwin); /* I/O error or EOF */
X }
X }
X (void)sigsetmask(oldmask);
X
X /*
X * Finally, if "oldsigio" is not SIG_DFL, call it.
X */
X if (oldsigio != SIG_DFL)
X (*oldsigio)(sig, code, scp);
X}
X
Xstatic
Xgetmesg(fd, uwin)
Xregister int fd;
Xregister UWIN uwin;
X{
X register int len;
X register char *cp;
X
X /*
X * Read some more bytes from control socket "fd" into the input
X * buffer. Return 1 if the message is now complete, -1 if an
X * EOF was reached, or 0 otherwise. Before returning 1, the byte
X * order of the common parameters (command, length) is changed
X * from network to host order.
X */
X cp = (char *)&uwin->uwi_ipcbuf + uwin->uwi_ipclen;
X if (uwin->uwi_ipclen < sizeof(uwin->uwi_ipcbuf.uwip_len)) {
X len = read(fd, cp, sizeof uwin->uwi_ipcbuf.uwip_len - uwin->uwi_ipclen);
X if (len == 0 || (len < 0 && errno != EWOULDBLOCK))
X return(-1);
X if (len < 0)
X return(0);
X if ((uwin->uwi_ipclen +=len) < sizeof uwin->uwi_ipcbuf.uwip_len)
X return(0);
X uwin->uwi_ipcbuf.uwip_len = ntohs(uwin->uwi_ipcbuf.uwip_len);
X if (uwin->uwi_ipcbuf.uwip_len==sizeof uwin->uwi_ipcbuf.uwip_len)
X return(1);
X cp += len;
X }
X if (uwin->uwi_ipcbuf.uwip_len > sizeof(struct uwipc))
X uwin->uwi_ipcbuf.uwip_len = sizeof(struct uwipc);
X len = read(fd, cp, uwin->uwi_ipcbuf.uwip_len - uwin->uwi_ipclen);
X if (len == 0 || (len < 0 && errno != EWOULDBLOCK))
X return(-1);
X if ((uwin->uwi_ipclen += len) == uwin->uwi_ipcbuf.uwip_len) {
X uwin->uwi_ipcbuf.uwip_cmd = ntohs(uwin->uwi_ipcbuf.uwip_cmd);
X return(1);
X } else
X return(0);
X}
SHAR_EOF
if test 6733 -ne "`wc -c < 'lib/uw_options.c'`"
then
echo shar: error transmitting "'lib/uw_options.c'" '(should have been 6733 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'lib/uw_perror.c'" '(1157 characters)'
if test -f 'lib/uw_perror.c'
then
echo shar: will not over-write existing file "'lib/uw_perror.c'"
else
sed 's/^X//' << \SHAR_EOF > 'lib/uw_perror.c'
X/*
X * uw library - uw_perror
X *
X * Copyright 1986 by John D. Bruner. All rights reserved. Permission to
X * copy this program is given provided that the copy is not sold and that
X * this copyright notice is included.
X */
X#include "uwlib.h"
X
Xchar *uwerrlist[] = {
X "no error",
X "system call error",
X "nonexistent window type",
X "window ID duplicated (in use)",
X "operation not implemented",
X "non-existent server",
X "unable to allocate required memory",
X "invalid argument to function",
X "no control file descriptor for window",
X};
Xunsigned uwnerr = sizeof uwerrlist / sizeof uwerrlist[0];
X
Xint uwerrno;
X
X/*ARGSUSED*/
Xvoid
Xuw_perror(mesg, uwerr, errno)
Xchar *mesg;
Xuwerr_t uwerr;
Xint errno;
X{
X register char *errmsg;
X
X /*
X * Print a UW error message. We call write() directly to avoid
X * making the UW library dependent upon stdio.
X */
X if (uwerr == UWE_ERRNO) {
X perror(mesg);
X } else {
X if (mesg != (char *)0) {
X (void)write(2, mesg, strlen(mesg));
X (void)write(2, ": ", 2);
X }
X if (uwerr >= uwnerr)
X errmsg = "unknown UW error";
X else
X errmsg = uwerrlist[uwerr];
X (void)write(2, errmsg, strlen(errmsg));
X (void)write(2, "\n", 1);
X }
X}
SHAR_EOF
if test 1157 -ne "`wc -c < 'lib/uw_perror.c'`"
then
echo shar: error transmitting "'lib/uw_perror.c'" '(should have been 1157 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'lib/uw_rsetopt.c'" '(2024 characters)'
if test -f 'lib/uw_rsetopt.c'
then
echo shar: will not over-write existing file "'lib/uw_rsetopt.c'"
else
sed 's/^X//' << \SHAR_EOF > 'lib/uw_rsetopt.c'
X/*
X * uw library - uw_rsetopt
X *
X * Copyright 1986 by John D. Bruner. All rights reserved. Permission to
X * copy this program is given provided that the copy is not sold and that
X * this copyright notice is included.
X */
X#include <sys/types.h>
X#include <sys/socket.h>
X#include <sys/un.h>
X#include <sys/ioctl.h>
X#include <sys/uio.h>
X#include <sys/file.h>
X#include <strings.h>
X#include <signal.h>
X#include "openpty.h"
X
X#include "uwlib.h"
X
Xextern char *malloc();
Xextern char *getenv();
X
Xuw_rsetopt(uwid, optnum, optval)
Xuwid_t uwid;
Xuwopt_t optnum;
Xunion uwoptval *optval;
X{
X register int sd;
X register struct uwipc *uwip;
X char *portal;
X struct iovec iov;
X struct msghdr msg;
X struct sockaddr_un sa;
X
X /*
X * Set a window option on a remote window (that is, one for which
X * we do not have a control fd).
X */
X
X /*
X * Create a UNIX-domain socket.
X */
X if (!(portal=getenv("UW_UIPC"))) {
X uwerrno = UWE_NXSERV;
X return(-1);
X }
X
X if ((sd=socket(AF_UNIX, SOCK_DGRAM, 0)) < 0) {
X uwerrno = UWE_ERRNO;
X return(-1);
X }
X sa.sun_family = AF_UNIX;
X (void)strncpy(sa.sun_path, portal, sizeof sa.sun_path-1);
X sa.sun_path[sizeof sa.sun_path-1] = '\0';
X
X
X /*
X * Construct the datagram we will send later.
X */
X uwip = (struct uwipc *)malloc(sizeof(struct uwipc));
X if (uwip == (struct uwipc *)0) {
X uwerrno = UWE_NOMEM;
X return(-1);
X }
X uwip->uwip_cmd = UWC_OPTION;
X uwip->uwip_len = sizeof(struct uwipc);
X uwip->uwip_option.uwop_id = uwid;
X uwip->uwip_option.uwop_cmd = UWOC_SET;
X uwip->uwip_option.uwop_opt = optnum;
X uwip->uwip_option.uwop_val = *optval;
X
X /*
X * Pass the file descriptor to the window server.
X */
X iov.iov_base = (char *)uwip;
X iov.iov_len = uwip->uwip_len;
X msg.msg_name = (caddr_t)&sa;
X msg.msg_namelen = sizeof sa.sun_family + strlen(sa.sun_path);
X msg.msg_iov = &iov;
X msg.msg_iovlen = 1;
X msg.msg_accrights = (caddr_t)0;
X msg.msg_accrightslen = 0;
X if (sendmsg(sd, &msg, 0) < 0) {
X free((char *)uwip);
X uwerrno = UWE_ERRNO;
X return(-1);
X }
X free((char *)uwip);
X uwerrno = UWE_NONE;
X return(0);
X}
SHAR_EOF
if test 2024 -ne "`wc -c < 'lib/uw_rsetopt.c'`"
then
echo shar: error transmitting "'lib/uw_rsetopt.c'" '(should have been 2024 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'lib/uw_shell.c'" '(851 characters)'
if test -f 'lib/uw_shell.c'
then
echo shar: will not over-write existing file "'lib/uw_shell.c'"
else
sed 's/^X//' << \SHAR_EOF > 'lib/uw_shell.c'
X/*
X * uw library - uw_shell
X *
X * Copyright 1986 by John D. Bruner. All rights reserved. Permission to
X * copy this program is given provided that the copy is not sold and that
X * this copyright notice is included.
X */
X#include "uwlib.h"
X
Xchar *uwshellname = "/bin/sh"; /* can be patched by caller if desired */
X
Xuwid_t
Xuw_shell(wtype, cmd)
Xuwtype_t wtype;
Xchar *cmd;
X{
X register uwid_t uwid;
X
X /*
X * Create a new window (using uw_fork()) and execute the specified
X * shell command in it. Returns the window ID of the new window
X * (or -1 if the window creation failed) There is no way to
X * determine if the executed command failed.
X */
X if ((uwid = uw_fork(wtype, (int *)0)) == 0) {
X (void)execl(uwshellname, uwshellname, "-c", cmd, (char *)0);
X _exit(1); /* we'd better not reach this point */
X /*NOTREACHED*/
X } else
X return(uwid);
X}
SHAR_EOF
if test 851 -ne "`wc -c < 'lib/uw_shell.c'`"
then
echo shar: error transmitting "'lib/uw_shell.c'" '(should have been 851 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'lib/uw_ttype.c'" '(1059 characters)'
if test -f 'lib/uw_ttype.c'
then
echo shar: will not over-write existing file "'lib/uw_ttype.c'"
else
sed 's/^X//' << \SHAR_EOF > 'lib/uw_ttype.c'
X/*
X * uw library - uw_ttype
X *
X * Copyright 1986 by John D. Bruner. All rights reserved. Permission to
X * copy this program is given provided that the copy is not sold and that
X * this copyright notice is included.
X */
X#include <strings.h>
X#include "uwlib.h"
X
Xstruct table {
X char *tname;
X uwtype_t wtype;
X};
X
X/* The following table must be sorted */
Xstatic struct table table[] = {
X { "aaa-24", UWT_ANSI },
X { "adm3", UWT_ADM31 },
X { "adm31", UWT_ADM31 },
X { "adm3a", UWT_ADM31 },
X { "ansi", UWT_ANSI },
X { "tek", UWT_TEK4010 },
X { "tek4010", UWT_TEK4010 },
X { "tek4012", UWT_TEK4010 },
X { "vt52", UWT_VT52 },
X};
X
Xuwtype_t
Xuw_ttype(name)
Xchar *name;
X{
X register struct table *t, *lo, *hi;
X register int cmp;
X
X /*
X * Map a terminal name string to a UW window emulation type.
X */
X lo = table;
X hi = table + sizeof table / sizeof table[0] - 1;
X while (lo <= hi) {
X t = lo + (hi-lo) / 2;
X cmp = strcmp(name, t->tname);
X if (cmp == 0)
X return(t->wtype);
X if (cmp < 0)
X hi = t-1;
X else
X lo = t+1;
X }
X return(UWT_ADM31); /* default if no match */
X}
SHAR_EOF
if test 1059 -ne "`wc -c < 'lib/uw_ttype.c'`"
then
echo shar: error transmitting "'lib/uw_ttype.c'" '(should have been 1059 characters)'
fi
fi # end of overwriting check
if test ! -d misc
then
echo shar: mkdir misc
mkdir misc
fi
echo shar: extracting "'misc/README'" '(746 characters)'
if test -f 'misc/README'
then
echo shar: will not over-write existing file "'misc/README'"
else
sed 's/^X//' << \SHAR_EOF > 'misc/README'
XThis directory contains three items that may be of interest:
X
X
X getopt.c The AT&T version of the getopt() library
X routine (for command-line processing). This
X version, to the best of my knowledge, was
X placed into the public domain by AT&T.
X
X
X macmouse.ml A package for use with Gosling's EMACS
X which intreprets encoded mouse-down and
X mouse-up events within windows to perform
X various operations.
X
X Author: Chris Kent (kent@decwrl.dec.com)
X
X
X macmouse.el A similar macro package for GNU EMACS.
X
X Author: Gregory Lauer (glauer@bbn.arpa)
X
X
XThe two EMACS macro packages were developed for a previous version of
XUW (version 2.10). Since I (John Bruner) am not an EMACS user, I do
Xnot know how well they will work with UW v4.2.
SHAR_EOF
if test 746 -ne "`wc -c < 'misc/README'`"
then
echo shar: error transmitting "'misc/README'" '(should have been 746 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'misc/getopt.c'" '(1247 characters)'
if test -f 'misc/getopt.c'
then
echo shar: will not over-write existing file "'misc/getopt.c'"
else
sed 's/^X//' << \SHAR_EOF > 'misc/getopt.c'
X/*LINTLIBRARY*/
X#define NULL 0
X#define EOF (-1)
X#define ERR(s, c) if(opterr){\
X extern int strlen(), write();\
X char errbuf[2];\
X errbuf[0] = c; errbuf[1] = '\n';\
X (void) write(2, argv[0], (unsigned)strlen(argv[0]));\
X (void) write(2, s, (unsigned)strlen(s));\
X (void) write(2, errbuf, 2);}
X
Xextern int strcmp();
Xextern char *strchr();
X
Xint opterr = 1;
Xint optind = 1;
Xint optopt;
Xchar *optarg;
X
Xint
Xgetopt(argc, argv, opts)
Xint argc;
Xchar **argv, *opts;
X{
X static int sp = 1;
X register int c;
X register char *cp;
X
X if(sp == 1)
X if(optind >= argc ||
X argv[optind][0] != '-' || argv[optind][1] == '\0')
X return(EOF);
X else if(strcmp(argv[optind], "--") == NULL) {
X optind++;
X return(EOF);
X }
X optopt = c = argv[optind][sp];
X if(c == ':' || (cp=strchr(opts, c)) == NULL) {
X ERR(": illegal option -- ", c);
X if(argv[optind][++sp] == '\0') {
X optind++;
X sp = 1;
X }
X return('?');
X }
X if(*++cp == ':') {
X if(argv[optind][sp+1] != '\0')
X optarg = &argv[optind++][sp+1];
X else if(++optind >= argc) {
X ERR(": option requires an argument -- ", c);
X sp = 1;
X return('?');
X } else
X optarg = argv[optind++];
X sp = 1;
X } else {
X if(argv[optind][++sp] == '\0') {
X sp = 1;
X optind++;
X }
X optarg = NULL;
X }
X return(c);
X}
SHAR_EOF
if test 1247 -ne "`wc -c < 'misc/getopt.c'`"
then
echo shar: error transmitting "'misc/getopt.c'" '(should have been 1247 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'misc/macmouse.el'" '(9277 characters)'
if test -f 'misc/macmouse.el'
then
echo shar: will not over-write existing file "'misc/macmouse.el'"
else
sed 's/^X//' << \SHAR_EOF > 'misc/macmouse.el'
X;;; macmouse.el (Version: 2.0)
X
X;;; Copyright (C) Gregory S. Lauer (glauer@bbn), 1985.
X;;; Please send suggestions and corrections to the above address.
X;;;
X;;; This file contains macmouse, a GNU Emacs mouse package for UW.
X
X
X;;
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but without any warranty. No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; document "GNU Emacs copying permission notice". An exact copy
X;; of the document is supposed to have been given to you along with
X;; GNU Emacs so that you can know how you may redistribute it all.
X;; It should be in a file named COPYING. Among other things, the
X;; copyright notice and this notice must be preserved on all copies.
X
X
X;;; Original version for Gosling emacs by Chris Kent, Purdue University 1985.
X;;; Modified by Gregory Lauer, BBN, Novemeber 1985.
X;
X;
X;
X; Macmouse provides the following features:
X; Up or down mouse button in a window selects that window
X;
X; A scroll bar/thumbing area for each window with the following features:
X; the mode lines are horizontal scroll bars
X; (running from rightmost column to under leftmost column)
X; the unused right window bar and the dividing lines between
X; windows are vertical scroll bars
X; (running from top of window THRU modeline
X; for vertical scroll bars:
X; click at line 1 does previous page
X; click at last line does next page
X; click anywhere else "thumbs" to the relative portion of the buffer.
X; shift-click at line 1 scrolls one line down
X; shift-click at last line scrolls one line up
X; shift-click elsewhere moves line to top of window
X; option-shift-click elsewhere moves line to bottom of window
X; for horizontal scroll bars:
X; click at column 1 does scroll right one window width
X; click at last column does scroll left one window width
X; click anywhere else moves to that "percent" of the buffer width
X; shift-click at column 1 scrolls one column right
X; shift-click at last column scrolls one column left
X; shift-click elsewhere moves column to right of window
X; option-shift-click elsewhere moves column to left of window
X;
X; There is also basic positioning and kill-buffer support:
X; click in a buffer moves dot there and selects that buffer
X; drag copies the dragged region to the kill buffer
X; shift-drag deletes the dragged region to the kill buffer
X;
X; It is possible to use the scrolling and thumbing area to make the region
X; larger than a single screen; just click, scroll, release. Make sure
X; that the last scroll is just a down event; the up must be in the buffer.
X; The last mouse position is remembered for each different buffer (not
X; window), and thus you can start a drag in one buffer, select another,
X; go back to the first buffer, etc.
X;
X; option-click yanks from the kill buffer
X; option-shift-click similarly yanks from a named buffer.
X;
X
X(defconst mouse-max-x 95 "Maximum UW column returned on mouse click")
X(defconst mouse-max-y 95 "Maximum UW row returned on mouse click")
X
X(make-variable-buffer-local 'mouse-last-x) ; x of last event
X(set-default 'mouse-last-x 0)
X
X(make-variable-buffer-local 'mouse-last-y) ; y of last event
X(set-default 'mouse-last-y 0)
X
X(make-variable-buffer-local 'mouse-last-b) ; buttons at last event
X(set-default 'mouse-last-b 0)
X
X(make-variable-buffer-local 'mouse-last-dot) ; dot after last event
X(set-default 'mouse-last-dot 0)
X
X(make-variable-buffer-local 'scrolling-p)
X(set-default 'scrolling-p nil)
X
X(defun move-mac-cursor ()
X (interactive)
X (let (savest b x y up down lock shift option command)
X (setq savest stack-trace-on-error)
X (setq stack-trace-on-error nil)
X ; decode everything
X (setq y (- (read-char) 32))
X (setq x (- (read-char) 32))
X (setq b (- (read-char) 32))
X (setq command (< 0 (logand b 1))) ; command key
X (setq shift (< 0 (logand b 2))) ; shift
X (setq lock (< 0 (logand b 4))) ; caps-lock
X (setq option (< 0 (logand b 8))) ; option
X (setq down (< 0 (logand b 16))) ; mouse down
X (setq up (< 0 (logand b 32))) ; mouse up
X (condition-case ()
X (progn
X (select-window-containing-x-and-y x y) ; side-effect sets scrolling-p
X (if scrolling-p
X (mouse-scroll-region b x y)
X (progn
X (move-to-window-x-y x y) ; move cursor to mouse-dot always
X (if down (setq mouse-last-dot (dot)))
X (mouse-edit-action))))
X (error (message "Click not in selectable window")
X (sit-for 1)
X (message "")))
X (setq stack-trace-on-error savest)
X (if down
X (progn
X (setq mouse-last-x x)
X (setq mouse-last-y y)
X (setq mouse-last-b b))
X (progn
X (setq mouse-last-x 0)
X (setq mouse-last-y 0)
X (setq mouse-last-b 0)))))
X
X(defun mouse-edit-action ()
X ;marking and editing actions on buttons:
X ; if no movement, nothing.
X ; if movement, save mouse-last-dot,
X ; and edit.
X ; editing (on upstrokes):
X ; unmodified, copy to kill buffer.
X ; SHIFTed, delete (cut) to kill buffer.
X ;
X ; option-click yanks from kill buffer;
X ; shift-option-click from named buffer.
X (let ((fun (get 'mouse-function b)))
X (if fun (apply fun nil))))
X
X
X ; individual button bindings
X ; generally will only need up mouse button: mouse-last-dot
X ; is saved automatically on down mouse button
X
X; only need to define functions for keys that get used
X
X(put 'mouse-function 32 ; up
X '(lambda ()
X (if (and (not (mouse-click-p))
X (not scrolling-p))
X (copy-region-as-kill (dot) mouse-last-dot))))
X
X(put 'mouse-function 34 ; up/shift
X '(lambda ()
X (if (and (not (mouse-click-p))
X (not scrolling-p))
X (kill-region (dot) mouse-last-dot))))
X
X(put 'mouse-function 40 ; up/option
X '(lambda ()
X (if (mouse-click-p)
X (progn
X (yank)
X (exchange-dot-and-mark)))))
X
X(put 'mouse-function 42
X '(lambda () ; up/option/shift
X (if (mouse-click-p)
X (insert-buffer (read-buffer "Insert contents of buffer: ")))))
X
X(defun mouse-click-p ()
X (= (dot) mouse-last-dot))
X
X(defun set-window-boundaries ()
X (let ((edges (window-edges)))
X (setq xl (1+ (car edges)))
X (setq yt (1+ (car (cdr edges))))
X (let ((temp (car (cdr (cdr edges)))))
X (setq xr (if (= (screen-width) temp) mouse-max-x temp)))
X (let ((temp (car (cdr (cdr (cdr edges))))))
X (setq yb (if (= (screen-height) temp) mouse-max-y temp )))))
X
X(defun select-window-containing-x-and-y (x y)
X (let ((starting-window (selected-window)))
X (set-window-boundaries)
X (while (not (point-in-window x y))
X (other-window 1)
X (if (eq (selected-window) starting-window)
X (error nil)
X (set-window-boundaries)))
X (if (or (= x xr) (= y yb))
X (setq scrolling-p t)
X (setq scrolling-p nil))))
X
X(defun point-in-window (x y)
X (and (<= xl x)(<= x xr)(<= yt y)(<= y yb)))
X
X(defun move-to-window-x-y (x y)
X (move-to-window-line (- y yt))
X (move-to-window-column (- x xl)))
X
X(defun move-to-window-column (x)
X (move-to-column (+ (max 0 (- (window-hscroll) 1)) x)))
X
X(defun mouse-scroll-region (b x y)
X (if down
X (if shift
X (do-lines b x y)
X (do-pages b x y)))
X (if (and up
X (or (/= x mouse-last-x)
X (/= y mouse-last-y)))
X (if shift
X (do-lines b x y)
X (do-pages b x y))))
X
X(defun do-lines (b x y) ; fine control over lines
X (if (= x xr)
X (cond ((= y yt)(scroll-down 1))
X ((= y yb)(scroll-up 1))
X (t (if option
X (scroll-down (- yb y 1))
X (scroll-up (- y yt))))))
X (if (and (= y yb) (/= x xr))
X (cond ((<= x xl)(scroll-right 1))
X ((>= x (1- xr))(scroll-left 1))
X (t (if option
X (move-column-right x)
X (move-column-left x))))))
X
X(defun move-column-left (x) ;need to mess about a bit because
X (scroll-left ;first scroll left of 1 just writes
X (if (= (window-hscroll) 0) ;a column of $s in column 1
X (- x xl)
X (- x xl 1))))
X
X(defun move-column-right (x)
X (scroll-right (- xr x 2)))
X
X
X(defun do-pages (b x y) ; large motions via pages and thumbing
X (if (= x xr)
X (cond ((= y yt)(scroll-down nil))
X ((= y yb)(scroll-up nil))
X (t (goto-percent (/ (* (- y yt 1) 100)
X (- yb yt 2))))))
X (if (and (= y yb)(/= x xr))
X (cond ((<= x xl)(scroll-right (- (window-width)
X next-screen-context-lines)))
X ((>= x (1- xr))(scroll-left (- (window-width)
X next-screen-context-lines)))
X (t (goto-horizontal-percent (/ (* (- x xl 1) 100)
X (- xr xl 2)))))))
X
X(defun goto-percent (p)
X (goto-char (/ (* (- (dot-max) (dot-min)) p) 100)))
X
X(defun goto-horizontal-percent (p) ;try to put this percent of columns
X (let ((window-offset (window-hscroll));in the center column of the window
X delta) ;unless that would move the first or
X (setq delta ;last column past the window edge
X (- window-offset
X (min (max 0 (- (/ (* (screen-width) p) 100)
X (/ (- xr xl) 2)))
X (- (screen-width) (- xr xl)))))
X (scroll-right delta)))
X
X
X(global-set-key "\em" 'move-mac-cursor)
SHAR_EOF
if test 9277 -ne "`wc -c < 'misc/macmouse.el'`"
then
echo shar: error transmitting "'misc/macmouse.el'" '(should have been 9277 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'misc/macmouse.ml'" '(8406 characters)'
if test -f 'misc/macmouse.ml'
then
echo shar: will not over-write existing file "'misc/macmouse.ml'"
else
sed 's/^X//' << \SHAR_EOF > 'misc/macmouse.ml'
X; $Header: /c/cak/lib/mlisp/RCS/macmouse.ml,v 1.5 85/11/05 14:01:44 cak Rel $
X;
X; Macintosh mouse routines for use with John Bruner's uw program.
X; Chris Kent, Purdue University Fri Oct 25 1985
X; Copyright 1985 by Christopher A. Kent. All rights reserved.
X; Permission to copy is given provided that the copy is not
X; sold and this copyright notice is included.
X;
X; Provides a scroll bar/thumbing area in the unused scroll bar with the
X; following features:
X; click at line 1 does previous page
X; click at line 24 does next page
X; click anywhere else "thumbs" to the relative portion of the buffer.
X; shift-click at line 1 scrolls one line down
X; shift-click at line 24 scrolls one line up
X; shift-click elsewhere moves line to top of window
X; option-shift-click elsewhere moves line to bottom of window
X;
X; There is also basic positioning and kill-buffer support:
X; click in a buffer moves dot there
X; drag copies the dragged region to the kill buffer (mark is left
X; at the beginning of the region.)
X; shift-drag deletes the dragged region to the kill buffer
X; it is possible to use the scrolling and thumbing area to make the region
X; larger than a single screen; just click, scroll, release. Make sure
X; that the last scroll is just a down event; the up must be in the buffer.
X;
X; option-click yanks from the kill buffer, doesn't affect mark.
X; option-shift-click similarly yanks from a named buffer.
X;
X
X(declare-global
X #mouse-last-x ; x of last event
X #mouse-last-y ; y of last event
X #mouse-last-b ; buttons at last event
X #mouse-last-dot ; dot after last event
X #mouse-last-action ; whether last was scroll (1) or edit (2)
X)
X
X(defun
X (move-mac-cursor savest b x y up down lock shift option command saveb
X (setq savest stack-trace-on-error)
X (setq stack-trace-on-error 0)
X ; decode everything
X (setq y (- (get-tty-character) 32))
X (setq x (- (get-tty-character) 32))
X (setq b (- (get-tty-character) 32))
X (setq saveb b)
X (setq command (% b 2))(setq b (/ b 2)) ; command key
X (setq shift (% b 2))(setq b (/ b 2)) ; shift
X (setq lock (% b 2))(setq b (/ b 2)) ; caps-lock
X (setq option (% b 2))(setq b (/ b 2)) ; option
X (setq down (% b 2))(setq b (/ b 2)) ; mouse down
X (setq up (% b 2))
X
X (if (= x 81) ; right margin -- move-dot-to-x-y is wrong
X (progn
X (#mouse-scroll-region)
X (setq #mouse-last-action 1))
X (if (error-occurred
X (if (= #mouse-last-action 2) ; not if just scrolled
X (setq #mouse-last-dot (dot)))
X (move-dot-to-x-y x y)
X (backward-character)(forward-character)
X (#mouse-edit-action)
X (setq #mouse-last-action 2)
X )
X (progn
X (#mouse-scroll-region b x y)
X (setq #mouse-last-action 1))
X ))
X (setq stack-trace-on-error savest)
X (if (= down 1)
X (progn
X (setq #mouse-last-x x)
X (setq #mouse-last-y y)
X (setq #mouse-last-b saveb))
X (progn
X (setq #mouse-last-x 0)
X (setq #mouse-last-y 0)
X (setq #mouse-last-b 0)))
X )
X
X (#mouse-edit-action ; marking and editing actions on buttons:
X ; if no movement, nothing.
X ; if movement, put mark at #mouse-last-dot,
X ; leave dot here,and edit.
X ; editing (on upstrokes):
X ; unmodified, copy to kill buffer.
X ; SHIFTed, delete (cut) to kill buffer.
X ;
X ; option-click yanks from kill buffer;
X ; shift-option-click from named buffer.
X (if (= saveb 16)
X (#mouse-d))
X (if (= saveb 17)
X (#mouse-dc))
X (if (= saveb 18)
X (#mouse-ds))
X (if (= saveb 19)
X (#mouse-dsc))
X (if (= saveb 20)
X (#mouse-dl))
X (if (= saveb 21)
X (#mouse-dlc))
X (if (= saveb 22)
X (#mouse-dls))
X (if (= saveb 23)
X (#mouse-dlsc))
X (if (= saveb 24)
X (#mouse-do))
X (if (= saveb 25)
X (#mouse-doc))
X (if (= saveb 26)
X (#mouse-dos))
X (if (= saveb 27)
X (#mouse-dosc))
X (if (= saveb 28)
X (#mouse-dol))
X (if (= saveb 29)
X (#mouse-dolc))
X (if (= saveb 30)
X (#mouse-dols))
X (if (= saveb 31)
X (#mouse-dolsc))
X (if (= saveb 32)
X (#mouse-u))
X (if (= saveb 33)
X (#mouse-uc))
X (if (= saveb 34)
X (#mouse-us))
X (if (= saveb 35)
X (#mouse-usc))
X (if (= saveb 36)
X (#mouse-ul))
X (if (= saveb 37)
X (#mouse-ulc))
X (if (= saveb 38)
X (#mouse-uls))
X (if (= saveb 39)
X (#mouse-ulsc))
X (if (= saveb 40)
X (#mouse-uo))
X (if (= saveb 41)
X (#mouse-uoc))
X (if (= saveb 42)
X (#mouse-uos))
X (if (= saveb 43)
X (#mouse-uosc))
X (if (= saveb 44)
X (#mouse-uol))
X (if (= saveb 45)
X (#mouse-uolc))
X (if (= saveb 46)
X (#mouse-uols))
X (if (= saveb 47)
X (#mouse-uolsc))
X )
X
X ; individual button bindings
X
X (#mouse-u ; up
X (if (! (#mouse-click-p))
X (progn
X (#mouse-set-region)
X (Copy-region-to-kill-buffer)
X ))
X )
X
X (#mouse-uc ; up/command
X )
X
X (#mouse-us ; up/shift
X (if (! (#mouse-click-p))
X (progn
X (#mouse-set-region)
X (delete-to-killbuffer)
X ))
X )
X
X (#mouse-usc ; up/shift/command
X )
X
X (#mouse-ul ; up/lock
X )
X
X (#mouse-ulc ; up/lock/command
X )
X
X (#mouse-uls ; up/lock/shift
X )
X
X (#mouse-ulsc ; up/lock/shift/command
X )
X
X (#mouse-uo ; up/option
X (if (#mouse-click-p)
X (yank-from-killbuffer)
X )
X )
X
X (#mouse-uoc ; up/option/command
X )
X
X (#mouse-uos ; up/option/shift
X (if (#mouse-click-p) ; click
X (yank-buffer (get-tty-buffer "Insert contents of buffer: "))
X )
X )
X
X (#mouse-uosc ; up/option/shift
X )
X
X (#mouse-uol ; up/option/lock
X )
X
X (#mouse-uolc ; up/option/lock
X )
X
X (#mouse-uols ; up/option/lock/shift
X )
X
X (#mouse-uolsc ; up/option/lock/shift/command
X )
X
X (#mouse-d ; down
X )
X
X (#mouse-dc ; down/command
X )
X
X (#mouse-ds ; down/shift
X )
X
X (#mouse-dsc ; down/shift/command
X )
X
X (#mouse-dl ; down/lock
X )
X
X (#mouse-dlc ; down/lock/command
X )
X
X (#mouse-dls ; down/lock/shift
X )
X
X (#mouse-dlsc ; down/lock/shift/command
X )
X
X (#mouse-do ; down/option
X )
X
X (#mouse-doc ; down/option/command
X )
X
X (#mouse-dos ; down/option/shift
X )
X
X (#mouse-dosc ; down/option/shift
X )
X
X (#mouse-dol ; down/option/lock
X )
X
X (#mouse-dolc ; down/option/lock
X )
X
X (#mouse-dols ; down/option/lock/shift
X )
X
X (#mouse-dolsc ; down/option/lock/shift/command
X )
X
X (#mouse-set-region ; set the region to be from last dot to dot.
X (set-mark)
X (goto-character #mouse-last-dot)
X (exchange-dot-and-mark)
X )
X
X (#mouse-click-p clickp
X (if (= (dot) #mouse-last-dot)
X (setq clickp 1)
X (setq clickp 0)
X ))
X
X (#mouse-scroll-region ; out of range actions:
X ; left margin -- hard to generate, ignored
X ; right margin -- simulate scroll bar
X ; line 1 -- previous page
X ; line 24/25 -- next page
X ; other lines -- thumbing
X ; top margin -- previous page
X ; bottom margin -- next page
X ;
X ; if shifted, deal with lines.
X ; line 1 scrolls one line down
X ; line 24/25 scrolls one line up
X ; else line to top; with option to bottom.
X ;
X ; if up stroke is in same place as down
X ; stroke, don't do anything, so clicks in
X ; the scroll region don't do the action
X ; twice.
X (if (= down 1)
X (if (= shift 1)
X (do-lines)
X (do-pages))
X )
X (if (& (= up 1)
X (| (!= x #mouse-last-x) (!= y #mouse-last-y)))
X (if (= shift 1)
X (do-lines)
X (do-pages)
X )
X )
X (#mouse-set-region)
X )
X
X (do-pages ; large motions via pages and thumbing
X (if (| (= y 0) (= y 1) (= y 24) (= y 25))
X (progn
X (if (| (= y 0) (= y 1))
X (previous-page)
X (Next-Page)
X ))
X (if (= x 81)
X (goto-percent (/ (* y 100) 25))
X )
X ))
X
X (do-lines ; fine control over lines
X (if (= x 81)
X (if (| (= y 1) (= y 24) (= y 25))
X (if (| (= y 0) (= y 1))
X (scroll-one-line-down)
X (scroll-one-line-up)
X )
X (progn
X (move-dot-to-x-y 1 y)
X (if (= option 0)
X (line-to-top-of-window)
X (line-to-bottom-of-window))
X )
X )
X )
X )
X
X (line-to-bottom-of-window nlines i
X (line-to-top-of-window)
X (setq i 0)
X (setq nlines (- (window-height) 1))
X (while (< i nlines)
X (scroll-one-line-down)
X (setq i (+ i 1))
X )
X )
X
X (goto-percent
X (goto-character (/ (* (buffer-size) (arg 1)) 100))
X )
X)
X
X(bind-to-key "move-mac-cursor" "\em")
SHAR_EOF
if test 8406 -ne "`wc -c < 'misc/macmouse.ml'`"
then
echo shar: error transmitting "'misc/macmouse.ml'" '(should have been 8406 characters)'
fi
fi # end of overwriting check
# End of shell archive
exit 0
--- end of part 5 ---
Technical Details
Message-ID:
<6587@dhw68k.cts.com>Path:
arc1-ca.pugleaf.net!utzoo!mnetor!uunet!ccicpg!felix!dhw68k!macintoshReferences:
<6493@dhw68k.cts.com> <6497@dhw68k.cts.com> <6515@dhw68k.cts.com> <6538@dhw68k.cts.com>Show Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!utzoo!mnetor!uunet!ccicpg!felix!dhw68k!macintosh From: jdb@mordor.s1.gov (John Bruner) Newsgroups: comp.sources.mac Subject: UW v4.2 (part 5 of 9) Message-ID: <6587@dhw68k.cts.com> Date: 6 Apr 88 14:09:05 GMT References: <6493@dhw68k.cts.com> <6497@dhw68k.cts.com> <6515@dhw68k.cts.com> <6538@dhw68k.cts.com> Sender: macintosh@dhw68k.cts.com Organization: Lawrence Livermore National Laboratory, S-1 Project Lines: 1395 Approved: bytebug@dhw68k.cts.com (Roger L. Long)