Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 104521. ------------------------------------------------------------ revno: 104521 committer: Paul Eggert branch nick: trunk timestamp: Mon 2011-06-06 21:16:37 -0700 message: [ChangeLog] * configure.in: Add --with-wide-int. * INSTALL: Mention this. [etc/ChangeLog] * NEWS: Mention new configure option --with-wide-int. diff: === modified file 'ChangeLog' --- ChangeLog 2011-06-06 19:53:44 +0000 +++ ChangeLog 2011-06-07 04:16:37 +0000 @@ -1,3 +1,8 @@ +2011-06-07 Paul Eggert + + * configure.in: Add --with-wide-int. + * INSTALL: Mention this. + 2011-06-06 Paul Eggert Merge from gnulib. === modified file 'INSTALL' --- INSTALL 2011-05-18 03:39:45 +0000 +++ INSTALL 2011-06-07 04:16:37 +0000 @@ -309,6 +309,10 @@ Use --without-sound to disable sound support. +Use --with-wide-int to implement Emacs values with the type 'long long', +even on hosts where a narrower type would do. With this option, on a +typical 32-bit host, Emacs integers have 62 bits instead of 30. + The `--prefix=PREFIXDIR' option specifies where the installation process should put emacs and its data files. This defaults to `/usr/local'. - Emacs (and the other utilities users run) go in PREFIXDIR/bin === modified file 'configure.in' --- configure.in 2011-05-28 22:39:39 +0000 +++ configure.in 2011-06-07 04:16:37 +0000 @@ -144,6 +144,11 @@ with_x_toolkit=$val ]) +OPTION_DEFAULT_OFF([wide-int], [prefer wide Emacs integers (typically 62-bit)]) +if test "$with_wide_int" = yes; then + AC_DEFINE([WIDE_EMACS_INT], 1, [Use long long for EMACS_INT if available.]) +fi + dnl _ON results in a '--without' option in the --help output, so dnl the help text should refer to "don't compile", etc. OPTION_DEFAULT_ON([xpm],[don't compile with XPM image support]) === modified file 'etc/ChangeLog' --- etc/ChangeLog 2011-06-06 19:43:39 +0000 +++ etc/ChangeLog 2011-06-07 04:16:37 +0000 @@ -1,3 +1,7 @@ +2011-06-07 Paul Eggert + + * NEWS: Mention new configure option --with-wide-int. + 2011-05-24 Leo Liu * NEWS: Mention the new primitive sha1 and the removal of sha1.el. === modified file 'etc/NEWS' --- etc/NEWS 2011-06-06 19:43:39 +0000 +++ etc/NEWS 2011-06-07 04:16:37 +0000 @@ -47,6 +47,9 @@ This is only useful for Emacs developers to debug certain types of bugs. This is not a new feature; only the configure flag is new. +** There is a new configure option --with-wide-int. +With it, Emacs integers typically have 62 bits, even on 32-bit machines. + --- ** New translation of the Emacs Tutorial in Hebrew is available. Type `C-u C-h t' to choose it in case your language setup doesn't ------------------------------------------------------------ revno: 104520 committer: Daniel Colascione branch nick: trunk timestamp: Mon 2011-06-06 18:39:26 -0700 message: * fns.c (Fputhash): Document return value. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-06 21:03:43 +0000 +++ src/ChangeLog 2011-06-07 01:39:26 +0000 @@ -1,3 +1,7 @@ +2011-06-07 Daniel Colascione + + * fns.c (Fputhash): Document return value. + 2011-06-06 Chong Yidong * image.c (gif_load): Implement gif89a spec "no disposal" method. === modified file 'src/fns.c' --- src/fns.c 2011-05-31 06:05:00 +0000 +++ src/fns.c 2011-06-07 01:39:26 +0000 @@ -4469,7 +4469,7 @@ DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0, doc: /* Associate KEY with VALUE in hash table TABLE. If KEY is already present in table, replace its current value with -VALUE. */) +VALUE. In any case, return VALUE. */) (Lisp_Object key, Lisp_Object value, Lisp_Object table) { struct Lisp_Hash_Table *h = check_hash_table (table); ------------------------------------------------------------ revno: 104519 committer: Chong Yidong branch nick: trunk timestamp: Mon 2011-06-06 17:03:43 -0400 message: * src/image.c (gif_load): Implement gif89a spec "no disposal" method. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-06 19:43:39 +0000 +++ src/ChangeLog 2011-06-06 21:03:43 +0000 @@ -1,3 +1,7 @@ +2011-06-06 Chong Yidong + + * image.c (gif_load): Implement gif89a spec "no disposal" method. + 2011-06-06 Paul Eggert Cons<->int and similar integer overflow fixes (Bug#8794). === modified file 'src/image.c' --- src/image.c 2011-06-06 19:43:39 +0000 +++ src/image.c 2011-06-06 21:03:43 +0000 @@ -7074,22 +7074,19 @@ static int gif_load (struct frame *f, struct image *img) { - Lisp_Object file, specified_file; - Lisp_Object specified_data; - int rc, width, height, x, y, i; - boolean transparent_p = 0; + Lisp_Object file; + int rc, width, height, x, y, i, j; XImagePtr ximg; ColorMapObject *gif_color_map; unsigned long pixel_colors[256]; GifFileType *gif; - Lisp_Object image; - int ino, image_height, image_width; + int image_height, image_width; gif_memory_source memsrc; - unsigned char *raster; - unsigned int transparency_color_index IF_LINT (= 0); - - specified_file = image_spec_value (img->spec, QCfile, NULL); - specified_data = image_spec_value (img->spec, QCdata, NULL); + Lisp_Object specified_bg = image_spec_value (img->spec, QCbackground, NULL); + Lisp_Object specified_file = image_spec_value (img->spec, QCfile, NULL); + Lisp_Object specified_data = image_spec_value (img->spec, QCdata, NULL); + unsigned long bgcolor = 0; + int idx; if (NILP (specified_data)) { @@ -7140,40 +7137,31 @@ /* Read entire contents. */ rc = fn_DGifSlurp (gif); - if (rc == GIF_ERROR) + if (rc == GIF_ERROR || gif->ImageCount <= 0) { image_error ("Error reading `%s'", img->spec, Qnil); fn_DGifCloseFile (gif); return 0; } - image = image_spec_value (img->spec, QCindex, NULL); - ino = INTEGERP (image) ? XFASTINT (image) : 0; - if (ino >= gif->ImageCount) - { - image_error ("Invalid image number `%s' in image `%s'", - image, img->spec); - fn_DGifCloseFile (gif); - return 0; - } - - for (i = 0; i < gif->SavedImages[ino].ExtensionBlockCount; i++) - if ((gif->SavedImages[ino].ExtensionBlocks[i].Function - == GIF_LOCAL_DESCRIPTOR_EXTENSION) - && gif->SavedImages[ino].ExtensionBlocks[i].ByteCount == 4 - /* Transparency enabled? */ - && gif->SavedImages[ino].ExtensionBlocks[i].Bytes[0] & 1) + /* Which sub-image are we to display? */ + { + Lisp_Object index = image_spec_value (img->spec, QCindex, NULL); + idx = INTEGERP (index) ? XFASTINT (index) : 0; + if (idx < 0 || idx >= gif->ImageCount) { - transparent_p = 1; - transparency_color_index - = (unsigned char) gif->SavedImages[ino].ExtensionBlocks[i].Bytes[3]; + image_error ("Invalid image number `%s' in image `%s'", + index, img->spec); + fn_DGifCloseFile (gif); + return 0; } + } - img->corners[TOP_CORNER] = gif->SavedImages[ino].ImageDesc.Top; - img->corners[LEFT_CORNER] = gif->SavedImages[ino].ImageDesc.Left; - image_height = gif->SavedImages[ino].ImageDesc.Height; + img->corners[TOP_CORNER] = gif->SavedImages[idx].ImageDesc.Top; + img->corners[LEFT_CORNER] = gif->SavedImages[idx].ImageDesc.Left; + image_height = gif->SavedImages[idx].ImageDesc.Height; img->corners[BOT_CORNER] = img->corners[TOP_CORNER] + image_height; - image_width = gif->SavedImages[ino].ImageDesc.Width; + image_width = gif->SavedImages[idx].ImageDesc.Width; img->corners[RIGHT_CORNER] = img->corners[LEFT_CORNER] + image_width; width = img->width = max (gif->SWidth, @@ -7197,44 +7185,10 @@ return 0; } - /* Allocate colors. */ - gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap; - if (!gif_color_map) - gif_color_map = gif->SColorMap; - init_color_table (); - memset (pixel_colors, 0, sizeof pixel_colors); - - if (gif_color_map) - for (i = 0; i < gif_color_map->ColorCount; ++i) - { - if (transparent_p && transparency_color_index == i) - { - Lisp_Object specified_bg - = image_spec_value (img->spec, QCbackground, NULL); - pixel_colors[i] = STRINGP (specified_bg) - ? x_alloc_image_color (f, img, specified_bg, - FRAME_BACKGROUND_PIXEL (f)) - : FRAME_BACKGROUND_PIXEL (f); - } - else - { - int r = gif_color_map->Colors[i].Red << 8; - int g = gif_color_map->Colors[i].Green << 8; - int b = gif_color_map->Colors[i].Blue << 8; - pixel_colors[i] = lookup_rgb_color (f, r, g, b); - } - } - -#ifdef COLOR_TABLE_SUPPORT - img->colors = colors_in_color_table (&img->ncolors); - free_color_table (); -#endif /* COLOR_TABLE_SUPPORT */ - - /* Clear the part of the screen image that are not covered by - the image from the GIF file. Full animated GIF support - requires more than can be done here (see the gif89 spec, - disposal methods). Let's simply assume that the part - not covered by a sub-image is in the frame's background color. */ + /* Clear the part of the screen image not covered by the image. + Full animated GIF support requires more here (see the gif89 spec, + disposal methods). Let's simply assume that the part not covered + by a sub-image is in the frame's background color. */ for (y = 0; y < img->corners[TOP_CORNER]; ++y) for (x = 0; x < width; ++x) XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f)); @@ -7251,55 +7205,119 @@ XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f)); } - /* Read the GIF image into the X image. We use a local variable - `raster' here because RasterBits below is a char *, and invites - problems with bytes >= 0x80. */ - raster = (unsigned char *) gif->SavedImages[ino].RasterBits; - - if (gif->SavedImages[ino].ImageDesc.Interlace) + /* Read the GIF image into the X image. */ + + /* FIXME: With the current implementation, loading an animated gif + is quadratic in the number of animation frames, since each frame + is a separate struct image. We must provide a way for a single + gif_load call to construct and save all animation frames. */ + + init_color_table (); + if (STRINGP (specified_bg)) + bgcolor = x_alloc_image_color (f, img, specified_bg, + FRAME_BACKGROUND_PIXEL (f)); + for (j = 0; j <= idx; ++j) { - int pass; - int row = interlace_start[0]; - - pass = 0; - - for (y = 0; y < image_height; y++) + /* We use a local variable `raster' here because RasterBits is a + char *, which invites problems with bytes >= 0x80. */ + struct SavedImage *subimage = gif->SavedImages + j; + unsigned char *raster = (unsigned char *) subimage->RasterBits; + int transparency_color_index = -1; + int disposal = 0; + + /* Find the Graphic Control Extension block for this sub-image. + Extract the disposal method and transparency color. */ + for (i = 0; i < subimage->ExtensionBlockCount; i++) { - if (row >= image_height) - { - row = interlace_start[++pass]; - while (row >= image_height) - row = interlace_start[++pass]; - } - - for (x = 0; x < image_width; x++) - { - int c = raster[(y * image_width) + x]; - XPutPixel (ximg, x + img->corners[LEFT_CORNER], - row + img->corners[TOP_CORNER], pixel_colors[c]); - } - - row += interlace_increment[pass]; + ExtensionBlock *extblock = subimage->ExtensionBlocks + i; + + if ((extblock->Function == GIF_LOCAL_DESCRIPTOR_EXTENSION) + && extblock->ByteCount == 4 + && extblock->Bytes[0] & 1) + { + /* From gif89a spec: 1 = "keep in place", 2 = "restore + to background". Treat any other value like 2. */ + disposal = (extblock->Bytes[0] >> 2) & 7; + transparency_color_index = extblock->Bytes[3]; + break; + } } - } - else - { - for (y = 0; y < image_height; ++y) - for (x = 0; x < image_width; ++x) + + /* We can't "keep in place" the first subimage. */ + if (j == 0) + disposal = 2; + + /* Allocate subimage colors. */ + memset (pixel_colors, 0, sizeof pixel_colors); + gif_color_map = subimage->ImageDesc.ColorMap; + if (!gif_color_map) + gif_color_map = gif->SColorMap; + + if (gif_color_map) + for (i = 0; i < gif_color_map->ColorCount; ++i) { - int c = raster[y * image_width + x]; - XPutPixel (ximg, x + img->corners[LEFT_CORNER], - y + img->corners[TOP_CORNER], pixel_colors[c]); + if (transparency_color_index == i) + pixel_colors[i] = STRINGP (specified_bg) + ? bgcolor : FRAME_BACKGROUND_PIXEL (f); + else + { + int r = gif_color_map->Colors[i].Red << 8; + int g = gif_color_map->Colors[i].Green << 8; + int b = gif_color_map->Colors[i].Blue << 8; + pixel_colors[i] = lookup_rgb_color (f, r, g, b); + } } + + /* Apply the pixel values. */ + if (gif->SavedImages[j].ImageDesc.Interlace) + { + int row, pass; + + for (y = 0, row = interlace_start[0], pass = 0; + y < image_height; + y++, row += interlace_increment[pass]) + { + if (row >= image_height) + { + row = interlace_start[++pass]; + while (row >= image_height) + row = interlace_start[++pass]; + } + + for (x = 0; x < image_width; x++) + { + int c = raster[y * image_width + x]; + if (transparency_color_index != c || disposal != 1) + XPutPixel (ximg, x + img->corners[LEFT_CORNER], + row + img->corners[TOP_CORNER], pixel_colors[c]); + } + } + } + else + { + for (y = 0; y < image_height; ++y) + for (x = 0; x < image_width; ++x) + { + int c = raster[y * image_width + x]; + if (transparency_color_index != c || disposal != 1) + XPutPixel (ximg, x + img->corners[LEFT_CORNER], + y + img->corners[TOP_CORNER], pixel_colors[c]); + } + } } +#ifdef COLOR_TABLE_SUPPORT + img->colors = colors_in_color_table (&img->ncolors); + free_color_table (); +#endif /* COLOR_TABLE_SUPPORT */ + /* Save GIF image extension data for `image-metadata'. Format is (count IMAGES extension-data (FUNCTION "BYTES" ...)). */ img->data.lisp_val = Qnil; - if (gif->SavedImages[ino].ExtensionBlockCount > 0) + if (gif->SavedImages[idx].ExtensionBlockCount > 0) { - ExtensionBlock *ext = gif->SavedImages[ino].ExtensionBlocks; - for (i = 0; i < gif->SavedImages[ino].ExtensionBlockCount; i++, ext++) + ExtensionBlock *ext = gif->SavedImages[idx].ExtensionBlocks; + for (i = 0; i < gif->SavedImages[idx].ExtensionBlockCount; i++, ext++) /* Append (... FUNCTION "BYTES") */ img->data.lisp_val = Fcons (make_unibyte_string (ext->Bytes, ext->ByteCount), Fcons (make_number (ext->Function), ------------------------------------------------------------ revno: 104518 committer: Paul Eggert branch nick: trunk timestamp: Mon 2011-06-06 12:53:44 -0700 message: Merge from gnulib. * lib/careadlinkat.c, lib/careadlinkat.h, m4/gnulib-common.m4: Merge. diff: === modified file 'ChangeLog' --- ChangeLog 2011-06-02 08:40:41 +0000 +++ ChangeLog 2011-06-06 19:53:44 +0000 @@ -1,3 +1,8 @@ +2011-06-06 Paul Eggert + + Merge from gnulib. + * lib/careadlinkat.c, lib/careadlinkat.h, m4/gnulib-common.m4: Merge. + 2011-06-02 Paul Eggert * lib/allocator.h, lib/careadlinkat.c: Merge from gnulib. === modified file 'lib/careadlinkat.c' --- lib/careadlinkat.c 2011-06-02 08:25:28 +0000 +++ lib/careadlinkat.c 2011-06-06 19:53:44 +0000 @@ -39,7 +39,6 @@ #include "allocator.h" -#if ! HAVE_READLINKAT /* Get the symbolic link value of FILENAME and put it into BUFFER, with size BUFFER_SIZE. This function acts like readlink but has readlinkat's signature. */ @@ -53,7 +52,6 @@ abort (); return readlink (filename, buffer, buffer_size); } -#endif /* Assuming the current directory is FD, get the symbolic link value of FILENAME as a null-terminated string and put it into a buffer. === modified file 'lib/careadlinkat.h' --- lib/careadlinkat.h 2011-04-09 18:44:05 +0000 +++ lib/careadlinkat.h 2011-06-06 19:53:44 +0000 @@ -56,8 +56,7 @@ when doing a plain readlink: Pass FD = AT_FDCWD and PREADLINKAT = careadlinkatcwd. */ #if HAVE_READLINKAT -/* AT_FDCWD is declared in , readlinkat in . */ -# define careadlinkatcwd readlinkat +/* AT_FDCWD is declared in . */ #else /* Define AT_FDCWD independently, so that the careadlinkat module does not depend on the fcntl-h module. The value does not matter, since @@ -66,8 +65,8 @@ # ifndef AT_FDCWD # define AT_FDCWD (-3041965) # endif +#endif ssize_t careadlinkatcwd (int fd, char const *filename, char *buffer, size_t buffer_size); -#endif #endif /* _GL_CAREADLINKAT_H */ === modified file 'm4/gnulib-common.m4' --- m4/gnulib-common.m4 2011-04-01 06:07:33 +0000 +++ m4/gnulib-common.m4 2011-06-06 19:53:44 +0000 @@ -1,4 +1,4 @@ -# gnulib-common.m4 serial 24 +# gnulib-common.m4 serial 25 dnl Copyright (C) 2007-2011 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -34,6 +34,20 @@ /* The name _UNUSED_PARAMETER_ is an earlier spelling, although the name is a misnomer outside of parameter lists. */ #define _UNUSED_PARAMETER_ _GL_UNUSED + +/* The __pure__ attribute was added in gcc 2.96. */ +#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96) +# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__)) +#else +# define _GL_ATTRIBUTE_PURE /* empty */ +#endif + +/* The __const__ attribute was added in gcc 2.95. */ +#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 95) +# define _GL_ATTRIBUTE_CONST __attribute__ ((__const__)) +#else +# define _GL_ATTRIBUTE_CONST /* empty */ +#endif ]) dnl Preparation for running test programs: dnl Tell glibc to write diagnostics from -D_FORTIFY_SOURCE=2 to stderr, not ------------------------------------------------------------ revno: 104517 [merge] committer: Paul Eggert branch nick: trunk timestamp: Mon 2011-06-06 12:44:36 -0700 message: Merge: Document wide integers better. diff: === modified file 'doc/emacs/ChangeLog' --- doc/emacs/ChangeLog 2011-05-28 18:22:08 +0000 +++ doc/emacs/ChangeLog 2011-06-06 19:43:39 +0000 @@ -1,3 +1,10 @@ +2011-06-02 Paul Eggert + + Document wide integers better. + * buffers.texi (Buffers): + * files.texi (Visiting): Document maxima for 64-bit machines, + and mention virtual memory limits. + 2011-05-28 Chong Yidong * custom.texi (Hooks): Reorganize. Mention Prog mode. === modified file 'doc/emacs/buffers.texi' --- doc/emacs/buffers.texi 2011-01-25 04:08:28 +0000 +++ doc/emacs/buffers.texi 2011-06-06 19:43:39 +0000 @@ -43,8 +43,11 @@ A buffer's size cannot be larger than some maximum, which is defined by the largest buffer position representable by the @dfn{Emacs integer} data type. This is because Emacs tracks buffer positions -using that data type. For 32-bit machines, the largest buffer size is -512 megabytes. +using that data type. For typical 64-bit machines, the maximum buffer size +enforced by the data types is @math{2^61 - 2} bytes, or about 2 EiB. +For typical 32-bit machines, the maximum is @math{2^29 - 2} bytes, or +about 512 MiB. Buffer sizes are also limited by the size of Emacs's +virtual memory. @menu * Select Buffer:: Creating a new buffer or reselecting an old one. === modified file 'doc/emacs/files.texi' --- doc/emacs/files.texi 2011-01-31 23:54:50 +0000 +++ doc/emacs/files.texi 2011-06-03 18:47:14 +0000 @@ -209,7 +209,8 @@ about 10 megabytes), Emacs asks you for confirmation first. You can answer @kbd{y} to proceed with visiting the file. Note, however, that Emacs cannot visit files that are larger than the maximum Emacs buffer -size, which is around 512 megabytes on 32-bit machines +size, which is limited by the amount of memory Emacs can allocate +and by the integers that Emacs can represent (@pxref{Buffers}). If you try, Emacs will display an error message saying that the maximum buffer size has been exceeded. === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2011-05-31 18:40:00 +0000 +++ doc/lispref/ChangeLog 2011-06-06 19:43:39 +0000 @@ -1,3 +1,15 @@ +2011-06-03 Paul Eggert + + Document wide integers better. + * files.texi (File Attributes): Document ino_t values better. + ino_t values no longer map to anything larger than a single cons. + * numbers.texi (Integer Basics, Integer Basics, Arithmetic Operations): + (Bitwise Operations): + * objects.texi (Integer Type): Use a binary notation that is a bit easier + to read, and that will port better if 62-bits becomes the default. + Fix or remove incorrect examples. + * os.texi (Time Conversion): Document time_t values better. + 2011-05-31 Lars Magne Ingebrigtsen * processes.texi (Process Information): Document === modified file 'doc/lispref/files.texi' --- doc/lispref/files.texi 2011-05-12 07:07:06 +0000 +++ doc/lispref/files.texi 2011-06-06 19:43:39 +0000 @@ -1237,11 +1237,12 @@ @item The file's inode number. If possible, this is an integer. If the inode number is too large to be represented as an integer in Emacs -Lisp, but still fits into a 32-bit integer, then the value has the +Lisp but dividing it by @math{2^16} yields a representable integer, +then the value has the form @code{(@var{high} . @var{low})}, where @var{low} holds the low 16 -bits. If the inode is wider than 32 bits, the value is of the form +bits. If the inode number is too wide for even that, the value is of the form @code{(@var{high} @var{middle} . @var{low})}, where @code{high} holds -the high 24 bits, @var{middle} the next 24 bits, and @var{low} the low +the high bits, @var{middle} the middle 24 bits, and @var{low} the low 16 bits. @item === modified file 'doc/lispref/numbers.texi' --- doc/lispref/numbers.texi 2011-05-05 06:31:14 +0000 +++ doc/lispref/numbers.texi 2011-06-06 19:43:39 +0000 @@ -50,8 +50,9 @@ @tex @math{2^{29}-1}), @end tex -but some machines may provide a wider range. Many examples in this -chapter assume an integer has 30 bits. +but some machines provide a wider range. Many examples in this +chapter assume that an integer has 30 bits and that floating point +numbers are IEEE double precision. @cindex overflow The Lisp reader reads an integer as a sequence of digits with optional @@ -97,17 +98,18 @@ In 30-bit binary, the decimal integer 5 looks like this: @example -00 0000 0000 0000 0000 0000 0000 0101 +0000...000101 (30 bits total) @end example @noindent -(We have inserted spaces between groups of 4 bits, and two spaces -between groups of 8 bits, to make the binary integer easier to read.) +(The @samp{...} stands for enough bits to fill out a 30-bit word; in +this case, @samp{...} stands for twenty 0 bits. Later examples also +use the @samp{...} notation to make binary integers easier to read.) The integer @minus{}1 looks like this: @example -11 1111 1111 1111 1111 1111 1111 1111 +1111...111111 (30 bits total) @end example @noindent @@ -120,14 +122,14 @@ @minus{}5 looks like this: @example -11 1111 1111 1111 1111 1111 1111 1011 +1111...111011 (30 bits total) @end example In this implementation, the largest 30-bit binary integer value is 536,870,911 in decimal. In binary, it looks like this: @example -01 1111 1111 1111 1111 1111 1111 1111 +0111...111111 (30 bits total) @end example Since the arithmetic functions do not check whether integers go @@ -137,7 +139,7 @@ @example (+ 1 536870911) @result{} -536870912 - @result{} 10 0000 0000 0000 0000 0000 0000 0000 + @result{} 1000...000000 (30 bits total) @end example Many of the functions described in this chapter accept markers for @@ -508,8 +510,8 @@ if any argument is floating. It is important to note that in Emacs Lisp, arithmetic functions -do not check for overflow. Thus @code{(1+ 268435455)} may evaluate to -@minus{}268435456, depending on your hardware. +do not check for overflow. Thus @code{(1+ 536870911)} may evaluate to +@minus{}536870912, depending on your hardware. @defun 1+ number-or-marker This function returns @var{number-or-marker} plus 1. @@ -829,19 +831,19 @@ The function @code{lsh}, like all Emacs Lisp arithmetic functions, does not check for overflow, so shifting left can discard significant bits and change the sign of the number. For example, left shifting -536,870,911 produces @minus{}2 on a 30-bit machine: +536,870,911 produces @minus{}2 in the 30-bit implementation: @example (lsh 536870911 1) ; @r{left shift} @result{} -2 @end example -In binary, in the 30-bit implementation, the argument looks like this: +In binary, the argument looks like this: @example @group ;; @r{Decimal 536,870,911} -01 1111 1111 1111 1111 1111 1111 1111 +0111...111111 (30 bits total) @end group @end example @@ -851,7 +853,7 @@ @example @group ;; @r{Decimal @minus{}2} -11 1111 1111 1111 1111 1111 1111 1110 +1111...111110 (30 bits total) @end group @end example @end defun @@ -874,9 +876,9 @@ @group (ash -6 -1) @result{} -3 ;; @r{Decimal @minus{}6 becomes decimal @minus{}3.} -11 1111 1111 1111 1111 1111 1111 1010 +1111...111010 (30 bits total) @result{} -11 1111 1111 1111 1111 1111 1111 1101 +1111...111101 (30 bits total) @end group @end example @@ -887,9 +889,9 @@ @group (lsh -6 -1) @result{} 536870909 ;; @r{Decimal @minus{}6 becomes decimal 536,870,909.} -11 1111 1111 1111 1111 1111 1111 1010 +1111...111010 (30 bits total) @result{} -01 1111 1111 1111 1111 1111 1111 1101 +0111...111101 (30 bits total) @end group @end example @@ -899,34 +901,35 @@ @c with smallbook but not with regular book! --rjc 16mar92 @smallexample @group - ; @r{ 30-bit binary values} + ; @r{ 30-bit binary values} -(lsh 5 2) ; 5 = @r{00 0000 0000 0000 0000 0000 0000 0101} - @result{} 20 ; = @r{00 0000 0000 0000 0000 0000 0001 0100} +(lsh 5 2) ; 5 = @r{0000...000101} + @result{} 20 ; = @r{0000...010100} @end group @group (ash 5 2) @result{} 20 -(lsh -5 2) ; -5 = @r{11 1111 1111 1111 1111 1111 1111 1011} - @result{} -20 ; = @r{11 1111 1111 1111 1111 1111 1110 1100} +(lsh -5 2) ; -5 = @r{1111...111011} + @result{} -20 ; = @r{1111...101100} (ash -5 2) @result{} -20 @end group @group -(lsh 5 -2) ; 5 = @r{00 0000 0000 0000 0000 0000 0000 0101} - @result{} 1 ; = @r{00 0000 0000 0000 0000 0000 0000 0001} +(lsh 5 -2) ; 5 = @r{0000...000101} + @result{} 1 ; = @r{0000...000001} @end group @group (ash 5 -2) @result{} 1 @end group @group -(lsh -5 -2) ; -5 = @r{11 1111 1111 1111 1111 1111 1111 1011} - @result{} 268435454 ; = @r{00 0111 1111 1111 1111 1111 1111 1110} +(lsh -5 -2) ; -5 = @r{1111...111011} + @result{} 268435454 + ; = @r{0011...111110} @end group @group -(ash -5 -2) ; -5 = @r{11 1111 1111 1111 1111 1111 1111 1011} - @result{} -2 ; = @r{11 1111 1111 1111 1111 1111 1111 1110} +(ash -5 -2) ; -5 = @r{1111...111011} + @result{} -2 ; = @r{1111...111110} @end group @end smallexample @end defun @@ -961,23 +964,23 @@ @smallexample @group - ; @r{ 30-bit binary values} + ; @r{ 30-bit binary values} -(logand 14 13) ; 14 = @r{00 0000 0000 0000 0000 0000 0000 1110} - ; 13 = @r{00 0000 0000 0000 0000 0000 0000 1101} - @result{} 12 ; 12 = @r{00 0000 0000 0000 0000 0000 0000 1100} +(logand 14 13) ; 14 = @r{0000...001110} + ; 13 = @r{0000...001101} + @result{} 12 ; 12 = @r{0000...001100} @end group @group -(logand 14 13 4) ; 14 = @r{00 0000 0000 0000 0000 0000 0000 1110} - ; 13 = @r{00 0000 0000 0000 0000 0000 0000 1101} - ; 4 = @r{00 0000 0000 0000 0000 0000 0000 0100} - @result{} 4 ; 4 = @r{00 0000 0000 0000 0000 0000 0000 0100} +(logand 14 13 4) ; 14 = @r{0000...001110} + ; 13 = @r{0000...001101} + ; 4 = @r{0000...000100} + @result{} 4 ; 4 = @r{0000...000100} @end group @group (logand) - @result{} -1 ; -1 = @r{11 1111 1111 1111 1111 1111 1111 1111} + @result{} -1 ; -1 = @r{1111...111111} @end group @end smallexample @end defun @@ -991,18 +994,18 @@ @smallexample @group - ; @r{ 30-bit binary values} + ; @r{ 30-bit binary values} -(logior 12 5) ; 12 = @r{00 0000 0000 0000 0000 0000 0000 1100} - ; 5 = @r{00 0000 0000 0000 0000 0000 0000 0101} - @result{} 13 ; 13 = @r{00 0000 0000 0000 0000 0000 0000 1101} +(logior 12 5) ; 12 = @r{0000...001100} + ; 5 = @r{0000...000101} + @result{} 13 ; 13 = @r{0000...001101} @end group @group -(logior 12 5 7) ; 12 = @r{00 0000 0000 0000 0000 0000 0000 1100} - ; 5 = @r{00 0000 0000 0000 0000 0000 0000 0101} - ; 7 = @r{00 0000 0000 0000 0000 0000 0000 0111} - @result{} 15 ; 15 = @r{00 0000 0000 0000 0000 0000 0000 1111} +(logior 12 5 7) ; 12 = @r{0000...001100} + ; 5 = @r{0000...000101} + ; 7 = @r{0000...000111} + @result{} 15 ; 15 = @r{0000...001111} @end group @end smallexample @end defun @@ -1016,18 +1019,18 @@ @smallexample @group - ; @r{ 30-bit binary values} + ; @r{ 30-bit binary values} -(logxor 12 5) ; 12 = @r{00 0000 0000 0000 0000 0000 0000 1100} - ; 5 = @r{00 0000 0000 0000 0000 0000 0000 0101} - @result{} 9 ; 9 = @r{00 0000 0000 0000 0000 0000 0000 1001} +(logxor 12 5) ; 12 = @r{0000...001100} + ; 5 = @r{0000...000101} + @result{} 9 ; 9 = @r{0000...001001} @end group @group -(logxor 12 5 7) ; 12 = @r{00 0000 0000 0000 0000 0000 0000 1100} - ; 5 = @r{00 0000 0000 0000 0000 0000 0000 0101} - ; 7 = @r{00 0000 0000 0000 0000 0000 0000 0111} - @result{} 14 ; 14 = @r{00 0000 0000 0000 0000 0000 0000 1110} +(logxor 12 5 7) ; 12 = @r{0000...001100} + ; 5 = @r{0000...000101} + ; 7 = @r{0000...000111} + @result{} 14 ; 14 = @r{0000...001110} @end group @end smallexample @end defun @@ -1040,9 +1043,9 @@ @example (lognot 5) @result{} -6 -;; 5 = @r{00 0000 0000 0000 0000 0000 0000 0101} +;; 5 = @r{0000...000101} (30 bits total) ;; @r{becomes} -;; -6 = @r{11 1111 1111 1111 1111 1111 1111 1010} +;; -6 = @r{1111...111010} (30 bits total) @end example @end defun === modified file 'doc/lispref/objects.texi' --- doc/lispref/objects.texi 2011-05-05 06:31:14 +0000 +++ doc/lispref/objects.texi 2011-06-06 19:43:39 +0000 @@ -179,10 +179,9 @@ @tex @math{2^{29}-1}) @end tex -on most machines. (Some machines may provide a wider range.) It is -important to note that the Emacs Lisp arithmetic functions do not check -for overflow. Thus @code{(1+ 536870911)} is @minus{}536870912 on most -machines. +on typical 32-bit machines. (Some machines provide a wider range.) +Emacs Lisp arithmetic functions do not check for overflow. Thus +@code{(1+ 536870911)} is @minus{}536870912 if Emacs integers are 30 bits. The read syntax for integers is a sequence of (base ten) digits with an optional sign at the beginning and an optional period at the end. The @@ -195,7 +194,6 @@ 1 ; @r{The integer 1.} 1. ; @r{Also the integer 1.} +1 ; @r{Also the integer 1.} -1073741825 ; @r{Also the integer 1 on a 30-bit implementation.} @end group @end example @@ -203,8 +201,8 @@ As a special exception, if a sequence of digits specifies an integer too large or too small to be a valid integer object, the Lisp reader reads it as a floating-point number (@pxref{Floating Point Type}). -For instance, on most machines @code{536870912} is read as the -floating-point number @code{536870912.0}. +For instance, if Emacs integers are 30 bits, @code{536870912} is read +as the floating-point number @code{536870912.0}. @xref{Numbers}, for more information. === modified file 'doc/lispref/os.texi' --- doc/lispref/os.texi 2011-02-01 07:23:48 +0000 +++ doc/lispref/os.texi 2011-06-03 18:49:33 +0000 @@ -1193,11 +1193,11 @@ from the functions @code{current-time} (@pxref{Time of Day}) and @code{file-attributes} (@pxref{Definition of file-attributes}). - Many operating systems are limited to time values that contain 32 bits + Many 32-bit operating systems are limited to time values that contain 32 bits of information; these systems typically handle only the times from -1901-12-13 20:45:52 UTC through 2038-01-19 03:14:07 UTC. However, some -operating systems have larger time values, and can represent times far -in the past or future. +1901-12-13 20:45:52 UTC through 2038-01-19 03:14:07 UTC. However, 64-bit +and some 32-bit operating systems have larger time values, and can +represent times far in the past or future. Time conversion functions always use the Gregorian calendar, even for dates before the Gregorian calendar was introduced. Year numbers ------------------------------------------------------------ revno: 104516 committer: Paul Eggert branch nick: trunk timestamp: Mon 2011-06-06 11:37:51 -0700 message: Add Bug#8794 to ChangeLog entry. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-06 18:36:36 +0000 +++ src/ChangeLog 2011-06-06 18:37:51 +0000 @@ -1,6 +1,6 @@ 2011-06-06 Paul Eggert - Cons<->int and similar integer overflow fixes. + Cons<->int and similar integer overflow fixes (Bug#8794). Check for overflow when converting integer to cons and back. * charset.c (Fdefine_charset_internal, Fdecode_char): ------------------------------------------------------------ revno: 104515 [merge] committer: Paul Eggert branch nick: trunk timestamp: Mon 2011-06-06 11:36:36 -0700 message: Merge: Cons<->int and similar integer overflow fixes. diff: === modified file 'lwlib/ChangeLog' --- lwlib/ChangeLog 2011-04-16 23:11:35 +0000 +++ lwlib/ChangeLog 2011-06-06 18:36:36 +0000 @@ -1,3 +1,8 @@ +2011-06-06 Paul Eggert + + * Makefile.in (ALL_CFLAGS): Add -I$(srcdir)/../lib. + This is needed because lisp.h includes intprops.h now (Bug#8794). + 2011-04-16 Paul Eggert Static checks with GCC 4.6.0 and non-default toolkits. === modified file 'lwlib/Makefile.in' --- lwlib/Makefile.in 2011-02-11 03:41:17 +0000 +++ lwlib/Makefile.in 2011-06-06 18:26:04 +0000 @@ -1,18 +1,18 @@ # Copyright (C) 1992, 1993 Lucid, Inc. # Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc. -# +# # This file is part of the Lucid Widget Library. -# +# # The Lucid Widget Library is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 1, or (at your option) # any later version. -# +# # The Lucid Widget Library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. -# +# # You should have received a copy of the GNU General Public License # along with GNU Emacs; see the file COPYING. If not, write to # the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, @@ -55,7 +55,8 @@ ALL_CFLAGS= $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \ $(C_SWITCH_X_SYSTEM) $(C_SWITCH_MACHINE) \ $(C_WARNINGS_SWITCH) $(PROFILING_CFLAGS) $(CFLAGS) \ - -DHAVE_CONFIG_H -Demacs -I../src -I$(srcdir) -I$(srcdir)/../src + -DHAVE_CONFIG_H -Demacs -I../src \ + -I$(srcdir) -I$(srcdir)/../src -I$(srcdir)/../lib .c.o: $(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $< === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-06 16:54:34 +0000 +++ src/ChangeLog 2011-06-06 18:36:36 +0000 @@ -1,3 +1,82 @@ +2011-06-06 Paul Eggert + + Cons<->int and similar integer overflow fixes. + + Check for overflow when converting integer to cons and back. + * charset.c (Fdefine_charset_internal, Fdecode_char): + Use cons_to_unsigned to catch overflow. + (Fencode_char): Use INTEGER_TO_CONS. + * composite.h (LGLYPH_CODE): Use cons_to_unsigned. + (LGLYPH_SET_CODE): Use INTEGER_TO_CONS. + * data.c (long_to_cons, cons_to_long): Remove. + (cons_to_unsigned, cons_to_signed): New functions. + These signal an error for invalid or out-of-range values. + * dired.c (Ffile_attributes): Use INTEGER_TO_CONS. + * fileio.c (Fset_visited_file_modtime): Use CONS_TO_INTEGER. + * font.c (Ffont_variation_glyphs): + * fontset.c (Finternal_char_font): Use INTEGER_TO_CONS. + * lisp.h: Include . + (INTEGER_TO_CONS, CONS_TO_INTEGER): New macros. + (cons_to_signed, cons_to_unsigned): New decls. + (long_to_cons, cons_to_long): Remove decls. + * undo.c (record_first_change): Use INTEGER_TO_CONS. + (Fprimitive_undo): Use CONS_TO_INTEGER. + * xfns.c (Fx_window_property): Likewise. + * xselect.c: Include . + (x_own_selection, selection_data_to_lisp_data): + Use INTEGER_TO_CONS. + (x_handle_selection_request, x_handle_selection_clear) + (x_get_foreign_selection, Fx_disown_selection_internal) + (Fx_get_atom_name, x_send_client_event): Use CONS_TO_INTEGER. + (lisp_data_to_selection_data): Use cons_to_unsigned. + (x_fill_property_data): Use cons_to_signed. + Report values out of range. + + Check for buffer and string overflow more precisely. + * buffer.h (BUF_BYTES_MAX): New macro. + * lisp.h (STRING_BYTES_MAX): New macro. + * alloc.c (Fmake_string): + * character.c (string_escape_byte8): + * coding.c (coding_alloc_by_realloc): + * doprnt.c (doprnt): + * editfns.c (Fformat): + * eval.c (verror): + Use STRING_BYTES_MAX, not MOST_POSITIVE_FIXNUM, + since they may not be the same number. + * editfns.c (Finsert_char): + * fileio.c (Finsert_file_contents): + Likewise for BUF_BYTES_MAX. + + * image.c: Use ptrdiff_t, not int, for sizes. + (slurp_file): Switch from int to ptrdiff_t. + All uses changed. + (slurp_file): Check that file size fits in both size_t (for + malloc) and ptrdiff_t (for sanity and safety). + + * fileio.c (Fverify_visited_file_modtime): Avoid time overflow + if b->modtime has its maximal value. + + * dired.c (Ffile_attributes): Don't assume EMACS_INT has >32 bits. + + Don't assume time_t can fit into int. + * buffer.h (struct buffer.modtime): Now time_t, not int. + * fileio.c (Fvisited_file_modtime): No need for time_t cast now. + * undo.c (Fprimitive_undo): Use time_t, not int, for time_t value. + + Minor fixes for signed vs unsigned integers. + * character.h (MAYBE_UNIFY_CHAR): + * charset.c (maybe_unify_char): + * keyboard.c (read_char, reorder_modifiers): + XINT -> XFASTINT, since the integer must be nonnegative. + * ftfont.c (ftfont_spec_pattern): + * keymap.c (access_keymap, silly_event_symbol_error): + XUINT -> XFASTINT, since the integer must be nonnegative. + (Fsingle_key_description, preferred_sequence_p): XUINT -> XINT, + since it makes no difference and we prefer signed. + * keyboard.c (record_char): Use XUINT when all the neighbors do. + (access_keymap): NATNUMP -> INTEGERP, since the integer must be + nonnegative. + 2011-06-06 Stefan Monnier * window.h (Fwindow_frame): Declare. === modified file 'src/alloc.c' --- src/alloc.c 2011-06-06 16:41:21 +0000 +++ src/alloc.c 2011-06-06 17:58:07 +0000 @@ -2204,7 +2204,7 @@ int len = CHAR_STRING (c, str); EMACS_INT string_len = XINT (length); - if (string_len > MOST_POSITIVE_FIXNUM / len) + if (string_len > STRING_BYTES_MAX / len) string_overflow (); nbytes = len * string_len; val = make_uninit_multibyte_string (string_len, nbytes); === modified file 'src/buffer.h' --- src/buffer.h 2011-05-12 07:07:06 +0000 +++ src/buffer.h 2011-06-06 06:16:12 +0000 @@ -306,6 +306,11 @@ } \ while (0) +/* Maximum number of bytes in a buffer. + A buffer cannot contain more bytes than a 1-origin fixnum can represent, + nor can it be so large that C pointer arithmetic stops working. */ +#define BUF_BYTES_MAX min (MOST_POSITIVE_FIXNUM - 1, min (SIZE_MAX, PTRDIFF_MAX)) + /* Return the address of byte position N in current buffer. */ #define BYTE_POS_ADDR(n) \ @@ -545,7 +550,7 @@ -1 means visited file was nonexistent. 0 means visited file modtime unknown; in no case complain about any mismatch on next save attempt. */ - int modtime; + time_t modtime; /* Size of the file when modtime was set. This is used to detect the case where the file grew while we were reading it, so the modtime is still the same (since it's rounded up to seconds) but we're actually === modified file 'src/character.c' --- src/character.c 2011-05-21 04:33:23 +0000 +++ src/character.c 2011-06-06 06:16:12 +0000 @@ -838,7 +838,7 @@ if (multibyte) { if ((MOST_POSITIVE_FIXNUM - nchars) / 3 < byte8_count - || (MOST_POSITIVE_FIXNUM - nbytes) / 2 < byte8_count) + || (STRING_BYTES_MAX - nbytes) / 2 < byte8_count) string_overflow (); /* Convert 2-byte sequence of byte8 chars to 4-byte octal. */ @@ -847,7 +847,7 @@ } else { - if ((MOST_POSITIVE_FIXNUM - nchars) / 3 < byte8_count) + if ((STRING_BYTES_MAX - nchars) / 3 < byte8_count) string_overflow (); /* Convert 1-byte sequence of byte8 chars to 4-byte octal. */ === modified file 'src/character.h' --- src/character.h 2011-05-21 04:33:23 +0000 +++ src/character.h 2011-06-01 02:49:12 +0000 @@ -544,7 +544,7 @@ Lisp_Object val; \ val = CHAR_TABLE_REF (Vchar_unify_table, c); \ if (INTEGERP (val)) \ - c = XINT (val); \ + c = XFASTINT (val); \ else if (! NILP (val)) \ c = maybe_unify_char (c, val); \ } \ === modified file 'src/charset.c' --- src/charset.c 2011-05-31 06:05:00 +0000 +++ src/charset.c 2011-06-06 08:29:01 +0000 @@ -932,17 +932,8 @@ val = args[charset_arg_min_code]; if (! NILP (val)) { - unsigned code; + unsigned code = cons_to_unsigned (val, UINT_MAX); - if (INTEGERP (val)) - code = XINT (val); - else - { - CHECK_CONS (val); - CHECK_NUMBER_CAR (val); - CHECK_NUMBER_CDR (val); - code = (XINT (XCAR (val)) << 16) | (XINT (XCDR (val))); - } if (code < charset.min_code || code > charset.max_code) args_out_of_range_3 (make_number (charset.min_code), @@ -954,17 +945,8 @@ val = args[charset_arg_max_code]; if (! NILP (val)) { - unsigned code; + unsigned code = cons_to_unsigned (val, UINT_MAX); - if (INTEGERP (val)) - code = XINT (val); - else - { - CHECK_CONS (val); - CHECK_NUMBER_CAR (val); - CHECK_NUMBER_CDR (val); - code = (XINT (XCAR (val)) << 16) | (XINT (XCDR (val))); - } if (code < charset.min_code || code > charset.max_code) args_out_of_range_3 (make_number (charset.min_code), @@ -1637,7 +1619,7 @@ struct charset *charset; if (INTEGERP (val)) - return XINT (val); + return XFASTINT (val); if (NILP (val)) return c; @@ -1647,7 +1629,7 @@ { val = CHAR_TABLE_REF (Vchar_unify_table, c); if (! NILP (val)) - c = XINT (val); + c = XFASTINT (val); } else { @@ -1865,17 +1847,7 @@ struct charset *charsetp; CHECK_CHARSET_GET_ID (charset, id); - if (CONSP (code_point)) - { - CHECK_NATNUM_CAR (code_point); - CHECK_NATNUM_CDR (code_point); - code = (XINT (XCAR (code_point)) << 16) | (XINT (XCDR (code_point))); - } - else - { - CHECK_NATNUM (code_point); - code = XINT (code_point); - } + code = cons_to_unsigned (code_point, UINT_MAX); charsetp = CHARSET_FROM_ID (id); c = DECODE_CHAR (charsetp, code); return (c >= 0 ? make_number (c) : Qnil); @@ -1900,9 +1872,7 @@ code = ENCODE_CHAR (charsetp, XINT (ch)); if (code == CHARSET_INVALID_CODE (charsetp)) return Qnil; - if (code > 0x7FFFFFF) - return Fcons (make_number (code >> 16), make_number (code & 0xFFFF)); - return make_number (code); + return INTEGER_TO_CONS (code); } === modified file 'src/coding.c' --- src/coding.c 2011-05-30 01:12:12 +0000 +++ src/coding.c 2011-06-06 06:16:12 +0000 @@ -1071,8 +1071,8 @@ static void coding_alloc_by_realloc (struct coding_system *coding, EMACS_INT bytes) { - if (coding->dst_bytes >= MOST_POSITIVE_FIXNUM - bytes) - error ("Maximum size of buffer or string exceeded"); + if (STRING_BYTES_MAX - coding->dst_bytes < bytes) + string_overflow (); coding->destination = (unsigned char *) xrealloc (coding->destination, coding->dst_bytes + bytes); coding->dst_bytes += bytes; === modified file 'src/composite.h' --- src/composite.h 2011-05-31 06:05:00 +0000 +++ src/composite.h 2011-06-06 08:29:01 +0000 @@ -265,10 +265,7 @@ #define LGLYPH_CODE(g) \ (NILP (AREF ((g), LGLYPH_IX_CODE)) \ ? FONT_INVALID_CODE \ - : CONSP (AREF ((g), LGLYPH_IX_CODE)) \ - ? ((XFASTINT (XCAR (AREF ((g), LGLYPH_IX_CODE))) << 16) \ - | (XFASTINT (XCDR (AREF ((g), LGLYPH_IX_CODE))))) \ - : XFASTINT (AREF ((g), LGLYPH_IX_CODE))) + : cons_to_unsigned (AREF (g, LGLYPH_IX_CODE), TYPE_MAXIMUM (unsigned))) #define LGLYPH_WIDTH(g) XINT (AREF ((g), LGLYPH_IX_WIDTH)) #define LGLYPH_LBEARING(g) XINT (AREF ((g), LGLYPH_IX_LBEARING)) #define LGLYPH_RBEARING(g) XINT (AREF ((g), LGLYPH_IX_RBEARING)) @@ -280,15 +277,8 @@ #define LGLYPH_SET_CHAR(g, val) ASET ((g), LGLYPH_IX_CHAR, make_number (val)) /* Callers must assure that VAL is not negative! */ #define LGLYPH_SET_CODE(g, val) \ - do { \ - if (val == FONT_INVALID_CODE) \ - ASET ((g), LGLYPH_IX_CODE, Qnil); \ - else if ((EMACS_INT)val > MOST_POSITIVE_FIXNUM) \ - ASET ((g), LGLYPH_IX_CODE, Fcons (make_number ((val) >> 16), \ - make_number ((val) & 0xFFFF))); \ - else \ - ASET ((g), LGLYPH_IX_CODE, make_number (val)); \ - } while (0) + ASET (g, LGLYPH_IX_CODE, \ + val == FONT_INVALID_CODE ? Qnil : INTEGER_TO_CONS (val)) #define LGLYPH_SET_WIDTH(g, val) ASET ((g), LGLYPH_IX_WIDTH, make_number (val)) #define LGLYPH_SET_LBEARING(g, val) ASET ((g), LGLYPH_IX_LBEARING, make_number (val)) === modified file 'src/data.c' --- src/data.c 2011-05-31 14:57:53 +0000 +++ src/data.c 2011-06-06 08:29:01 +0000 @@ -2326,33 +2326,110 @@ return Qnil; } -/* Convert between long values and pairs of Lisp integers. - Note that long_to_cons returns a single Lisp integer - when the value fits in one. */ +/* Convert the cons-of-integers, integer, or float value C to an + unsigned value with maximum value MAX. Signal an error if C does not + have a valid format or is out of range. */ +uintmax_t +cons_to_unsigned (Lisp_Object c, uintmax_t max) +{ + int valid = 0; + uintmax_t val IF_LINT (= 0); + if (INTEGERP (c)) + { + valid = 0 <= XINT (c); + val = XINT (c); + } + else if (FLOATP (c)) + { + double d = XFLOAT_DATA (c); + if (0 <= d + && d < (max == UINTMAX_MAX ? (double) UINTMAX_MAX + 1 : max + 1)) + { + val = d; + valid = 1; + } + } + else if (CONSP (c) && NATNUMP (XCAR (c))) + { + uintmax_t top = XFASTINT (XCAR (c)); + Lisp_Object rest = XCDR (c); + if (top <= UINTMAX_MAX >> 24 >> 16 + && CONSP (rest) + && NATNUMP (XCAR (rest)) && XFASTINT (XCAR (rest)) < 1 << 24 + && NATNUMP (XCDR (rest)) && XFASTINT (XCDR (rest)) < 1 << 16) + { + uintmax_t mid = XFASTINT (XCAR (rest)); + val = top << 24 << 16 | mid << 16 | XFASTINT (XCDR (rest)); + valid = 1; + } + else if (top <= UINTMAX_MAX >> 16) + { + if (CONSP (rest)) + rest = XCAR (rest); + if (NATNUMP (rest) && XFASTINT (rest) < 1 << 16) + { + val = top << 16 | XFASTINT (rest); + valid = 1; + } + } + } -Lisp_Object -long_to_cons (long unsigned int i) -{ - unsigned long top = i >> 16; - unsigned int bot = i & 0xFFFF; - if (top == 0) - return make_number (bot); - if (top == (unsigned long)-1 >> 16) - return Fcons (make_number (-1), make_number (bot)); - return Fcons (make_number (top), make_number (bot)); + if (! (valid && val <= max)) + error ("Not an in-range integer, float, or cons of integers"); + return val; } -unsigned long -cons_to_long (Lisp_Object c) +/* Convert the cons-of-integers, integer, or float value C to a signed + value with extrema MIN and MAX. Signal an error if C does not have + a valid format or is out of range. */ +intmax_t +cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) { - Lisp_Object top, bot; + int valid = 0; + intmax_t val IF_LINT (= 0); if (INTEGERP (c)) - return XINT (c); - top = XCAR (c); - bot = XCDR (c); - if (CONSP (bot)) - bot = XCAR (bot); - return ((XINT (top) << 16) | XINT (bot)); + { + val = XINT (c); + valid = 1; + } + else if (FLOATP (c)) + { + double d = XFLOAT_DATA (c); + if (min <= d + && d < (max == INTMAX_MAX ? (double) INTMAX_MAX + 1 : max + 1)) + { + val = d; + valid = 1; + } + } + else if (CONSP (c) && INTEGERP (XCAR (c))) + { + intmax_t top = XINT (XCAR (c)); + Lisp_Object rest = XCDR (c); + if (INTMAX_MIN >> 24 >> 16 <= top && top <= INTMAX_MAX >> 24 >> 16 + && CONSP (rest) + && NATNUMP (XCAR (rest)) && XFASTINT (XCAR (rest)) < 1 << 24 + && NATNUMP (XCDR (rest)) && XFASTINT (XCDR (rest)) < 1 << 16) + { + intmax_t mid = XFASTINT (XCAR (rest)); + val = top << 24 << 16 | mid << 16 | XFASTINT (XCDR (rest)); + valid = 1; + } + else if (INTMAX_MIN >> 16 <= top && top <= INTMAX_MAX >> 16) + { + if (CONSP (rest)) + rest = XCAR (rest); + if (NATNUMP (rest) && XFASTINT (rest) < 1 << 16) + { + val = top << 16 | XFASTINT (rest); + valid = 1; + } + } + } + + if (! (valid && min <= val && val <= max)) + error ("Not an in-range integer, float, or cons of integers"); + return val; } DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0, === modified file 'src/dired.c' --- src/dired.c 2011-04-14 19:34:42 +0000 +++ src/dired.c 2011-06-06 08:29:01 +0000 @@ -900,11 +900,10 @@ This is a floating point number if the size is too large for an integer. 8. File modes, as a string of ten letters or dashes as in ls -l. 9. t if file's gid would change if file were deleted and recreated. -10. inode number. If inode number is larger than what Emacs integer - can hold, but still fits into a 32-bit number, this is a cons cell - containing two integers: first the high part, then the low 16 bits. - If the inode number is wider than 32 bits, this is of the form - (HIGH MIDDLE . LOW): first the high 24 bits, then middle 24 bits, +10. inode number. If it is larger than what an Emacs integer can hold, + this is of the form (HIGH . LOW): first the high bits, then the low 16 bits. + If even HIGH is too large for an Emacs integer, this is instead of the form + (HIGH MIDDLE . LOW): first the high bits, then the middle 24 bits, and finally the low 16 bits. 11. Filesystem device number. If it is larger than what the Emacs integer can hold, this is a cons cell, similar to the inode number. @@ -998,35 +997,8 @@ #else /* file gid will be egid */ values[9] = (s.st_gid != getegid ()) ? Qt : Qnil; #endif /* not BSD4_2 */ - if (!FIXNUM_OVERFLOW_P (s.st_ino)) - /* Keep the most common cases as integers. */ - values[10] = make_number (s.st_ino); - else if (!FIXNUM_OVERFLOW_P (s.st_ino >> 16)) - /* To allow inode numbers larger than VALBITS, separate the bottom - 16 bits. */ - values[10] = Fcons (make_number ((EMACS_INT)(s.st_ino >> 16)), - make_number ((EMACS_INT)(s.st_ino & 0xffff))); - else - { - /* To allow inode numbers beyond 32 bits, separate into 2 24-bit - high parts and a 16-bit bottom part. - The code on the next line avoids a compiler warning on - systems where st_ino is 32 bit wide. (bug#766). */ - EMACS_INT high_ino = s.st_ino >> 31 >> 1; - EMACS_INT low_ino = s.st_ino & 0xffffffff; - - values[10] = Fcons (make_number (high_ino >> 8), - Fcons (make_number (((high_ino & 0xff) << 16) - + (low_ino >> 16)), - make_number (low_ino & 0xffff))); - } - - /* Likewise for device. */ - if (FIXNUM_OVERFLOW_P (s.st_dev)) - values[11] = Fcons (make_number (s.st_dev >> 16), - make_number (s.st_dev & 0xffff)); - else - values[11] = make_number (s.st_dev); + values[10] = INTEGER_TO_CONS (s.st_ino); + values[11] = INTEGER_TO_CONS (s.st_dev); return Flist (sizeof(values) / sizeof(values[0]), values); } === modified file 'src/doprnt.c' --- src/doprnt.c 2011-04-30 20:05:43 +0000 +++ src/doprnt.c 2011-06-06 06:16:12 +0000 @@ -329,7 +329,7 @@ minlen = atoi (&fmtcpy[1]); string = va_arg (ap, char *); tem = strlen (string); - if (tem > MOST_POSITIVE_FIXNUM) + if (tem > STRING_BYTES_MAX) error ("String for %%s or %%S format is too long"); width = strwidth (string, tem); goto doit1; @@ -338,7 +338,7 @@ doit: /* Coming here means STRING contains ASCII only. */ tem = strlen (string); - if (tem > MOST_POSITIVE_FIXNUM) + if (tem > STRING_BYTES_MAX) error ("Format width or precision too large"); width = tem; doit1: === modified file 'src/editfns.c' --- src/editfns.c 2011-06-05 22:46:26 +0000 +++ src/editfns.c 2011-06-06 06:16:12 +0000 @@ -2342,7 +2342,7 @@ len = CHAR_STRING (XFASTINT (character), str); else str[0] = XFASTINT (character), len = 1; - if (MOST_POSITIVE_FIXNUM / len < XINT (count)) + if (BUF_BYTES_MAX / len < XINT (count)) error ("Maximum buffer size would be exceeded"); n = XINT (count) * len; if (n <= 0) @@ -3589,7 +3589,7 @@ char initial_buffer[4000]; char *buf = initial_buffer; EMACS_INT bufsize = sizeof initial_buffer; - EMACS_INT max_bufsize = min (MOST_POSITIVE_FIXNUM + 1, SIZE_MAX); + EMACS_INT max_bufsize = STRING_BYTES_MAX + 1; char *p; Lisp_Object buf_save_value IF_LINT (= {0}); register char *format, *end, *format_start; === modified file 'src/eval.c' --- src/eval.c 2011-05-30 05:39:59 +0000 +++ src/eval.c 2011-06-06 06:16:12 +0000 @@ -1994,7 +1994,7 @@ { char buf[4000]; size_t size = sizeof buf; - size_t size_max = min (MOST_POSITIVE_FIXNUM + 1, SIZE_MAX); + size_t size_max = STRING_BYTES_MAX + 1; size_t mlen = strlen (m); char *buffer = buf; size_t used; === modified file 'src/fileio.c' --- src/fileio.c 2011-04-29 19:47:29 +0000 +++ src/fileio.c 2011-06-06 08:29:01 +0000 @@ -3248,7 +3248,7 @@ /* Check whether the size is too large or negative, which can happen on a platform that allows file sizes greater than the maximum off_t value. */ if (! not_regular - && ! (0 <= st.st_size && st.st_size <= MOST_POSITIVE_FIXNUM)) + && ! (0 <= st.st_size && st.st_size <= BUF_BYTES_MAX)) error ("Maximum buffer size exceeded"); /* Prevent redisplay optimizations. */ @@ -4960,7 +4960,7 @@ if ((st.st_mtime == b->modtime /* If both are positive, accept them if they are off by one second. */ || (st.st_mtime > 0 && b->modtime > 0 - && (st.st_mtime == b->modtime + 1 + && (st.st_mtime - 1 == b->modtime || st.st_mtime == b->modtime - 1))) && (st.st_size == b->modtime_size || b->modtime_size < 0)) @@ -4990,7 +4990,7 @@ { if (! current_buffer->modtime) return make_number (0); - return make_time ((time_t) current_buffer->modtime); + return make_time (current_buffer->modtime); } DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, @@ -5005,7 +5005,7 @@ { if (!NILP (time_list)) { - current_buffer->modtime = cons_to_long (time_list); + CONS_TO_INTEGER (time_list, time_t, current_buffer->modtime); current_buffer->modtime_size = -1; } else === modified file 'src/font.c' --- src/font.c 2011-05-29 19:04:01 +0000 +++ src/font.c 2011-06-06 08:29:01 +0000 @@ -4388,16 +4388,8 @@ for (i = 0; i < 255; i++) if (variations[i]) { - Lisp_Object code; int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16)); - /* Stops GCC whining about limited range of data type. */ - EMACS_INT var = variations[i]; - - if (var > MOST_POSITIVE_FIXNUM) - code = Fcons (make_number ((variations[i]) >> 16), - make_number ((variations[i]) & 0xFFFF)); - else - code = make_number (variations[i]); + Lisp_Object code = INTEGER_TO_CONS (variations[i]); val = Fcons (Fcons (make_number (vs), code), val); } return val; === modified file 'src/fontset.c' --- src/fontset.c 2011-05-28 22:39:39 +0000 +++ src/fontset.c 2011-06-06 08:29:01 +0000 @@ -1859,17 +1859,11 @@ { unsigned code = face->font->driver->encode_char (face->font, c); Lisp_Object font_object; - /* Assignment to EMACS_INT stops GCC whining about limited range - of data type. */ - EMACS_INT cod = code; if (code == FONT_INVALID_CODE) return Qnil; XSETFONT (font_object, face->font); - if (cod <= MOST_POSITIVE_FIXNUM) - return Fcons (font_object, make_number (code)); - return Fcons (font_object, Fcons (make_number (code >> 16), - make_number (code & 0xFFFF))); + return Fcons (font_object, INTEGER_TO_CONS (code)); } return Qnil; } === modified file 'src/ftfont.c' --- src/ftfont.c 2011-04-11 03:39:45 +0000 +++ src/ftfont.c 2011-06-01 02:49:12 +0000 @@ -815,7 +815,7 @@ goto err; for (chars = XCDR (chars); CONSP (chars); chars = XCDR (chars)) if (CHARACTERP (XCAR (chars)) - && ! FcCharSetAddChar (charset, XUINT (XCAR (chars)))) + && ! FcCharSetAddChar (charset, XFASTINT (XCAR (chars)))) goto err; } } === modified file 'src/image.c' --- src/image.c 2011-05-31 06:05:00 +0000 +++ src/image.c 2011-06-06 06:10:06 +0000 @@ -2112,9 +2112,6 @@ File Handling ***********************************************************************/ -static unsigned char *slurp_file (char *, int *); - - /* Find image file FILE. Look in data-directory/images, then x-bitmap-file-path. Value is the encoded full name of the file found, or nil if not found. */ @@ -2151,7 +2148,7 @@ occurred. *SIZE is set to the size of the file. */ static unsigned char * -slurp_file (char *file, int *size) +slurp_file (char *file, ptrdiff_t *size) { FILE *fp = NULL; unsigned char *buf = NULL; @@ -2159,6 +2156,7 @@ if (stat (file, &st) == 0 && (fp = fopen (file, "rb")) != NULL + && 0 <= st.st_size && st.st_size <= min (PTRDIFF_MAX, SIZE_MAX) && (buf = (unsigned char *) xmalloc (st.st_size), fread (buf, 1, st.st_size, fp) == st.st_size)) { @@ -2814,7 +2812,7 @@ { Lisp_Object file; unsigned char *contents; - int size; + ptrdiff_t size; file = x_find_image_file (file_name); if (!STRINGP (file)) @@ -4039,7 +4037,7 @@ { Lisp_Object file; unsigned char *contents; - int size; + ptrdiff_t size; file = x_find_image_file (file_name); if (!STRINGP (file)) @@ -5021,6 +5019,7 @@ if (stat (SDATA (file), &st) == 0 && (fp = fopen (SDATA (file), "rb")) != NULL + && 0 <= st.st_size && st.st_size <= min (PTRDIFF_MAX, SIZE_MAX) && (buf = (char *) xmalloc (st.st_size), fread (buf, 1, st.st_size, fp) == st.st_size)) { @@ -5055,7 +5054,7 @@ enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type; unsigned char *contents = NULL; unsigned char *end, *p; - int size; + ptrdiff_t size; specified_file = image_spec_value (img->spec, QCfile, NULL); @@ -7869,7 +7868,7 @@ static int svg_load (struct frame *f, struct image *img); static int svg_load_image (struct frame *, struct image *, - unsigned char *, unsigned int); + unsigned char *, ptrdiff_t); /* The symbol `svg' identifying images of this type. */ @@ -8047,7 +8046,7 @@ { Lisp_Object file; unsigned char *contents; - int size; + ptrdiff_t size; file = x_find_image_file (file_name); if (!STRINGP (file)) @@ -8096,7 +8095,7 @@ svg_load_image (struct frame *f, /* Pointer to emacs frame structure. */ struct image *img, /* Pointer to emacs image structure. */ unsigned char *contents, /* String containing the SVG XML data to be parsed. */ - unsigned int size) /* Size of data in bytes. */ + ptrdiff_t size) /* Size of data in bytes. */ { RsvgHandle *rsvg_handle; RsvgDimensionData dimension_data; === modified file 'src/keyboard.c' --- src/keyboard.c 2011-06-04 07:41:44 +0000 +++ src/keyboard.c 2011-06-06 05:48:28 +0000 @@ -2395,8 +2395,8 @@ c = Faref (Vexecuting_kbd_macro, make_number (executing_kbd_macro_index)); if (STRINGP (Vexecuting_kbd_macro) - && (XINT (c) & 0x80) && (XUINT (c) <= 0xff)) - XSETFASTINT (c, CHAR_META | (XINT (c) & ~0x80)); + && (XFASTINT (c) & 0x80) && (XFASTINT (c) <= 0xff)) + XSETFASTINT (c, CHAR_META | (XFASTINT (c) & ~0x80)); executing_kbd_macro_index++; @@ -3321,7 +3321,7 @@ if (INTEGERP (c)) { if (XUINT (c) < 0x100) - putc (XINT (c), dribble); + putc (XUINT (c), dribble); else fprintf (dribble, " 0x%"pI"x", XUINT (c)); } @@ -6370,7 +6370,7 @@ Lisp_Object parsed; parsed = parse_modifiers (symbol); - return apply_modifiers ((int) XINT (XCAR (XCDR (parsed))), + return apply_modifiers (XFASTINT (XCAR (XCDR (parsed))), XCAR (parsed)); } === modified file 'src/keymap.c' --- src/keymap.c 2011-05-12 07:07:06 +0000 +++ src/keymap.c 2011-06-01 02:49:12 +0000 @@ -462,7 +462,7 @@ XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1))); /* Handle the special meta -> esc mapping. */ - if (INTEGERP (idx) && XUINT (idx) & meta_modifier) + if (INTEGERP (idx) && XFASTINT (idx) & meta_modifier) { /* See if there is a meta-map. If there's none, there is no binding for IDX, unless a default binding exists in MAP. */ @@ -480,7 +480,7 @@ if (CONSP (event_meta_map)) { map = event_meta_map; - idx = make_number (XUINT (idx) & ~meta_modifier); + idx = make_number (XFASTINT (idx) & ~meta_modifier); } else if (t_ok) /* Set IDX to t, so that we only find a default binding. */ @@ -529,7 +529,7 @@ } else if (VECTORP (binding)) { - if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding)) + if (INTEGERP (idx) && XFASTINT (idx) < ASIZE (binding)) val = AREF (binding, XFASTINT (idx)); } else if (CHAR_TABLE_P (binding)) @@ -537,7 +537,7 @@ /* Character codes with modifiers are not included in a char-table. All character codes without modifiers are included. */ - if (NATNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0) + if (INTEGERP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0) { val = Faref (binding, idx); /* `nil' has a special meaning for char-tables, so @@ -1357,7 +1357,7 @@ int modifiers; parsed = parse_modifiers (c); - modifiers = (int) XUINT (XCAR (XCDR (parsed))); + modifiers = XFASTINT (XCAR (XCDR (parsed))); base = XCAR (parsed); name = Fsymbol_name (base); /* This alist includes elements such as ("RET" . "\\r"). */ @@ -2416,7 +2416,7 @@ { char tem[KEY_DESCRIPTION_SIZE]; - *push_key_description (XUINT (key), tem, 1) = 0; + *push_key_description (XINT (key), tem, 1) = 0; return build_string (tem); } else if (SYMBOLP (key)) /* Function key or event-symbol */ @@ -2515,7 +2515,7 @@ return 0; else { - int modifiers = XUINT (elt) & (CHAR_MODIFIER_MASK & ~CHAR_META); + int modifiers = XINT (elt) & (CHAR_MODIFIER_MASK & ~CHAR_META); if (modifiers == where_is_preferred_modifier) result = 2; else if (modifiers) === modified file 'src/lisp.h' --- src/lisp.h 2011-06-06 13:57:49 +0000 +++ src/lisp.h 2011-06-06 17:58:07 +0000 @@ -24,6 +24,8 @@ #include #include +#include + /* Use the configure flag --enable-checking[=LIST] to enable various types of run time checks for Lisp objects. */ @@ -763,6 +765,12 @@ #endif /* not GC_CHECK_STRING_BYTES */ +/* A string cannot contain more bytes than a fixnum can represent, + nor can it be so long that C pointer arithmetic stops working on + the string plus a terminating null. */ +#define STRING_BYTES_MAX \ + min (MOST_POSITIVE_FIXNUM, min (SIZE_MAX, PTRDIFF_MAX) - 1) + /* Mark STR as a unibyte string. */ #define STRING_SET_UNIBYTE(STR) \ do { if (EQ (STR, empty_multibyte_string)) \ @@ -2402,9 +2410,35 @@ EXFUN (Fsub1, 1); EXFUN (Fmake_variable_buffer_local, 1); +/* Convert the integer I to an Emacs representation, either the integer + itself, or a cons of two or three integers, or if all else fails a float. + I should not have side effects. */ +#define INTEGER_TO_CONS(i) \ + (! FIXNUM_OVERFLOW_P (i) \ + ? make_number (i) \ + : ! ((FIXNUM_OVERFLOW_P (INTMAX_MIN >> 16) \ + || FIXNUM_OVERFLOW_P (UINTMAX_MAX >> 16)) \ + && FIXNUM_OVERFLOW_P ((i) >> 16)) \ + ? Fcons (make_number ((i) >> 16), make_number ((i) & 0xffff)) \ + : ! ((FIXNUM_OVERFLOW_P (INTMAX_MIN >> 16 >> 24) \ + || FIXNUM_OVERFLOW_P (UINTMAX_MAX >> 16 >> 24)) \ + && FIXNUM_OVERFLOW_P ((i) >> 16 >> 24)) \ + ? Fcons (make_number ((i) >> 16 >> 24), \ + Fcons (make_number ((i) >> 16 & 0xffffff), \ + make_number ((i) & 0xffff))) \ + : make_float (i)) + +/* Convert the Emacs representation CONS back to an integer of type + TYPE, storing the result the variable VAR. Signal an error if CONS + is not a valid representation or is out of range for TYPE. */ +#define CONS_TO_INTEGER(cons, type, var) \ + (TYPE_SIGNED (type) \ + ? ((var) = cons_to_signed (cons, TYPE_MINIMUM (type), TYPE_MAXIMUM (type))) \ + : ((var) = cons_to_unsigned (cons, TYPE_MAXIMUM (type)))) +extern intmax_t cons_to_signed (Lisp_Object, intmax_t, intmax_t); +extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t); + extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *); -extern Lisp_Object long_to_cons (unsigned long); -extern unsigned long cons_to_long (Lisp_Object); extern void args_out_of_range (Lisp_Object, Lisp_Object) NO_RETURN; extern void args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object) NO_RETURN; === modified file 'src/undo.c' --- src/undo.c 2011-04-14 05:04:02 +0000 +++ src/undo.c 2011-06-06 08:29:01 +0000 @@ -212,7 +212,6 @@ void record_first_change (void) { - Lisp_Object high, low; struct buffer *base_buffer = current_buffer; if (EQ (BVAR (current_buffer, undo_list), Qt)) @@ -225,9 +224,9 @@ if (base_buffer->base_buffer) base_buffer = base_buffer->base_buffer; - XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff); - XSETFASTINT (low, base_buffer->modtime & 0xffff); - BVAR (current_buffer, undo_list) = Fcons (Fcons (Qt, Fcons (high, low)), BVAR (current_buffer, undo_list)); + BVAR (current_buffer, undo_list) = + Fcons (Fcons (Qt, INTEGER_TO_CONS (base_buffer->modtime)), + BVAR (current_buffer, undo_list)); } /* Record a change in property PROP (whose old value was VAL) @@ -499,13 +498,9 @@ if (EQ (car, Qt)) { /* Element (t high . low) records previous modtime. */ - Lisp_Object high, low; - int mod_time; struct buffer *base_buffer = current_buffer; - - high = Fcar (cdr); - low = Fcdr (cdr); - mod_time = (XFASTINT (high) << 16) + XFASTINT (low); + time_t mod_time; + CONS_TO_INTEGER (cdr, time_t, mod_time); if (current_buffer->base_buffer) base_buffer = current_buffer->base_buffer; === modified file 'src/xfns.c' --- src/xfns.c 2011-06-05 22:20:42 +0000 +++ src/xfns.c 2011-06-06 08:29:01 +0000 @@ -4299,18 +4299,9 @@ if (! NILP (source)) { - if (NUMBERP (source)) - { - if (FLOATP (source)) - target_window = (Window) XFLOAT (source); - else - target_window = XFASTINT (source); - - if (target_window == 0) - target_window = FRAME_X_DISPLAY_INFO (f)->root_window; - } - else if (CONSP (source)) - target_window = cons_to_long (source); + CONS_TO_INTEGER (source, Window, target_window); + if (! target_window) + target_window = FRAME_X_DISPLAY_INFO (f)->root_window; } BLOCK_INPUT; === modified file 'src/xselect.c' --- src/xselect.c 2011-06-04 22:08:32 +0000 +++ src/xselect.c 2011-06-06 08:29:01 +0000 @@ -20,6 +20,7 @@ /* Rewritten by jwz */ #include +#include #include /* termhooks.h needs this */ #include @@ -335,7 +336,7 @@ Lisp_Object prev_value; selection_data = list4 (selection_name, selection_value, - long_to_cons (timestamp), frame); + INTEGER_TO_CONS (timestamp), frame); prev_value = LOCAL_SELECTION (selection_name, dpyinfo); dpyinfo->terminal->Vselection_alist @@ -419,7 +420,7 @@ || INTEGERP (check) || NILP (value)) return value; - /* Check for a value that cons_to_long could handle. */ + /* Check for a value that CONS_TO_INTEGER could handle. */ else if (CONSP (check) && INTEGERP (XCAR (check)) && (INTEGERP (XCDR (check)) @@ -782,8 +783,8 @@ if (NILP (local_selection_data)) goto DONE; /* Decline requests issued prior to our acquiring the selection. */ - local_selection_time - = (Time) cons_to_long (XCAR (XCDR (XCDR (local_selection_data)))); + CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data))), + Time, local_selection_time); if (SELECTION_EVENT_TIME (event) != CurrentTime && local_selection_time > SELECTION_EVENT_TIME (event)) goto DONE; @@ -950,8 +951,8 @@ /* Well, we already believe that we don't own it, so that's just fine. */ if (NILP (local_selection_data)) return; - local_selection_time = (Time) - cons_to_long (XCAR (XCDR (XCDR (local_selection_data)))); + CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data))), + Time, local_selection_time); /* We have reasserted the selection since this SelectionClear was generated, so we can disregard it. */ @@ -1212,16 +1213,7 @@ return Qnil; if (! NILP (time_stamp)) - { - if (CONSP (time_stamp)) - requestor_time = (Time) cons_to_long (time_stamp); - else if (INTEGERP (time_stamp)) - requestor_time = (Time) XUINT (time_stamp); - else if (FLOATP (time_stamp)) - requestor_time = (Time) XFLOAT_DATA (time_stamp); - else - error ("TIME_STAMP must be cons or number"); - } + CONS_TO_INTEGER (time_stamp, Time, requestor_time); BLOCK_INPUT; TRACE2 ("Get selection %s, type %s", @@ -1639,7 +1631,7 @@ convert it to a cons of integers, 16 bits in each half. */ else if (format == 32 && size == sizeof (int)) - return long_to_cons (((unsigned int *) data) [0]); + return INTEGER_TO_CONS (((unsigned int *) data) [0]); else if (format == 16 && size == sizeof (short)) return make_number ((int) (((unsigned short *) data) [0])); @@ -1665,7 +1657,7 @@ for (i = 0; i < size / 4; i++) { unsigned int j = ((unsigned int *) data) [i]; - Faset (v, make_number (i), long_to_cons (j)); + Faset (v, make_number (i), INTEGER_TO_CONS (j)); } return v; } @@ -1742,7 +1734,7 @@ *size_ret = 1; *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1); (*data_ret) [sizeof (long)] = 0; - (*(unsigned long **) data_ret) [0] = cons_to_long (obj); + (*(unsigned long **) data_ret) [0] = cons_to_unsigned (obj, ULONG_MAX); if (NILP (type)) type = QINTEGER; } else if (VECTORP (obj)) @@ -1790,11 +1782,11 @@ *data_ret = (unsigned char *) xmalloc (*size_ret * data_size); for (i = 0; i < *size_ret; i++) if (*format_ret == 32) - (*((unsigned long **) data_ret)) [i] - = cons_to_long (XVECTOR (obj)->contents [i]); + (*((unsigned long **) data_ret)) [i] = + cons_to_unsigned (XVECTOR (obj)->contents [i], ULONG_MAX); else - (*((unsigned short **) data_ret)) [i] - = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]); + (*((unsigned short **) data_ret)) [i] = + cons_to_unsigned (XVECTOR (obj)->contents [i], USHRT_MAX); } } else @@ -2012,8 +2004,10 @@ selection_atom = symbol_to_x_atom (dpyinfo, selection); BLOCK_INPUT; - timestamp = (NILP (time_object) ? last_event_timestamp - : cons_to_long (time_object)); + if (NILP (time_object)) + timestamp = last_event_timestamp; + else + CONS_TO_INTEGER (time_object, Time, timestamp); XSetSelectionOwner (dpyinfo->display, selection_atom, None, timestamp); UNBLOCK_INPUT; @@ -2250,12 +2244,8 @@ { Lisp_Object o = XCAR (iter); - if (INTEGERP (o)) - val = (long) XFASTINT (o); - else if (FLOATP (o)) - val = (long) XFLOAT_DATA (o); - else if (CONSP (o)) - val = (long) cons_to_long (o); + if (INTEGERP (o) || FLOATP (o) || CONSP (o)) + val = cons_to_signed (o, LONG_MIN, LONG_MAX); else if (STRINGP (o)) { BLOCK_INPUT; @@ -2266,9 +2256,19 @@ error ("Wrong type, must be string, number or cons"); if (format == 8) - *d08++ = (char) val; + { + if (CHAR_MIN <= val && val <= CHAR_MAX) + *d08++ = val; + else + error ("Out of 'char' range"); + } else if (format == 16) - *d16++ = (short) val; + { + if (SHRT_MIN <= val && val <= SHRT_MAX) + *d16++ = val; + else + error ("Out of 'short' range"); + } else *d32++ = val; } @@ -2352,14 +2352,7 @@ Atom atom; int had_errors; - if (INTEGERP (value)) - atom = (Atom) XUINT (value); - else if (FLOATP (value)) - atom = (Atom) XFLOAT_DATA (value); - else if (CONSP (value)) - atom = (Atom) cons_to_long (value); - else - error ("Wrong type, value must be number or cons"); + CONS_TO_INTEGER (value, Atom, atom); BLOCK_INPUT; x_catch_errors (dpy); @@ -2549,17 +2542,8 @@ else error ("DEST as a string must be one of PointerWindow or InputFocus"); } - else if (INTEGERP (dest)) - wdest = (Window) XFASTINT (dest); - else if (FLOATP (dest)) - wdest = (Window) XFLOAT_DATA (dest); - else if (CONSP (dest)) - { - if (! NUMBERP (XCAR (dest)) || ! NUMBERP (XCDR (dest))) - error ("Both car and cdr for DEST must be numbers"); - else - wdest = (Window) cons_to_long (dest); - } + else if (INTEGERP (dest) || FLOATP (dest) || CONSP (dest)) + CONS_TO_INTEGER (dest, Window, wdest); else error ("DEST must be a frame, nil, string, number or cons"); ------------------------------------------------------------ revno: 104514 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2011-06-06 13:54:34 -0300 message: * src/window.h (Fwindow_frame): Declare. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-06 16:41:21 +0000 +++ src/ChangeLog 2011-06-06 16:54:34 +0000 @@ -1,3 +1,7 @@ +2011-06-06 Stefan Monnier + + * window.h (Fwindow_frame): Declare. + 2011-06-06 Paul Eggert * alloc.c: Simplify handling of large-request failures (Bug#8800). @@ -35,8 +39,8 @@ or arbitrary window as argument. Update doc-strings. (Fminibuffer_window): Move up in code. (Fwindow_minibuffer_p): Move up in code and simplify. - (Fset_frame_selected_window): Move here from frame.c. Marginal - rewrite. + (Fset_frame_selected_window): Move here from frame.c. + Marginal rewrite. (Fselected_window, select_window, Fselect_window): Move up in code. Minor doc-string fixes. @@ -75,8 +79,8 @@ * xselect.c (x_clipboard_manager_save): Remove redundant arg. (x_clipboard_manager_save): Add return value. - (x_clipboard_manager_error_1, x_clipboard_manager_error_2): New - error handlers. + (x_clipboard_manager_error_1, x_clipboard_manager_error_2): + New error handlers. (x_clipboard_manager_save_frame, x_clipboard_manager_save_all): Obey Vx_select_enable_clipboard_manager. Catch errors in x_clipboard_manager_save (Bug#8779). @@ -104,8 +108,8 @@ (bidi_fetch_char, bidi_fetch_char_advance): New functions. (bidi_cache_search, bidi_cache_iterator_state) (bidi_paragraph_init, bidi_resolve_explicit, bidi_resolve_weak) - (bidi_level_of_next_char, bidi_move_to_visually_next): Support - character positions inside a run of characters covered by a + (bidi_level_of_next_char, bidi_move_to_visually_next): + Support character positions inside a run of characters covered by a display string. (bidi_paragraph_init, bidi_resolve_explicit_1) (bidi_level_of_next_char): Call bidi_fetch_char and @@ -116,8 +120,8 @@ definitions. (bidi_explicit_dir_char): Lookup character type in bidi_type_table, instead of using explicit *_CHAR codes. - (bidi_resolve_explicit, bidi_resolve_weak): Use - FETCH_MULTIBYTE_CHAR instead of FETCH_CHAR, as reordering of + (bidi_resolve_explicit, bidi_resolve_weak): + Use FETCH_MULTIBYTE_CHAR instead of FETCH_CHAR, as reordering of bidirectional text is supported only in multibyte buffers. (bidi_init_it): Accept additional argument FRAME_WINDOW_P and use it to initialize the frame_window_p member of struct bidi_it. @@ -135,8 +139,8 @@ (single_display_spec_intangible_p): Function deleted. (display_prop_intangible_p): Reimplement to call handle_display_spec instead of single_display_spec_intangible_p. - Accept 3 additional arguments needed by handle_display_spec. This - fixes incorrect cursor motion across display property with complex + Accept 3 additional arguments needed by handle_display_spec. + This fixes incorrect cursor motion across display property with complex values: lists, `(when COND...)' forms, etc. (single_display_spec_string_p): Support property values that are lists with the argument STRING its top-level element. @@ -153,8 +157,8 @@ the display property will replace the characters it covers. (Fcurrent_bidi_paragraph_direction): Initialize the nchars and frame_window_p members of struct bidi_it. - (compute_display_string_pos, compute_display_string_end): New - functions. + (compute_display_string_pos, compute_display_string_end): + New functions. (push_it): Accept second argument POSITION, where pop_it should jump to continue iteration. (reseat_1): Initialize bidi_it.disp_pos. @@ -165,8 +169,8 @@ * dispextern.h (struct bidi_it): New member frame_window_p. (bidi_init_it): Update prototypes. (display_prop_intangible_p): Update prototype. - (compute_display_string_pos, compute_display_string_end): Declare - prototypes. + (compute_display_string_pos, compute_display_string_end): + Declare prototypes. (struct bidi_it): New members nchars and disp_pos. ch_len is now EMACS_INT. === modified file 'src/window.h' --- src/window.h 2011-06-06 13:57:49 +0000 +++ src/window.h 2011-06-06 16:54:34 +0000 @@ -845,6 +845,7 @@ extern Lisp_Object Vwindow_list; EXFUN (Fwindow_buffer, 1); +EXFUN (Fwindow_frame, 1); EXFUN (Fget_buffer_window, 2); EXFUN (Fwindow_minibuffer_p, 1); EXFUN (Fselected_window, 0); ------------------------------------------------------------ revno: 104513 committer: Paul Eggert branch nick: trunk timestamp: Mon 2011-06-06 09:41:21 -0700 message: * alloc.c: Simplify handling of large-request failures (Bug#8800). (SPARE_MEMORY): Always define. (LARGE_REQUEST): Remove. (memory_full): Use SPARE_MEMORY rather than LARGE_REQUEST. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-06 13:57:49 +0000 +++ src/ChangeLog 2011-06-06 16:41:21 +0000 @@ -1,3 +1,10 @@ +2011-06-06 Paul Eggert + + * alloc.c: Simplify handling of large-request failures (Bug#8800). + (SPARE_MEMORY): Always define. + (LARGE_REQUEST): Remove. + (memory_full): Use SPARE_MEMORY rather than LARGE_REQUEST. + 2011-06-06 Martin Rudalics * lisp.h: Move EXFUNS for Fframe_root_window, === modified file 'src/alloc.c' --- src/alloc.c 2011-06-06 04:54:23 +0000 +++ src/alloc.c 2011-06-06 16:41:21 +0000 @@ -190,17 +190,10 @@ static char *spare_memory[7]; -#ifndef SYSTEM_MALLOC -/* Amount of spare memory to keep in large reserve block. */ +/* Amount of spare memory to keep in large reserve block, or to see + whether this much is available when malloc fails on a larger request. */ #define SPARE_MEMORY (1 << 14) -#endif - -#ifdef SYSTEM_MALLOC -# define LARGE_REQUEST (1 << 14) -#else -# define LARGE_REQUEST SPARE_MEMORY -#endif /* Number of extra blocks malloc should get when it needs more core. */ @@ -3289,9 +3282,9 @@ { /* Do not go into hysterics merely because a large request failed. */ int enough_free_memory = 0; - if (LARGE_REQUEST < nbytes) + if (SPARE_MEMORY < nbytes) { - void *p = malloc (LARGE_REQUEST); + void *p = malloc (SPARE_MEMORY); if (p) { free (p); ------------------------------------------------------------ revno: 104512 committer: martin rudalics branch nick: trunk timestamp: Mon 2011-06-06 17:21:07 +0200 message: Add window-tree based, atomic and side window functions to window.el. * window.el (window-right, window-left, window-child) (window-child-count, window-last-child, window-any-p) (normalize-live-buffer, normalize-live-frame) (normalize-any-window, normalize-live-window) (window-iso-combination-p, window-iso-combined-p) (window-iso-combinations) (walk-window-tree-1, walk-window-tree, walk-window-subtree) (windows-with-parameter, window-with-parameter) (window-atom-root, make-window-atom, window-atom-check-1) (window-atom-check, window-side-check, window-check): New functions. (ignore-window-parameters, window-sides, window-sides-vertical) (window-sides-slots): New variables. (window-size-fixed): Move down in code. Minor doc-string fix. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-05 23:20:16 +0000 +++ lisp/ChangeLog 2011-06-06 15:21:07 +0000 @@ -1,3 +1,20 @@ +2011-06-06 Martin Rudalics + + * window.el (window-right, window-left, window-child) + (window-child-count, window-last-child, window-any-p) + (normalize-live-buffer, normalize-live-frame) + (normalize-any-window, normalize-live-window) + (window-iso-combination-p, window-iso-combined-p) + (window-iso-combinations) + (walk-window-tree-1, walk-window-tree, walk-window-subtree) + (windows-with-parameter, window-with-parameter) + (window-atom-root, make-window-atom, window-atom-check-1) + (window-atom-check, window-side-check, window-check): New + functions. + (ignore-window-parameters, window-sides, window-sides-vertical) + (window-sides-slots): New variables. + (window-size-fixed): Move down in code. Minor doc-string fix. + 2011-06-05 Andreas Schwab * comint.el (comint-dynamic-complete-as-filename) === modified file 'lisp/window.el' --- lisp/window.el 2011-04-19 13:44:55 +0000 +++ lisp/window.el 2011-06-06 15:21:07 +0000 @@ -30,15 +30,6 @@ (eval-when-compile (require 'cl)) -(defvar window-size-fixed nil - "*Non-nil in a buffer means windows displaying the buffer are fixed-size. -If the value is `height', then only the window's height is fixed. -If the value is `width', then only the window's width is fixed. -Any other non-nil value fixes both the width and the height. -Emacs won't change the size of any window displaying that buffer, -unless you explicitly change the size, or Emacs has no other choice.") -(make-variable-buffer-local 'window-size-fixed) - (defmacro save-selected-window (&rest body) "Execute BODY, then select the previously selected window. The value returned is the value of the last form in BODY. @@ -72,6 +63,434 @@ (when (window-live-p save-selected-window-window) (select-window save-selected-window-window 'norecord)))))) +;; The following two functions are like `window-next' and `window-prev' +;; but the WINDOW argument is _not_ optional (so they don't substitute +;; the selected window for nil), and they return nil when WINDOW doesn't +;; have a parent (like a frame's root window or a minibuffer window). +(defsubst window-right (window) + "Return WINDOW's right sibling. +Return nil if WINDOW is the root window of its frame. WINDOW can +be any window." + (and window (window-parent window) (window-next window))) + +(defsubst window-left (window) + "Return WINDOW's left sibling. +Return nil if WINDOW is the root window of its frame. WINDOW can +be any window." + (and window (window-parent window) (window-prev window))) + +(defsubst window-child (window) + "Return WINDOW's first child window." + (or (window-vchild window) (window-hchild window))) + +(defun window-child-count (window) + "Return number of WINDOW's child windows." + (let ((count 0)) + (when (and (windowp window) (setq window (window-child window))) + (while window + (setq count (1+ count)) + (setq window (window-next window)))) + count)) + +(defun window-last-child (window) + "Return last child window of WINDOW." + (when (and (windowp window) (setq window (window-child window))) + (while (window-next window) + (setq window (window-next window)))) + window) + +(defsubst window-any-p (object) + "Return t if OBJECT denotes a live or internal window." + (and (windowp object) + (or (window-buffer object) (window-child object)) + t)) + +;; The following four functions should probably go to subr.el. +(defsubst normalize-live-buffer (buffer-or-name) + "Return buffer specified by BUFFER-OR-NAME. +BUFFER-OR-NAME must be either a buffer or a string naming a live +buffer and defaults to the current buffer." + (cond + ((not buffer-or-name) + (current-buffer)) + ((bufferp buffer-or-name) + (if (buffer-live-p buffer-or-name) + buffer-or-name + (error "Buffer %s is not a live buffer" buffer-or-name))) + ((get-buffer buffer-or-name)) + (t + (error "No such buffer %s" buffer-or-name)))) + +(defsubst normalize-live-frame (frame) + "Return frame specified by FRAME. +FRAME must be a live frame and defaults to the selected frame." + (if frame + (if (frame-live-p frame) + frame + (error "%s is not a live frame" frame)) + (selected-frame))) + +(defsubst normalize-any-window (window) + "Return window specified by WINDOW. +WINDOW must be a window that has not been deleted and defaults to +the selected window." + (if window + (if (window-any-p window) + window + (error "%s is not a window" window)) + (selected-window))) + +(defsubst normalize-live-window (window) + "Return live window specified by WINDOW. +WINDOW must be a live window and defaults to the selected one." + (if window + (if (and (windowp window) (window-buffer window)) + window + (error "%s is not a live window" window)) + (selected-window))) + +(defvar ignore-window-parameters nil + "If non-nil, standard functions ignore window parameters. +The functions currently affected by this are `split-window', +`delete-window', `delete-other-windows' and `other-window'. + +An application may bind this to a non-nil value around calls to +these functions to inhibit processing of window parameters.") + +(defun window-iso-combination-p (&optional window horizontal) + "If WINDOW is a vertical combination return WINDOW's first child. +WINDOW can be any window and defaults to the selected one. +Optional argument HORIZONTAL non-nil means return WINDOW's first +child if WINDOW is a horizontal combination." + (setq window (normalize-any-window window)) + (if horizontal + (window-hchild window) + (window-vchild window))) + +(defsubst window-iso-combined-p (&optional window horizontal) + "Return non-nil if and only if WINDOW is vertically combined. +WINDOW can be any window and defaults to the selected one. +Optional argument HORIZONTAL non-nil means return non-nil if and +only if WINDOW is horizontally combined." + (setq window (normalize-any-window window)) + (let ((parent (window-parent window))) + (and parent (window-iso-combination-p parent horizontal)))) + +(defun window-iso-combinations (&optional window horizontal) + "Return largest number of vertically arranged subwindows of WINDOW. +WINDOW can be any window and defaults to the selected one. +Optional argument HORIZONTAL non-nil means to return the largest +number of horizontally arranged subwindows of WINDOW." + (setq window (normalize-any-window window)) + (cond + ((window-live-p window) + ;; If WINDOW is live, return 1. + 1) + ((window-iso-combination-p window horizontal) + ;; If WINDOW is iso-combined, return the sum of the values for all + ;; subwindows of WINDOW. + (let ((child (window-child window)) + (count 0)) + (while child + (setq count + (+ (window-iso-combinations child horizontal) + count)) + (setq child (window-right child))) + count)) + (t + ;; If WINDOW is not iso-combined, return the maximum value of any + ;; subwindow of WINDOW. + (let ((child (window-child window)) + (count 1)) + (while child + (setq count + (max (window-iso-combinations child horizontal) + count)) + (setq child (window-right child))) + count)))) + +(defun walk-window-tree-1 (proc walk-window-tree-window any &optional sub-only) + "Helper function for `walk-window-tree' and `walk-window-subtree'." + (let (walk-window-tree-buffer) + (while walk-window-tree-window + (setq walk-window-tree-buffer + (window-buffer walk-window-tree-window)) + (when (or walk-window-tree-buffer any) + (funcall proc walk-window-tree-window)) + (unless walk-window-tree-buffer + (walk-window-tree-1 + proc (window-hchild walk-window-tree-window) any) + (walk-window-tree-1 + proc (window-vchild walk-window-tree-window) any)) + (if sub-only + (setq walk-window-tree-window nil) + (setq walk-window-tree-window + (window-right walk-window-tree-window)))))) + +(defun walk-window-tree (proc &optional frame any) + "Run function PROC on each live window of FRAME. +PROC must be a function with one argument - a window. FRAME must +be a live frame and defaults to the selected one. ANY, if +non-nil means to run PROC on all live and internal windows of +FRAME. + +This function performs a pre-order, depth-first traversal of the +window tree. If PROC changes the window tree, the result is +unpredictable." + (let ((walk-window-tree-frame (normalize-live-frame frame))) + (walk-window-tree-1 + proc (frame-root-window walk-window-tree-frame) any))) + +(defun walk-window-subtree (proc &optional window any) + "Run function PROC on each live subwindow of WINDOW. +WINDOW defaults to the selected window. PROC must be a function +with one argument - a window. ANY, if non-nil means to run PROC +on all live and internal subwindows of WINDOW. + +This function performs a pre-order, depth-first traversal of the +window tree rooted at WINDOW. If PROC changes that window tree, +the result is unpredictable." + (setq window (normalize-any-window window)) + (walk-window-tree-1 proc window any t)) + +(defun windows-with-parameter (parameter &optional value frame any values) + "Return a list of all windows on FRAME with PARAMETER non-nil. +FRAME defaults to the selected frame. Optional argument VALUE +non-nil means only return windows whose window-parameter value of +PARAMETER equals VALUE \(comparison is done using `equal'). +Optional argument ANY non-nil means consider internal windows +too. Optional argument VALUES non-nil means return a list of cons +cells whose car is the value of the parameter and whose cdr is +the window." + (let (this-value windows) + (walk-window-tree + (lambda (window) + (when (and (setq this-value (window-parameter window parameter)) + (or (not value) (or (equal value this-value)))) + (setq windows + (if values + (cons (cons this-value window) windows) + (cons window windows))))) + frame any) + + (nreverse windows))) + +(defun window-with-parameter (parameter &optional value frame any) + "Return first window on FRAME with PARAMETER non-nil. +FRAME defaults to the selected frame. Optional argument VALUE +non-nil means only return a window whose window-parameter value +for PARAMETER equals VALUE \(comparison is done with `equal'). +Optional argument ANY non-nil means consider internal windows +too." + (let (this-value windows) + (catch 'found + (walk-window-tree + (lambda (window) + (when (and (setq this-value (window-parameter window parameter)) + (or (not value) (equal value this-value))) + (throw 'found window))) + frame any)))) + +;;; Atomic windows. +(defun window-atom-root (&optional window) + "Return root of atomic window WINDOW is a part of. +WINDOW can be any window and defaults to the selected one. +Return nil if WINDOW is not part of a atomic window." + (setq window (normalize-any-window window)) + (let (root) + (while (and window (window-parameter window 'window-atom)) + (setq root window) + (setq window (window-parent window))) + root)) + +(defun make-window-atom (window) + "Make WINDOW an atomic window. +WINDOW must be an internal window. Return WINDOW." + (if (not (window-child window)) + (error "Window %s is not an internal window" window) + (walk-window-subtree + (lambda (window) + (set-window-parameter window 'window-atom t)) + window t) + window)) + +(defun window-atom-check-1 (window) + "Subroutine of `window-atom-check'." + (when window + (if (window-parameter window 'window-atom) + (let ((count 0)) + (when (or (catch 'reset + (walk-window-subtree + (lambda (window) + (if (window-parameter window 'window-atom) + (setq count (1+ count)) + (throw 'reset t))) + window t)) + ;; count >= 1 must hold here. If there's no other + ;; window around dissolve this atomic window. + (= count 1)) + ;; Dissolve atomic window. + (walk-window-subtree + (lambda (window) + (set-window-parameter window 'window-atom nil)) + window t))) + ;; Check children. + (unless (window-buffer window) + (window-atom-check-1 (window-hchild window)) + (window-atom-check-1 (window-vchild window)))) + ;; Check right sibling + (window-atom-check-1 (window-right window)))) + +(defun window-atom-check (&optional frame) + "Check atomicity of all windows on FRAME. +FRAME defaults to the selected frame. If an atomic window is +wrongly configured, reset the atomicity of all its subwindows to +nil. An atomic window is wrongly configured if it has no +subwindows or one of its subwindows is not atomic." + (window-atom-check-1 (frame-root-window frame))) + +;; Side windows. +(defvar window-sides '(left top right bottom) + "Window sides.") + +(defcustom window-sides-vertical nil + "If non-nil, left and right side windows are full height. +Otherwise, top and bottom side windows are full width." + :type 'boolean + :group 'windows + :version "24.1") + +(defcustom window-sides-slots '(nil nil nil nil) + "Maximum number of side window slots. +The value is a list of four elements specifying the number of +side window slots on \(in this order) the left, top, right and +bottom side of each frame. If an element is a number, this means +to display at most that many side windows on the corresponding +side. If an element is nil, this means there's no bound on the +number of slots on that side." + :risky t + :type + '(list + :value (nil nil nil nil) + (choice + :tag "Left" + :help-echo "Maximum slots of left side window." + :value nil + :format "%[Left%] %v\n" + (const :tag "Unlimited" :format "%t" nil) + (integer :tag "Number" :value 2 :size 5)) + (choice + :tag "Top" + :help-echo "Maximum slots of top side window." + :value nil + :format "%[Top%] %v\n" + (const :tag "Unlimited" :format "%t" nil) + (integer :tag "Number" :value 3 :size 5)) + (choice + :tag "Right" + :help-echo "Maximum slots of right side window." + :value nil + :format "%[Right%] %v\n" + (const :tag "Unlimited" :format "%t" nil) + (integer :tag "Number" :value 2 :size 5)) + (choice + :tag "Bottom" + :help-echo "Maximum slots of bottom side window." + :value nil + :format "%[Bottom%] %v\n" + (const :tag "Unlimited" :format "%t" nil) + (integer :tag "Number" :value 3 :size 5))) + :group 'windows) + +(defun window-side-check (&optional frame) + "Check the window-side parameter of all windows on FRAME. +FRAME defaults to the selected frame. If the configuration is +invalid, reset all window-side parameters to nil. + +A valid configuration has to preserve the following invariant: + +- If a window has a non-nil window-side parameter, it must have a + parent window and the parent window's window-side parameter + must be either nil or the same as for window. + +- If windows with non-nil window-side parameters exist, there + must be at most one window of each side and non-side with a + parent whose window-side parameter is nil and there must be no + leaf window whose window-side parameter is nil." + (let (normal none left top right bottom + side parent parent-side code) + (when (or (catch 'reset + (walk-window-tree + (lambda (window) + (setq side (window-parameter window 'window-side)) + (setq parent (window-parent window)) + (setq parent-side + (and parent (window-parameter parent 'window-side))) + ;; The following `cond' seems a bit tedious, but I'd + ;; rather stick to using just the stack. + (cond + (parent-side + (when (not (eq parent-side side)) + ;; A parent whose window-side is non-nil must + ;; have a child with the same window-side. + (throw 'reset t))) + ;; Now check that there's more than one main window + ;; for any of none, left, top, right and bottom. + ((eq side 'none) + (if none + (throw 'reset t) + (setq none t))) + ((eq side 'left) + (if left + (throw 'reset t) + (setq left t))) + ((eq side 'top) + (if top + (throw 'reset t) + (setq top t))) + ((eq side 'right) + (if right + (throw 'reset t) + (setq right t))) + ((eq side 'bottom) + (if bottom + (throw 'reset t) + (setq bottom t))) + ((window-buffer window) + ;; A leaf window without window-side parameter, + ;; record its existence. + (setq normal t)))) + frame t)) + (if none + ;; At least one non-side window exists, so there must + ;; be at least one side-window and no normal window. + (or (not (or left top right bottom)) normal) + ;; No non-side window exists, so there must be no side + ;; window either. + (or left top right bottom))) + (walk-window-tree + (lambda (window) + (set-window-parameter window 'window-side nil)) + frame t)))) + +(defun window-check (&optional frame) + "Check atomic and side windows on FRAME. +FRAME defaults to the selected frame." + (window-side-check frame) + (window-atom-check frame)) + +;;; Window sizes. +(defvar window-size-fixed nil + "Non-nil in a buffer means windows displaying the buffer are fixed-size. +If the value is `height', then only the window's height is fixed. +If the value is `width', then only the window's width is fixed. +Any other non-nil value fixes both the width and the height. + +Emacs won't change the size of any window displaying that buffer, +unless it has no other choice \(like when deleting a neighboring +window).") +(make-variable-buffer-local 'window-size-fixed) + (defun window-body-height (&optional window) "Return number of lines in WINDOW available for actual buffer text. WINDOW defaults to the selected window. ------------------------------------------------------------ revno: 104511 committer: martin rudalics branch nick: trunk timestamp: Mon 2011-06-06 15:57:49 +0200 message: Move some window-related functions from frame.c to window.c. * lisp.h: Move EXFUNS for Fframe_root_window, Fframe_first_window and Fset_frame_selected_window to window.h. * window.h: Move EXFUNS for Fframe_root_window, Fframe_first_window and Fset_frame_selected_window here from lisp.h. * frame.c (Fwindow_frame, Fframe_first_window) (Fframe_root_window, Fframe_selected_window) (Fset_frame_selected_window): Move to window.c. (Factive_minibuffer_window): Move to minibuf.c. (Fother_visible_frames_p): New function. * minibuf.c (Factive_minibuffer_window): Move here from frame.c. * window.c (Fwindow_frame): Move here from frame.c. Accept any window as argument. (Fframe_root_window, Fframe_first_window) (Fframe_selected_window): Move here from frame.c. Accept frame or arbitrary window as argument. Update doc-strings. (Fminibuffer_window): Move up in code. (Fwindow_minibuffer_p): Move up in code and simplify. (Fset_frame_selected_window): Move here from frame.c. Marginal rewrite. (Fselected_window, select_window, Fselect_window): Move up in code. Minor doc-string fixes. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-06 09:09:42 +0000 +++ src/ChangeLog 2011-06-06 13:57:49 +0000 @@ -1,11 +1,37 @@ 2011-06-06 Martin Rudalics + * lisp.h: Move EXFUNS for Fframe_root_window, + Fframe_first_window and Fset_frame_selected_window to window.h. + + * window.h: Move EXFUNS for Fframe_root_window, + Fframe_first_window and Fset_frame_selected_window here from + lisp.h. + + * frame.c (Fwindow_frame, Fframe_first_window) + (Fframe_root_window, Fframe_selected_window) + (Fset_frame_selected_window): Move to window.c. + (Factive_minibuffer_window): Move to minibuf.c. + (Fother_visible_frames_p): New function. + + * minibuf.c (Factive_minibuffer_window): Move here from frame.c. + * window.c (decode_window, decode_any_window): Move up in code. (Fwindowp, Fwindow_live_p): Rewrite doc-strings. (inhibit_frame_unsplittable): Remove unused variable. (Fwindow_buffer): Move up and rewrite doc-string. (Fwindow_parent, Fwindow_vchild, Fwindow_hchild, Fwindow_next) (Fwindow_prev): New functions. + (Fwindow_frame): Move here from frame.c. Accept any window as + argument. + (Fframe_root_window, Fframe_first_window) + (Fframe_selected_window): Move here from frame.c. Accept frame + or arbitrary window as argument. Update doc-strings. + (Fminibuffer_window): Move up in code. + (Fwindow_minibuffer_p): Move up in code and simplify. + (Fset_frame_selected_window): Move here from frame.c. Marginal + rewrite. + (Fselected_window, select_window, Fselect_window): Move up in + code. Minor doc-string fixes. 2011-06-06 Paul Eggert === modified file 'src/frame.c' --- src/frame.c 2011-05-31 14:52:10 +0000 +++ src/frame.c 2011-06-06 13:57:49 +0000 @@ -904,111 +904,6 @@ return selected_frame; } -DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0, - doc: /* Return the frame object that window WINDOW is on. */) - (Lisp_Object window) -{ - CHECK_LIVE_WINDOW (window); - return XWINDOW (window)->frame; -} - -DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0, - doc: /* Returns the topmost, leftmost window of FRAME. -If omitted, FRAME defaults to the currently selected frame. */) - (Lisp_Object frame) -{ - Lisp_Object w; - - if (NILP (frame)) - w = SELECTED_FRAME ()->root_window; - else - { - CHECK_LIVE_FRAME (frame); - w = XFRAME (frame)->root_window; - } - while (NILP (XWINDOW (w)->buffer)) - { - if (! NILP (XWINDOW (w)->hchild)) - w = XWINDOW (w)->hchild; - else if (! NILP (XWINDOW (w)->vchild)) - w = XWINDOW (w)->vchild; - else - abort (); - } - return w; -} - -DEFUN ("active-minibuffer-window", Factive_minibuffer_window, - Sactive_minibuffer_window, 0, 0, 0, - doc: /* Return the currently active minibuffer window, or nil if none. */) - (void) -{ - return minibuf_level ? minibuf_window : Qnil; -} - -DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0, - doc: /* Returns the root-window of FRAME. -If omitted, FRAME defaults to the currently selected frame. */) - (Lisp_Object frame) -{ - Lisp_Object window; - - if (NILP (frame)) - window = SELECTED_FRAME ()->root_window; - else - { - CHECK_LIVE_FRAME (frame); - window = XFRAME (frame)->root_window; - } - - return window; -} - -DEFUN ("frame-selected-window", Fframe_selected_window, - Sframe_selected_window, 0, 1, 0, - doc: /* Return the selected window of FRAME. -FRAME defaults to the currently selected frame. */) - (Lisp_Object frame) -{ - Lisp_Object window; - - if (NILP (frame)) - window = SELECTED_FRAME ()->selected_window; - else - { - CHECK_LIVE_FRAME (frame); - window = XFRAME (frame)->selected_window; - } - - return window; -} - -DEFUN ("set-frame-selected-window", Fset_frame_selected_window, - Sset_frame_selected_window, 2, 3, 0, - doc: /* Set selected window of FRAME to WINDOW. -If FRAME is nil, use the selected frame. If FRAME is the -selected frame, this makes WINDOW the selected window. -Optional argument NORECORD non-nil means to neither change the -order of recently selected windows nor the buffer list. -Return WINDOW. */) - (Lisp_Object frame, Lisp_Object window, Lisp_Object norecord) -{ - if (NILP (frame)) - frame = selected_frame; - - CHECK_LIVE_FRAME (frame); - CHECK_LIVE_WINDOW (window); - - if (! EQ (frame, WINDOW_FRAME (XWINDOW (window)))) - error ("In `set-frame-selected-window', WINDOW is not on FRAME"); - - if (EQ (frame, selected_frame)) - return Fselect_window (window, norecord); - - return XFRAME (frame)->selected_window = window; -} - - DEFUN ("frame-list", Fframe_list, Sframe_list, 0, 0, 0, doc: /* Return a list of all live frames. */) @@ -1265,6 +1160,17 @@ return 1; } +DEFUN ("other-visible-frames-p", Fother_visible_frames_p, Sother_visible_frames_p, 0, 1, 0, + doc: /* Return t if there are other visible frames beside FRAME. +FRAME defaults to the selected frame. */) + (Lisp_Object frame) +{ + if (NILP (frame)) + frame = selected_frame; + CHECK_LIVE_FRAME (frame); + return other_visible_frames (XFRAME (frame)) ? Qt : Qnil; +} + /* Delete FRAME. When FORCE equals Qnoelisp, delete FRAME unconditionally. x_connection_closed and delete_terminal use this. Any other value of FORCE implements the semantics @@ -4605,7 +4511,6 @@ staticpro (&Vframe_list); - defsubr (&Sactive_minibuffer_window); defsubr (&Sframep); defsubr (&Sframe_live_p); defsubr (&Swindow_system); @@ -4613,14 +4518,10 @@ defsubr (&Shandle_switch_frame); defsubr (&Sselect_frame); defsubr (&Sselected_frame); - defsubr (&Swindow_frame); - defsubr (&Sframe_root_window); - defsubr (&Sframe_first_window); - defsubr (&Sframe_selected_window); - defsubr (&Sset_frame_selected_window); defsubr (&Sframe_list); defsubr (&Snext_frame); defsubr (&Sprevious_frame); + defsubr (&Sother_visible_frames_p); defsubr (&Sdelete_frame); defsubr (&Smouse_position); defsubr (&Smouse_pixel_position); === modified file 'src/lisp.h' --- src/lisp.h 2011-06-02 08:25:28 +0000 +++ src/lisp.h 2011-06-06 13:57:49 +0000 @@ -3181,16 +3181,12 @@ extern Lisp_Object frame_buffer_predicate (Lisp_Object); EXFUN (Fselect_frame, 2); EXFUN (Fselected_frame, 0); -EXFUN (Fwindow_frame, 1); -EXFUN (Fframe_root_window, 1); -EXFUN (Fframe_first_window, 1); EXFUN (Fmake_frame_visible, 1); EXFUN (Ficonify_frame, 1); EXFUN (Fframe_parameter, 2); EXFUN (Fmodify_frame_parameters, 2); EXFUN (Fraise_frame, 1); EXFUN (Fredirect_frame_focus, 2); -EXFUN (Fset_frame_selected_window, 3); extern Lisp_Object frame_buffer_list (Lisp_Object); extern void frames_discard_buffer (Lisp_Object); extern void set_frame_buffer_list (Lisp_Object, Lisp_Object); === modified file 'src/minibuf.c' --- src/minibuf.c 2011-06-02 08:25:28 +0000 +++ src/minibuf.c 2011-06-06 13:57:49 +0000 @@ -143,6 +143,14 @@ return Qnil; } +DEFUN ("active-minibuffer-window", Factive_minibuffer_window, + Sactive_minibuffer_window, 0, 0, 0, + doc: /* Return the currently active minibuffer window, or nil if none. */) + (void) +{ + return minibuf_level ? minibuf_window : Qnil; +} + DEFUN ("set-minibuffer-window", Fset_minibuffer_window, Sset_minibuffer_window, 1, 1, 0, doc: /* Specify which minibuffer window to use for the minibuffer. @@ -2181,6 +2189,7 @@ doc: /* Minibuffer keymap used for reading Lisp expressions. */); Vread_expression_map = Qnil; + defsubr (&Sactive_minibuffer_window); defsubr (&Sset_minibuffer_window); defsubr (&Sread_from_minibuffer); defsubr (&Seval_minibuffer); === modified file 'src/window.c' --- src/window.c 2011-06-06 09:09:42 +0000 +++ src/window.c 2011-06-06 13:57:49 +0000 @@ -168,7 +168,248 @@ { return WINDOW_LIVE_P (object) ? Qt : Qnil; } - + +/* Frames and windows. */ +DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0, + doc: /* Return the frame that window WINDOW is on. +WINDOW can be any window and defaults to the selected one. */) + (Lisp_Object window) +{ + return decode_any_window (window)->frame; +} + +DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0, + doc: /* Return the root window of FRAME_OR_WINDOW. +If omitted, FRAME_OR_WINDOW defaults to the currently selected frame. +Else if FRAME_OR_WINDOW denotes any window, return the root window of +that window's frame. If FRAME_OR_WINDOW denotes a live frame, return +the root window of that frame. */) + (Lisp_Object frame_or_window) +{ + Lisp_Object window; + + if (NILP (frame_or_window)) + window = SELECTED_FRAME ()->root_window; + else if (WINDOWP (frame_or_window)) + window = XFRAME (WINDOW_FRAME (XWINDOW (frame_or_window)))->root_window; + else + { + CHECK_LIVE_FRAME (frame_or_window); + window = XFRAME (frame_or_window)->root_window; + } + + return window; +} + +DEFUN ("minibuffer-window", Fminibuffer_window, Sminibuffer_window, 0, 1, 0, + doc: /* Return the window used now for minibuffers. +If the optional argument FRAME is specified, return the minibuffer window +used by that frame. */) + (Lisp_Object frame) +{ + if (NILP (frame)) + frame = selected_frame; + CHECK_LIVE_FRAME (frame); + return FRAME_MINIBUF_WINDOW (XFRAME (frame)); +} + +DEFUN ("window-minibuffer-p", Fwindow_minibuffer_p, + Swindow_minibuffer_p, 0, 1, 0, + doc: /* Return non-nil if WINDOW is a minibuffer window. +WINDOW can be any window and defaults to the selected one. */) + (Lisp_Object window) +{ + return MINI_WINDOW_P (decode_any_window (window)) ? Qt : Qnil; +} + +/* Don't move this to window.el - this must be a safe routine. */ +DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0, + doc: /* Return the topmost, leftmost live window on FRAME_OR_WINDOW. +If omitted, FRAME_OR_WINDOW defaults to the currently selected frame. +Else if FRAME_OR_WINDOW denotes any window, return the first window of +that window's frame. If FRAME_OR_WINDOW denotes a live frame, return +the first window of that frame. */) + (Lisp_Object frame_or_window) +{ + Lisp_Object window; + + if (NILP (frame_or_window)) + window = SELECTED_FRAME ()->root_window; + else if (WINDOWP (frame_or_window)) + window = XFRAME (WINDOW_FRAME (XWINDOW (frame_or_window)))->root_window; + else + { + CHECK_LIVE_FRAME (frame_or_window); + window = XFRAME (frame_or_window)->root_window; + } + + while (NILP (XWINDOW (window)->buffer)) + { + if (! NILP (XWINDOW (window)->hchild)) + window = XWINDOW (window)->hchild; + else if (! NILP (XWINDOW (window)->vchild)) + window = XWINDOW (window)->vchild; + else + abort (); + } + + return window; +} + +DEFUN ("frame-selected-window", Fframe_selected_window, + Sframe_selected_window, 0, 1, 0, + doc: /* Return the selected window of FRAME_OR_WINDOW. +If omitted, FRAME_OR_WINDOW defaults to the currently selected frame. +Else if FRAME_OR_WINDOW denotes any window, return the selected window +of that window's frame. If FRAME_OR_WINDOW denotes a live frame, return +the selected window of that frame. */) + (Lisp_Object frame_or_window) +{ + Lisp_Object window; + + if (NILP (frame_or_window)) + window = SELECTED_FRAME ()->selected_window; + else if (WINDOWP (frame_or_window)) + window = XFRAME (WINDOW_FRAME (XWINDOW (frame_or_window)))->selected_window; + else + { + CHECK_LIVE_FRAME (frame_or_window); + window = XFRAME (frame_or_window)->selected_window; + } + + return window; +} + +DEFUN ("set-frame-selected-window", Fset_frame_selected_window, + Sset_frame_selected_window, 2, 3, 0, + doc: /* Set selected window of FRAME to WINDOW. +FRAME must be a live frame and defaults to the selected one. If FRAME +is the selected frame, this makes WINDOW the selected window. Optional +argument NORECORD non-nil means to neither change the order of recently +selected windows nor the buffer list. WINDOW must denote a live window. +Return WINDOW. */) + (Lisp_Object frame, Lisp_Object window, Lisp_Object norecord) +{ + if (NILP (frame)) + frame = selected_frame; + + CHECK_LIVE_FRAME (frame); + CHECK_LIVE_WINDOW (window); + + if (! EQ (frame, WINDOW_FRAME (XWINDOW (window)))) + error ("In `set-frame-selected-window', WINDOW is not on FRAME"); + + if (EQ (frame, selected_frame)) + return Fselect_window (window, norecord); + else + return XFRAME (frame)->selected_window = window; +} + +DEFUN ("selected-window", Fselected_window, Sselected_window, 0, 0, 0, + doc: /* Return the selected window. +The selected window is the window in which the standard cursor for +selected windows appears and to which many commands apply. */) + (void) +{ + return selected_window; +} + +/* If select_window is called with inhibit_point_swap non-zero it will + not store point of the old selected window's buffer back into that + window's pointm slot. This is needed by Fset_window_configuration to + avoid that the display routine is called with selected_window set to + Qnil causing a subsequent crash. */ +static Lisp_Object +select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap) +{ + register struct window *w; + register struct window *ow; + struct frame *sf; + + CHECK_LIVE_WINDOW (window); + + w = XWINDOW (window); + w->frozen_window_start_p = 0; + + if (NILP (norecord)) + { + ++window_select_count; + XSETFASTINT (w->use_time, window_select_count); + record_buffer (w->buffer); + } + + if (EQ (window, selected_window) && !inhibit_point_swap) + return window; + + sf = SELECTED_FRAME (); + if (XFRAME (WINDOW_FRAME (w)) != sf) + { + XFRAME (WINDOW_FRAME (w))->selected_window = window; + /* Use this rather than Fhandle_switch_frame + so that FRAME_FOCUS_FRAME is moved appropriately as we + move around in the state where a minibuffer in a separate + frame is active. */ + Fselect_frame (WINDOW_FRAME (w), norecord); + /* Fselect_frame called us back so we've done all the work already. */ + eassert (EQ (window, selected_window)); + return window; + } + else + sf->selected_window = window; + + /* Store the current buffer's actual point into the + old selected window. It belongs to that window, + and when the window is not selected, must be in the window. */ + if (!inhibit_point_swap) + { + ow = XWINDOW (selected_window); + if (! NILP (ow->buffer)) + set_marker_both (ow->pointm, ow->buffer, + BUF_PT (XBUFFER (ow->buffer)), + BUF_PT_BYTE (XBUFFER (ow->buffer))); + } + + selected_window = window; + + Fset_buffer (w->buffer); + + BVAR (XBUFFER (w->buffer), last_selected_window) = window; + + /* Go to the point recorded in the window. + This is important when the buffer is in more + than one window. It also matters when + redisplay_window has altered point after scrolling, + because it makes the change only in the window. */ + { + register EMACS_INT new_point = marker_position (w->pointm); + if (new_point < BEGV) + SET_PT (BEGV); + else if (new_point > ZV) + SET_PT (ZV); + else + SET_PT (new_point); + } + + windows_or_buffers_changed++; + return window; +} + +DEFUN ("select-window", Fselect_window, Sselect_window, 1, 2, 0, + doc: /* Select WINDOW. Most editing will apply to WINDOW's buffer. +Also make WINDOW's buffer current and make WINDOW the frame's selected +window. Return WINDOW. + +Optional second arg NORECORD non-nil means do not put this buffer at the +front of the buffer list and do not make this window the most recently +selected one. + +Note that the main editor command loop sets the current buffer to the +buffer of the selected window before each command. */) + (register Lisp_Object window, Lisp_Object norecord) +{ + return select_window (window, norecord, 0); +} + DEFUN ("window-buffer", Fwindow_buffer, Swindow_buffer, 0, 1, 0, doc: /* Return the buffer that WINDOW is displaying. WINDOW can be any window and defaults to the selected one. @@ -276,36 +517,6 @@ return val; } -DEFUN ("selected-window", Fselected_window, Sselected_window, 0, 0, 0, - doc: /* Return the window that the cursor now appears in and commands apply to. */) - (void) -{ - return selected_window; -} - -DEFUN ("minibuffer-window", Fminibuffer_window, Sminibuffer_window, 0, 1, 0, - doc: /* Return the window used now for minibuffers. -If the optional argument FRAME is specified, return the minibuffer window -used by that frame. */) - (Lisp_Object frame) -{ - if (NILP (frame)) - frame = selected_frame; - CHECK_LIVE_FRAME (frame); - return FRAME_MINIBUF_WINDOW (XFRAME (frame)); -} - -DEFUN ("window-minibuffer-p", Fwindow_minibuffer_p, - Swindow_minibuffer_p, 0, 1, 0, - doc: /* Return non-nil if WINDOW is a minibuffer window. -WINDOW defaults to the selected window. */) - (Lisp_Object window) -{ - struct window *w = decode_window (window); - return MINI_WINDOW_P (w) ? Qt : Qnil; -} - - DEFUN ("pos-visible-in-window-p", Fpos_visible_in_window_p, Spos_visible_in_window_p, 0, 3, 0, doc: /* Return non-nil if position POS is currently on the frame in WINDOW. @@ -3527,106 +3738,6 @@ return Qnil; } -/* If select_window is called with inhibit_point_swap non-zero it will - not store point of the old selected window's buffer back into that - window's pointm slot. This is needed by Fset_window_configuration to - avoid that the display routine is called with selected_window set to - Qnil causing a subsequent crash. */ - -static Lisp_Object -select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap) -{ - register struct window *w; - register struct window *ow; - struct frame *sf; - - CHECK_LIVE_WINDOW (window); - - w = XWINDOW (window); - w->frozen_window_start_p = 0; - - if (NILP (norecord)) - { - ++window_select_count; - XSETFASTINT (w->use_time, window_select_count); - record_buffer (w->buffer); - } - - if (EQ (window, selected_window) && !inhibit_point_swap) - return window; - - sf = SELECTED_FRAME (); - if (XFRAME (WINDOW_FRAME (w)) != sf) - { - XFRAME (WINDOW_FRAME (w))->selected_window = window; - /* Use this rather than Fhandle_switch_frame - so that FRAME_FOCUS_FRAME is moved appropriately as we - move around in the state where a minibuffer in a separate - frame is active. */ - Fselect_frame (WINDOW_FRAME (w), norecord); - /* Fselect_frame called us back so we've done all the work already. */ - eassert (EQ (window, selected_window)); - return window; - } - else - sf->selected_window = window; - - /* Store the current buffer's actual point into the - old selected window. It belongs to that window, - and when the window is not selected, must be in the window. */ - if (!inhibit_point_swap) - { - ow = XWINDOW (selected_window); - if (! NILP (ow->buffer)) - set_marker_both (ow->pointm, ow->buffer, - BUF_PT (XBUFFER (ow->buffer)), - BUF_PT_BYTE (XBUFFER (ow->buffer))); - } - - selected_window = window; - - Fset_buffer (w->buffer); - - BVAR (XBUFFER (w->buffer), last_selected_window) = window; - - /* Go to the point recorded in the window. - This is important when the buffer is in more - than one window. It also matters when - redisplay_window has altered point after scrolling, - because it makes the change only in the window. */ - { - register EMACS_INT new_point = marker_position (w->pointm); - if (new_point < BEGV) - SET_PT (BEGV); - else if (new_point > ZV) - SET_PT (ZV); - else - SET_PT (new_point); - } - - windows_or_buffers_changed++; - return window; -} - - -/* Note that selected_window can be nil when this is called from - Fset_window_configuration. */ - -DEFUN ("select-window", Fselect_window, Sselect_window, 1, 2, 0, - doc: /* Select WINDOW. Most editing will apply to WINDOW's buffer. -If WINDOW is not already selected, make WINDOW's buffer current -and make WINDOW the frame's selected window. Return WINDOW. -Optional second arg NORECORD non-nil means do not put this buffer -at the front of the list of recently selected ones and do not -make this window the most recently selected one. - -Note that the main editor command loop selects the buffer of the -selected window before each command. */) - (register Lisp_Object window, Lisp_Object norecord) -{ - return select_window (window, norecord, 0); -} - static Lisp_Object select_window_norecord (Lisp_Object window) { @@ -7156,6 +7267,11 @@ defsubr (&Swindow_minibuffer_p); defsubr (&Swindowp); defsubr (&Swindow_live_p); + defsubr (&Swindow_frame); + defsubr (&Sframe_root_window); + defsubr (&Sframe_first_window); + defsubr (&Sframe_selected_window); + defsubr (&Sset_frame_selected_window); defsubr (&Spos_visible_in_window_p); defsubr (&Swindow_line_height); defsubr (&Swindow_buffer); === modified file 'src/window.h' --- src/window.h 2011-05-12 07:07:06 +0000 +++ src/window.h 2011-06-06 13:57:49 +0000 @@ -844,11 +844,14 @@ extern Lisp_Object Qwindowp, Qwindow_live_p; extern Lisp_Object Vwindow_list; +EXFUN (Fwindow_buffer, 1); +EXFUN (Fget_buffer_window, 2); +EXFUN (Fwindow_minibuffer_p, 1); EXFUN (Fselected_window, 0); -EXFUN (Fwindow_minibuffer_p, 1); +EXFUN (Fframe_root_window, 1); +EXFUN (Fframe_first_window, 1); +EXFUN (Fset_frame_selected_window, 3); EXFUN (Fdelete_window, 1); -EXFUN (Fwindow_buffer, 1); -EXFUN (Fget_buffer_window, 2); EXFUN (Fset_window_configuration, 1); EXFUN (Fcurrent_window_configuration, 1); extern int compare_window_configurations (Lisp_Object, Lisp_Object, int); ------------------------------------------------------------ revno: 104510 committer: martin rudalics branch nick: trunk timestamp: Mon 2011-06-06 11:09:42 +0200 message: Expose window-tree functions in Elisp. (Fwindow_buffer): Move up and rewrite doc-string. (Fwindow_parent, Fwindow_vchild, Fwindow_hchild, Fwindow_next) (Fwindow_prev): New functions. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-06 08:13:36 +0000 +++ src/ChangeLog 2011-06-06 09:09:42 +0000 @@ -3,6 +3,9 @@ * window.c (decode_window, decode_any_window): Move up in code. (Fwindowp, Fwindow_live_p): Rewrite doc-strings. (inhibit_frame_unsplittable): Remove unused variable. + (Fwindow_buffer): Move up and rewrite doc-string. + (Fwindow_parent, Fwindow_vchild, Fwindow_hchild, Fwindow_next) + (Fwindow_prev): New functions. 2011-06-06 Paul Eggert === modified file 'src/window.c' --- src/window.c 2011-06-06 08:13:36 +0000 +++ src/window.c 2011-06-06 09:09:42 +0000 @@ -169,6 +169,60 @@ return WINDOW_LIVE_P (object) ? Qt : Qnil; } +DEFUN ("window-buffer", Fwindow_buffer, Swindow_buffer, 0, 1, 0, + doc: /* Return the buffer that WINDOW is displaying. +WINDOW can be any window and defaults to the selected one. +If WINDOW is an internal window return nil. */) + (Lisp_Object window) +{ + return decode_any_window (window)->buffer; +} + +DEFUN ("window-parent", Fwindow_parent, Swindow_parent, 0, 1, 0, + doc: /* Return WINDOW's parent window. +WINDOW can be any window and defaults to the selected one. +Return nil if WINDOW has no parent. */) + (Lisp_Object window) +{ + return decode_any_window (window)->parent; +} + +DEFUN ("window-vchild", Fwindow_vchild, Swindow_vchild, 0, 1, 0, + doc: /* Return WINDOW's first vertical child window. +WINDOW can be any window and defaults to the selected one. +Return nil if WINDOW has no vertical child. */) + (Lisp_Object window) +{ + return decode_any_window (window)->vchild; +} + +DEFUN ("window-hchild", Fwindow_hchild, Swindow_hchild, 0, 1, 0, + doc: /* Return WINDOW's first horizontal child window. +WINDOW can be any window and defaults to the selected one. +Return nil if WINDOW has no horizontal child. */) + (Lisp_Object window) +{ + return decode_any_window (window)->hchild; +} + +DEFUN ("window-next", Fwindow_next, Swindow_next, 0, 1, 0, + doc: /* Return WINDOW's right sibling window. +WINDOW can be any window and defaults to the selected one. +Return nil if WINDOW has no right sibling. */) + (Lisp_Object window) +{ + return decode_any_window (window)->next; +} + +DEFUN ("window-prev", Fwindow_prev, Swindow_prev, 0, 1, 0, + doc: /* Return WINDOW's left sibling window. +WINDOW can be any window and defaults to the selected one. +Return nil if WINDOW has no left sibling. */) + (Lisp_Object window) +{ + return decode_any_window (window)->prev; +} + Lisp_Object make_window (void) { @@ -429,14 +483,6 @@ -DEFUN ("window-buffer", Fwindow_buffer, Swindow_buffer, 0, 1, 0, - doc: /* Return the buffer that WINDOW is displaying. -WINDOW defaults to the selected window. */) - (Lisp_Object window) -{ - return decode_window (window)->buffer; -} - DEFUN ("window-height", Fwindow_height, Swindow_height, 0, 1, 0, doc: /* Return the number of lines in WINDOW. WINDOW defaults to the selected window. @@ -7113,6 +7159,11 @@ defsubr (&Spos_visible_in_window_p); defsubr (&Swindow_line_height); defsubr (&Swindow_buffer); + defsubr (&Swindow_parent); + defsubr (&Swindow_vchild); + defsubr (&Swindow_hchild); + defsubr (&Swindow_next); + defsubr (&Swindow_prev); defsubr (&Swindow_height); defsubr (&Swindow_width); defsubr (&Swindow_full_width_p); ------------------------------------------------------------ revno: 104509 committer: martin rudalics branch nick: trunk timestamp: Mon 2011-06-06 10:13:36 +0200 message: Prepare for exposing window-tree functions in Elisp. * window.c (decode_window, decode_any_window): Move up in code. (Fwindowp, Fwindow_live_p): Rewrite doc-strings. (inhibit_frame_unsplittable): Remove unused variable. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-06 04:54:23 +0000 +++ src/ChangeLog 2011-06-06 08:13:36 +0000 @@ -1,3 +1,9 @@ +2011-06-06 Martin Rudalics + + * window.c (decode_window, decode_any_window): Move up in code. + (Fwindowp, Fwindow_live_p): Rewrite doc-strings. + (inhibit_frame_unsplittable): Remove unused variable. + 2011-06-06 Paul Eggert * alloc.c (memory_full) [SYSTEM_MALLOC]: Port to MacOS (Bug#8800). === modified file 'src/window.c' --- src/window.c 2011-05-15 17:17:44 +0000 +++ src/window.c 2011-06-06 08:13:36 +0000 @@ -94,71 +94,76 @@ This value is always the same as FRAME_SELECTED_WINDOW (selected_frame). */ - Lisp_Object selected_window; /* A list of all windows for use by next_window and Fwindow_list. Functions creating or deleting windows should invalidate this cache by setting it to nil. */ - Lisp_Object Vwindow_list; /* The mini-buffer window of the selected frame. Note that you cannot test for mini-bufferness of an arbitrary window by comparing against this; but you can test for mini-bufferness of the selected window. */ - Lisp_Object minibuf_window; /* Non-nil means it is the window whose mode line should be shown as the selected window when the minibuffer is selected. */ - Lisp_Object minibuf_selected_window; /* Hook run at end of temp_output_buffer_show. */ - static Lisp_Object Qtemp_buffer_show_hook; /* Incremented for each window created. */ - static int sequence_number; /* Nonzero after init_window_once has finished. */ - static int window_initialized; /* Hook to run when window config changes. */ - static Lisp_Object Qwindow_configuration_change_hook; + /* Incremented by 1 whenever a window is deleted. */ - static int window_deletion_count; /* Used by the function window_scroll_pixel_based */ - static int window_scroll_pixel_based_preserve_x; static int window_scroll_pixel_based_preserve_y; /* Same for window_scroll_line_based. */ - static int window_scroll_preserve_hpos; static int window_scroll_preserve_vpos; - -#if 0 /* This isn't used anywhere. */ -/* Nonzero means we can split a frame even if it is "unsplittable". */ -static int inhibit_frame_unsplittable; -#endif - +static struct window * +decode_window (register Lisp_Object window) +{ + if (NILP (window)) + return XWINDOW (selected_window); + + CHECK_LIVE_WINDOW (window); + return XWINDOW (window); +} + +static struct window * +decode_any_window (register Lisp_Object window) +{ + if (NILP (window)) + return XWINDOW (selected_window); + + CHECK_WINDOW (window); + return XWINDOW (window); +} + DEFUN ("windowp", Fwindowp, Swindowp, 1, 1, 0, - doc: /* Return t if OBJECT is a window. */) + doc: /* Return t if OBJECT is a window and nil otherwise. */) (Lisp_Object object) { return WINDOWP (object) ? Qt : Qnil; } DEFUN ("window-live-p", Fwindow_live_p, Swindow_live_p, 1, 1, 0, - doc: /* Return t if OBJECT is a window which is currently visible. */) + doc: /* Return t if OBJECT is a live window and nil otherwise. +A live window is a window that displays a buffer. */) (Lisp_Object object) { return WINDOW_LIVE_P (object) ? Qt : Qnil; @@ -424,26 +429,6 @@ -static struct window * -decode_window (register Lisp_Object window) -{ - if (NILP (window)) - return XWINDOW (selected_window); - - CHECK_LIVE_WINDOW (window); - return XWINDOW (window); -} - -static struct window * -decode_any_window (register Lisp_Object window) -{ - if (NILP (window)) - return XWINDOW (selected_window); - - CHECK_WINDOW (window); - return XWINDOW (window); -} - DEFUN ("window-buffer", Fwindow_buffer, Swindow_buffer, 0, 1, 0, doc: /* Return the buffer that WINDOW is displaying. WINDOW defaults to the selected window. */) ------------------------------------------------------------ revno: 104508 fixes bug(s): http://debbugs.gnu.org/8800 committer: Paul Eggert branch nick: trunk timestamp: Sun 2011-06-05 21:54:23 -0700 message: * alloc.c (memory_full) [SYSTEM_MALLOC]: Port to MacO). diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-05 22:46:26 +0000 +++ src/ChangeLog 2011-06-06 04:54:23 +0000 @@ -1,3 +1,11 @@ +2011-06-06 Paul Eggert + + * alloc.c (memory_full) [SYSTEM_MALLOC]: Port to MacOS (Bug#8800). + Do not assume that spare memory exists; that assumption is valid + only if SYSTEM_MALLOC. + (LARGE_REQUEST): New macro, so that the issue of large requests + is separated from the issue of spare memory. + 2011-06-05 Andreas Schwab * editfns.c (Fformat): Correctly handle zero flag with hexadecimal === modified file 'src/alloc.c' --- src/alloc.c 2011-06-02 08:35:28 +0000 +++ src/alloc.c 2011-06-06 04:54:23 +0000 @@ -196,6 +196,12 @@ #define SPARE_MEMORY (1 << 14) #endif +#ifdef SYSTEM_MALLOC +# define LARGE_REQUEST (1 << 14) +#else +# define LARGE_REQUEST SPARE_MEMORY +#endif + /* Number of extra blocks malloc should get when it needs more core. */ static int malloc_hysteresis; @@ -3283,15 +3289,12 @@ { /* Do not go into hysterics merely because a large request failed. */ int enough_free_memory = 0; - if (SPARE_MEMORY < nbytes) + if (LARGE_REQUEST < nbytes) { - void *p = malloc (SPARE_MEMORY); + void *p = malloc (LARGE_REQUEST); if (p) { - if (spare_memory[0]) - free (p); - else - spare_memory[0] = p; + free (p); enough_free_memory = 1; } } ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.