/* cursor.c -- Cursor handling $Id: cursors.c,v 1.19 2002/11/03 21:00:36 jsh Exp $ Copyright (C) 1999 John Harper This file is part of sawmill. sawmill is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. sawmill is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with sawmill; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "sawmill.h" #include static Lisp_Cursor *cursor_list; int cursor_type; repv default_cursor; DEFSYM(cursor_shape, "cursor-shape"); /* Cursors from bitmaps */ static Cursor make_bm_cursor (repv image, repv mask, repv fg, repv bg) { rep_GC_root gc_image, gc_mask, gc_fg, gc_bg; int width, height, x_hot, y_hot; Pixmap bm_image, bm_mask; Cursor cursor = 0; if (rep_STRINGP(fg)) fg = Fget_color (fg, Qnil); if (rep_STRINGP(bg)) bg = Fget_color (bg, Qnil); if (!rep_STRINGP(image) || !rep_STRINGP(mask) || !COLORP(fg) || !COLORP(bg)) { return 0; } rep_PUSHGC(gc_image, image); rep_PUSHGC(gc_mask, mask); rep_PUSHGC(gc_fg, fg); rep_PUSHGC(gc_bg, bg); bm_mask = make_bitmap (mask, &width, &height, &x_hot, &y_hot); if (bm_mask != 0) { bm_image = make_bitmap (image, &width, &height, &x_hot, &y_hot); if (bm_image != 0) { XColor xc_fg, xc_bg; xc_fg.red = VCOLOR(fg)->red; xc_fg.green = VCOLOR(fg)->green; xc_fg.blue = VCOLOR(fg)->blue; xc_fg.pixel = VCOLOR(fg)->pixel; xc_bg.red = VCOLOR(bg)->red; xc_bg.green = VCOLOR(bg)->green; xc_bg.blue = VCOLOR(bg)->blue; xc_bg.pixel = VCOLOR(bg)->pixel; cursor = XCreatePixmapCursor (dpy, bm_image, bm_mask, &xc_fg, &xc_bg, x_hot, y_hot); XFreePixmap (dpy, bm_image); } XFreePixmap (dpy, bm_mask); } rep_POPGC; rep_POPGC; rep_POPGC; rep_POPGC; return cursor; } DEFUN("get-cursor", Fget_cursor, Sget_cursor, (repv data), rep_Subr1) /* ::doc:sawfish.wm.cursors#get-cursor:: get-cursor DATA Returns the cursor object representing the cursor defined by DATA. If DATA is a symbol, it's replaced by its `cursor-shape' property. Possible DATA values are an integer representing a glyph in the standard X11 cursor font, or an image object. ::end:: */ { Lisp_Cursor *f; if (dpy == 0) return Qnil; if (rep_SYMBOLP(data)) data = Fget (data, Qcursor_shape); f = cursor_list; while (f != 0 && f->data != data) f = f->next; if (f == 0) { Cursor cursor = 0; if (rep_INTP(data)) cursor = XCreateFontCursor (dpy, rep_INT(data)); else if (IMAGEP(data)) { /* XXX implement cursors from images..? */ } else if (rep_VECTORP(data) && rep_VECT_LEN (data) >= 4) { cursor = make_bm_cursor (rep_VECTI(data, 0), rep_VECTI(data, 1), rep_VECTI(data, 2), rep_VECTI(data, 3)); } if (cursor != 0) { f = rep_ALLOC_CELL(sizeof(Lisp_Cursor)); rep_data_after_gc += sizeof (Lisp_Cursor); f->car = cursor_type; f->next = cursor_list; cursor_list = f; f->data = data; f->cursor = cursor; } else { return Fsignal (Qerror, rep_list_2 (rep_string_dup("no such cursor"), data)); } } return rep_VAL(f); } DEFUN("recolor-cursor", Frecolor_cursor, Srecolor_cursor, (repv cursor, repv fg, repv bg), rep_Subr3) /* ::doc:sawfish.wm.cursors#recolor-cursor:: recolor-cursor CURSOR FG BG ::end:: */ { XColor xc_fg, xc_bg; rep_DECLARE1(cursor, CURSORP); if (rep_STRINGP(fg)) fg = Fget_color (fg, Qnil); rep_DECLARE(2, fg, fg && COLORP(fg)); if (rep_STRINGP(bg)) bg = Fget_color (bg, Qnil); rep_DECLARE(3, bg, bg && COLORP(bg)); xc_fg.red = VCOLOR(fg)->red; xc_fg.green = VCOLOR(fg)->green; xc_fg.blue = VCOLOR(fg)->blue; xc_fg.pixel = VCOLOR(fg)->pixel; xc_bg.red = VCOLOR(bg)->red; xc_bg.green = VCOLOR(bg)->green; xc_bg.blue = VCOLOR(bg)->blue; xc_bg.pixel = VCOLOR(bg)->pixel; XRecolorCursor (dpy, VCURSOR(cursor)->cursor, &xc_fg, &xc_bg); return cursor; } DEFUN("default-cursor", Fdefault_cursor, Sdefault_cursor, (repv arg), rep_Subr1) /* ::doc:sawfish.wm.cursors#default-cursor:: default-cursor [NEW-VALUE] The cursor object displayed in the root window, and in frame parts which have no other cursor specified. ::end:: */ { if (CURSORP(arg)) { default_cursor = arg; XDefineCursor (dpy, root_window, VCURSOR(default_cursor)->cursor); } return default_cursor; } DEFUN("cursorp", Fcursorp, Scursorp, (repv arg), rep_Subr1) /* ::doc:sawfish.wm.cursors#cursorp:: cursor ARG Returns t if ARG is an cursor object. ::end:: */ { return CURSORP(arg) ? Qt : Qnil; } /* type hooks */ static int cursor_cmp (repv w1, repv w2) { return w1 != w2; } static void cursor_prin (repv stream, repv obj) { char buf[256]; sprintf (buf, "#", (u_int) VCURSOR(obj)->cursor); rep_stream_puts (stream, buf, -1, FALSE); } static void cursor_mark (repv obj) { rep_MARKVAL(VCURSOR(obj)->data); } static void cursor_sweep (void) { Lisp_Cursor *w = cursor_list; cursor_list = 0; while (w != 0) { Lisp_Cursor *next = w->next; if (!rep_GC_CELL_MARKEDP(rep_VAL(w))) { XFreeCursor (dpy, w->cursor); rep_FREE_CELL(w); } else { rep_GC_CLR_CELL(rep_VAL(w)); w->next = cursor_list; cursor_list = w; } w = next; } } /* initialisation */ void cursors_init (void) { repv tem = rep_push_structure ("sawfish.wm.cursors"); cursor_type = rep_register_new_type ("cursor", cursor_cmp, cursor_prin, cursor_prin, cursor_sweep, cursor_mark, 0, 0, 0, 0, 0, 0, 0); rep_ADD_SUBR(Sget_cursor); rep_ADD_SUBR(Srecolor_cursor); rep_ADD_SUBR(Sdefault_cursor); rep_ADD_SUBR(Scursorp); if (!batch_mode_p ()) Fdefault_cursor (Fget_cursor (rep_MAKE_INT (XC_left_ptr))); else default_cursor = Qnil; rep_mark_static (&default_cursor); rep_INTERN(cursor_shape); rep_pop_structure (tem); } void cursors_kill (void) { }