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

   1 /* Specifier implementation
   2    Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
   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: Not in FSF. */
  23
  24 /* Design by Ben Wing;
  25    Original version by Chuck Thompson;
  26    rewritten by Ben Wing;
  27    Magic specifiers by Kirill Katsnelson;
  28 */
  29
  30 #include <config.h>
  31 #include "lisp.h"
  32
  33 #include "buffer.h"
  34 #include "device.h"
  35 #include "frame.h"
  36 #include "opaque.h"
  37 #include "specifier.h"
  38 #include "window.h"
  39 #include "chartab.h"
  40 #include "rangetab.h"
  41
  42 Lisp_Object Qspecifierp;
  43 Lisp_Object Qremove_tag_set_prepend, Qremove_tag_set_append;
  44 Lisp_Object Qremove_locale, Qremove_locale_type;
  45
  46 Lisp_Object Qconsole_type, Qdevice_class;
  47
  48 Lisp_Object Qspecifier_syntax_error;
  49 Lisp_Object Qspecifier_argument_error;
  50 Lisp_Object Qspecifier_change_error;
  51
  52 static Lisp_Object Vuser_defined_tags;
  53
  54 typedef struct specifier_type_entry specifier_type_entry;
  55 struct specifier_type_entry {
  56         Lisp_Object symbol;
  57         struct specifier_methods *meths;
  58 };
  59
  60 typedef struct {
  61         Dynarr_declare(specifier_type_entry);
  62 } specifier_type_entry_dynarr;
  63
  64 static specifier_type_entry_dynarr *the_specifier_type_entry_dynarr;
  65
  66 static const struct lrecord_description ste_description_1[] = {
  67         {XD_LISP_OBJECT, offsetof(specifier_type_entry, symbol)},
  68         {XD_STRUCT_PTR, offsetof(specifier_type_entry, meths), 1,
  69          &specifier_methods_description},
  70         {XD_END}
  71 };
  72
  73 static const struct struct_description ste_description = {
  74         sizeof(specifier_type_entry),
  75         ste_description_1
  76 };
  77
  78 static const struct lrecord_description sted_description_1[] = {
  79         XD_DYNARR_DESC(specifier_type_entry_dynarr, &ste_description),
  80         {XD_END}
  81 };
  82
  83 static const struct struct_description sted_description = {
  84         sizeof(specifier_type_entry_dynarr),
  85         sted_description_1
  86 };
  87
  88 static Lisp_Object Vspecifier_type_list;
  89
  90 static Lisp_Object Vcached_specifiers;
  91 /* Do NOT mark through this, or specifiers will never be GC'd. */
  92 static Lisp_Object Vall_specifiers;
  93
  94 static Lisp_Object Vunlock_ghost_specifiers;
  95
  96 /* #### The purpose of this is to check for inheritance loops
  97    in specifiers that can inherit from other specifiers, but it's
  98    not yet implemented.
  99
 100    #### Look into this for 19.14. */
 101 /* static Lisp_Object_dynarr current_specifiers; */
 102
 103 static void recompute_cached_specifier_everywhere(Lisp_Object specifier);
 104
 105 EXFUN(Fspecifier_specs, 4);
 106 EXFUN(Fremove_specifier, 4);
 107 \f
 108 /************************************************************************/
 109 /*                       Specifier object methods                       */
 110 /************************************************************************/
 111
 112 /* Remove dead objects from the specified assoc list. */
 113
 114 static Lisp_Object cleanup_assoc_list(Lisp_Object list)
 115 {
 116         Lisp_Object loop, prev, retval;
 117
 118         loop = retval = list;
 119         prev = Qnil;
 120
 121         while (!NILP(loop)) {
 122                 Lisp_Object entry = XCAR(loop);
 123                 Lisp_Object key = XCAR(entry);
 124
 125                 /* remember, dead windows can become alive again. */
 126                 if (!WINDOWP(key) && object_dead_p(key)) {
 127                         if (NILP(prev)) {
 128                                 /* Removing the head. */
 129                                 retval = XCDR(retval);
 130                         } else {
 131                                 Fsetcdr(prev, XCDR(loop));
 132                         }
 133                 } else
 134                         prev = loop;
 135
 136                 loop = XCDR(loop);
 137         }
 138
 139         return retval;
 140 }
 141
 142 /* Remove dead objects from the various lists so that they
 143    don't keep getting marked as long as this specifier exists and
 144    therefore wasting memory. */
 145
 146 void cleanup_specifiers(void)
 147 {
 148         Lisp_Object rest;
 149
 150         for (rest = Vall_specifiers;
 151              !NILP(rest); rest = XSPECIFIER(rest)->next_specifier) {
 152                 Lisp_Specifier *sp = XSPECIFIER(rest);
 153                 /* This effectively changes the specifier specs.
 154                    However, there's no need to call
 155                    recompute_cached_specifier_everywhere() or the
 156                    after-change methods because the only specs we
 157                    are removing are for dead objects, and they can
 158                    never have any effect on the specifier values:
 159                    specifiers can only be instantiated over live
 160                    objects, and you can't derive a dead object
 161                    from a live one. */
 162                 sp->device_specs = cleanup_assoc_list(sp->device_specs);
 163                 sp->frame_specs = cleanup_assoc_list(sp->frame_specs);
 164                 sp->buffer_specs = cleanup_assoc_list(sp->buffer_specs);
 165                 /* windows are handled specially because dead windows
 166                    can be resurrected */
 167         }
 168 }
 169
 170 void kill_specifier_buffer_locals(Lisp_Object buffer)
 171 {
 172         Lisp_Object rest;
 173
 174         for (rest = Vall_specifiers;
 175              !NILP(rest); rest = XSPECIFIER(rest)->next_specifier) {
 176                 Lisp_Specifier *sp = XSPECIFIER(rest);
 177
 178                 /* Make sure we're actually going to be changing something.
 179                    Fremove_specifier() always calls
 180                    recompute_cached_specifier_everywhere() (#### but should
 181                    be smarter about this). */
 182                 if (!NILP(assq_no_quit(buffer, sp->buffer_specs)))
 183                         Fremove_specifier(rest, buffer, Qnil, Qnil);
 184         }
 185 }
 186
 187 static Lisp_Object mark_specifier(Lisp_Object obj)
 188 {
 189         Lisp_Specifier *specifier = XSPECIFIER(obj);
 190
 191         mark_object(specifier->global_specs);
 192         mark_object(specifier->device_specs);
 193         mark_object(specifier->frame_specs);
 194         mark_object(specifier->window_specs);
 195         mark_object(specifier->buffer_specs);
 196         mark_object(specifier->magic_parent);
 197         mark_object(specifier->fallback);
 198         if (!GHOST_SPECIFIER_P(XSPECIFIER(obj)))
 199                 MAYBE_SPECMETH(specifier, mark, (obj));
 200         return Qnil;
 201 }
 202
 203 /* The idea here is that the specifier specs point to locales
 204    (windows, buffers, frames, and devices), and we want to make sure
 205    that the specs disappear automatically when the associated locale
 206    is no longer in use.  For all but windows, "no longer in use"
 207    corresponds exactly to when the object is deleted (non-deleted
 208    objects are always held permanently in special lists, and deleted
 209    objects are never on these lists and never reusable).  To handle
 210    this, we just have cleanup_specifiers() called periodically
 211    (at the beginning of garbage collection); it removes all dead
 212    objects.
 213
 214    For windows, however, it's trickier because dead objects can be
 215    converted to live ones again if the dead object is in a window
 216    configuration.  Therefore, for windows, "no longer in use"
 217    corresponds to when the window object is garbage-collected.
 218    We now use weak lists for this purpose.
 219
 220 */
 221
 222 void prune_specifiers(void)
 223 {
 224         Lisp_Object rest, prev = Qnil;
 225
 226         for (rest = Vall_specifiers;
 227              !NILP(rest); rest = XSPECIFIER(rest)->next_specifier) {
 228                 if (!marked_p(rest)) {
 229                         Lisp_Specifier *sp = XSPECIFIER(rest);
 230                         /* A bit of assertion that we're removing both parts of the
 231                            magic one altogether */
 232 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
 233 #  define MARKED_P(a) marked_p(a)
 234 #else
 235 #  define MARKED_P(a) 1
 236 #endif
 237                         assert(!MAGIC_SPECIFIER_P(sp)
 238                                || ( BODILY_SPECIFIER_P(sp) &&
 239                                     MARKED_P(sp->fallback) )
 240                                || ( GHOST_SPECIFIER_P(sp) &&
 241                                     MARKED_P(sp->magic_parent)));
 242 #undef MARKED_P
 243                         /* This specifier is garbage.  Remove it from the list. */
 244                         if (NILP(prev))
 245                                 Vall_specifiers = sp->next_specifier;
 246                         else
 247                                 XSPECIFIER(prev)->next_specifier =
 248                                     sp->next_specifier;
 249                 } else
 250                         prev = rest;
 251         }
 252 }
 253
 254 static void
 255 print_specifier(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 256 {
 257         Lisp_Specifier *sp = XSPECIFIER(obj);
 258         int count = specpdl_depth();