xemacs-beta: src/buffer.c comparison

comparison src/buffer.c @ 442:abe6d1db359e r21-2-36

Import from CVS: tag r21-2-36

author	cvs
date	Mon, 13 Aug 2007 11:35:02 +0200
parents	8de8e3f6228a
children	576fb035e263

comparison

equal deleted inserted replaced

-:72a7cfa4a488
+:abe6d1db359e
 #include "lstream.h"
 #include "process.h"            /* for kill_buffer_processes */
 #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 */
 #include "window.h"
 Lisp_Object QSFundamental;	/* A string "Fundamental" */
 Lisp_Object QSscratch;          /* "*scratch*" */
 Lisp_Object Qdefault_directory;
 Lisp_Object Qkill_buffer_hook;
-Lisp_Object Qrecord_buffer_hook;
 Lisp_Object Qrename_auto_save_file;
 Lisp_Object Qget_file_buffer;
 Lisp_Object Qchange_major_mode_hook, Vchange_major_mode_hook;
 FILENAME will be converted to its truename and used for searching, but
 the search will still be done on `buffer-file-name'.
 */
 (filename))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC.  GC checked and fixed 7-11-2000 ben. */
 REGISTER Lisp_Object buf;
 struct gcpro gcpro1;
 #ifdef I18N3
 /* DO NOT translate the filename. */
 if (NILP (fn))
 	{
 	  dn = Ffile_name_directory (filename);
 	  fn = Ffile_truename (dn, Qnil);
 	  if (! NILP (fn)) dn = fn;
-	  fn = Fexpand_file_name (Ffile_name_nondirectory (filename),
+	  /* Formerly the two calls below were combined, but that is
-				  dn);
+	     not GC-safe because the first call returns unprotected
+	     data and the second call can GC. --ben */
+	  fn = Ffile_name_nondirectory (filename);
+	  fn = Fexpand_file_name (fn, dn);
 	}
 filename = fn;
 NUNGCPRO;
 }
 {
-Lisp_Object elt;
 LIST_LOOP_2 (elt, Vbuffer_alist)
 {
 	buf = Fcdr (elt);
 	if (!BUFFERP (buf)) continue;
 	if (!STRINGP (XBUFFER (buf)->filename)) continue;
 }
 Lisp_Object
 get_truename_buffer (REGISTER Lisp_Object filename)
 {
+/* This function can GC.  GC correct 7-11-00 ben */
 /* FSFmacs has its own code here and doesn't call get-file-buffer.
 That's because their equivalent of find-file-compare-truenames
 (find-file-existing-other-name) isn't looked at in get-file-buffer.
 This way is more correct. */
 int count = specpdl_depth ();
 /* #### This really does not need to be called.  We already
 initialized the buffer-local variables in allocate_buffer().
 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;
 b->name = name;
 if (string_byte (XSTRING (name), 0) != ' ')
 #undef MARKED_SLOT
 }
 return result;
 }
-DEFUN ("buffer-dedicated-frame", Fbuffer_dedicated_frame, 0, 1, 0, /*
-Return the frame dedicated to this BUFFER, or nil if there is none.
-No argument or nil as argument means use current buffer as BUFFER.
-*/
-(buffer))
-{
-struct buffer *buf = decode_buffer (buffer, 0);
-/* XEmacs addition: if the frame is dead, silently make it go away. */
-if (!NILP (buf->dedicated_frame) &&
-!FRAME_LIVE_P (XFRAME (buf->dedicated_frame)))
-buf->dedicated_frame = Qnil;
-return buf->dedicated_frame;
-}
-DEFUN ("set-buffer-dedicated-frame", Fset_buffer_dedicated_frame, 2, 2, 0, /*
-For this BUFFER, set the FRAME dedicated to it.
-FRAME must be a frame or nil.
-*/
-(buffer, frame))
-{
-struct buffer *buf = decode_buffer (buffer, 0);
-if (!NILP (frame))
-CHECK_LIVE_FRAME (frame); /* XEmacs change */
-return buf->dedicated_frame = frame;
-}
 DEFUN ("buffer-modified-p", Fbuffer_modified_p, 0, 1, 0, /*
 Return t if BUFFER was modified since its file was last read or saved.
 No argument or nil as argument means use current buffer as BUFFER.
 */
 buf = Fcurrent_buffer ();
 /* 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);
 /* refetch since that last call may have done GC */
 /* (hypothetical relocating GC) */
 Lisp_Object killp;
 GCPRO1 (buf);
 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))
 	return Qnil;
 b = XBUFFER (buf);        /* Hypothetical relocating GC. */
 	    }
 	}
 /* Then run the hooks.  */
 run_hook (Qkill_buffer_hook);
-#ifdef HAVE_X_WINDOWS
-/* If an X selection was in this buffer, disown it.
+/* Inform the selection code that a buffer just got killed.
-	 We could have done this by simply adding this function to the
+	 We do this in C because (a) it's faster, and (b) it needs
-	 kill-buffer-hook, but the user might mess that up.
+to access data internal to select.c that can't be seen from
-	 */
+Lisp (so the Lisp code would just call into C anyway. */
-if (EQ (Vwindow_system, Qx))
+select_notify_buffer_kill (buf);
-	call0 (intern ("xselect-kill-buffer-hook"));
-/* #### generalize me! */
-#endif /* HAVE_X_WINDOWS */
 unbind_to (speccount, Qnil);
 UNGCPRO;
 b = XBUFFER (buf);        /* Hypothetical relocating GC. */
 }
 int speccount = specpdl_depth ();
 specbind (Qinhibit_quit, Qt);
 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.  */
 if (STRINGP (b->auto_save_file_name)
 else
 XCDR (prev) = XCDR (XCDR (prev));
 XCDR (lynk) = f->buffer_alist;
 f->buffer_alist = lynk;
-va_run_hook_with_args (Qrecord_buffer_hook, 1, buffer);
 return Qnil;
 }
 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, 1, 1, 0, /*
 Set an appropriate major mode for BUFFER, according to `default-major-mode'.
 INVALIDATE_PIXEL_TO_GLYPH_CACHE;
 old_buf = current_buffer;
 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
 	 that an indirect buffer shares the undo list of its base.  */
 }
 #else
 #define coding_system_is_binary(coding_system) 1
 #endif
-static Extbyte_dynarr *conversion_out_dynarr;
+typedef struct
-static Bufbyte_dynarr *conversion_in_dynarr;
+{
+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;
 static Lisp_Object
 #endif
 				dfc_conversion_type sink_type,
 				dfc_conversion_data *sink)
 {
 int count = specpdl_depth ();
+Extbyte_dynarr *conversion_out_dynarr;
 type_checking_assert
 (((source_type == DFC_TYPE_DATA) ||
 (source_type == DFC_TYPE_LISP_LSTREAM && LSTREAMP (source->lisp_object)) ||
 (source_type == DFC_TYPE_LISP_STRING && STRINGP (source->lisp_object)))
 &&
 ((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
 garbage collection, and this could be problematic if the source
 #endif
 				dfc_conversion_type sink_type,
 				dfc_conversion_data *sink)
 {
 int count = specpdl_depth ();
+Bufbyte_dynarr *conversion_in_dynarr;
 type_checking_assert
 ((source_type == DFC_TYPE_DATA ||
 source_type == DFC_TYPE_LISP_LSTREAM)
 &&
 (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))
 {
 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");
 defsymbol (&Qbefore_change_functions, "before-change-functions");
 defsymbol (&Qafter_change_functions, "after-change-functions");
 DEFSUBR (Fbuffer_name);
 DEFSUBR (Fbuffer_file_name);
 DEFSUBR (Fbuffer_base_buffer);
 DEFSUBR (Fbuffer_indirect_children);
 DEFSUBR (Fbuffer_local_variables);
-DEFSUBR (Fbuffer_dedicated_frame);
-DEFSUBR (Fset_buffer_dedicated_frame);
 DEFSUBR (Fbuffer_modified_p);
 DEFSUBR (Fset_buffer_modified_p);
 DEFSUBR (Fbuffer_modified_tick);
 DEFSUBR (Frename_buffer);
 DEFSUBR (Fother_buffer);
 DEFSUBR (Fkill_all_local_variables);
 #ifdef MEMORY_USAGE_STATS
 DEFSUBR (Fbuffer_memory_usage);
 #endif
-deferror (&Qprotected_field, "protected-field",
+DEFERROR (Qprotected_field, "Attempt to modify a protected field",
-	    "Attempt to modify a protected field", Qerror);
+	    Qinvalid_change);
 }
 void
 reinit_vars_of_buffer (void)
 {
-conversion_in_dynarr  = Dynarr_new (Bufbyte);
+conversion_in_dynarr_list = Dynarr_new2 (Bufbyte_dynarr_dynarr,
-conversion_out_dynarr = Dynarr_new (Extbyte);
+					   Bufbyte_dynarr *);
+conversion_out_dynarr_list = Dynarr_new2 (Extbyte_dynarr_dynarr,
+					    Extbyte_dynarr *);
 staticpro_nodump (&Vbuffer_alist);
 Vbuffer_alist = Qnil;
 current_buffer = 0;
 }
 /* The docstrings for DEFVAR_* are recorded externally by make-docfile.  */
 /* 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		\
+static const struct symbol_value_forward I_hate_C =				\
-= { { { symbol_value_forward_lheader_initializer,				\
+{ /* struct symbol_value_forward */						\
-	    (struct lcrecord_header *) &(buffer_local_flags.field_name), 69 },	\
+{ /* struct symbol_value_magic */						\
-	  forward_type }, magicfun };						\
+{ /* 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);					\
 defvar_magic (lname, &I_hate_C);						\
 										\
 */ );
 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.
+Value may be a string, symbol, glyph, generic specifier, list or cons cell.
-For a symbol, its value is used (but it is ignored if t or nil).
+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.
 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.
+section.) If extents are nested, all keymaps are properly consulted
-For a list whose car is a face, the cdr of the list is processed
+when processing mouse clicks, but multiple faces are not correctly
-normally but the results will be displayed using the face in the car.
+merged (only the first face is used), and lists of faces are not
-For a list whose car is a keymap, the cdr of the list is processed
+correctly handled.  See `generated-modeline-string' for more information.
-normally but the keymap will apply for mouse clicks over the results,
-in addition to `modeline-map'.  Nested keymap specifications are
-handled properly.
 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)
 %b -- print buffer name.      %c -- print the current column number.
 %f -- print visited file name.
 /* Want no undo records for *scratch* until after Emacs is dumped */
 Fbuffer_disable_undo (scratch);
 }
 }
+#ifndef WIN32_NATIVE
 /* Is PWD another name for `.' ? */
 static int
 directory_is_current_directory (Extbyte *pwd)
 {
 Bufbyte *pwd_internal;
 TO_INTERNAL_FORMAT (DATA, (pwd, strlen ((char *)pwd) + 1),
 		      ALLOCA, (pwd_internal, pwd_internal_len),
 		      Qfile_name);
 return (IS_DIRECTORY_SEP (*pwd_internal)
-	  && stat ((char *) pwd_internal, &pwdstat) == 0
+	  && xemacs_stat ((char *) pwd_internal, &pwdstat) == 0
-	  && stat (".", &dotstat) == 0
+	  && xemacs_stat (".", &dotstat) == 0
 	  && dotstat.st_ino == pwdstat.st_ino
 	  && 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)
+else
-fatal ("`getcwd' failed: %s\n", strerror (errno));
+#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
 whose definition is filename syntax dependent.  */
 {
 	initial_directory[len] = DIRECTORY_SEP;
 	initial_directory[len + 1] = '\0';
 }
 }
-/* XEmacs change: store buffer's default directory
+#ifdef CORRECT_DIR_SEPS
-using preferred (i.e. as defined at compile-time)
+CORRECT_DIR_SEPS (initial_directory);
-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);
 #endif
 }
 void
 init_buffer (void)

Mercurial > hg > xemacs-beta

comparison src/buffer.c @ 442:abe6d1db359e r21-2-36