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

   1 /* Generic frame functions.
   2    Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
   3    Copyright (C) 1995, 1996 Ben Wing.
   4    Copyright (C) 1995 Sun Microsystems, Inc.
   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: FSF 19.30. */
  23
  24 /* This file has been Mule-ized. */
  25
  26 #include <config.h>
  27 #include "lisp.h"
  28
  29 #include "buffer.h"             /* for Vbuffer_alist */
  30 #include "console.h"
  31 #define INCLUDE_EVENTS_H_PRIVATE_SPHERE
  32 #include "events/events.h"
  33 #include "extents.h"
  34 #include "faces.h"
  35 #include "frame.h"
  36 #include "glyphs.h"
  37 #include "gutter.h"
  38 #include "menubar.h"
  39 #include "redisplay.h"
  40 #include "scrollbar.h"
  41 #include "window.h"
  42
  43 Lisp_Object Vselect_frame_hook, Qselect_frame_hook;
  44 Lisp_Object Vdeselect_frame_hook, Qdeselect_frame_hook;
  45 Lisp_Object Vcreate_frame_hook, Qcreate_frame_hook;
  46 Lisp_Object Vdelete_frame_hook, Qdelete_frame_hook;
  47 Lisp_Object Vmouse_enter_frame_hook, Qmouse_enter_frame_hook;
  48 Lisp_Object Vmouse_leave_frame_hook, Qmouse_leave_frame_hook;
  49 Lisp_Object Vmap_frame_hook, Qmap_frame_hook;
  50 Lisp_Object Vunmap_frame_hook, Qunmap_frame_hook;
  51 int allow_deletion_of_last_visible_frame;
  52 Lisp_Object Vadjust_frame_function;
  53 Lisp_Object Vmouse_motion_handler;
  54 Lisp_Object Vsynchronize_minibuffers;
  55 Lisp_Object Qsynchronize_minibuffers;
  56 Lisp_Object Qbuffer_predicate;
  57 Lisp_Object Qmake_initial_minibuffer_frame;
  58 Lisp_Object Qcustom_initialize_frame;
  59
  60 /* We declare all these frame properties here even though many of them
  61    are currently only used in frame-x.c, because we should generalize
  62    them. */
  63
  64 Lisp_Object Qminibuffer;
  65 Lisp_Object Qunsplittable;
  66 Lisp_Object Qinternal_border_width;
  67 Lisp_Object Qtop_toolbar_shadow_color;
  68 Lisp_Object Qbottom_toolbar_shadow_color;
  69 Lisp_Object Qbackground_toolbar_color;
  70 Lisp_Object Qtop_toolbar_shadow_pixmap;
  71 Lisp_Object Qbottom_toolbar_shadow_pixmap;
  72 Lisp_Object Qtoolbar_shadow_thickness;
  73 Lisp_Object Qscrollbar_placement;
  74 Lisp_Object Qinter_line_space;
  75 Lisp_Object Qvisual_bell;
  76 Lisp_Object Qbell_volume;
  77 Lisp_Object Qpointer_background;
  78 Lisp_Object Qpointer_color;
  79 Lisp_Object Qtext_pointer;
  80 Lisp_Object Qspace_pointer;
  81 Lisp_Object Qmodeline_pointer;
  82 Lisp_Object Qgc_pointer;
  83 Lisp_Object Qinitially_unmapped;
  84 Lisp_Object Quse_backing_store;
  85 Lisp_Object Qborder_color;
  86 Lisp_Object Qborder_width;
  87
  88 Lisp_Object Qframep, Qframe_live_p;
  89 Lisp_Object Qdelete_frame;
  90
  91 Lisp_Object Qframe_title_format, Vframe_title_format;
  92 Lisp_Object Qframe_icon_title_format, Vframe_icon_title_format;
  93
  94 Lisp_Object Vdefault_frame_name;
  95 Lisp_Object Vdefault_frame_plist;
  96
  97 Lisp_Object Vframe_icon_glyph;
  98
  99 Lisp_Object Qhidden;
 100
 101 Lisp_Object Qvisible, Qiconic, Qinvisible, Qvisible_iconic, Qinvisible_iconic;
 102 Lisp_Object Qnomini, Qvisible_nomini, Qiconic_nomini, Qinvisible_nomini;
 103 Lisp_Object Qvisible_iconic_nomini, Qinvisible_iconic_nomini;
 104
 105 Lisp_Object Qset_specifier, Qset_face_property;
 106 Lisp_Object Qface_property_instance;
 107
 108 Lisp_Object Qframe_property_alias;
 109
 110 /* If this is non-nil, it is the frame that make-frame is currently
 111    creating.  We can't set the current frame to this in case the
 112    debugger goes off because it would try and display to it.  However,
 113    there are some places which need to reference it which have no
 114    other way of getting it if it isn't the selected frame. */
 115 Lisp_Object Vframe_being_created;
 116 Lisp_Object Qframe_being_created;
 117
 118 static void store_minibuf_frame_prop(struct frame *f, Lisp_Object val);
 119 static void frame_conversion_internal(struct frame *f, int pixel_to_char,
 120                                       int *pixel_width, int *pixel_height,
 121                                       int *char_width, int *char_height,
 122                                       int real_face);
 123 static struct display_line title_string_display_line;
 124 /* Used by generate_title_string. Global because they get used so much that
 125    the dynamic allocation time adds up. */
 126 static Emchar_dynarr *title_string_emchar_dynarr;
 127 \f
 128 static Lisp_Object mark_frame(Lisp_Object obj)
 129 {
 130         struct frame *f = XFRAME(obj);
 131
 132 #define MARKED_SLOT(x) mark_object (f->x)
 133 #include "frameslots.h"
 134
 135         if (FRAME_LIVE_P(f))    /* device is nil for a dead frame */
 136                 MAYBE_FRAMEMETH(f, mark_frame, (f));
 137
 138         return Qnil;
 139 }
 140
 141 static void
 142 print_frame(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 143 {
 144         struct frame *frm = XFRAME(obj);
 145
 146         if (print_readably)
 147                 error("printing unreadable object #<frame %s 0x%x>",
 148                       XSTRING_DATA(frm->name), frm->header.uid);
 149
 150         write_fmt_string(printcharfun, "#<%s-frame ",
 151                          (!FRAME_LIVE_P(frm) ? "dead" : FRAME_TYPE_NAME(frm)));
 152         print_internal(frm->name, printcharfun, 1);
 153         write_fmt_str(printcharfun, " 0x%x>", frm->header.uid);
 154 }
 155
 156 DEFINE_LRECORD_IMPLEMENTATION("frame", frame,
 157                               mark_frame, print_frame, 0, 0, 0, 0,
 158                               struct frame);
 159 \f
 160 static void nuke_all_frame_slots(struct frame *f)
 161 {
 162 #define MARKED_SLOT(x)  f->x = Qnil
 163 #include "frameslots.h"
 164 }
 165
 166 /* Allocate a new frame object and set all its fields to reasonable
 167    values.  The root window is created but the minibuffer will be done
 168    later. */
 169
 170 static struct frame *allocate_frame_core(Lisp_Object device)
 171 {
 172         /* This function can GC */
 173         Lisp_Object frame;
 174         Lisp_Object root_window;
 175         struct frame *f = alloc_lcrecord_type(struct frame, &lrecord_frame);
 176
 177         zero_lcrecord(f);
 178         nuke_all_frame_slots(f);
 179         XSETFRAME(frame, f);
 180
 181         f->device = device;
 182         f->framemeths = XDEVICE(device)->devmeths;
 183         f->buffer_alist = Fcopy_sequence(Vbuffer_alist);
 184
 185         root_window = allocate_window();
 186         XWINDOW(root_window)->frame = frame;
 187
 188         /* 10 is arbitrary,
 189            Just so that there is "something there."
 190            Correct size will be set up later with change_frame_size.  */
 191
 192         f->width = 10;
 193         f->height = 10;
 194
 195         XWINDOW(root_window)->pixel_width = 10;
 196         XWINDOW(root_window)->pixel_height = 9;
 197
 198         f->root_window = root_window;
 199         f->selected_window = root_window;
 200         f->last_nonminibuf_window = root_window;
 201
 202         /* cache of subwindows visible on frame */
 203         f->subwindow_instance_cache = make_weak_list(WEAK_LIST_SIMPLE);
 204
 205         /* associated exposure ignore list */
 206         f->subwindow_exposures = 0;
 207         f->subwindow_exposures_tail = 0;
 208
 209         FRAME_SET_PAGENUMBER(f, 1);
 210
 211         /* Choose a buffer for the frame's root window.  */
 212         XWINDOW(root_window)->buffer = Qt;
 213         {
 214                 Lisp_Object buf = Fcurrent_buffer();
 215                 Lisp_Object tmp = Fbuffer_name(buf);
 216
 217                 /* If buf is a 'hidden' buffer (i.e. one whose name starts with
 218                    a space), try to find another one.  */
 219                 if (string_char(XSTRING(tmp), 0) == ' ') {
 220                         buf = Fother_buffer(buf, Qnil, Qnil);
 221                 }
 222                 Fset_window_buffer(root_window, buf, Qnil);
 223         }
 224
 225         return f;
 226 }
 227
 228 static void setup_normal_frame(struct frame *f)
 229 {
 230         Lisp_Object mini_window;
 231         Lisp_Object frame;
 232
 233         XSETFRAME(frame, f);
 234
 235         mini_window = allocate_window();
 236         XWINDOW(f->root_window)->next = mini_window;
 237         XWINDOW(mini_window)->prev = f->root_window;
 238         XWINDOW(mini_window)->mini_p = Qt;
 239         XWINDOW(mini_window)->frame = frame;
 240         f->minibuffer_window = mini_window;
 241         f->has_minibuffer = 1;
 242
 243         XWINDOW(mini_window)->buffer = Qt;
 244         Fset_window_buffer(mini_window, Vminibuffer_zero, Qt);
 245 }
 246
 247 /* Make a frame using a separate minibuffer window on another frame.
 248    MINI_WINDOW is the minibuffer window to use.  nil means use the
 249    default-minibuffer-frame.  */
 250
 251 static void
 252 setup_frame_without_minibuffer(struct frame *f, Lisp_Object mini_window)
 253 {
 254         /* This function can GC */
 255         Lisp_Object device = f->device;
 256
 257         if (!NILP(mini_window))
 258                 CHECK_LIVE_WINDOW(mini_window);
 259
 260         if (!NILP(mini_window)
 261             && !EQ(DEVICE_CONSOLE(XDEVICE(device)),
 262                    FRAME_CONSOLE(XFRAME(XWINDOW(mini_window)->frame))))
 263                 error("frame and minibuffer must be on the same console");
 264
 265         /* Do not create a default minibuffer frame on printer devices.  */
 266         if (NILP(mini_window)
 267             && DEVICE_DISPLAY_P(XDEVICE(FRAME_DEVICE(f)))) {
 268                 struct console *con = XCONSOLE(FRAME_CONSOLE(f));
 269                 /* Use default-minibuffer-frame if possible.  */
 270                 if (!FRAMEP(con->default_minibuffer_frame)
 271                     || !FRAME_LIVE_P(XFRAME(con->default_minibuffer_frame))) {
 272                         /* If there's no minibuffer frame to use, create one.  */
 273                         con->default_minibuffer_frame
 274                             = call1(Qmake_initial_minibuffer_frame, device);
 275                 }
 276                 mini_window =
 277                     XFRAME(con->default_minibuffer_frame)->minibuffer_window;
 278         }
 279
 280         /* Install the chosen minibuffer window, with proper buffer.  */
 281         if (!NILP(mini_window)) {
 282                 store_minibuf_frame_prop(f, mini_window);
 283                 Fset_window_buffer(mini_window, Vminibuffer_zero, Qt);
 284         } else
 285                 f->minibuffer_window = Qnil;
 286 }
 287
 288 /* Make a frame containing only a minibuffer window.  */
 289
 290 static void setup_minibuffer_frame(struct frame *f)
 291 {
 292         /* This function can GC */
 293         /* First make a frame containing just a root window, no minibuffer.  */
 294         Lisp_Object mini_window;
 295         Lisp_Object frame;
 296
 297         XSETFRAME(frame, f);
 298
 299         f->no_split = 1;
 300         f->has_minibuffer = 1;
 301
 302         /* Now label the root window as also being the minibuffer.
 303            Avoid infinite looping on the window chain by marking next pointer
 304            as nil. */
 305
 306         mini_window = f->minibuffer_window = f->root_window;
 307         XWINDOW(mini_window)->mini_p = Qt;
 308         XWINDOW(mini_window)->next = Qnil;
 309         XWINDOW(mini_window)->prev = Qnil;
 310         XWINDOW(mini_window)->frame = frame;
 311
 312         /* Put the proper buffer in that window.  */
 313
 314         Fset_window_buffer(mini_window, Vminibuffer_zero, Qt);
 315 }
 316
 317 static Lisp_Object make_sure_its_a_fresh_plist(Lisp_Object foolist)
 318 {
 319         Lisp_Object tmp = Fcar(foolist);
 320         if (CONSP(tmp)) {
 321                 /* looks like an alist to me. */
 322                 foolist = Fcopy_alist(foolist);
 323                 foolist = Fdestructive_alist_to_plist(foolist);
 324         } else {
 325                 foolist = Fcopy_sequence(foolist);
 326         }
 327         return foolist;
 328 }
 329
 330 DEFUN("make-frame", Fmake_frame, 0, 2, "",      /*
 331 Create and return a new frame, displaying the current buffer.
 332 Runs the functions listed in `create-frame-hook' after frame creation.
 333
 334 Optional argument PROPS is a property list (a list of alternating
 335 keyword-value specifications) of properties for the new frame.
 336 \(An alist is accepted for backward compatibility but should not
 337 be passed in.)
 338
 339 See `set-frame-properties', `default-x-frame-plist', and
 340 `default-tty-frame-plist' for the specially-recognized properties.
 341 */
 342       (props, device))
 343 {
 344         struct frame *f;
 345         struct device *d;
 346         Lisp_Object frame = Qnil, name = Qnil, minibuf;
 347         struct gcpro gcpro1, gcpro2, gcpro3;
 348         int speccount = specpdl_depth();
 349         int first_frame_on_device = 0;
 350         int first_frame_on_console = 0;
 351
 352         d = decode_device(device);
 353         XSETDEVICE(device, d);
 354
 355         /* PROPS and NAME may be freshly-created, so make sure to GCPRO. */
 356         GCPRO3(frame, props, name);
 357
 358         props = make_sure_its_a_fresh_plist(props);
 359         if (DEVICE_SPECIFIC_FRAME_PROPS(d))
 360                 /* Put the device-specific props before the more general ones so
 361                    that they override them. */
 362                 props = nconc2(props,
 363                                make_sure_its_a_fresh_plist
 364                                (*DEVICE_SPECIFIC_FRAME_PROPS(d)));
 365         props =
 366             nconc2(props, make_sure_its_a_fresh_plist(Vdefault_frame_plist));
 367         Fcanonicalize_lax_plist(props, Qnil);
 368
 369         name = Flax_plist_get(props, Qname, Qnil);
 370         if (!NILP(name))
 371                 CHECK_STRING(name);
 372         else if (STRINGP(Vdefault_frame_name))
 373                 name = Vdefault_frame_name;
 374         else
 375                 name = build_string("SXEmacs");
 376
 377         if (!NILP(Fstring_match(make_string((const Bufbyte *)"\\.", 2), name,
 378                                 Qnil, Qnil)))
 379                 signal_simple_error(". not allowed in frame names", name);
 380
 381         f = allocate_frame_core(device);
 382         XSETFRAME(frame, f);
 383
 384         specbind(Qframe_being_created, name);
 385         f->name = name;
 386
 387         FRAMEMETH(f, init_frame_1, (f, props));
 388
 389         minibuf = Flax_plist_get(props, Qminibuffer, Qunbound);
 390         if (UNBOUNDP(minibuf)) {
 391                 /* If minibuf is unspecified, then look for a minibuffer X resource. */
 392                 /* #### Not implemented any more.  We need to fix things up so
 393                    that we search out all X resources and append them to the end of
 394                    props, above.  This is the only way in general to assure
 395                    coherent behavior for all frame properties/resources/etc. */
 396         } else
 397                 props = Flax_plist_remprop(props, Qminibuffer);
 398
 399         if (EQ(minibuf, Qnone) || NILP(minibuf))
 400                 setup_frame_without_minibuffer(f, Qnil);
 401         else if (EQ(minibuf, Qonly))
 402                 setup_minibuffer_frame(f);
 403         else if (WINDOWP(minibuf))
 404                 setup_frame_without_minibuffer(f, minibuf);
 405         else if (EQ(minibuf, Qt) || UNBOUNDP(minibuf))
 406                 setup_normal_frame(f);
 407         else
 408                 signal_simple_error("Invalid value for `minibuffer'", minibuf);
 409
 410         update_frame_window_mirror(f);
 411
 412         if (initialized && !DEVICE_STREAM_P(d)) {
 413                 if (!NILP(f->minibuffer_window))
 414                         reset_face_cachels(XWINDOW(f->minibuffer_window));
 415                 reset_face_cachels(XWINDOW(f->root_window));
 416         }
 417
 418         /* If no frames on this device formerly existed, say this is the
 419            first frame.  It kind of assumes that frameless devices don't
 420            exist, but it shouldn't be too harmful.  */
 421         if (NILP(DEVICE_FRAME_LIST(d)))
 422                 first_frame_on_device = 1;
 423
 424         /* This *must* go before the init_*() methods.  Those functions
 425            call Lisp code, and if any of them causes a warning to be displayed
 426            and the *Warnings* buffer to be created, it won't get added to
 427            the frame-specific version of the buffer-alist unless the frame
 428            is accessible from the device. */
 429
 430 #if 0
 431         DEVICE_FRAME_LIST(d) = nconc2(DEVICE_FRAME_LIST(d), Fcons(frame, Qnil));
 432 #endif
 433         DEVICE_FRAME_LIST(d) = Fcons(frame, DEVICE_FRAME_LIST(d));
 434         RESET_CHANGED_SET_FLAGS;
 435
 436         /* Now make sure that the initial cached values are set correctly.
 437            Do this after the init_frame method is called because that may
 438            do things (e.g. create widgets) that are necessary for the
 439            specifier value-changed methods to work OK. */
 440         recompute_all_cached_specifiers_in_frame(f);
 441
 442         if (!DEVICE_STREAM_P(d)) {
 443                 init_frame_faces(f);
 444
 445 #ifdef HAVE_SCROLLBARS
 446                 /* Finish up resourcing the scrollbars. */
 447                 init_frame_scrollbars(f);
 448 #endif
 449
 450 #ifdef HAVE_TOOLBARS
 451                 /* Create the initial toolbars.  We have to do this after the frame
 452                    methods are called because it may potentially call some things itself
 453                    which depend on the normal frame methods having initialized
 454                    things. */
 455                 init_frame_toolbars(f);
 456 #endif
 457                 reset_face_cachels(XWINDOW(FRAME_SELECTED_WINDOW(f)));
 458                 reset_glyph_cachels(XWINDOW(FRAME_SELECTED_WINDOW(f)));
 459
 460                 change_frame_size(f, f->height, f->width, 0);
 461         }
 462
 463         MAYBE_FRAMEMETH(f, init_frame_2, (f, props));
 464         Fset_frame_properties(frame, props);
 465         MAYBE_FRAMEMETH(f, init_frame_3, (f));
 466
 467         /* Hallelujah, praise the lord. */
 468         f->init_finished = 1;
 469
 470         /* If this is the first frame on the device, make it the selected one. */
 471         if (first_frame_on_device && NILP(DEVICE_SELECTED_FRAME(d)))
 472                 set_device_selected_frame(d, frame);
 473
 474         /* If at startup or if the current console is a stream console
 475            (usually also at startup), make this console the selected one
 476            so that messages show up on it. */
 477         {
 478                 Lisp_Object tmp = Fselected_console();
 479                 if (NILP(tmp) || CONSOLE_STREAM_P(XCONSOLE(tmp))) {
 480                         Fselect_console(DEVICE_CONSOLE(d));
 481                 }
 482         }
 483
 484         first_frame_on_console =
 485             (first_frame_on_device &&
 486              XINT(Flength(CONSOLE_DEVICE_LIST(XCONSOLE(DEVICE_CONSOLE(d)))))
 487              == 1);
 488
 489         /* #### all this calling of frame methods at various odd times
 490            is somewhat of a mess.  It's necessary to do it this way due
 491            to strange console-type-specific things that need to be done. */
 492         MAYBE_FRAMEMETH(f, after_init_frame, (f, first_frame_on_device,
 493                                               first_frame_on_console));
 494
 495         if (!DEVICE_STREAM_P(d)) {
 496                 /* Now initialise the gutters. This won't change the frame size,
 497                    but is needed as input to the layout that change_frame_size
 498                    will eventually do. Unfortunately gutter sizing code relies
 499                    on the frame in question being visible so we can't do this
 500                    earlier. */
 501                 init_frame_gutters(f);
 502
 503                 change_frame_size(f, f->height, f->width, 0);
 504         }
 505
 506         if (first_frame_on_device) {
 507                 if (first_frame_on_console)
 508                         va_run_hook_with_args(Qcreate_console_hook, 1,
 509                                               DEVICE_CONSOLE(d));
 510                 va_run_hook_with_args(Qcreate_device_hook, 1, device);
 511         }
 512         va_run_hook_with_args(Qcreate_frame_hook, 1, frame);
 513
 514         /* Initialize custom-specific stuff. */
 515         if (!UNBOUNDP(symbol_function(XSYMBOL(Qcustom_initialize_frame))))
 516                 call1(Qcustom_initialize_frame, frame);
 517