/* * Epoch 4.0 - Code to provide abstract screens (== X-windows) for Epoch */ /* copyright (c) 1985, 1986, 1987, 1988, 1989, 1990, 1991 Free Software Foundation, Inc. this file is part of Epoch, a modified version of GNU Emacs. Epoch is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY. No author or distributor accepts responsibility to anyone for the consequences of using it or for whether it serves any particular purpose or works at all, unless he says so in writing. Refer to the GNU Emacs General Public License for full details. Everyone is granted permission to copy, modify and redistribute Epoch, but only under the conditions described in the GNU Emacs General Public License. A copy of this license is supposed to have been given to you along with Epoch so you can know your rights and responsibilities. It should be in a file named COPYING. Among other things, the copyright notice and this notice must be preserved on all copies. */ /* * $Revision: 1.56 $ * $Source: /import/kaplan/stable/distrib/epoch-4.2/src/RCS/screen.c,v $ * $Date: 92/08/26 23:14:12 $ * $Author: marca $ */ #ifndef LINT static char rcsid[] = "$Author: marca $ $Date: 92/08/26 23:14:12 $ $Source: /import/kaplan/stable/distrib/epoch-4.2/src/RCS/screen.c,v $ $Revision: 1.56 $"; #endif #include #undef NULL #include #include /* load sys/types.h, but make sure we haven't done it twice */ #ifndef makedev #include #endif #include "config.h" #include "lisp.h" #include "x11term.h" #include "buffer.h" #include "window.h" /* #include "cm.h" */ #include "screen.h" #include "screenW.h" #include "screenX.h" #include "button.h" #include "xdefault.h" #include "xresource.h" #include "dispepoch.h" /* Epoch */ /* X11 includes used; used NIL rather than NULL from lisp.h */ extern int in_display; extern int interrupt_input; void DEBUG(); /* variables first */ /* X atom constants used throughout Epoch */ Atom XA_current; /* current property atom */ Atom XA_screen_id; /* root block sequence # */ Atom XA_wm_change_state; /* change state atom for iconification */ Atom XA_resource_manager; /* Resource manager property atom */ Atom XA_targets; /* request for list of valid conversions */ Atom XA_text; /* request type "TEXT" */ Atom XA_length; /* request type "LENGTH" */ Atom XA_list_length; /* request type "LIST LENGTH" */ Atom XA_clipboard; /* CLIPBOARD selection */ /* * Default values - set up Lisp Objects later to point into these */ Display *XD_display; /* default display */ int XD_plane; /* x screen to work with */ char XD_is_color; /* color display? */ char *XD_display_name; /* its name */ char *XD_resource_name; /* process resource name */ char *XD_resource_class; /* resource class */ char *XD_command_line; /* original command line string */ char XD_use_defaults; /* look at .Xdefaults file? */ /* * Screen support. ROOT will anchor display structure. MINI_ROOT will * point to minibuffer screen in ring of screens (if distinct). CUR_ROOT * will point to currently active screen. */ struct Root_Block *root; /* Anchor to display structure */ struct Root_Block *mini_root; /* Minibuffer screen (if distinct) */ struct Root_Block *cur_root; /* Current edit screen */ struct X_Screen *cur_Xscreen; /* X11 info of active screen */ struct W_Screen *cur_Wscreen; /* Window info of active screen */ Lisp_Object rootblock; /* Lisp object pointing at display structure */ Lisp_Object minibuf_rootblock; /* Lisp object pointing at minibuf screen */ Lisp_Object Vx_screen_properties; Lisp_Object Vx_global_update; Lisp_Object Qepoch_screenp; int screen_changed; /* set if some screens need updating */ static long root_seq; /* root block sequence # */ static char first_time; /* flag for when things are done at init */ /* * Pointers at window structures: minibuffer window and selected window */ extern Lisp_Object minibuf_window; extern Lisp_Object selected_window; extern int distinct_minibuffer; extern int xargc; extern char ** xargv; extern char *getenv(); extern Lisp_Object find_block(); #define MIN(a,b) ( (a) < (b) ? (a) : (b) ) #define MAX(a,b) ( (a) > (b) ? (a) : (b) ) /* CODE */ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ char * strdup(s) char * s; /* string to duplicate */ { extern char * strcpy(); return strcpy(xmalloc(strlen(s)+1),s); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* set starting X-windows defaults */ #include "xd.h" /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ void x_init_defaults() { /* set up global defaults for things not specified by the user */ XD_screen.plane = XD_screen.plane = -1; XD_screen.font = XD_minibuf.font = "fixed"; XD_screen.name = "Edit"; XD_minibuf.name = "Minibuffer"; XD_screen.class = XD_minibuf.class = (char *)0; XD_screen.resource = XD_minibuf.resource = (char *)0; XD_screen.in_border = XD_minibuf.in_border = 2; XD_screen.out_border = XD_minibuf.out_border = 2; XD_screen.default_geometry = "80x24"; XD_minibuf.default_geometry = "80x1"; XD_screen.initial_state = XD_minibuf.initial_state = 1; XD_screen.min_width = XD_minibuf.min_width = 4; XD_screen.min_height = 2; XD_screen.nonlocal_minibuf = 1; /* Default */ XD_minibuf.min_height = 1; /* these defaults need to be dealt with specially during screen creation */ XD_screen.requested_geometry = XD_minibuf.requested_geometry = ""; XD_screen.foreground = XD_minibuf.foreground = (char *)0; XD_screen.background = XD_minibuf.background = (char *)0; XD_screen.cursor = XD_minibuf.cursor = (char *)0; XD_screen.xfcursor = XD_minibuf.xfcursor = XD_screen.xbcursor = XD_minibuf.xbcursor = (char *)0; XD_screen.cursor_glyph = XD_minibuf.cursor_glyph = XC_pencil; XD_screen.color_border = XD_minibuf.color_border = (char *)0; XD_screen.update_screen = XD_minibuf.update_screen = 0; XD_screen.motion_hints = XD_minibuf.motion_hints = 0; XD_screen.class = XD_minibuf.class = (char *)0; XD_screen.resource = XD_minibuf.resource = (char *)0; XD_screen.icon_name = XD_minibuf.icon_name = (char *)0; XD_screen.parent = XD_minibuf.parent = 0; /* call and get user specified defaults */ x_get_defaults(xdef,xdef_size,&xargc,xargv); /* if the resource/class names weren't set by the defaults, set them to * the global names */ if (!XD_screen.resource) XD_screen.resource = XD_resource_name; if (!XD_minibuf.resource) XD_minibuf.resource = XD_resource_name; if (!XD_screen.class) XD_screen.class = XD_resource_class; if (!XD_minibuf.class) XD_minibuf.class = XD_resource_class; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ Lisp_Object make_root_block() { Lisp_Object val; struct Root_Block *rb; struct W_Screen *ws; struct X_Screen *xs; val = Fmake_vector(make_number( (sizeof(struct Root_Block) - sizeof(struct Lisp_Vector) + sizeof(Lisp_Object)) / sizeof(Lisp_Object)),Qnil); XSETTYPE(val,Lisp_Root_Block); rb = XROOT(val); rb->next = val; rb->prev = val; rb->ewin = Qnil; XSET(rb->x11,Lisp_Raw_Data,xmalloc(sizeof(struct X_Screen))); XSET(rb->win,Lisp_Raw_Data,xmalloc(sizeof(struct W_Screen))); ws = XWSCREEN(rb->win); xs = XXSCREEN(rb->x11); XSET(rb->seq,Lisp_Int,root_seq++); rb->select = Qnil; ws->cursor_x = ws->cursor_y = 0; ws->vis_xpos = ws->vis_ypos = 0; xs->highlight = 0; ws->size_change_pending = 0; ws->size_change = 0; /* Dead screen bug?? */ xs->configure_pending = 0; xs->mapped = 0; #if 0 xs->expose_pending = 0; xs->extop = xs->exleft = xs->exbot = xs->exright = 0; #endif return val; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static void x_set_wm_hints(xs,istate) struct X_Screen *xs; /* screen descriptor */ int istate; /* initial state */ { XWMHints wm_hints; /* window manager hints */ wm_hints.initial_state = istate; wm_hints.input = True; if (distinct_minibuffer) { wm_hints.window_group = XXSCREEN(mini_root->x11)->xid; wm_hints.flags = InputHint | StateHint | WindowGroupHint; } else { wm_hints.flags = InputHint | StateHint; } HOLD_INPUT(XSetWMHints(xs->display,xs->xid,&wm_hints)); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static void x_set_hints(rb,xd,ugmask,pgmask) struct Root_Block *rb; struct Default_Set *xd; unsigned int ugmask,pgmask; { XS_DEF; WS_DEF; XSizeHints size_hints; XClassHint class_hint; struct X_font *f = XXFONT(XSTYLE(rb->stylenorm)->font); /* set the window name */ if (xd->name) HOLD_INPUT(XStoreName(xs->display,xs->xid,xd->name)); if (xd->icon_name) HOLD_INPUT(XSetIconName(xs->display,xs->xid,xd->icon_name)); /* set sizing hints */ #ifdef PBaseSize size_hints.base_width = 2*ws->in_border; size_hints.base_height = 2*ws->in_border; #endif size_hints.width = xs->pixwidth; size_hints.height = xs->pixheight; size_hints.x = xs->basex; size_hints.y = xs->basey; /* It isn't clear what the increments should be with variable fonts. */ if (XFVARIABLE(f)) { size_hints.width_inc = 1; size_hints.height_inc = 1; } else { size_hints.width_inc = XFWIDTH(f); size_hints.height_inc = XFHEIGHT(f); } size_hints.min_width = xd->min_width*XFWIDTH(f) + 2*ws->in_border; size_hints.min_height = xd->min_height*XFHEIGHT(f) + 2*ws->in_border; #ifdef PBaseSize size_hints.flags = PMinSize | PResizeInc | PBaseSize; #else size_hints.flags = PMinSize | PResizeInc; #endif size_hints.flags |= (ugmask & (XValue|YValue)) ? USPosition : (pgmask & (XValue|YValue)) ? PPosition : 0; size_hints.flags |= (ugmask & (WidthValue|HeightValue)) ? USSize : (pgmask & (XValue|YValue)) ? PSize : 0; if (size_hints.flags & USPosition) { /* If user-specified size, also set gravity */ switch (ugmask & (XNegative | YNegative)) { case 0: size_hints.win_gravity = NorthWestGravity; break; case XNegative: size_hints.win_gravity = NorthEastGravity; break; case YNegative: size_hints.win_gravity = SouthWestGravity; break; default: size_hints.win_gravity = SouthEastGravity; break; } size_hints.flags |= PWinGravity; } #if defined(PBaseSize) && !defined(NO_WM_NORMAL_HINTS) HOLD_INPUT(XSetWMNormalHints(xs->display,xs->xid,&size_hints)); #else HOLD_INPUT(XSetNormalHints(xs->display,xs->xid,&size_hints)); #endif /* resource and class names */ class_hint.res_name = xd->resource; class_hint.res_class = xd->class; HOLD_INPUT(XSetClassHint(xs->display,xs->xid,&class_hint)); x_set_wm_hints(xs, xd->initial_state ? NormalState : IconicState); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* give the defaults, create a screen */ static void x_create_screen(root,xdbase,alist) struct Root_Block * root; /* structure to fill in */ struct Default_Set *xdbase; /* user specified values */ Lisp_Object alist; { unsigned int ugmask,pgmask; /* geometry parse return user/program */ int x = 0,y = 0; unsigned int dx = 0,dy = 0; /* base and size */ unsigned long xcursor_color; /* X cursor color */ struct X_Screen *xs = XXSCREEN(root->x11); struct W_Screen *ws = XWSCREEN(root->win); Lisp_Object style,style1,style2; struct Lisp_Style *s; struct X_font *font; struct Default_Set xd; XColor color,xcf,xcb; /* scratch, x-cursor-fore/back */ char xcfflag,xcbflag; /* successful parsing? */ Colormap cmap; XGCValues gc; BLOCK_INPUT_DECLARE(); long foreground,background; xs->display = XD_display; xs->plane = DefaultScreen(xs->display); cmap = DefaultColormap(xs->display,xs->plane); xs->colormap = cmap; /* get the values from the alists */ memcpy(&xd,xdbase,sizeof(xd)); x_read_screen_alist(&xd,Vx_screen_properties); x_read_screen_alist(&xd,alist); root->update = xd.update_screen ? Qt : Qnil; /* set update flag */ /* deal with the font */ font = load_font(xd.font); if (!font) { if (first_time) { fprintf(stderr,"Cannot load font `%s'\n",xd.font); exit(1); } else { free(xs); free(ws); /* this should be all that's allocated now */ error("Bad font '%s'",xd.font); } } /* set up the geometry */ /* the value returned is a mask of what was actually changed. We don't * worry about it since we know that default_geometry contains * enough info to fill them all in. [No longer true -- MPF] * The original version is much different, and makes no sense to me. * It used XGeometry() with bizarre parameters, and appeared to be * confused about whether it meant pixels or characters. I have chosen * to arrange things to interpret AxB as characters, not pixels. * I believe the original was bogus, and was corrected by a call * to change the window size before the end of all initializations * (runs with dbx support this hypothesis). * I have changed the code to work in what I believe to the be * correct way. */ /* XGeometry is not used because it assumes the specs are in pixels, * not in characters. */ pgmask = XParseGeometry(xd.default_geometry,&x,&y,&dx,&dy); ugmask = XParseGeometry(xd.requested_geometry,&x,&y,&dx,&dy); /* clip to proper range */ dx = MAX(dx,xd.min_width); dy = MAX(dy,xd.min_height); xs->out_border = xd.out_border; ws->in_border = xd.in_border; xs->pixwidth = dx*XFWIDTH(font) + 2*ws->in_border; xs->pixheight = dy*XFHEIGHT(font) + 2*ws->in_border; ws->pixw = dx*XFWIDTH(font); ws->pixh = dy*XFHEIGHT(font); ws->width = dx; ws->height = dy; /* check for "relative" specifications, and adjust the values. */ if ((ugmask | pgmask) & XNegative) x += DisplayWidth(xs->display,xs->plane) - xs->pixwidth - 2*xs->out_border; if ((ugmask | pgmask) & YNegative) y += DisplayHeight(xs->display,xs->plane) - xs->pixheight - 2*xs->out_border; xs->basex = x; xs->basey = y; /* now, do the colors */ BLOCK_INPUT(); /* server queries here, have to block */ /* have to do the colors one by one, yay */ foreground = (xd.foreground && XParseColor(xs->display,cmap,xd.foreground,&color) && XAllocColor(xs->display,cmap,&color) ) ? color.pixel : BlackPixel(xs->display,xs->plane); background = (xd.background && XParseColor(xs->display,cmap,xd.background,&color) && XAllocColor(xs->display,cmap,&color) ) ? color.pixel : WhitePixel(xs->display,xs->plane); xs->border_color = (xd.color_border && XParseColor(xs->display,cmap,xd.color_border,&color) && XAllocColor(xs->display,cmap,&color) ) ? color.pixel : BlackPixel(xs->display,xs->plane); xcursor_color = (xd.cursor && XParseColor(xs->display,cmap,xd.cursor,&color) && XAllocColor(xs->display,cmap,&color) ) ? color.pixel : foreground; /* cursor colors are strange, since we must have both fore/back * in order to recolor the cursor, and we want to be able to flip colors * in case the reverse flag is set. What we will do is try to get * any user specified colors first, but if that fails we'll use the * text foreground/background values. The flag variables are true if * the user specified a color AND it was successful parsed. */ if (xd.xfcursor && XParseColor(xs->display,cmap,xd.xfcursor,&xcf)) xcfflag = 1; else { xcf.pixel = foreground; XQueryColor(xs->display,cmap,&xcf); xcfflag = 0; } if (xd.xbcursor && XParseColor(xs->display,cmap,xd.xbcursor,&xcb)) xcbflag = 1; else { xcb.pixel = background; XQueryColor(xs->display,cmap,&xcb); xcbflag = 0; } UNBLOCK_INPUT(); if (xd.reverse) /* want reversed colors */ { color.pixel = foreground; foreground = background; background = color.pixel; if (!xd.cursor) xcursor_color = foreground; memcpy(&color,&xcf,sizeof(color)); memcpy(&xcf,&xcb,sizeof(color)); memcpy(&xcb,&color,sizeof(color)); } /* make sure the cursor is visible */ if (xcursor_color == background && !xd.cursor) xcursor_color = foreground; /* make visible border unless explicitly set */ if (xs->border_color == background && !xd.background) xs->border_color = foreground; /* time to make the window */ BLOCK_INPUT(); xs->xid = XCreateSimpleWindow( xs->display, xd.parent ? xd.parent : RootWindow(xs->display,xs->plane), /* put it the root window on the current display */ xs->basex,xs->basey, /* upper left */ xs->pixwidth,xs->pixheight, /* size */ xs->out_border,xs->border_color, background); UNBLOCK_INPUT(); if (xs->xid == 0) { /* all that's been done is mallocing the substructures and * creating the lisp RootBlock. Free the substructures, and the * garbage collector will take care of the RootBlock */ free(xs); free(ws); error("Unable to create new screen"); } /* * Set up styles; at this level, all fields must be valid. Note that for * these internal styles, "font" is only valid in stylenorm. */ style = Fepoch_make_style(); s = XSTYLE(style); XSET(root->stylenorm,Lisp_Style,s); style1 = Fepoch_make_style(); s = XSTYLE(style1); XSET(root->stylerev,Lisp_Style,s); style2 = Fepoch_make_style(); s = XSTYLE(style2); XSET(root->stylecursor,Lisp_Style,s); XSTYLE(root->stylenorm)->foreground = make_Xresource(xs->display,xs->plane, foreground, XA_CARDINAL); XSTYLE(root->stylenorm)->background = make_Xresource(xs->display,xs->plane, background, XA_CARDINAL); XSET(XSTYLE(root->stylenorm)->font,Lisp_Raw_Data,font); XSTYLE(root->stylerev)->foreground = XSTYLE(root->stylenorm)->background; XSTYLE(root->stylerev)->background = XSTYLE(root->stylenorm)->foreground; XSTYLE(root->stylecursor)->cursor_foreground = XSTYLE(root->stylenorm)->background; XSTYLE(root->stylecursor)->cursor_background = make_Xresource(xs->display,xs->plane, xcursor_color, XA_CARDINAL); BLOCK_INPUT(); XFlush(xs->display); gc.font = XFID(font); gc.foreground = foreground; gc.background = background; xs->gc_norm = XCreateGC(xs->display, xs->xid, GCFont|GCForeground|GCBackground, &gc); xs->gc_inverse = XCreateGC(xs->display, xs->xid, GCFont | GCForeground | GCBackground, &gc); gc.foreground = background; gc.background = foreground; xs->gc_rev = XCreateGC(xs->display, xs->xid, GCFont|GCForeground|GCBackground, &gc); xs->gc_style = XCreateGC(xs->display, xs->xid, GCFont | GCForeground | GCBackground, &gc); gc.foreground = background; gc.background = xcursor_color; xs->gc_curs = XCreateGC(XD_display, xs->xid, GCFont|GCForeground|GCBackground, &gc); xs->the_cursor = XCreateFontCursor(xs->display, xd.cursor_glyph); XDefineCursor (xs->display, xs->xid, xs->the_cursor); if (xcfflag || xcbflag || xd.reverse) XRecolorCursor(xs->display,xs->the_cursor,&xcf,&xcb); memcpy(&(xs->xfcursor),&xcf,sizeof(xcf)); memcpy(&(xs->xbcursor),&xcb,sizeof(xcb)); xs->cursor_glyph = xd.cursor_glyph; xs->cursor_exists = 0; /* cursor hasn't been plotted */ ws->vis_xpos = 0; /* and it isn't anywhere yet */ ws->vis_ypos = 0; x_set_hints(root,&xd,ugmask,pgmask); /* set window-manager hints */ root->motion_hints = xd.motion_hints ? Qt : Qnil; XSelectInput(xs->display, xs->xid, NORMAL_INPUT | (xd.motion_hints ? MOTION_INPUT : 0)); /* export the root block sequence number */ x = XFASTINT(root->seq); XChangeProperty(xs->display,xs->xid, XA_screen_id,XA_INTEGER,32, /* 32 is magic */ PropModeReplace,(unsigned char *) &x,1); screen_changed++; root->needs_update = Qt; /* Leaving this out for ICCCM reasons. Need to be able to set properties on * it before it gets mapped. */ #if 0 XMapWindow (xs->display, xs->xid); XFlush (xs->display); #endif UNBLOCK_INPUT(); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* creates the data structures for the base and minibuff screens */ void x_init_roots() { struct window *w; struct W_Screen *ws; /* * Make base root structure. This will occur regardless of minibuffer * mode. */ if (!inhibit_window_system && distinct_minibuffer) mini_root = XROOT(make_root_block()); rootblock = make_root_block(); cur_root = XROOT(rootblock); cur_Xscreen = XXSCREEN(cur_root->x11); cur_Wscreen = XWSCREEN(cur_root->win); root = cur_root; /* * Set some window stuff up. Note that window dimensions are not set * here; they are set after x_create_screen() has been called, etc. */ if (!distinct_minibuffer) { /* Running with 1 minibuffer window per screen */ mini_root = 0; minibuf_rootblock = Qnil; /* Pointers to next/prev screen will loop back on itself */ cur_root->next = rootblock; cur_root->prev = rootblock; cur_root->minibuf_window = minibuf_window; XSET(rootblock,Lisp_Root_Block,root); /* Set up root window root value, etc */ w = XWINDOW(XWINDOW(minibuf_window)->prev); w->root = rootblock; cur_root->ewin = XWINDOW(minibuf_window)->prev; cur_root->select = cur_root->ewin; cur_root->prev_select = cur_root->ewin; cur_root->minibuf_window = minibuf_window; w = XWINDOW(minibuf_window); w->root = rootblock; w = XWINDOW(cur_root->ewin); w->next = cur_root->minibuf_window; } else { /* Running under X with distinct minibuffer. * set up the minibuffer rootblock */ /* mini_root = XROOT(make_root_block()); */ ws = XWSCREEN(mini_root->win); /* this depends on mini_root and cur_root being 1-cycles */ cur_root->next = mini_root->next; mini_root->next = cur_root->prev; mini_root->prev = cur_root->prev; cur_root->prev = cur_root->next; XSET(minibuf_rootblock,Lisp_Root_Block,mini_root); XSET(rootblock,Lisp_Root_Block,cur_root); /* need to set the root-window root value to the root system we * made for it */ w = XWINDOW(XWINDOW(minibuf_window)->prev); w->root = rootblock; cur_root->ewin = XWINDOW(minibuf_window)->prev; cur_root->select = cur_root->ewin; cur_root->minibuf_window = minibuf_window; w = XWINDOW(minibuf_window); w->root = minibuf_rootblock; mini_root->ewin = minibuf_window; mini_root->minibuf_window = minibuf_window; mini_root->select = minibuf_window; } } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Set up the X-window system and init all the defaults. Also, set up * a screen for the base window and for the minibuff */ void x_init_display() { struct X_Screen *xs; struct W_Screen *ws; extern Lisp_Object Vdistinct_minibuffers; root_seq = 0; /* because we can't have initialized statics */ screen_changed = 0; /* start not needing */ /* open the Display / connect to X-server * XD_display_name is set by the default loader as a special case */ XD_display = XOpenDisplay(XD_display_name); if (XD_display == 0) { fprintf(stderr,"Cannot connect to X-server"); if (XD_display_name == 0 || *XD_display_name == '\0') XD_display_name = getenv("DISPLAY"); if (XD_display_name == 0 || *XD_display_name == '\0') fprintf(stderr," - no DISPLAY set\n"); else fprintf(stderr," on DISPLAY %s\n",XD_display_name); exit(37); } XD_plane = DefaultScreen(XD_display); XD_is_color = DisplayCells(XD_display,DefaultScreen(XD_display)) > 2; /* set up special properties */ XA_current = XInternAtom(XD_display,XA_EPOCH_CURRENT,False); XA_screen_id = XInternAtom(XD_display,XA_EPOCH_SCREEN_ID,False); XA_wm_change_state = XInternAtom(XD_display,"WM_CHANGE_STATE",False); XA_resource_manager = XInternAtom(XD_display,"RESOURCE_MANAGER",False); XA_targets = XInternAtom(XD_display,"TARGETS",False); XA_text = XInternAtom(XD_display,"TEXT",False); XA_length = XInternAtom(XD_display,"LENGTH",False); XA_list_length = XInternAtom(XD_display,"LIST_LENGTH",False); XA_clipboard = XInternAtom(XD_display,"CLIPBOARD",False); /* set up the default values, including minibuffer mode -> local or not */ x_init_defaults(); distinct_minibuffer = XD_screen.nonlocal_minibuf; Vdistinct_minibuffers = distinct_minibuffer ? Qt : Qnil; first_time = 1; /* mark as initialization time */ /* *create the structures to hold the initial screen(s) */ x_init_roots(); x_create_screen(cur_root,&XD_screen,Qnil); if (distinct_minibuffer) { /* Distinct minibuffer...screen has no minibuffer window at bottom */ struct window *w; w = XWINDOW(cur_root->ewin); XFASTINT(w->pixtop) = XWSCREEN(cur_root->win)->in_border; XFASTINT(w->pixleft) = XWSCREEN(cur_root->win)->in_border; XFASTINT(w->pixwidth) = XWSCREEN(cur_root->win)->pixw; XFASTINT(w->pixheight) = XWSCREEN(cur_root->win)->pixh; ws = XWSCREEN(cur_root->win); ws->cur_line = ws->new_cur_line = XLINE(w->lines); ws->cur_char = ws->new_cur_char = XLINE(w->lines)->body; ws->cur_w = ws->new_cur_w = w; /* Create the screens as well */ x_create_screen(mini_root,&XD_minibuf,Qnil); w = XWINDOW(mini_root->minibuf_window); XFASTINT(w->pixtop) = XWSCREEN(mini_root->win)->in_border; XFASTINT(w->pixleft) = XWSCREEN(mini_root->win)->in_border; XFASTINT(w->pixwidth) = XWSCREEN(mini_root->win)->pixw; XFASTINT(w->pixheight) = XWSCREEN(mini_root->win)->pixh; ws = XWSCREEN(mini_root->win); ws->cur_line = ws->new_cur_line = XLINE(w->lines); ws->cur_char = ws->new_cur_char = XLINE(w->lines)->body; ws->cur_w = ws->new_cur_w = w; /* have to fix up the miniroot property and base screen specially */ xs = XXSCREEN(mini_root->x11); XChangeProperty(xs->display,xs->xid,XA_current,XA_STRING,8, PropModeReplace,"minibuf",8); XChangeProperty(xs->display,xs->xid,XA_WM_COMMAND,XA_STRING,8, PropModeReplace,(unsigned char *) XD_command_line, strlen(XD_command_line)+1); /* force the minibuffer to be mapped (for errors) */ XMapWindow(xs->display,xs->xid); } else { /* Minibuffer window at bottom of each screen */ struct window *w; struct buffer *b; struct X_font *font; w = XWINDOW(minibuf_window); b = XBUFFER(w->buffer); font = XXFONT(STYLE_FIELD(w,font,stylenorm)); /* set minibuffer window's height, etc. */ w = XWINDOW(cur_root->minibuf_window); XFASTINT(w->pixtop) = XWSCREEN(cur_root->win)->in_border + XWSCREEN(cur_root->win)->pixh - XFHEIGHT(font); XFASTINT(w->pixleft) = XWSCREEN(cur_root->win)->in_border; XFASTINT(w->pixwidth) = XWSCREEN(cur_root->win)->pixw; XFASTINT(w->pixheight) = XFHEIGHT(font); /* set root window(s) height */ w = XWINDOW(XWINDOW(minibuf_window)->prev); set_window_height(cur_root->ewin, XWSCREEN(cur_root->win)->pixh - XFHEIGHT(font)); XFASTINT(w->pixleft) = XWSCREEN(cur_root->win)->in_border; XFASTINT(w->pixwidth) = XWSCREEN(cur_root->win)->pixw; XFASTINT(w->pixtop) = XWSCREEN(cur_root->win)->in_border; ws = XWSCREEN(root->win); ws->cur_line = ws->new_cur_line = XLINE(w->lines); ws->cur_char = ws->new_cur_char = XLINE(w->lines)->body; ws->cur_w = ws->new_cur_w = w; xs = XXSCREEN(cur_root->x11); XMapWindow(xs->display,xs->xid); } first_time = 0; /* this would normally be handled in x_select_screen */ xs = XXSCREEN(cur_root->x11); XChangeProperty(xs->display,xs->xid,XA_current,XA_STRING,8, PropModeReplace,"yes",4); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* returns the root_block that points to the temp * XW_Screen structs, or NULL if it couldn't find it. */ struct Root_Block * x_find_screen(wid) Window wid; /* window id of the event */ { struct Root_Block *rb; /* search the list, anchored at mini-buf */ rb = root; do { if (XXSCREEN(rb->x11)->xid == wid) return rb; rb = XROOT(rb->next); } while (rb != root); return 0; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* returns the root_block given the sequence #, or Qnil if not found */ Lisp_Object x_find_screen_seq(seq) Lisp_Object seq; { Lisp_Object block = rootblock; /* search the list, anchored at mini-buf */ do { if (EQ(XROOT(block)->seq,seq)) return block; block = XROOT(block)->next; } while (!EQ(block,rootblock)); return Qnil; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::screen-p",Fscreen_p,Sscreen_p,1,1,0, "Return t if the argument is a screen, nil otherwise") (screen) Lisp_Object screen; { return XTYPE(screen) == Lisp_Root_Block ? Qt : Qnil ; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::current-screen",Fcurrent_screen,Scurrent_screen,0,0,0, "Return the ID of the current screen.") () { return EDIT_SCREEN; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::minibuf-screen",Fminibuf_screen,Sminibuf_screen,0,0,0, "Return the ID of the minibuf screen.") () { return minibuf_rootblock; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* window size changes are held up during critical regions. afterwards, * we want to deal with any delayed changes */ void hold_window_change () { in_display = 1; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ void unhold_window_change() { struct Root_Block *rb = root; struct W_Screen *ws; in_display = 0; do { ws = XWSCREEN(rb->win); if (ws->size_change_pending) change_screen_size(ws->new_height,ws->new_width,1,rb); rb = XROOT(rb->next); } while (rb != root); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* for each root block except the mini_root, call the passed function on * the root window of that block. The current root is handled specially so * that the return value for that block can be returned */ Lisp_Object do_windows_of_screens(func,obj) Lisp_Object (*func)(); Lisp_Object obj; { struct Root_Block *rb = cur_root; Lisp_Object value = Qnil; do { RW_FIXUP(rb) if (rb != mini_root) value = func(rb->ewin,obj); } while ((rb=XROOT(rb->next)) != cur_root && NIL(value)); return value; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* return the screen if the buffer is in the window or child-window */ static Lisp_Object epoch_buffer_in_window_p(w,obj) Lisp_Object w; Lisp_Object obj; { struct window *p; for ( ; !NIL(w) && !EQ(w,XROOT(XWINDOW(w)->root)->minibuf_window) ; w = XWINDOW(w)->next ) { p = XWINDOW(w); if (EQ (p->buffer, obj)) return p->root; if (!NIL(p->vchild) && !NIL(epoch_buffer_in_window_p(p->vchild,obj))) return p->root; if (!NIL(p->hchild) && !NIL(epoch_buffer_in_window_p(p->hchild,obj))) return p->root; } return Qnil; /* indicate not done yet */ } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::screens-of-buffer", Fepoch_screens_of_buffer,Sepoch_screens_of_buffer, 0,1,"b", "Return a list of screens for which BUFFER is displayed in a window.") (buffer) Lisp_Object buffer; { struct Root_Block *rb; Lisp_Object screen; Lisp_Object value = Qnil; if (NIL(buffer)) buffer = Fcurrent_buffer(); else buffer = Fget_buffer(buffer); if (NIL(buffer)) return Qnil; rb = root; do { RW_FIXUP(rb); screen = epoch_buffer_in_window_p(rb->ewin,buffer); if (!NIL(screen)) value = Fcons(screen,value); rb = XROOT(rb->next); } while (rb != root); return value; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::reparent-screen",Freparent_screen,Sreparent_screen,3,4,0, "Reparent screen to be under specified X-WINDOW, with position X,Y\n\ Defaults to current screen; optional fourth argument specifies a screen.") (xwin,x,y,scr) Lisp_Object xwin,x,y,scr; { struct X_Screen *xs = 0; Display *dpy; Window win,parent; int plane,px,py; if (XRESOURCEP(scr)) { if (XXRESOURCE(scr)->type != XA_WINDOW) error("Screen resource must be of type WINDOW"); dpy = XXRESOURCE(scr)->dpy; win = XXRESOURCE(scr)->id; plane = XXRESOURCE(scr)->plane; } else { scr = find_block(scr); xs = XXSCREEN(XROOT(scr)->x11); dpy = xs->display; win = xs->xid; plane = xs->plane; } CHECK_NUMBER(x,0); CHECK_NUMBER(y,0); CHECK_XRESOURCE(xwin,0); px = XFASTINT(x); py = XFASTINT(y); parent = XXRESOURCE(xwin)->id; XReparentWindow(dpy,win,parent,px,py); return Qt; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::create-screen",Fcreate_screen,Screate_screen,0,2,0, "Create a new X11 screen using association list ALIST.\n\ Optional argument is buffer to put in the screen.\n\ If non-existent or nil, a new one is created.") (buff,alist) Lisp_Object buff,alist; { Lisp_Object new_root; struct Root_Block *rb; struct W_Screen *ws; struct X_Screen *xs; struct window *w; struct buffer *b; struct X_font *font; /* verify buffer argument before doing anything else */ if (!NIL(buff)) buff = Fget_buffer(buff); new_root = make_root_block(); rb = XROOT(new_root); ws = XWSCREEN(rb->win); xs = XXSCREEN(rb->x11); /* need a screen now */ x_create_screen(rb,&XD_screen,alist); /* link it in in front of the minibuf (or root of screens) */ rb->prev = root->prev; XROOT(root->prev)->next = new_root; root->prev = new_root; rb->next = rootblock; if (distinct_minibuffer) { /* Screen contains no minibuffer at bottom */ rb->minibuf_window = minibuf_window; /* make a window to attach */ rb->ewin = make_window(); rb->select = rb->ewin; w = XWINDOW(rb->ewin); w->root = new_root; ws->cur_line = ws->new_cur_line = XLINE(w->lines); ws->cur_char = ws->new_cur_char = XLINE(w->lines)->body; ws->cur_w = ws->new_cur_w = w; set_window_height(rb->ewin,ws->pixh,1); XFASTINT( w->pixwidth ) = ws->pixw; XFASTINT( w->pixtop ) = ws->in_border; XFASTINT( w->pixleft ) = ws->in_border; w->next = minibuf_window; /* set the buffer */ Fset_window_buffer(rb->ewin, NIL(buff) ? Fget_buffer_create(build_string("*scratch*")) : buff); } else { /* * Create the screen's minibuffer window. Link it to same buffer * as "global" minibuf_window. */ rb->minibuf_window = make_window(); w = XWINDOW(rb->minibuf_window); w->buffer = XWINDOW(minibuf_window)->buffer; b = XBUFFER(w->buffer); /* Same as minibuf window */ w->root = new_root; font = XXFONT(STYLE_FIELD(w,font,stylenorm)); XFASTINT(w->pixtop) = ws->in_border + ws->pixh - XFHEIGHT(font); XFASTINT(w->pixleft) = ws->in_border; XFASTINT(w->pixheight) = XFHEIGHT(font); XFASTINT(w->pixwidth) = ws->pixw; /* * Create root window for screen. */ rb->ewin = make_window(); w = XWINDOW(rb->ewin); w->next = rb->minibuf_window; rb->select = rb->ewin; w->root = new_root; ws->cur_line = ws->new_cur_line = XLINE(w->lines); ws->cur_char = ws->new_cur_char = XLINE(w->lines)->body; ws->cur_w = ws->new_cur_w = XWINDOW(rb->ewin); set_window_height(rb->ewin,ws->pixh - XFHEIGHT(font),1); XFASTINT(w->pixwidth) = ws->pixw; XFASTINT(w->pixtop) = ws->in_border; XFASTINT(w->pixleft) = ws->in_border; Fset_window_buffer(rb->ewin, NIL(buff) ? Fget_buffer_create(build_string("*scratch*")) : buff); } return new_root; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ Lisp_Object find_block(seq) Lisp_Object seq; { Lisp_Object block; if (NIL(seq)) block = EDIT_SCREEN; else if (ROOTP(seq)) /* make sure it's a live screen */ block = EQ(Qnil,XROOT(seq)->next) ? Qnil : seq; else if (XTYPE(seq) != Lisp_Int) error("Need screen or int argument"); else block = x_find_screen_seq(seq); return NIL(block) ? Qnil : block; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* return the next or previous screen, depending on the flag */ x_another_screen(seq,map,dir) Lisp_Object seq,map; int dir; { Lisp_Object block, start; block = find_block(seq); if (NIL(block)) return Qnil; start = block; /* don't go around in circles */ do { if (dir) block = XROOT(block)->next; else block = XROOT(block)->prev; /* if it's not the minibuf and we can find unmapped screens or * it's mapped, return it */ if (!EQ(block,minibuf_rootblock) && (!NIL(map) || XXSCREEN(XROOT(block)->x11)->mapped)) return block; } while (!EQ(block,start)); return Qnil; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::next-screen",Fnext_screen,Snext_screen,0,2,0, "Return the ID of the \"next\" screen. The minibuf is excepted, and\n\ unmapped windows are also. The first optional argument is the ID of\n\ the screen to start at - if omitted, the current screen is assumed.\n\ The second optional argument if not nil indicates that unmapped\n\ screens should be found.") (seq,map) Lisp_Object seq,map; /* next from this one */ { return x_another_screen(seq,map,1); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::prev-screen",Fprev_screen,Sprev_screen,0,2,0, "Return the ID of the \"previous\" screen. The minibuf is excepted,\n\ and unmapped windows are also. The first optional argument is the ID\n\ of the screen to start at - if omitted, the current screen is\n\ assumed. The second optional argument if not nil indicates that\n\ unmapped screens should be found.") (seq,map) Lisp_Object seq,map; /* next from this one */ { return x_another_screen(seq,map,0); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::select-screen", Fselect_screen, Sselect_screen, 0, 1, 0, "Change the selected screen to the screen whose ID is passed as the\n\ first argument. If omitted, the \"next\" screen is selected.") (seq) Lisp_Object seq; { Lisp_Object block = Qnil; char *msg = "Holy PH Batman, the buffer's missing!\n"; char *msg2 = "Holy Panes Batman, the window's missing!\n"; /* find out where we're going, first */ if (NIL(seq)) { /* look for a mapped screen, first, and if none, any screen */ block = Fnext_screen(Qnil,Qnil); if (NIL(block)) block = Fnext_screen(Qnil,Qt); } else block = find_block(seq); if (NIL(block)) return Qnil; if (EQ(block,minibuf_rootblock)) return Qnil; if (XTYPE(XROOT(block)->select) != Lisp_Window) { write(2,msg2,strlen(msg2)); fprintf (stderr, " ** Window type is %d\n", XTYPE(XROOT(block)->select)); abort(); } if (XTYPE(XWINDOW(XROOT(block)->select)->buffer) != Lisp_Buffer) { write(2,msg,strlen(msg)); fprintf (stderr, " ** Buffer type is %d\n", XTYPE(XWINDOW(XROOT(block)->select)->buffer)); abort(); } /*selecting the window fixes everything */ if (selected_window == minibuf_window) { if (!distinct_minibuffer && (XROOT(block)->select != minibuf_window)) { XROOT(block)->prev_select = XROOT(block)->select; } /* need to get back to the minibuf in this case */ if (distinct_minibuffer) Fselect_window(XROOT(block)->select); else Fselect_window(XROOT(block)->prev_select); Fselect_window(minibuf_window); } else Fselect_window(XROOT(block)->select); return block; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* select a screen. this is called from Fselect_window, to make sure that * whenever a window is selected, the screen it's on is also selected. We * have to do some checks about the minibuf to make sure that the window * pointers go to the right places */ Lisp_Object x_select_screen(screen) Lisp_Object screen; { struct Root_Block *rb,*oldrb; Lisp_Object old_screen; char same_edit = 0; char *msg = "SELECT ERROR : NOT A SCREEN!\n"; extern char X_focus; /* set by x11term.c */ BLOCK_INPUT_DECLARE(); if (!ROOTP(screen)) { write(2,msg,strlen(msg)); abort(); } rb = XROOT(screen); if (rb == cur_root) /* selecting current screen */ { cur_Wscreen = XWSCREEN(rb->win); /* make sure that all pointers are */ cur_Xscreen = XXSCREEN(rb->x11); /* up to date - inexpensive to do */ return screen; } /* check for dead screens : */ if (EQ(Qnil,rb->seq)) /* it's dead, don't select it */ { Fselect_window(cur_root->select); error("Attempt to select dead screen"); } /* remove cursor from the old screen */ if (cur_Xscreen->cursor_exists) { BLOCK_INPUT(); CursorToggle(cur_root); UNBLOCK_INPUT(); } /* if it's just switch back from the minibuf to the edit screen, * don't do the redisplay and all that */ if (screen == EDIT_SCREEN) same_edit = 1; /* set this screen up as the edit screen */ cur_root = rb; cur_Xscreen = XXSCREEN(rb->x11); cur_Wscreen = XWSCREEN(rb->win); /* if selecting minibuf or the same edit screen, that's all */ if (rb == mini_root || same_edit) return screen; RW_FIXUP(rb); /* make sure we have root-window */ /* need to do things to the old screen */ old_screen = EDIT_SCREEN; oldrb = XROOT(old_screen); /* tell WM that it's not current anymore */ BLOCK_INPUT(); XChangeProperty(XXSCREEN(oldrb->x11)->display, XXSCREEN(oldrb->x11)->xid, XA_current,XA_STRING,8, PropModeReplace,"no",3); UNBLOCK_INPUT(); /* fix up the current screen before we leave, so that the garbage * collect doesn't zap parent windows */ RW_FIXUP(oldrb); /* tell the WM that this screen is current */ BLOCK_INPUT(); XChangeProperty(cur_Xscreen->display,cur_Xscreen->xid, XA_current,XA_STRING,8, PropModeReplace,"yes",4); UNBLOCK_INPUT(); if (distinct_minibuffer) { /* attach screen to window tree of current screen */ XWINDOW(minibuf_window)->prev = rb->ewin; } else { /* If minibuffer window is selected window on old screen, make it * the selected window on new screen. */ if (!NIL(oldrb->prev_select)) oldrb->select = oldrb->prev_select; /* UGLY: *the* minibuffer window is attached to the window * hierarchy of the current screen. Screen being selected has its * own "fake" minibuffer window. We must swap these two windows * now. */ swap_minibuf_windows(oldrb,rb); } Fset_screen_modified(old_screen); /* in case of garbage */ return screen; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ #define SWAP(a,b) {\ Lisp_Object swap;\ swap = a;\ a = b;\ b = swap;} swap_minibuf_windows(old,new) struct Root_Block *old,*new; { struct window *w1,*w2; SWAP(old->minibuf_window,new->minibuf_window); XWINDOW(old->minibuf_window)->prev = old->ewin; XWINDOW(old->ewin)->next = old->minibuf_window; XWINDOW(minibuf_window)->prev = new->ewin; XWINDOW(new->ewin)->next = minibuf_window; w1 = XWINDOW(new->minibuf_window); /* THE minibuffer */ w2 = XWINDOW(old->minibuf_window); /* FAKE minibuffer */ SWAP(w1->root,w2->root); /* Root pointers */ SWAP(w1->pixleft,w2->pixleft); SWAP(w1->pixtop,w2->pixtop); SWAP(w1->pixwidth,w2->pixwidth); SWAP(w1->pixheight,w2->pixheight); SWAP(w1->window_end_vpos,w2->window_end_vpos); SWAP(w1->window_end_valid,w2->window_end_valid); w1->size_change = Qt; } #undef SWAP /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static Lisp_Object delete_screen(block) Lisp_Object block; { Lisp_Object dest = Qnil; struct Root_Block *rb; struct X_Screen *xs; struct W_Screen *ws; if (EQ(block,minibuf_rootblock)) error ("Attempt to delete minibuffer"); /* if we're deleting the current screen, we need to go elsewhere */ if (EQ(block,EDIT_SCREEN)) /* yep, current screen is toast */ { /* look for a mapped screen first. If we can't find one, use an * unmapped one. */ dest = Fnext_screen(Qnil,Qnil); if (!ROOTP(dest) || EQ(dest,block)) dest = Fnext_screen(Qnil,Qt); if (EQ(dest,block) || !ROOTP(dest)) error ("Attempt to delete only edit screen"); Fselect_screen(dest); /* now go there */ } rb = XROOT(block); /* clip it out of the list */ XROOT(rb->next)->prev = rb->prev; XROOT(rb->prev)->next = rb->next; /* Check if anchor to display structure was pointing at this screen */ if (rb == root) { if (NIL(dest)) dest = EDIT_SCREEN; root = XROOT(dest); XSET(rootblock,Lisp_Root_Block,root); } RW_FIXUP(rb) destroy_window_tree(rb->ewin); xs = XXSCREEN(rb->x11); /* free up the graphics contexts */ XFreeGC(xs->display,xs->gc_norm); XFreeGC(xs->display,xs->gc_rev); XFreeGC(xs->display,xs->gc_curs); XFreeGC(xs->display,xs->gc_style); XFreeGC(xs->display,xs->gc_inverse); XFreeCursor(xs->display,xs->the_cursor); XDestroyWindow(xs->display,xs->xid); /* have to free up the x block storage */ free(xs); /* take care of w block storage */ ws = XWSCREEN(rb->win); free(ws); /* now we can relase the W block */ /* the root is collected by the garbage collector */ rb->next = rb->prev = Qnil; /* mark as dead */ return dest; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static Lisp_Object x_internal_block_handler(seq,action) Lisp_Object seq; int action; { Lisp_Object screen; struct X_Screen *xs = 0; Display *dpy; Window win; int plane; Lisp_Object result = Qt; XEvent message; if (XRESOURCEP(seq)) { if (XXRESOURCE(seq)->type != XA_WINDOW) error("Screen resource must be of type WINDOW"); dpy = XXRESOURCE(seq)->dpy; win = XXRESOURCE(seq)->id; plane = XXRESOURCE(seq)->plane; screen = seq; } else { screen = find_block(seq); if (NIL(screen)) return Qnil; dpy = XXSCREEN(XROOT(screen)->x11)->display; win = XXSCREEN(XROOT(screen)->x11)->xid; plane = XXSCREEN(XROOT(screen)->x11)->plane; xs = XXSCREEN(XROOT(screen)->x11); } result = screen; switch (action) { case 1 : HOLD_INPUT(XRaiseWindow(dpy,win)); break; /* 2 unused */ case 3 : if (xs) result = XROOT(screen)->seq; break; case 4 : if (xs) result = delete_screen(screen); break; case 5 : HOLD_INPUT(XLowerWindow(dpy,win)); break; case 6 : /* Map == Go to NormalState */ if (xs) x_set_wm_hints(xs,NormalState); /* in case of Withdrawn */ HOLD_INPUT(XMapWindow(dpy,win)) break; case 7 : /* Unmap == Go to WithdrawnState */ HOLD_INPUT(XUnmapWindow(dpy,win)) /* normal unmap first */ /* now a synthetic unmap */ message.xany.type = UnmapNotify; message.xunmap.event = RootWindow(dpy,plane); message.xunmap.window = win; message.xunmap.from_configure = False; HOLD_INPUT(XSendEvent(dpy,message.xunmap.event, False, /* don't propagate */ SubstructureRedirectMask|SubstructureNotifyMask, &message) /* event to send */ ) break; case 14 : /* Iconify == Go to IconicState */ /* requires a screen */ if (xs && xs->mapped) /* now in normal state */ { message.xany.type = ClientMessage; message.xclient.window = win; message.xclient.message_type = XA_wm_change_state; message.xclient.format = 32; message.xclient.data.l[0] = IconicState; HOLD_INPUT(XSendEvent(dpy,RootWindow(dpy,plane), False, /* don't propagate */ SubstructureRedirectMask|SubstructureNotifyMask, &message) /* event to send */ ) } else if (xs) /* was withdrawn or iconic */ { x_set_wm_hints(xs,IconicState); HOLD_INPUT(XMapWindow(xs->display,xs->xid)) } break; case 8 : result = xs ? screen : Qnil; break; case 9 : if (xs) result = xs->mapped ? Qt : Qnil ; break; case 10 : if (xs) result = XWSCREEN(XROOT(screen)->win)->height; break; case 11 : if (xs) result = XWSCREEN(XROOT(screen)->win)->width; break; case 12 : if (xs) result = XROOT(screen)->update; break; case 13 : if (xs) x_set_wm_hints(xs,NormalState); /* in case of Withdrawn */ HOLD_INPUT(XMapRaised(dpy,win)) break; /* 14 is used */ case 15 : if (xs) result = XROOT(screen)->motion_hints; break; } HOLD_INPUT(XFlush(dpy)) return result; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::raise-screen",Fraise_screen,Sraise_screen, 0, 1, 0, "Raise the screen to the top of the display. The argument is the\ ID of the screen - if absent, the current screen is raised. Returns the \ screen if it was raised, nil otherwise.") (seq) Lisp_Object seq; { return x_internal_block_handler(seq,1); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::mapraised-screen",Fmapraised_screen,Smapraised_screen, 0, 1, 0, "Map and raise the screen to the top of the display. The argument is the\ ID of the screen - if absent, the current screen is raised. Returns the\ screen if it was raised, nil otherwise.") (seq) Lisp_Object seq; { return x_internal_block_handler(seq,13); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::iconify-screen",Ficonify_screen,Siconify_screen, 0, 1, 0, "Map and raise the screen to the top of the display. The argument is the\ ID of the screen - if absent, the current screen is raised. Returns t if\ the screen was raised, nil otherwise.") (seq) Lisp_Object seq; { return x_internal_block_handler(seq,14); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::get-screen-id",Fget_screen_id,Sget_screen_id,0,1,0,"Convert a screen or id to an id") (seq) Lisp_Object seq; { return x_internal_block_handler(seq,3); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::get-screen",Fget_screen,Sget_screen,0,1,0, "Convert an ID or screen to a screen") (seq) Lisp_Object seq; { return x_internal_block_handler(seq,8); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::delete-screen",Fdelete_screen,Sdelete_screen,0,1,0, "Delete a screen. A screen cannot be deleted if it is the last mapped\ editing screen.") (seq) Lisp_Object seq; { return x_internal_block_handler(seq,4); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::lower-screen",Flower_screen,Slower_screen,0,1,0, "Lower the screen to the bottom of the display") (seq) Lisp_Object seq; { return x_internal_block_handler(seq,5); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::map-screen",Fmap_screen,Smap_screen,0,1,0, "Map the screen onto the display") (seq) Lisp_Object seq; { return x_internal_block_handler(seq,6); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::unmap-screen",Funmap_screen,Sunmap_screen,0,1,0, "Unmap the screen") (seq) Lisp_Object seq; { return x_internal_block_handler(seq,7); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::screen-mapped-p",Fscreen_mapped_p,Sscreen_mapped_p,0,1,0, "Return t if the screen exists and is mapped, nil otherwise") (seq) Lisp_Object seq; { return x_internal_block_handler(seq,9); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::screen-height",Fx_screen_height,Sx_screen_height,0,1,0, "Return the height of the screen") (screen) Lisp_Object screen; { return x_internal_block_handler(screen,10); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::screen-width",Fx_screen_width,Sx_screen_width,0,1,0, "Return the width of the screen") (screen) Lisp_Object screen; { return x_internal_block_handler(screen,11); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::update-p",Fx_update_p,Sx_update_p,0,1,0, "Return t if the screen is updated when not current, nil otherwise") (screen) Lisp_Object screen; { return x_internal_block_handler(screen,12); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::set-update",Fx_set_update,Sx_set_update,1,2,0, "Set the update when not current flag. Returns the previous value.") (flag,screen) Lisp_Object flag,screen; { Lisp_Object result; Lisp_Object block; struct Root_Block *rb; block = find_block(screen); if (NIL(block)) return Qnil; rb = XROOT(block); result = rb->update; rb->update = EQ(Qnil,flag) ? Qnil : Qt; /* normalize */ return result; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::motion-hints-p",Fx_motion_hints_p,Sx_motion_hints_p,0,1,0, "Return t if the screen has motion hints enabled, nil if disabled.") (screen) Lisp_Object screen; { return x_internal_block_handler(screen,15); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::set-motion-hints",Fx_set_motion_hints,Sx_set_motion_hints,1,2,0, "Enable/Disable motion hints for a screen. Returns the previous value") (flag,screen) Lisp_Object flag,screen; { Lisp_Object result; Lisp_Object block; struct Root_Block *rb; struct X_Screen *xs; BLOCK_INPUT_DECLARE(); block = find_block(screen); if (NIL(block)) return Qnil; rb = XROOT(block); result = rb->motion_hints; rb->motion_hints = EQ(Qnil,flag) ? Qnil : Qt; /* normalize */ xs = XXSCREEN(rb->x11); BLOCK_INPUT(); if (EQ(Qnil,flag)) XSelectInput(xs->display, xs->xid, NORMAL_INPUT); else XSelectInput(xs->display, xs->xid, NORMAL_INPUT|MOTION_INPUT); UNBLOCK_INPUT(); return result; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* look for a buffer in the windows of a screen */ static Lisp_Object find_buffer_in_window(w,obj) Lisp_Object w; Lisp_Object obj; { struct window *p; Lisp_Object tem; for ( ; !NIL(w) && !EQ(w,XROOT(XWINDOW(w)->root)->minibuf_window) ; w = XWINDOW(w)->next ) { p = XWINDOW(w); if ( EQ ( p->buffer , obj ) ) return w; if (!NIL(p->vchild) && !NIL(tem=find_buffer_in_window(p->vchild,obj)) ) return tem; if (!NIL(p->hchild) && !NIL(tem=find_buffer_in_window(p->hchild,obj)) ) return tem; } return Qnil; /* failure */ } Lisp_Object find_buffer_start_button_in_window(w,obj) Lisp_Object w; Lisp_Object obj; { struct window *p; for ( ; !NIL(w) && !EQ(w,XROOT(XWINDOW(w)->root)->minibuf_window) ; w = XWINDOW(w)->next) { p = XWINDOW(w); if (EQ(p->buffer,obj)) p->start_button = Qnil; if (!NIL(p->vchild)) find_buffer_start_button_in_window(p->vchild,obj); if (!NIL(p->hchild)) find_buffer_start_button_in_window(p->hchild,obj); } return Qnil; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::get-buffer-window",Fx_get_buffer_window,Sx_get_buffer_window, 1,1,0, "Return a window displaying BUFFER, even in another screen, or\ nil if none") (buffer) Lisp_Object buffer; { buffer = Fget_buffer(buffer); return XTYPE(buffer) == Lisp_Buffer ? do_windows_of_screens(find_buffer_in_window,buffer) : Qnil; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::screen-list",Fscreen_list,Sscreen_list,0,1,0, "Return a list of screens. If the argument is present and not nil\ then unmapped screens are returned in the list. The minibuf screen is _never_\ in the list") (unmap) Lisp_Object unmap; { Lisp_Object block = rootblock; Lisp_Object list = Qnil; struct gcpro gcpro1; GCPRO1(list); do { if (!EQ(block,minibuf_rootblock) && (XXSCREEN(XROOT(block)->x11)->mapped || !NIL(unmap))) list = Fcons(block,list); block = XROOT(block)->next; } while (!EQ(block,rootblock)); UNGCPRO; return list; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::screen-of-window",Fscreen_of_window,Sscreen_of_window,0,1,0, "Return the screen that a window is on") (window) Lisp_Object window; { if (NIL(window)) window = selected_window; CHECK_WINDOW(window,0); return XWINDOW(window)->root; } /* ------------------------------------------------------------------------ */ DEFUN ("epoch::first-window",Fepoch_first_window,Sepoch_first_window,0,1,0, "Return the first window in the canonical order of SCREEN") (screen) Lisp_Object screen; { struct Root_Block *rb; Lisp_Object win; struct window *w; screen = find_block(screen); if (NIL(screen)) return Qnil; rb = XROOT(screen); RW_FIXUP(rb); win = rb->ewin; while(1) { w = XWINDOW(win); if (!NIL(w->vchild)) win = w->vchild; else if (!NIL(w->hchild)) win = w->hchild; else break; /* hit bottom */ } return win; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::selected-window",Fepoch_selected_window,Sepoch_selected_window, 0,1,0, "Return the selected window in on SCREEN") (screen) Lisp_Object screen; { screen = find_block(screen); if (NIL(screen)) return Qnil; return XROOT(screen)->select; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::change-screen-size",Fchange_screen_size,Schange_screen_size, 0,3,0, "Change the size of a screen. Arguments are the new width and \ height. The third optional argument is the screen") (col,row,screen) Lisp_Object col,row,screen; { struct X_Screen *xs; struct W_Screen *ws; unsigned int dx,dy; unsigned int height,width; struct X_font *f; screen = find_block(screen); if (NIL(screen)) return Qnil; xs = XXSCREEN(XROOT(screen)->x11); ws = XWSCREEN(XROOT(screen)->win); f = XXFONT(XSTYLE(XROOT(screen)->stylenorm)->font); if (NIL(col)) col = make_number(ws->width); else CHECK_NUMBER(col,0); width = MAX(XFASTINT(col),4); if (NIL(row)) row = make_number(ws->height); else CHECK_NUMBER(row,0); height = MAX(XFASTINT(row),2 - (XROOT(screen) == mini_root)); dx = 2*ws->in_border + width*XFWIDTH(f); dy = 2*ws->in_border + height*XFHEIGHT(f); /* NOTE: Only set this flag if there is a net size change and the * XResizeWindow request will actually go through */ if ((dx != xs->pixwidth) || (dy != xs->pixheight)) ws->size_change = 1; return Success == XResizeWindow(xs->display,xs->xid,dx,dy) ? Qt : Qnil; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN ("epoch::move-screen",Fmove_screen,Smove_screen, 2,3,0, "Move the screen on the root window. Argumnents are X, Y [ screen ], with X,Y in pixels.") (X,Y,screen) Lisp_Object X,Y,screen; { struct Lisp_Xresource *xr; BLOCK_INPUT_DECLARE(); if (! (xr = ResourceOrScreen(screen,0)) ) return Qnil; CHECK_NUMBER(X,0); CHECK_NUMBER(Y,0); BLOCK_INPUT(); XMoveWindow(xr->dpy,xr->id,XFASTINT(X),XFASTINT(Y)); UNBLOCK_INPUT(); return Qt; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ DEFUN("dbx",Fdbx,Sdbx,0,0,"","Call DEBUG for debugger trap") () { DEBUG(); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ Lisp_Object Vepoch_version; Lisp_Object Vdistinct_minibuffers; Lisp_Object Vsynchronize_minibuffers; Lisp_Object Vepoch_bell_volume; Lisp_Object Vepoch_function_key_mapping; /* list of symbols recognized for screen property alist */ Lisp_Object Qx_cursor_glyph; Lisp_Object Qx_title; Lisp_Object Qx_name,Qx_icon_name; Lisp_Object Qx_class; Lisp_Object Qx_font; Lisp_Object Qx_geometry; Lisp_Object Qx_foreground,Qx_background,Qx_border_color; Lisp_Object Qx_cursor_foreground,Qx_cursor_background; Lisp_Object Qx_cursor_color; Lisp_Object Qx_initial_state,Qx_update; Lisp_Object Qx_reverse,Qx_in_border_width,Qx_ex_border_width; Lisp_Object Qx_motion_hints,Qx_parent; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ void syms_of_screen() { staticpro(&minibuf_rootblock); staticpro(&rootblock); defsubr(&Sdbx); #if 0 if (!inhibit_window_system) #endif if (1) { staticpro(&Qepoch_screenp); Qepoch_screenp = intern("epoch::screen-p"); defsubr(&Sreparent_screen); defsubr(&Screate_screen); defsubr(&Sraise_screen); defsubr(&Smapraised_screen); defsubr(&Siconify_screen); defsubr(&Scurrent_screen); defsubr(&Sminibuf_screen); defsubr(&Snext_screen); defsubr(&Sprev_screen); defsubr(&Sselect_screen); defsubr(&Sdelete_screen); defsubr(&Sget_screen_id); defsubr(&Sget_screen); defsubr(&Slower_screen); defsubr(&Smap_screen); defsubr(&Sunmap_screen); defsubr(&Sscreen_list); defsubr(&Sscreen_mapped_p); defsubr(&Sscreen_p); defsubr(&Sscreen_of_window); defsubr(&Sepoch_first_window); defsubr(&Sepoch_selected_window); defsubr(&Schange_screen_size); defsubr(&Smove_screen); defsubr(&Sx_screen_height); defsubr(&Sx_screen_width); defsubr(&Sx_get_buffer_window); defsubr(&Sepoch_screens_of_buffer); defsubr(&Sx_update_p); defsubr(&Sx_set_update); defsubr(&Sx_motion_hints_p); defsubr(&Sx_set_motion_hints); DEFVAR_LISP("epoch::version",&Vepoch_version, "Version number of Epoch"); Vepoch_version = build_string("Epoch 4.2"); DEFVAR_LISP("epoch::nonlocal-minibuffer",&Vdistinct_minibuffers, "Set to t if minibuffer is in distinct screen"); Vdistinct_minibuffers = distinct_minibuffer ? Qt : Qnil; DEFVAR_LISP("epoch::synchronize-minibuffers",&Vsynchronize_minibuffers, "Set to t if all minibuffer windows are to be synchronized"); Vsynchronize_minibuffers = Qnil; DEFVAR_LISP("epoch::bell-volume", &Vepoch_bell_volume, "X bell volume"); Vepoch_bell_volume = make_number(50); DEFVAR_LISP("epoch::function-key-mapping", &Vepoch_function_key_mapping, "Cause Epoch to map X function keysym to extended sequences"); Vepoch_function_key_mapping = Qt; DEFVAR_LISP("epoch::global-update",&Vx_global_update, "If not nil, update screens with update flag set during normal updates"); Vx_global_update = Qnil; DEFVAR_LISP("epoch::screen-properties",&Vx_screen_properties, "Alist of symbol, value pairs of defaults for creating a new screen.\n\ To have new screens have the title 'Fred', you would use\n\ (setq epoch::screen-properties (list (cons 'title \"Fred\")))\n\ Recognized symbols are\n\ title : title\n\ name : resource name\n\ class : resource class\n\ icon-name : icon name\n\ foreground : foreground color\n\ background : background color\n\ font : font name\n\ geometry : geometry specification string\n\ initial-state : Start normal or iconic\n\ reverse : reverse foreground/background colors\n\ update : set global update flag for this screen\n\ cursor-color : text cursor color "); Vx_screen_properties = Qnil; /* screen property alist symbols */ Qx_cursor_glyph = intern("cursor-glyph"); staticpro(&Qx_cursor_glyph); Qx_title = intern("title"); staticpro(&Qx_title); Qx_name = intern("name"); staticpro(&Qx_name); Qx_class = intern("class"); staticpro(&Qx_class); Qx_icon_name = intern("icon-name"); staticpro(&Qx_icon_name); Qx_foreground = intern("foreground"); staticpro(&Qx_foreground); Qx_background = intern("background"); staticpro(&Qx_background); Qx_cursor_foreground = intern("cursor-foreground"); staticpro(&Qx_cursor_foreground); Qx_cursor_background = intern("cursor-background"); staticpro(&Qx_cursor_background); Qx_border_color = intern("border-color"); staticpro(&Qx_border_color); Qx_font = intern("font"); staticpro(&Qx_font); Qx_geometry = intern("geometry"); staticpro(&Qx_geometry); Qx_cursor_color = intern("cursor-color"); staticpro(&Qx_cursor_color); Qx_in_border_width = intern("in-border-width"); staticpro(&Qx_in_border_width); Qx_ex_border_width = intern("ex-border-width"); staticpro(&Qx_ex_border_width); Qx_initial_state = intern("initial-state"); staticpro(&Qx_initial_state); Qx_reverse = intern("reverse"); staticpro(&Qx_reverse); Qx_update = intern("update"); staticpro(&Qx_update); Qx_motion_hints = intern("motion-hints"); staticpro(&Qx_motion_hints); Qx_parent = intern("parent"); staticpro(&Qx_parent); syms_of_button(); syms_of_xutil(); syms_of_xevent(); syms_of_xresource(); syms_of_property(); syms_of_selection(); } } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ void DEBUG() { print_window(XWINDOW(cur_root->select)); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* this is all debugging code from here on */ static char *tabs[] = { " "," "," "," "," " }; /* print out the window tree. Used in dumps and debugging runs */ void print_window_tree(w,l) Lisp_Object w; int l; { struct window *p; fprintf(stderr,"%s",tabs[l]); if (NIL(w)) fprintf(stderr,"nil\n\r"); else if (XTYPE(w) != Lisp_Window) fprintf(stderr,"###\n\r"); else if (EQ(w,minibuf_window)) fprintf(stderr,"minibuf\n\r"); else { p = XWINDOW(w); fprintf(stderr,"%d (parent ",w); if (NIL(p->parent)) fprintf(stderr,"nil)\n\r"); else fprintf(stderr,"%d)\n\r",p->parent); print_window_tree(p->hchild,l+1); print_window_tree(p->vchild,l+1); print_window_tree(p->next,l); } } /* print the window tree for every screen */ void print_all_windows() { Lisp_Object screen = rootblock; struct Root_Block *rb; do { screen = XROOT(screen)->next; rb = XROOT(screen); RW_FIXUP(rb); fprintf(stderr,"Screen %d\n\r",rb->seq); print_window_tree(rb->ewin,0); } while (!EQ(screen,rootblock)); }