cgit.sxemacs.org Git - sxemacs/blob - src/ui/device.c

   1 /* Generic device functions.
   2    Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
   3    Copyright (C) 1994, 1995 Free Software Foundation, Inc.
   4    Copyright (C) 1995, 1996 Ben Wing
   5
   6 This file is part of SXEmacs
   7
   8 SXEmacs is free software: you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation, either version 3 of the License, or
  11 (at your option) any later version.
  12
  13 SXEmacs is distributed in the hope that it will be useful,
  14 but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 GNU General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  20
  21
  22 /* Synched up with: Not in FSF. */
  23
  24 /* Original version by Chuck Thompson;
  25    rewritten and expanded by Ben Wing. */
  26
  27 #include <config.h>
  28 #include "lisp.h"
  29
  30 #include "buffer.h"
  31 #include "console.h"
  32 #include "device.h"
  33 #include "elhash.h"
  34 #include "events/events.h"
  35 #include "faces.h"
  36 #include "frame.h"
  37 #include "keymap.h"
  38 #include "redisplay.h"
  39 #include "specifier.h"
  40 #include "sysdep.h"
  41 #include "window.h"
  42
  43 #ifdef HAVE_SCROLLBARS
  44 #include "scrollbar.h"
  45 #endif
  46
  47 #include "syssignal.h"
  48
  49 /* Vdefault_device is the firstly-created non-stream device that's still
  50    around.  We don't really use it anywhere currently, but it might
  51    be used for resourcing at some point.  (Currently we use
  52    Vdefault_x_device.) */
  53 Lisp_Object Vdefault_device;
  54
  55 Lisp_Object Vcreate_device_hook, Vdelete_device_hook;
  56
  57 /* Device classes */
  58 /* Qcolor defined in general.c */
  59 Lisp_Object Qgrayscale, Qmono;
  60
  61 /* Device metrics symbols */
  62 Lisp_Object
  63     Qcolor_default, Qcolor_select, Qcolor_balloon, Qcolor_3d_face,
  64     Qcolor_3d_light, Qcolor_3d_dark, Qcolor_menu, Qcolor_menu_highlight,
  65     Qcolor_menu_button, Qcolor_menu_disabled, Qcolor_toolbar,
  66     Qcolor_scrollbar, Qcolor_desktop, Qcolor_workspace, Qfont_default,
  67     Qfont_menubar, Qfont_dialog, Qsize_cursor, Qsize_scrollbar,
  68     Qsize_menu, Qsize_toolbar, Qsize_toolbar_button,
  69     Qsize_toolbar_border, Qsize_icon, Qsize_icon_small, Qsize_device,
  70     Qsize_workspace, Qoffset_workspace, Qsize_device_mm, Qdevice_dpi,
  71     Qnum_bit_planes, Qnum_color_cells, Qmouse_buttons, Qswap_buttons,
  72     Qshow_sounds, Qslow_device, Qsecurity;
  73
  74 Lisp_Object Qdevicep, Qdevice_live_p;
  75 Lisp_Object Qcreate_device_hook;
  76 Lisp_Object Qdelete_device_hook;
  77 Lisp_Object Vdevice_class_list;
  78 \f
  79 static Lisp_Object mark_device(Lisp_Object obj)
  80 {
  81         struct device *d = XDEVICE(obj);
  82
  83         mark_object(d->name);
  84         mark_object(d->connection);
  85         mark_object(d->canon_connection);
  86         mark_object(d->console);
  87         mark_object(d->selected_frame);
  88         mark_object(d->frame_with_focus_real);
  89         mark_object(d->frame_with_focus_for_hooks);
  90         mark_object(d->frame_that_ought_to_have_focus);
  91         mark_object(d->device_class);
  92         mark_object(d->user_defined_tags);
  93         mark_object(d->pixel_to_glyph_cache.obj1);
  94         mark_object(d->pixel_to_glyph_cache.obj2);
  95
  96         mark_object(d->color_instance_cache);
  97         mark_object(d->font_instance_cache);
  98 #ifdef MULE
  99         mark_object(d->charset_font_cache);
 100 #endif
 101         mark_object(d->image_instance_cache);
 102
 103         if (d->devmeths) {
 104                 mark_object(d->devmeths->symbol);
 105                 MAYBE_DEVMETH(d, mark_device, (d));
 106         }
 107
 108         return (d->frame_list);
 109 }
 110
 111 static void
 112 print_device(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 113 {
 114         struct device *d = XDEVICE(obj);
 115
 116         if (print_readably)
 117                 error("printing unreadable object #<device %s 0x%x>",
 118                       XSTRING_DATA(d->name), d->header.uid);
 119
 120         write_fmt_string(printcharfun, "#<%s-device",
 121                          (!DEVICE_LIVE_P(d) ? "dead" :DEVICE_TYPE_NAME(d)));
 122         if (DEVICE_LIVE_P(d) && !NILP(DEVICE_CONNECTION(d))) {
 123                 write_c_string(" on ", printcharfun);
 124                 print_internal(DEVICE_CONNECTION(d), printcharfun, 1);
 125         }
 126         write_fmt_str(printcharfun, " 0x%x>", d->header.uid);
 127 }
 128
 129 DEFINE_LRECORD_IMPLEMENTATION("device", device,
 130                               mark_device, print_device, 0, 0, 0, 0,
 131                               struct device);
 132 \f
 133 int valid_device_class_p(Lisp_Object class)
 134 {
 135         return !NILP(memq_no_quit(class, Vdevice_class_list));
 136 }
 137
 138 DEFUN("valid-device-class-p", Fvalid_device_class_p, 1, 1, 0,   /*
 139 Given a DEVICE-CLASS, return t if it is valid.
 140 Valid classes are 'color, 'grayscale, and 'mono.
 141 */
 142       (device_class))
 143 {
 144         return valid_device_class_p(device_class) ? Qt : Qnil;
 145 }
 146
 147 DEFUN("device-class-list", Fdevice_class_list, 0, 0, 0, /*
 148 Return a list of valid device classes.
 149 */
 150       ())
 151 {
 152         return Fcopy_sequence(Vdevice_class_list);
 153 }
 154
 155 static struct device *allocate_device(Lisp_Object console)
 156 {
 157         Lisp_Object device;
 158         struct device *d = alloc_lcrecord_type(struct device, &lrecord_device);
 159         struct gcpro gcpro1;
 160
 161         zero_lcrecord(d);
 162
 163         XSETDEVICE(device, d);
 164         GCPRO1(device);
 165
 166         d->name = Qnil;
 167         d->console = console;
 168         d->connection = Qnil;
 169         d->canon_connection = Qnil;
 170         d->frame_list = Qnil;
 171         d->selected_frame = Qnil;
 172         d->frame_with_focus_real = Qnil;
 173         d->frame_with_focus_for_hooks = Qnil;
 174         d->frame_that_ought_to_have_focus = Qnil;
 175         d->device_class = Qnil;
 176         d->user_defined_tags = Qnil;
 177         d->pixel_to_glyph_cache.obj1 = Qnil;
 178         d->pixel_to_glyph_cache.obj2 = Qnil;
 179
 180         d->infd = d->outfd = -1;
 181
 182         /* #### is 20 reasonable? */
 183         d->color_instance_cache =
 184             make_lisp_hash_table(20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL);
 185         d->font_instance_cache =
 186             make_lisp_hash_table(20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL);
 187 #ifdef MULE
 188         /* Note that the following table is bi-level. */
 189         d->charset_font_cache =
 190             make_lisp_hash_table(20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
 191 #endif
 192         /*
 193            Note that the image instance cache is actually bi-level.
 194            See device.h.  We use a low number here because most of the
 195            time there aren't very many different masks that will be used.
 196          */
 197         d->image_instance_cache =
 198             make_lisp_hash_table(5, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
 199
 200         UNGCPRO;
 201         return d;
 202 }
 203
 204 struct device *decode_device(Lisp_Object device)
 205 {
 206         if (NILP(device))
 207                 device = Fselected_device(Qnil);
 208         /* quietly accept frames for the device arg */
 209         else if (FRAMEP(device))
 210                 device = FRAME_DEVICE(decode_frame(device));
 211         CHECK_LIVE_DEVICE(device);
 212         return XDEVICE(device);
 213 }
 214
 215 DEFUN("dfw-device", Fdfw_device, 1, 1, 0,       /*
 216 Given a device, frame, or window, return the associated device.
 217 Return nil otherwise.
 218 */
 219       (object))
 220 {
 221         return DFW_DEVICE(object);
 222 }
 223 \f
 224 DEFUN("selected-device", Fselected_device, 0, 1, 0,     /*
 225 Return the device which is currently active.
 226 If optional CONSOLE is non-nil, return the device that would be currently
 227 active if CONSOLE were the selected console.
 228 */
 229       (console))
 230 {
 231         if (NILP(console) && NILP(Vselected_console))
 232                 return Qnil;    /* happens early in temacs */
 233         return CONSOLE_SELECTED_DEVICE(decode_console(console));
 234 }
 235
 236 /* Called from selected_frame_1(), called from Fselect_window() */
 237 void select_device_1(Lisp_Object device)
 238 {
 239         struct device *dev = XDEVICE(device);
 240         Lisp_Object old_selected_device = Fselected_device(Qnil);
 241
 242         if (EQ(device, old_selected_device))
 243                 return;
 244
 245         /* now select the device's console */
 246         CONSOLE_SELECTED_DEVICE(XCONSOLE(DEVICE_CONSOLE(dev))) = device;
 247         select_console_1(DEVICE_CONSOLE(dev));
 248 }
 249
 250 DEFUN("select-device", Fselect_device, 1, 1, 0, /*
 251 Select the device DEVICE.
 252 Subsequent editing commands apply to its console, selected frame,
 253 and selected window.
 254 The selection of DEVICE lasts until the next time the user does
 255 something to select a different device, or until the next time this
 256 function is called.
 257 */
 258       (device))
 259 {
 260         CHECK_LIVE_DEVICE(device);
 261
 262         /* select the device's selected frame's selected window.  This will call
 263            selected_frame_1()->selected_device_1()->selected_console_1(). */
 264         if (!NILP(DEVICE_SELECTED_FRAME(XDEVICE(device))))
 265                 Fselect_window(FRAME_SELECTED_WINDOW
 266                                (XFRAME(DEVICE_SELECTED_FRAME(XDEVICE(device)))),
 267                                Qnil);
 268         else
 269                 error("Can't select a device with no frames");
 270         return Qnil;
 271 }
 272
 273 void set_device_selected_frame(struct device *d, Lisp_Object frame)
 274 {
 275         if (!NILP(frame) && !FRAME_MINIBUF_ONLY_P(XFRAME(frame)))
 276                 set_console_last_nonminibuf_frame(XCONSOLE(DEVICE_CONSOLE(d)),
 277                                                   frame);
 278         d->selected_frame = frame;
 279 }
 280
 281 DEFUN("set-device-selected-frame", Fset_device_selected_frame, 2, 2, 0, /*
 282 Set the selected frame of device object DEVICE to FRAME.
 283 If DEVICE is nil, the selected device is used.
 284 If DEVICE is the selected device, this makes FRAME the selected frame.
 285 */
 286       (device, frame))
 287 {
 288         XSETDEVICE(device, decode_device(device));
 289         CHECK_LIVE_FRAME(frame);
 290
 291         if (!EQ(device, FRAME_DEVICE(XFRAME(frame))))
 292                 error("In `set-device-selected-frame', FRAME is not on DEVICE");
 293
 294         if (EQ(device, Fselected_device(Qnil)))
 295                 return Fselect_frame(frame);
 296
 297         set_device_selected_frame(XDEVICE(device), frame);
 298         return frame;
 299 }
 300
 301 DEFUN("devicep", Fdevicep, 1, 1, 0,     /*
 302 Return non-nil if OBJECT is a device.
 303 */
 304       (object))
 305 {
 306         return DEVICEP(object) ? Qt : Qnil;
 307 }
 308
 309 DEFUN("device-live-p", Fdevice_live_p, 1, 1, 0, /*
 310 Return non-nil if OBJECT is a device that has not been deleted.
 311 */
 312       (object))
 313 {
 314         return DEVICEP(object) && DEVICE_LIVE_P(XDEVICE(object)) ? Qt : Qnil;
 315 }
 316
 317 DEFUN("device-name", Fdevice_name, 0, 1, 0,     /*
 318 Return the name of the specified device.
 319 DEVICE defaults to the selected device if omitted.
 320 */
 321       (device))
 322 {
 323         return DEVICE_NAME(decode_device(device));
 324 }
 325
 326 DEFUN("device-connection", Fdevice_connection, 0, 1, 0, /*
 327 Return the connection of the specified device.
 328 DEVICE defaults to the selected device if omitted.
 329 */
 330       (device))
 331 {
 332         return DEVICE_CONNECTION(decode_device(device));
 333 }
 334
 335 DEFUN("device-console", Fdevice_console, 0, 1, 0,       /*
 336 Return the console of the specified device.
 337 DEVICE defaults to the selected device if omitted.
 338 */
 339       (device))