import -ko -b 1.1.3 XEmacs XEmacs-21_2 r21-2-35
[chise/xemacs-chise.git.1] / src / buffer.c
index b7c18f9..eb440de 100644 (file)
@@ -84,6 +84,7 @@ Boston, MA 02111-1307, USA.  */
 #ifdef REGION_CACHE_NEEDS_WORK
 #include "region-cache.h"
 #endif
+#include "select.h"     /* for select_notify_buffer_kill */
 #include "specifier.h"
 #include "syntax.h"
 #include "sysdep.h"    /* for getwd */
@@ -195,7 +196,6 @@ Lisp_Object QSscratch;          /* "*scratch*" */
 Lisp_Object Qdefault_directory;
 
 Lisp_Object Qkill_buffer_hook;
-Lisp_Object Qrecord_buffer_hook;
 
 Lisp_Object Qrename_auto_save_file;
 
@@ -567,7 +567,7 @@ finish_init_buffer (struct buffer *b, Lisp_Object name)
      local_var_alist is set to Qnil at the same point, in
      nuke_all_buffer_slots(). */
   reset_buffer_local_variables (b, 1);
-  b->directory = ((current_buffer) ? current_buffer->directory : Qnil);
+  b->directory = current_buffer ? current_buffer->directory : Qnil;
 
   b->last_window_start = 1;
 
@@ -1027,6 +1027,7 @@ This does not change the name of the visited file (if any).
   /* The aconses in the Vbuffer_alist are shared with frame->buffer_alist,
      so this will change it in the per-frame ordering as well. */
   Fsetcar (Frassq (buf, Vbuffer_alist), newname);
+
   if (NILP (current_buffer->filename)
       && !NILP (current_buffer->auto_save_file_name))
     call0 (Qrename_auto_save_file);
@@ -1186,7 +1187,7 @@ with `delete-process'.
       killp = call1
        (Qyes_or_no_p,
         (emacs_doprnt_string_c
-         ((CONST Bufbyte *) GETTEXT ("Buffer %s modified; kill anyway? "),
+         ((const Bufbyte *) GETTEXT ("Buffer %s modified; kill anyway? "),
           Qnil, -1, XSTRING_DATA (b->name))));
       UNGCPRO;
       if (NILP (killp))
@@ -1220,15 +1221,13 @@ with `delete-process'.
 
       /* Then run the hooks.  */
       run_hook (Qkill_buffer_hook);
-#ifdef HAVE_X_WINDOWS
-      /* If an X selection was in this buffer, disown it.
-        We could have done this by simply adding this function to the
-        kill-buffer-hook, but the user might mess that up.
-        */
-      if (EQ (Vwindow_system, Qx))
-       call0 (intern ("xselect-kill-buffer-hook"));
-      /* #### generalize me! */
-#endif /* HAVE_X_WINDOWS */
+
+      /* Inform the selection code that a buffer just got killed.
+        We do this in C because (a) it's faster, and (b) it needs
+         to access data internal to select.c that can't be seen from
+         Lisp (so the Lisp code would just call into C anyway. */
+      select_notify_buffer_kill (buf);
+      
       unbind_to (speccount, Qnil);
       UNGCPRO;
       b = XBUFFER (buf);        /* Hypothetical relocating GC. */
@@ -1304,13 +1303,13 @@ with `delete-process'.
 
     kill_buffer_processes (buf);
 
+    delete_from_buffer_alist (buf);
+
     /* #### This is a problem if this buffer is in a dedicated window.
        Need to undedicate any windows of this buffer first (and delete them?)
        */
     Freplace_buffer_in_windows (buf);
 
-    delete_from_buffer_alist (buf);
-
     font_lock_buffer_was_killed (b);
 
     /* Delete any auto-save file, if we saved it in this session.  */
@@ -1413,8 +1412,6 @@ buffer.  See `other-buffer' for more information.
   XCDR (lynk) = f->buffer_alist;
   f->buffer_alist = lynk;
 
-  va_run_hook_with_args (Qrecord_buffer_hook, 1, buffer);
-
   return Qnil;
 }
 
@@ -1483,20 +1480,6 @@ set_buffer_internal (struct buffer *b)
   current_buffer = b;
   invalidate_current_column ();   /* invalidate indentation cache */
 
-#ifdef HAVE_FEP
-  if (!noninteractive && initialized)
-    {
-      extern Lisp_Object Ffep_force_on (), Ffep_force_off (), Ffep_get_mode ();
-
-      old_buf->fep_mode = Ffep_get_mode ();
-
-      if (!NILP (current_buffer->fep_mode))
-       Ffep_force_on ();
-      else
-       Ffep_force_off ();
-  }
-#endif /* HAVE_FEP */
-
   if (old_buf)
     {
       /* Put the undo list back in the base buffer, so that it appears
@@ -1832,8 +1815,18 @@ coding_system_is_binary (Lisp_Object coding_system)
 #define coding_system_is_binary(coding_system) 1
 #endif
 
-static Extbyte_dynarr *conversion_out_dynarr;
-static Bufbyte_dynarr *conversion_in_dynarr;
+typedef struct
+{
+  Dynarr_declare (Bufbyte_dynarr *);
+} Bufbyte_dynarr_dynarr;
+
+typedef struct
+{
+  Dynarr_declare (Extbyte_dynarr *);
+} Extbyte_dynarr_dynarr;
+
+static Extbyte_dynarr_dynarr *conversion_out_dynarr_list;
+static Bufbyte_dynarr_dynarr *conversion_in_dynarr_list;
 
 static int dfc_convert_to_external_format_in_use;
 static int dfc_convert_to_internal_format_in_use;
@@ -1862,6 +1855,7 @@ dfc_convert_to_external_format (dfc_conversion_type source_type,
                                dfc_conversion_data *sink)
 {
   int count = specpdl_depth ();
+  Extbyte_dynarr *conversion_out_dynarr;
 
   type_checking_assert
     (((source_type == DFC_TYPE_DATA) ||
@@ -1871,20 +1865,20 @@ dfc_convert_to_external_format (dfc_conversion_type source_type,
      ((sink_type == DFC_TYPE_DATA) ||
       (sink_type == DFC_TYPE_LISP_LSTREAM && LSTREAMP (source->lisp_object))));
 
-  if (dfc_convert_to_external_format_in_use != 0)
-    error ("Can't call a conversion function from a conversion function");
-  else
-    dfc_convert_to_external_format_in_use = 1;
-
   record_unwind_protect (dfc_convert_to_external_format_reset_in_use,
-                        Qzero);
+                        make_int (dfc_convert_to_external_format_in_use));
+  if (Dynarr_length (conversion_out_dynarr_list) <=
+      dfc_convert_to_external_format_in_use)
+    Dynarr_add (conversion_out_dynarr_list, Dynarr_new (Extbyte));
+  conversion_out_dynarr = Dynarr_at (conversion_out_dynarr_list,
+                                    dfc_convert_to_external_format_in_use);
+  dfc_convert_to_external_format_in_use++;
+  Dynarr_reset (conversion_out_dynarr);
 
 #ifdef FILE_CODING
   coding_system = Fget_coding_system (coding_system);
 #endif
 
-  Dynarr_reset (conversion_out_dynarr);
-
   /* Here we optimize in the case where the coding system does no
      conversion. However, we don't want to optimize in case the source
      or sink is an lstream, since writing to an lstream can cause a
@@ -2017,6 +2011,7 @@ dfc_convert_to_internal_format (dfc_conversion_type source_type,
                                dfc_conversion_data *sink)
 {
   int count = specpdl_depth ();
+  Bufbyte_dynarr *conversion_in_dynarr;
 
   type_checking_assert
     ((source_type == DFC_TYPE_DATA ||
@@ -2025,20 +2020,20 @@ dfc_convert_to_internal_format (dfc_conversion_type source_type,
     (sink_type   == DFC_TYPE_DATA ||
      sink_type   == DFC_TYPE_LISP_LSTREAM));
 
-  if (dfc_convert_to_internal_format_in_use != 0)
-    error ("Can't call a conversion function from a conversion function");
-  else
-    dfc_convert_to_internal_format_in_use = 1;
-
   record_unwind_protect (dfc_convert_to_internal_format_reset_in_use,
-                        Qzero);
+                        make_int (dfc_convert_to_internal_format_in_use));
+  if (Dynarr_length (conversion_in_dynarr_list) <=
+      dfc_convert_to_internal_format_in_use)
+    Dynarr_add (conversion_in_dynarr_list, Dynarr_new (Bufbyte));
+  conversion_in_dynarr = Dynarr_at (conversion_in_dynarr_list,
+                                   dfc_convert_to_internal_format_in_use);
+  dfc_convert_to_internal_format_in_use++;
+  Dynarr_reset (conversion_in_dynarr);
 
 #ifdef FILE_CODING
   coding_system = Fget_coding_system (coding_system);
 #endif
 
-  Dynarr_reset (conversion_in_dynarr);
-
   if (source_type != DFC_TYPE_LISP_LSTREAM &&
       sink_type   != DFC_TYPE_LISP_LSTREAM &&
       coding_system_is_binary (coding_system))
@@ -2148,12 +2143,13 @@ dfc_convert_to_internal_format (dfc_conversion_type source_type,
 void
 syms_of_buffer (void)
 {
+  INIT_LRECORD_IMPLEMENTATION (buffer);
+
   defsymbol (&Qbuffer_live_p, "buffer-live-p");
   defsymbol (&Qbuffer_or_string_p, "buffer-or-string-p");
   defsymbol (&Qmode_class, "mode-class");
   defsymbol (&Qrename_auto_save_file, "rename-auto-save-file");
   defsymbol (&Qkill_buffer_hook, "kill-buffer-hook");
-  defsymbol (&Qrecord_buffer_hook, "record-buffer-hook");
   defsymbol (&Qpermanent_local, "permanent-local");
 
   defsymbol (&Qfirst_change_hook, "first-change-hook");
@@ -2219,8 +2215,10 @@ syms_of_buffer (void)
 void
 reinit_vars_of_buffer (void)
 {
-  conversion_in_dynarr  = Dynarr_new (Bufbyte);
-  conversion_out_dynarr = Dynarr_new (Extbyte);
+  conversion_in_dynarr_list = Dynarr_new2 (Bufbyte_dynarr_dynarr,
+                                          Bufbyte_dynarr *);
+  conversion_out_dynarr_list = Dynarr_new2 (Extbyte_dynarr_dynarr,
+                                           Extbyte_dynarr *);
 
   staticpro_nodump (&Vbuffer_alist);
   Vbuffer_alist = Qnil;
@@ -2373,15 +2371,27 @@ List of functions called with no args to query before killing a buffer.
 
 /* Renamed from DEFVAR_PER_BUFFER because FSFmacs D_P_B takes
    a bogus extra arg, which confuses an otherwise identical make-docfile.c */
-
-/* Declaring this stuff as const produces 'Cannot reinitialize' messages
-   from SunPro C's fix-and-continue feature (a way neato feature that
-   makes debugging unbelievably more bearable) */
 #define DEFVAR_BUFFER_LOCAL_1(lname, field_name, forward_type, magicfun) do {  \
-  static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C               \
-    = { { { symbol_value_forward_lheader_initializer,                          \
-           (struct lcrecord_header *) &(buffer_local_flags.field_name), 69 },  \
-         forward_type }, magicfun };                                           \
+  static const struct symbol_value_forward I_hate_C =                          \
+  { /* struct symbol_value_forward */                                          \
+    { /* struct symbol_value_magic */                                          \
+      { /* struct lcrecord_header */                                           \
+       { /* struct lrecord_header */                                           \
+         lrecord_type_symbol_value_forward, /* lrecord_type_index */           \
+         1, /* mark bit */                                                     \
+         1, /* c_readonly bit */                                               \
+         1  /* lisp_readonly bit */                                            \
+       },                                                                      \
+       0, /* next */                                                           \
+       0, /* uid  */                                                           \
+       0  /* free */                                                           \
+      },                                                                       \
+      &(buffer_local_flags.field_name),                                                \
+      forward_type                                                             \
+    },                                                                         \
+    magicfun                                                                   \
+  };                                                                           \
+                                                                               \
   {                                                                            \
     int offset = ((char *)symbol_value_forward_forward (&I_hate_C) -           \
                  (char *)&buffer_local_flags);                                 \
@@ -2650,31 +2660,31 @@ This is the same as (default-value 'case-fold-search).
   DEFVAR_BUFFER_LOCAL ("modeline-format", modeline_format /*
 Template for displaying modeline for current buffer.
 Each buffer has its own value of this variable.
-Value may be a string, a symbol or a list or cons cell.
-For a symbol, its value is used (but it is ignored if t or nil).
+Value may be a string, symbol, glyph, generic specifier, list or cons cell.
+For a symbol, its value is processed (but it is ignored if t or nil).
  A string appearing directly as the value of a symbol is processed verbatim
  in that the %-constructs below are not recognized.
 For a glyph, it is inserted as is.
+For a generic specifier (i.e. a specifier of type `generic'), its instance
+ is computed in the current window using the equivalent of `specifier-instance'
+ and the value is processed.
 For a list whose car is a symbol, the symbol's value is taken,
  and if that is non-nil, the cadr of the list is processed recursively.
  Otherwise, the caddr of the list (if there is one) is processed.
 For a list whose car is a string or list, each element is processed
  recursively and the results are effectively concatenated.
 For a list whose car is an integer, the cdr of the list is processed
-  and padded (if the number is positive) or truncated (if negative)
-  to the width specified by that number.
+ and padded (if the number is positive) or truncated (if negative)
+ to the width specified by that number.
 For a list whose car is an extent, the cdr of the list is processed
  normally but the results are displayed using the face of the
  extent, and mouse clicks over this section are processed using the
  keymap of the extent. (In addition, if the extent has a help-echo
  property, that string will be echoed when the mouse moves over this
- section.) See `generated-modeline-string' for more information.
-For a list whose car is a face, the cdr of the list is processed
- normally but the results will be displayed using the face in the car.
-For a list whose car is a keymap, the cdr of the list is processed
- normally but the keymap will apply for mouse clicks over the results,
- in addition to `modeline-map'.  Nested keymap specifications are
- handled properly.
+ section.) If extents are nested, all keymaps are properly consulted
+ when processing mouse clicks, but multiple faces are not correctly
+ merged (only the first face is used), and lists of faces are not
+ correctly handled.  See `generated-modeline-string' for more information.
 A string is printed verbatim in the modeline except for %-constructs:
   (%-constructs are processed when the string is the entire modeline-format
    or when it is found in a cons-cell or a list)
@@ -3089,6 +3099,7 @@ handled:
   }
 }
 
+#ifndef WIN32_NATIVE
 /* Is PWD another name for `.' ? */
 static int
 directory_is_current_directory (Extbyte *pwd)
@@ -3108,23 +3119,29 @@ directory_is_current_directory (Extbyte *pwd)
          && dotstat.st_dev == pwdstat.st_dev
          && pwd_internal_len < MAXPATHLEN);
 }
+#endif
 
 void
 init_initial_directory (void)
 {
   /* This function can GC */
 
+#ifndef WIN32_NATIVE
   Extbyte *pwd;
+#endif
 
   initial_directory[0] = 0;
 
   /* If PWD is accurate, use it instead of calling getcwd.  This is faster
      when PWD is right, and may avoid a fatal error.  */
+#ifndef WIN32_NATIVE
   if ((pwd = (Extbyte *) getenv ("PWD")) != NULL
       && directory_is_current_directory (pwd))
     strcpy (initial_directory, (char *) pwd);
-  else if (getcwd (initial_directory, MAXPATHLEN) == NULL)
-    fatal ("`getcwd' failed: %s\n", strerror (errno));
+  else
+#endif
+    if (getcwd (initial_directory, MAXPATHLEN) == NULL)
+      fatal ("`getcwd' failed: %s\n", strerror (errno));
 
   /* Make sure pwd is DIRECTORY_SEP-terminated.
      Maybe this should really use some standard subroutine
@@ -3139,16 +3156,8 @@ init_initial_directory (void)
       }
   }
 
-  /* XEmacs change: store buffer's default directory
-     using preferred (i.e. as defined at compile-time)
-     directory separator. --marcpa */
-#ifdef DOS_NT
-#define CORRECT_DIR_SEPS(s) \
-  do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
-       else unixtodos_filename (s); \
-  } while (0)
-
-  CORRECT_DIR_SEPS(initial_directory);
+#ifdef CORRECT_DIR_SEPS
+  CORRECT_DIR_SEPS (initial_directory);
 #endif
 }