Now on revision 113455. ------------------------------------------------------------ revno: 113455 committer: Xue Fuqiao branch nick: trunk timestamp: Fri 2013-07-19 14:31:17 +0800 message: * doc/lispref/windows.texi (Display Action Functions): Mention next-window. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2013-07-16 06:45:01 +0000 +++ doc/lispref/ChangeLog 2013-07-19 06:31:17 +0000 @@ -1,3 +1,7 @@ +2013-07-19 Xue Fuqiao + + * windows.texi (Display Action Functions): Mention next-window. + 2013-07-16 Xue Fuqiao * windows.texi (Selecting Windows): Fix the introduction of === modified file 'doc/lispref/windows.texi' --- doc/lispref/windows.texi 2013-07-16 06:45:01 +0000 +++ doc/lispref/windows.texi 2013-07-19 06:31:17 +0000 @@ -1924,6 +1924,10 @@ A frame means consider windows on that frame only. @end itemize +Note that these meanings differ slightly from those of the +@var{all-frames} argument to @code{next-window} (@pxref{Cyclic Window +Ordering}). + If @var{alist} contains no @code{reusable-frames} entry, this function normally searches just the selected frame; however, if the variable @code{pop-up-frames} is non-@code{nil}, it searches all frames on the ------------------------------------------------------------ revno: 113454 author: Paul Eggert committer: Paul Eggert branch nick: trunk timestamp: Thu 2013-07-18 22:36:50 -0700 message: * sysdep.c [GNU_LINUX]: Fix fd and memory leaks and similar issues. (procfs_ttyname): Don't use uninitialized storage if emacs_fopen or fscanf fails. (system_process_attributes): Prefer plain char to unsigned char when either will do. Clean up properly if interrupted or if memory allocations fail. Don't assume sscanf succeeds. Remove no-longer-needed workaround to stop GCC from whining. Read command-line once, instead of multiple times. Check read status a bit more carefully. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-07-19 01:24:35 +0000 +++ src/ChangeLog 2013-07-19 05:36:50 +0000 @@ -1,5 +1,15 @@ 2013-07-19 Paul Eggert + * sysdep.c [GNU_LINUX]: Fix fd and memory leaks and similar issues. + (procfs_ttyname): Don't use uninitialized storage if emacs_fopen + or fscanf fails. + (system_process_attributes): Prefer plain char to unsigned char + when either will do. Clean up properly if interrupted or if + memory allocations fail. Don't assume sscanf succeeds. Remove + no-longer-needed workaround to stop GCC from whining. Read + command-line once, instead of multiple times. Check read status a + bit more carefully. + Fix obscure porting bug with varargs functions. The code assumed that int is treated like ptrdiff_t in a vararg function, which is not a portable assumption. There was a similar === modified file 'src/sysdep.c' --- src/sysdep.c 2013-07-16 18:30:52 +0000 +++ src/sysdep.c 2013-07-19 05:36:50 +0000 @@ -2807,11 +2807,12 @@ static Lisp_Object procfs_ttyname (int rdev) { - FILE *fdev = NULL; + FILE *fdev; char name[PATH_MAX]; block_input (); fdev = emacs_fopen ("/proc/tty/drivers", "r"); + name[0] = 0; if (fdev) { @@ -2820,7 +2821,7 @@ char minor[25]; /* 2 32-bit numbers + dash */ char *endp; - while (!feof (fdev) && !ferror (fdev)) + for (; !feof (fdev) && !ferror (fdev); name[0] = 0) { if (fscanf (fdev, "%*s %s %u %s %*s\n", name, &major, minor) >= 3 && major == MAJOR (rdev)) @@ -2849,7 +2850,7 @@ static unsigned long procfs_get_total_memory (void) { - FILE *fmem = NULL; + FILE *fmem; unsigned long retval = 2 * 1024 * 1024; /* default: 2GB */ block_input (); @@ -2892,7 +2893,7 @@ int cmdsize = sizeof default_cmd - 1; char *cmdline = NULL; ptrdiff_t cmdline_size; - unsigned char c; + char c; printmax_t proc_id; int ppid, pgrp, sess, tty, tpgid, thcount; uid_t uid; @@ -2903,7 +2904,8 @@ EMACS_TIME tnow, tstart, tboot, telapsed, us_time; double pcpu, pmem; Lisp_Object attrs = Qnil; - Lisp_Object cmd_str, decoded_cmd, tem; + Lisp_Object cmd_str, decoded_cmd; + ptrdiff_t count; struct gcpro gcpro1, gcpro2; CHECK_NUMBER_OR_FLOAT (pid); @@ -2931,11 +2933,19 @@ if (gr) attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); + count = SPECPDL_INDEX (); strcpy (fn, procfn); procfn_end = fn + strlen (fn); strcpy (procfn_end, "/stat"); fd = emacs_open (fn, O_RDONLY, 0); - if (fd >= 0 && (nread = emacs_read (fd, procbuf, sizeof (procbuf) - 1)) > 0) + if (fd < 0) + nread = 0; + else + { + record_unwind_protect_int (close_file_unwind, fd); + nread = emacs_read (fd, procbuf, sizeof procbuf - 1); + } + if (0 < nread) { procbuf[nread] = '\0'; p = procbuf; @@ -2959,39 +2969,32 @@ Vlocale_coding_system, 0); attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs); - if (q) + /* state ppid pgrp sess tty tpgid . minflt cminflt majflt cmajflt + utime stime cutime cstime priority nice thcount . start vsize rss */ + if (q + && (sscanf (q + 2, ("%c %d %d %d %d %d %*u %lu %lu %lu %lu " + "%Lu %Lu %Lu %Lu %ld %ld %d %*d %Lu %lu %ld"), + &c, &ppid, &pgrp, &sess, &tty, &tpgid, + &minflt, &cminflt, &majflt, &cmajflt, + &u_time, &s_time, &cutime, &cstime, + &priority, &niceness, &thcount, &start, &vsize, &rss) + == 20)) { - EMACS_INT ppid_eint, pgrp_eint, sess_eint, tpgid_eint, thcount_eint; - p = q + 2; - /* state ppid pgrp sess tty tpgid . minflt cminflt majflt cmajflt utime stime cutime cstime priority nice thcount . start vsize rss */ - sscanf (p, "%c %d %d %d %d %d %*u %lu %lu %lu %lu %Lu %Lu %Lu %Lu %ld %ld %d %*d %Lu %lu %ld", - &c, &ppid, &pgrp, &sess, &tty, &tpgid, - &minflt, &cminflt, &majflt, &cmajflt, - &u_time, &s_time, &cutime, &cstime, - &priority, &niceness, &thcount, &start, &vsize, &rss); - { - char state_str[2]; - - state_str[0] = c; - state_str[1] = '\0'; - tem = build_string (state_str); - attrs = Fcons (Fcons (Qstate, tem), attrs); - } - /* Stops GCC whining about limited range of data type. */ - ppid_eint = ppid; - pgrp_eint = pgrp; - sess_eint = sess; - tpgid_eint = tpgid; - thcount_eint = thcount; - attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (ppid_eint)), attrs); - attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pgrp_eint)), attrs); - attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (sess_eint)), attrs); + char state_str[2]; + state_str[0] = c; + state_str[1] = '\0'; + attrs = Fcons (Fcons (Qstate, build_string (state_str)), attrs); + attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (ppid)), attrs); + attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pgrp)), attrs); + attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (sess)), attrs); attrs = Fcons (Fcons (Qttname, procfs_ttyname (tty)), attrs); - attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (tpgid_eint)), attrs); + attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (tpgid)), attrs); attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float (minflt)), attrs); attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float (majflt)), attrs); - attrs = Fcons (Fcons (Qcminflt, make_fixnum_or_float (cminflt)), attrs); - attrs = Fcons (Fcons (Qcmajflt, make_fixnum_or_float (cmajflt)), attrs); + attrs = Fcons (Fcons (Qcminflt, make_fixnum_or_float (cminflt)), + attrs); + attrs = Fcons (Fcons (Qcmajflt, make_fixnum_or_float (cmajflt)), + attrs); clocks_per_sec = sysconf (_SC_CLK_TCK); if (clocks_per_sec < 0) clocks_per_sec = 100; @@ -3012,19 +3015,22 @@ ltime_from_jiffies (cstime, clocks_per_sec)), attrs); attrs = Fcons (Fcons (Qctime, - ltime_from_jiffies (cstime+cutime, clocks_per_sec)), + ltime_from_jiffies (cstime + cutime, + clocks_per_sec)), attrs); attrs = Fcons (Fcons (Qpri, make_number (priority)), attrs); attrs = Fcons (Fcons (Qnice, make_number (niceness)), attrs); - attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (thcount_eint)), attrs); + attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (thcount)), + attrs); tnow = current_emacs_time (); telapsed = get_up_time (); tboot = sub_emacs_time (tnow, telapsed); tstart = time_from_jiffies (start, clocks_per_sec); tstart = add_emacs_time (tboot, tstart); attrs = Fcons (Fcons (Qstart, make_lisp_time (tstart)), attrs); - attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (vsize/1024)), attrs); - attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (4*rss)), attrs); + attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (vsize / 1024)), + attrs); + attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (4 * rss)), attrs); telapsed = sub_emacs_time (tnow, tstart); attrs = Fcons (Fcons (Qetime, make_lisp_time (telapsed)), attrs); us_time = time_from_jiffies (u_time + s_time, clocks_per_sec); @@ -3039,67 +3045,63 @@ attrs = Fcons (Fcons (Qpmem, make_float (pmem)), attrs); } } - if (fd >= 0) - emacs_close (fd); + unbind_to (count, Qnil); /* args */ strcpy (procfn_end, "/cmdline"); fd = emacs_open (fn, O_RDONLY, 0); if (fd >= 0) { - char ch; - for (cmdline_size = 0; cmdline_size < STRING_BYTES_BOUND; cmdline_size++) + ptrdiff_t readsize, nread_incr; + record_unwind_protect_int (close_file_unwind, fd); + record_unwind_protect_nothing (); + nread = cmdline_size = 0; + + do { - if (emacs_read (fd, &ch, 1) != 1) - break; - c = ch; - if (c_isspace (c) || c == '\\') - cmdline_size++; /* for later quoting, see below */ + cmdline = xpalloc (cmdline, &cmdline_size, 2, STRING_BYTES_BOUND, 1); + set_unwind_protect_ptr (count + 1, xfree, cmdline); + + /* Leave room even if every byte needs escaping below. */ + readsize = (cmdline_size >> 1) - nread; + + nread_incr = emacs_read (fd, cmdline + nread, readsize); + nread += max (0, nread_incr); } - if (cmdline_size) + while (nread_incr == readsize); + + if (nread) { - cmdline = xmalloc (cmdline_size + 1); - lseek (fd, 0L, SEEK_SET); - cmdline[0] = '\0'; - if ((nread = read (fd, cmdline, cmdline_size)) >= 0) - cmdline[nread++] = '\0'; - else - { - /* Assigning zero to `nread' makes us skip the following - two loops, assign zero to cmdline_size, and enter the - following `if' clause that handles unknown command - lines. */ - nread = 0; - } /* We don't want trailing null characters. */ - for (p = cmdline + nread; p > cmdline + 1 && !p[-1]; p--) - nread--; - for (p = cmdline; p < cmdline + nread; p++) + for (p = cmdline + nread; cmdline < p && !p[-1]; p--) + continue; + + /* Escape-quote whitespace and backslashes. */ + q = cmdline + cmdline_size; + while (cmdline < p) { - /* Escape-quote whitespace and backslashes. */ - if (c_isspace (*p) || *p == '\\') - { - memmove (p + 1, p, nread - (p - cmdline)); - nread++; - *p++ = '\\'; - } - else if (*p == '\0') - *p = ' '; + char c = *--p; + *--q = c ? c : ' '; + if (c_isspace (c) || c == '\\') + *--q = '\\'; } - cmdline_size = nread; + + nread = cmdline + cmdline_size - q; } - if (!cmdline_size) + + if (!nread) { - cmdline_size = cmdsize + 2; - cmdline = xmalloc (cmdline_size + 1); + nread = cmdsize + 2; + cmdline_size = nread + 1; + q = cmdline = xrealloc (cmdline, cmdline_size); + set_unwind_protect_ptr (count + 1, xfree, cmdline); sprintf (cmdline, "[%.*s]", cmdsize, cmd); } - emacs_close (fd); /* Command line is encoded in locale-coding-system; decode it. */ - cmd_str = make_unibyte_string (cmdline, cmdline_size); + cmd_str = make_unibyte_string (q, nread); decoded_cmd = code_convert_string_norecord (cmd_str, Vlocale_coding_system, 0); - xfree (cmdline); + unbind_to (count, Qnil); attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs); } @@ -3141,8 +3143,9 @@ uid_t uid; gid_t gid; Lisp_Object attrs = Qnil; - Lisp_Object decoded_cmd, tem; + Lisp_Object decoded_cmd; struct gcpro gcpro1, gcpro2; + ptrdiff_t count; CHECK_NUMBER_OR_FLOAT (pid); CONS_TO_INTEGER (pid, pid_t, proc_id); @@ -3169,72 +3172,83 @@ if (gr) attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); + count = SPECPDL_INDEX (); strcpy (fn, procfn); procfn_end = fn + strlen (fn); strcpy (procfn_end, "/psinfo"); fd = emacs_open (fn, O_RDONLY, 0); - if (fd >= 0 - && (nread = read (fd, (char*)&pinfo, sizeof (struct psinfo)) > 0)) - { - attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (pinfo.pr_ppid)), attrs); - attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pinfo.pr_pgid)), attrs); - attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (pinfo.pr_sid)), attrs); - - { - char state_str[2]; - state_str[0] = pinfo.pr_lwp.pr_sname; - state_str[1] = '\0'; - tem = build_string (state_str); - attrs = Fcons (Fcons (Qstate, tem), attrs); - } - - /* FIXME: missing Qttyname. psinfo.pr_ttydev is a dev_t, - need to get a string from it. */ - - /* FIXME: missing: Qtpgid */ - - /* FIXME: missing: - Qminflt - Qmajflt - Qcminflt - Qcmajflt - - Qutime - Qcutime - Qstime - Qcstime - Are they available? */ - - attrs = Fcons (Fcons (Qtime, make_lisp_time (pinfo.pr_time)), attrs); - attrs = Fcons (Fcons (Qctime, make_lisp_time (pinfo.pr_ctime)), attrs); - attrs = Fcons (Fcons (Qpri, make_number (pinfo.pr_lwp.pr_pri)), attrs); - attrs = Fcons (Fcons (Qnice, make_number (pinfo.pr_lwp.pr_nice)), attrs); - attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (pinfo.pr_nlwp)), attrs); - - attrs = Fcons (Fcons (Qstart, make_lisp_time (pinfo.pr_start)), attrs); - attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (pinfo.pr_size)), attrs); - attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (pinfo.pr_rssize)), attrs); - - /* pr_pctcpu and pr_pctmem are unsigned integers in the - range 0 .. 2**15, representing 0.0 .. 1.0. */ - attrs = Fcons (Fcons (Qpcpu, make_float (100.0 / 0x8000 * pinfo.pr_pctcpu)), attrs); - attrs = Fcons (Fcons (Qpmem, make_float (100.0 / 0x8000 * pinfo.pr_pctmem)), attrs); - - decoded_cmd - = code_convert_string_norecord (make_unibyte_string (pinfo.pr_fname, - strlen (pinfo.pr_fname)), - Vlocale_coding_system, 0); - attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs); - decoded_cmd - = code_convert_string_norecord (make_unibyte_string (pinfo.pr_psargs, - strlen (pinfo.pr_psargs)), - Vlocale_coding_system, 0); - attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs); - } - - if (fd >= 0) - emacs_close (fd); - + if (fd < 0) + nread = 0; + else + { + record_unwind_protect (close_file_unwind, fd); + nread = emacs_read (fd, &pinfo, sizeof pinfo); + } + + if (nread == sizeof pinfo) + { + attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (pinfo.pr_ppid)), attrs); + attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pinfo.pr_pgid)), attrs); + attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (pinfo.pr_sid)), attrs); + + { + char state_str[2]; + state_str[0] = pinfo.pr_lwp.pr_sname; + state_str[1] = '\0'; + attrs = Fcons (Fcons (Qstate, build_string (state_str)), attrs); + } + + /* FIXME: missing Qttyname. psinfo.pr_ttydev is a dev_t, + need to get a string from it. */ + + /* FIXME: missing: Qtpgid */ + + /* FIXME: missing: + Qminflt + Qmajflt + Qcminflt + Qcmajflt + + Qutime + Qcutime + Qstime + Qcstime + Are they available? */ + + attrs = Fcons (Fcons (Qtime, make_lisp_time (pinfo.pr_time)), attrs); + attrs = Fcons (Fcons (Qctime, make_lisp_time (pinfo.pr_ctime)), attrs); + attrs = Fcons (Fcons (Qpri, make_number (pinfo.pr_lwp.pr_pri)), attrs); + attrs = Fcons (Fcons (Qnice, make_number (pinfo.pr_lwp.pr_nice)), attrs); + attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (pinfo.pr_nlwp)), + attrs); + + attrs = Fcons (Fcons (Qstart, make_lisp_time (pinfo.pr_start)), attrs); + attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (pinfo.pr_size)), + attrs); + attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (pinfo.pr_rssize)), + attrs); + + /* pr_pctcpu and pr_pctmem are unsigned integers in the + range 0 .. 2**15, representing 0.0 .. 1.0. */ + attrs = Fcons (Fcons (Qpcpu, + make_float (100.0 / 0x8000 * pinfo.pr_pctcpu)), + attrs); + attrs = Fcons (Fcons (Qpmem, + make_float (100.0 / 0x8000 * pinfo.pr_pctmem)), + attrs); + + decoded_cmd = (code_convert_string_norecord + (make_unibyte_string (pinfo.pr_fname, + strlen (pinfo.pr_fname)), + Vlocale_coding_system, 0)); + attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs); + decoded_cmd = (code_convert_string_norecord + (make_unibyte_string (pinfo.pr_psargs, + strlen (pinfo.pr_psargs)), + Vlocale_coding_system, 0)); + attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs); + } + unbind_to (count, Qnil); UNGCPRO; return attrs; } ------------------------------------------------------------ revno: 113453 committer: Paul Eggert branch nick: trunk timestamp: Thu 2013-07-18 18:24:35 -0700 message: Fix obscure porting bug with varargs functions. The code assumed that int is treated like ptrdiff_t in a vararg function, which is not a portable assumption. There was a similar -- though these days less likely -- porting problem with various assumptions that pointers of different types all smell the same as far as vararg functions is conserved. To make this problem less likely in the future, redo the API to use varargs functions. * alloc.c (make_save_value): Remove this vararg function. All uses changed to ... (make_save_int_int_int, make_save_obj_obj_obj_obj) (make_save_ptr_int, make_save_funcptr_ptr_obj, make_save_memory): New functions. (make_save_ptr): Rename from make_save_pointer, for consistency with the above. Define only on platforms that need it. All uses changed. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-07-19 00:38:19 +0000 +++ src/ChangeLog 2013-07-19 01:24:35 +0000 @@ -1,3 +1,20 @@ +2013-07-19 Paul Eggert + + Fix obscure porting bug with varargs functions. + The code assumed that int is treated like ptrdiff_t in a vararg + function, which is not a portable assumption. There was a similar + -- though these days less likely -- porting problem with various + assumptions that pointers of different types all smell the same as + far as vararg functions is conserved. To make this problem less + likely in the future, redo the API to use varargs functions. + * alloc.c (make_save_value): Remove this vararg function. + All uses changed to ... + (make_save_int_int_int, make_save_obj_obj_obj_obj) + (make_save_ptr_int, make_save_funcptr_ptr_obj, make_save_memory): + New functions. + (make_save_ptr): Rename from make_save_pointer, for consistency with + the above. Define only on platforms that need it. All uses changed. + 2013-07-18 Paul Eggert * keyboard.c: Try to fix typos in previous change. === modified file 'src/alloc.c' --- src/alloc.c 2013-07-16 21:35:45 +0000 +++ src/alloc.c 2013-07-19 01:24:35 +0000 @@ -3342,62 +3342,81 @@ >> SAVE_SLOT_BITS) == 0); -/* Return a Lisp_Save_Value object with the data saved according to - DATA_TYPE. DATA_TYPE should be one of SAVE_TYPE_INT_INT, etc. */ - -Lisp_Object -make_save_value (enum Lisp_Save_Type save_type, ...) -{ - va_list ap; - int i; - Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); - struct Lisp_Save_Value *p = XSAVE_VALUE (val); - - eassert (0 < save_type - && (save_type < 1 << (SAVE_TYPE_BITS - 1) - || save_type == SAVE_TYPE_MEMORY)); - p->save_type = save_type; - va_start (ap, save_type); - save_type &= ~ (1 << (SAVE_TYPE_BITS - 1)); - - for (i = 0; save_type; i++, save_type >>= SAVE_SLOT_BITS) - switch (save_type & ((1 << SAVE_SLOT_BITS) - 1)) - { - case SAVE_POINTER: - p->data[i].pointer = va_arg (ap, void *); - break; - - case SAVE_FUNCPOINTER: - p->data[i].funcpointer = va_arg (ap, voidfuncptr); - break; - - case SAVE_INTEGER: - p->data[i].integer = va_arg (ap, ptrdiff_t); - break; - - case SAVE_OBJECT: - p->data[i].object = va_arg (ap, Lisp_Object); - break; - - default: - emacs_abort (); - } - - va_end (ap); - return val; -} - -/* Save just one C pointer. record_unwind_protect_ptr is simpler and - faster than combining this with record_unwind_protect, but - occasionally this function is useful for other reasons. */ - -Lisp_Object -make_save_pointer (void *pointer) +/* Return Lisp_Save_Value objects for the various combinations + that callers need. */ + +Lisp_Object +make_save_int_int_int (ptrdiff_t a, ptrdiff_t b, ptrdiff_t c) +{ + Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); + struct Lisp_Save_Value *p = XSAVE_VALUE (val); + p->save_type = SAVE_TYPE_INT_INT_INT; + p->data[0].integer = a; + p->data[1].integer = b; + p->data[2].integer = c; + return val; +} + +Lisp_Object +make_save_obj_obj_obj_obj (Lisp_Object a, Lisp_Object b, Lisp_Object c, + Lisp_Object d) +{ + Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); + struct Lisp_Save_Value *p = XSAVE_VALUE (val); + p->save_type = SAVE_TYPE_OBJ_OBJ_OBJ_OBJ; + p->data[0].object = a; + p->data[1].object = b; + p->data[2].object = c; + p->data[3].object = d; + return val; +} + +#if defined HAVE_NS || defined DOS_NT +Lisp_Object +make_save_ptr (void *a) { Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); struct Lisp_Save_Value *p = XSAVE_VALUE (val); p->save_type = SAVE_POINTER; - p->data[0].pointer = pointer; + p->data[0].pointer = a; + return val; +} +#endif + +Lisp_Object +make_save_ptr_int (void *a, ptrdiff_t b) +{ + Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); + struct Lisp_Save_Value *p = XSAVE_VALUE (val); + p->save_type = SAVE_TYPE_PTR_INT; + p->data[0].pointer = a; + p->data[1].integer = b; + return val; +} + +Lisp_Object +make_save_funcptr_ptr_obj (void (*a) (void), void *b, Lisp_Object c) +{ + Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); + struct Lisp_Save_Value *p = XSAVE_VALUE (val); + p->save_type = SAVE_TYPE_FUNCPTR_PTR_OBJ; + p->data[0].funcpointer = a; + p->data[1].pointer = b; + p->data[2].object = c; + return val; +} + +/* Return a Lisp_Save_Value object that represents an array A + of N Lisp objects. */ + +Lisp_Object +make_save_memory (Lisp_Object *a, ptrdiff_t n) +{ + Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); + struct Lisp_Save_Value *p = XSAVE_VALUE (val); + p->save_type = SAVE_TYPE_MEMORY; + p->data[0].pointer = a; + p->data[1].integer = n; return val; } === modified file 'src/editfns.c' --- src/editfns.c 2013-07-17 17:24:54 +0000 +++ src/editfns.c 2013-07-19 01:24:35 +0000 @@ -838,9 +838,8 @@ Lisp_Object save_excursion_save (void) { - return make_save_value - (SAVE_TYPE_OBJ_OBJ_OBJ_OBJ, - Fpoint_marker (), + return make_save_obj_obj_obj_obj + (Fpoint_marker (), /* Do not copy the mark if it points to nowhere. */ (XMARKER (BVAR (current_buffer, mark))->buffer ? Fcopy_marker (BVAR (current_buffer, mark), Qnil) === modified file 'src/fileio.c' --- src/fileio.c 2013-07-18 02:12:59 +0000 +++ src/fileio.c 2013-07-19 01:24:35 +0000 @@ -4215,8 +4215,7 @@ to be signaled after decoding the text we read. */ nbytes = internal_condition_case_1 (read_non_regular, - make_save_value (SAVE_TYPE_INT_INT_INT, (ptrdiff_t) fd, - inserted, trytry), + make_save_int_int_int (fd, inserted, trytry), Qerror, read_non_regular_quit); if (NILP (nbytes)) === modified file 'src/font.c' --- src/font.c 2013-07-16 06:39:49 +0000 +++ src/font.c 2013-07-19 01:24:35 +0000 @@ -1861,7 +1861,7 @@ else { otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL; - val = make_save_pointer (otf); + val = make_save_ptr (otf); otf_list = Fcons (Fcons (file, val), otf_list); } return otf; === modified file 'src/ftfont.c' --- src/ftfont.c 2013-07-16 06:39:49 +0000 +++ src/ftfont.c 2013-07-19 01:24:35 +0000 @@ -393,7 +393,7 @@ cache_data = xmalloc (sizeof *cache_data); cache_data->ft_face = NULL; cache_data->fc_charset = NULL; - val = make_save_value (SAVE_TYPE_PTR_INT, cache_data, 0); + val = make_save_ptr_int (cache_data, 0); cache = Fcons (Qnil, val); Fputhash (key, cache, ft_face_cache); } === modified file 'src/keymap.c' --- src/keymap.c 2013-07-16 06:39:49 +0000 +++ src/keymap.c 2013-07-19 01:24:35 +0000 @@ -617,8 +617,8 @@ } else if (CHAR_TABLE_P (binding)) map_char_table (map_keymap_char_table_item, Qnil, binding, - make_save_value (SAVE_TYPE_FUNCPTR_PTR_OBJ, - (voidfuncptr) fun, data, args)); + make_save_funcptr_ptr_obj ((voidfuncptr) fun, data, + args)); } UNGCPRO; return tail; === modified file 'src/lisp.h' --- src/lisp.h 2013-07-18 02:12:59 +0000 +++ src/lisp.h 2013-07-19 01:24:35 +0000 @@ -441,8 +441,7 @@ displayed to users. These are Lisp_Save_Value, a Lisp_Misc subtype; and PVEC_OTHER, a kind of vectorlike object. The former is suitable for temporarily stashing away pointers and integers in - a Lisp object (see the existing uses of make_save_value and - XSAVE_VALUE). The latter is useful for vector-like Lisp objects + a Lisp object. The latter is useful for vector-like Lisp objects that need to be used as part of other objects, but which are never shown to users or Lisp code (search for PVEC_OTHER in xterm.c for an example). @@ -1815,30 +1814,26 @@ This is mostly used to package C integers and pointers to call record_unwind_protect when two or more values need to be saved. - make_save_value lets you pack up to SAVE_VALUE_SLOTS integers, pointers, - function pointers or Lisp_Objects and conveniently get them back - with XSAVE_INTEGER, XSAVE_POINTER, XSAVE_FUNCPOINTER, and - XSAVE_OBJECT macros: + For example: ... struct my_data *md = get_my_data (); - Lisp_Object my_object = get_my_object (); - record_unwind_protect - (my_unwind, make_save_value (SAVE_TYPE_PTR_OBJ, md, my_object)); + ptrdiff_t mi = get_my_integer (); + record_unwind_protect (my_unwind, make_save_ptr_int (md, mi)); ... Lisp_Object my_unwind (Lisp_Object arg) { struct my_data *md = XSAVE_POINTER (arg, 0); - Lisp_Object my_object = XSAVE_OBJECT (arg, 1); + ptrdiff_t mi = XSAVE_INTEGER (arg, 1); ... } If ENABLE_CHECKING is in effect, XSAVE_xxx macros do type checking of the saved objects and raise eassert if type of the saved object doesn't match the type which is extracted. In the example above, XSAVE_INTEGER (arg, 2) - or XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and - Lisp_Object was saved in slot 1 of ARG. */ + and XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and + slot 0 is a pointer. */ typedef void (*voidfuncptr) (void); @@ -1848,12 +1843,13 @@ unsigned gcmarkbit : 1; int spacer : 32 - (16 + 1 + SAVE_TYPE_BITS); - /* DATA[N] may hold up to SAVE_VALUE_SLOTS entries. The type of - V's Ith entry is given by save_type (V, I). E.g., if save_type - (V, 3) == SAVE_INTEGER, V->data[3].integer is in use. + /* V->data may hold up to SAVE_VALUE_SLOTS entries. The type of + V's data entries are determined by V->save_type. E.g., if + V->save_type == SAVE_TYPE_PTR_OBJ, V->data[0] is a pointer, + V->data[1] is an integer, and V's other data entries are unused. - If SAVE_TYPE == SAVE_TYPE_MEMORY, DATA[0].pointer is the address of - a memory area containing DATA[1].integer potential Lisp_Objects. */ + If V->save_type == SAVE_TYPE_MEMORY, V->data[0].pointer is the address of + a memory area containing V->data[1].integer potential Lisp_Objects. */ ENUM_BF (Lisp_Save_Type) save_type : SAVE_TYPE_BITS; union { void *pointer; @@ -3580,8 +3576,15 @@ extern Lisp_Object make_float (double); extern void display_malloc_warning (void); extern ptrdiff_t inhibit_garbage_collection (void); -extern Lisp_Object make_save_value (enum Lisp_Save_Type, ...); -extern Lisp_Object make_save_pointer (void *); +extern Lisp_Object make_save_int_int_int (ptrdiff_t, ptrdiff_t, ptrdiff_t); +extern Lisp_Object make_save_obj_obj_obj_obj (Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object); +extern Lisp_Object make_save_ptr (void *); +extern Lisp_Object make_save_ptr_int (void *, ptrdiff_t); +extern Lisp_Object make_save_ptr_ptr (void *, void *); +extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *, + Lisp_Object); +extern Lisp_Object make_save_memory (Lisp_Object *, ptrdiff_t); extern void free_save_value (Lisp_Object); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); extern void free_marker (Lisp_Object); @@ -4314,7 +4317,7 @@ { \ Lisp_Object arg_; \ buf = xmalloc ((nelt) * word_size); \ - arg_ = make_save_value (SAVE_TYPE_MEMORY, buf, nelt); \ + arg_ = make_save_memory (buf, nelt); \ sa_must_free = 1; \ record_unwind_protect (free_save_value, arg_); \ } \ === modified file 'src/nsterm.m' --- src/nsterm.m 2013-07-16 11:41:06 +0000 +++ src/nsterm.m 2013-07-19 01:24:35 +0000 @@ -3777,7 +3777,7 @@ } bar = [[EmacsScroller alloc] initFrame: r window: win]; - wset_vertical_scroll_bar (window, make_save_pointer (bar)); + wset_vertical_scroll_bar (window, make_save_ptr (bar)); } else { === modified file 'src/w32fns.c' --- src/w32fns.c 2013-07-16 23:29:05 +0000 +++ src/w32fns.c 2013-07-19 01:24:35 +0000 @@ -4916,7 +4916,7 @@ { Lisp_Object *monitor_list = (Lisp_Object *) dwData; - *monitor_list = Fcons (make_save_pointer (monitor), *monitor_list); + *monitor_list = Fcons (make_save_ptr (monitor), *monitor_list); return TRUE; } === modified file 'src/xmenu.c' --- src/xmenu.c 2013-07-16 21:35:45 +0000 +++ src/xmenu.c 2013-07-19 01:24:35 +0000 @@ -2465,8 +2465,7 @@ XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f)); #endif - record_unwind_protect (pop_down_menu, - make_save_value (SAVE_TYPE_PTR_PTR, f, menu)); + record_unwind_protect (pop_down_menu, make_save_ptr_ptr (f, menu)); /* Help display under X won't work because XMenuActivate contains a loop that doesn't give Emacs a chance to process it. */ ------------------------------------------------------------ revno: 113452 committer: Juanma Barranquero branch nick: trunk timestamp: Fri 2013-07-19 02:38:19 +0200 message: lisp/ChangeLog, src/ChangeLog: Fix typos. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-07-18 16:50:05 +0000 +++ lisp/ChangeLog 2013-07-19 00:38:19 +0000 @@ -5,13 +5,13 @@ 2013-07-18 Michael Albinus - * filenotify.el (file-notify--library): Renamed from + * filenotify.el (file-notify--library): Rename from `file-notify-support'. Do not autoload. Adapt all uses. (file-notify-supported-p): New defun. - * autorevert.el (auto-revert-use-notify): Use - `file-notify-supported-p' instead of `file-notify-support'. Adapt - docstring. + * autorevert.el (auto-revert-use-notify): + Use `file-notify-supported-p' instead of `file-notify-support'. + Adapt docstring. (auto-revert-notify-add-watch): Use `file-notify-supported-p'. * net/tramp.el (tramp-file-name-for-operation): @@ -3572,8 +3572,8 @@ (prolog-char-quote-workaround): * progmodes/cperl-mode.el (cperl-under-as-char): * progmodes/vhdl-mode.el (vhdl-underscore-is-part-of-word): - Mark as obsolete. - (vhdl-mode-syntax-table, vhdl-mode-ext-syntax-table): Initialize in + Mark as obsolete. + (vhdl-mode-syntax-table, vhdl-mode-ext-syntax-table): Initialize in their declaration. (vhdl-mode-syntax-table-init): Remove. === modified file 'src/ChangeLog' --- src/ChangeLog 2013-07-18 21:16:33 +0000 +++ src/ChangeLog 2013-07-19 00:38:19 +0000 @@ -3,7 +3,7 @@ * keyboard.c: Try to fix typos in previous change. (DISPLAY_LIST_INFO): New macro. (kbd_buffer_get_event): Do not access members that are not present - in X11. Revert nadvertent change of "!=" to "=". + in X11. Revert inadvertent change of "!=" to "=". 2013-07-18 Juanma Barranquero ------------------------------------------------------------ revno: 113451 committer: Paul Eggert branch nick: trunk timestamp: Thu 2013-07-18 14:16:33 -0700 message: * keyboard.c: Try to fix typos in previous change. (DISPLAY_LIST_INFO): New macro. (kbd_buffer_get_event): Do not access members that are not present in X11. Revert nadvertent change of "!=" to "=". diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-07-18 16:50:05 +0000 +++ src/ChangeLog 2013-07-18 21:16:33 +0000 @@ -1,3 +1,10 @@ +2013-07-18 Paul Eggert + + * keyboard.c: Try to fix typos in previous change. + (DISPLAY_LIST_INFO): New macro. + (kbd_buffer_get_event): Do not access members that are not present + in X11. Revert nadvertent change of "!=" to "=". + 2013-07-18 Juanma Barranquero * keyboard.c (kbd_buffer_get_event): === modified file 'src/keyboard.c' --- src/keyboard.c 2013-07-18 16:50:05 +0000 +++ src/keyboard.c 2013-07-18 21:16:33 +0000 @@ -4066,7 +4066,12 @@ } else if (event->kind == FOCUS_OUT_EVENT) { -#if defined (HAVE_NS) || defined (HAVE_X11) || defined (WINDOWSNT) +#if defined HAVE_X11 || defined HAVE_NS +# define DISPLAY_LIST_INFO(di) (di) +#elif defined WINDOWSNT +# define DISPLAY_LIST_INFO(di) FRAME_X_DISPLAY_INFO (di) +#endif +#ifdef DISPLAY_LIST_INFO #ifdef HAVE_NS struct ns_display_info *di; @@ -4076,11 +4081,13 @@ Lisp_Object frame = event->frame_or_window; bool focused = false; - for (di = x_display_list; di && ! focused; di = FRAME_X_DISPLAY_INFO (di)->next) - focused = FRAME_X_DISPLAY_INFO (di)->x_highlight_frame = 0; + for (di = x_display_list; + di && ! focused; + di = DISPLAY_LIST_INFO (di)->next) + focused = DISPLAY_LIST_INFO (di)->x_highlight_frame != 0; if (! focused) obj = make_lispy_focus_out (frame); -#endif /* HAVE_NS || HAVE_X11 || WINDOWSNT */ +#endif /* DISPLAY_LIST_INFO */ kbd_fetch_ptr = event + 1; } ------------------------------------------------------------ revno: 113450 committer: Juanma Barranquero branch nick: trunk timestamp: Thu 2013-07-18 18:50:05 +0200 message: Followup to revno:113431. * lisp/frame.el (blink-cursor-timer-function, blink-cursor-suspend): Add check for W32. * src/keyboard.c (kbd_buffer_get_event): * src/w32term.c (x_focus_changed): Port FOCUS_(IN|OUT)_EVENT changes to W32. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-07-18 10:03:49 +0000 +++ lisp/ChangeLog 2013-07-18 16:50:05 +0000 @@ -1,3 +1,8 @@ +2013-07-18 Juanma Barranquero + + * frame.el (blink-cursor-timer-function, blink-cursor-suspend): + Add check for W32 (followup to revno:113431). + 2013-07-18 Michael Albinus * filenotify.el (file-notify--library): Renamed from === modified file 'lisp/frame.el' --- lisp/frame.el 2013-07-16 11:41:06 +0000 +++ lisp/frame.el 2013-07-18 16:50:05 +0000 @@ -1709,7 +1709,7 @@ "Timer function of timer `blink-cursor-timer'." (internal-show-cursor nil (not (internal-show-cursor-p))) ;; Each blink is two calls to this function. - (when (memq window-system '(x ns)) + (when (memq window-system '(x ns w32)) (setq blink-cursor-blinks-done (1+ blink-cursor-blinks-done)) (when (and (> blink-cursor-blinks 0) (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done)) @@ -1729,11 +1729,11 @@ (setq blink-cursor-timer nil))) (defun blink-cursor-suspend () - "Suspend cursor blinking on NS and X. + "Suspend cursor blinking on NS, X and W32. This is called when no frame has focus and timers can be suspended. Timers are restarted by `blink-cursor-check', which is called when a frame receives focus." - (when (memq window-system '(x ns)) + (when (memq window-system '(x ns w32)) (blink-cursor-end) (when blink-cursor-idle-timer (cancel-timer blink-cursor-idle-timer) === modified file 'src/ChangeLog' --- src/ChangeLog 2013-07-18 10:24:26 +0000 +++ src/ChangeLog 2013-07-18 16:50:05 +0000 @@ -1,3 +1,9 @@ +2013-07-18 Juanma Barranquero + + * keyboard.c (kbd_buffer_get_event): + * w32term.c (x_focus_changed): Port FOCUS_(IN|OUT)_EVENT changes to W32. + Followup to revno:113431. + 2013-07-18 Paul Eggert * filelock.c: Fix unlikely file descriptor leaks. === modified file 'src/keyboard.c' --- src/keyboard.c 2013-07-16 21:35:45 +0000 +++ src/keyboard.c 2013-07-18 16:50:05 +0000 @@ -4066,7 +4066,7 @@ } else if (event->kind == FOCUS_OUT_EVENT) { -#if defined(HAVE_NS) || defined (HAVE_X11) +#if defined (HAVE_NS) || defined (HAVE_X11) || defined (WINDOWSNT) #ifdef HAVE_NS struct ns_display_info *di; @@ -4076,11 +4076,11 @@ Lisp_Object frame = event->frame_or_window; bool focused = false; - for (di = x_display_list; di && ! focused; di = di->next) - focused = di->x_highlight_frame != 0; + for (di = x_display_list; di && ! focused; di = FRAME_X_DISPLAY_INFO (di)->next) + focused = FRAME_X_DISPLAY_INFO (di)->x_highlight_frame = 0; if (! focused) obj = make_lispy_focus_out (frame); -#endif /* HAVE_NS || HAVE_X11 */ +#endif /* HAVE_NS || HAVE_X11 || WINDOWSNT */ kbd_fetch_ptr = event + 1; } === modified file 'src/w32term.c' --- src/w32term.c 2013-07-13 14:21:01 +0000 +++ src/w32term.c 2013-07-18 16:50:05 +0000 @@ -2912,9 +2912,15 @@ && CONSP (Vframe_list) && !NILP (XCDR (Vframe_list))) { - bufp->kind = FOCUS_IN_EVENT; - XSETFRAME (bufp->frame_or_window, frame); - } + bufp->arg = Qt; + } + else + { + bufp->arg = Qnil; + } + + bufp->kind = FOCUS_IN_EVENT; + XSETFRAME (bufp->frame_or_window, frame); } frame->output_data.x->focus_state |= state; @@ -2929,7 +2935,10 @@ { dpyinfo->w32_focus_event_frame = 0; x_new_focus_frame (dpyinfo, 0); - } + + bufp->kind = FOCUS_OUT_EVENT; + XSETFRAME (bufp->frame_or_window, frame); + } /* TODO: IME focus? */ } ------------------------------------------------------------ revno: 113449 committer: Katsumi Yamaoka branch nick: trunk timestamp: Thu 2013-07-18 11:26:04 +0000 message: gnus-art.el (gnus-shr-put-image): Make it work as well for shr.el's that the old Emacs 24s bundle diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-07-14 05:18:48 +0000 +++ lisp/gnus/ChangeLog 2013-07-18 11:26:04 +0000 @@ -1,3 +1,8 @@ +2013-07-18 Katsumi Yamaoka + + * gnus-art.el (gnus-shr-put-image): Make it work as well for shr.el's + that the old Emacs 24s bundle. + 2013-07-10 David Engster * gnus-start.el (gnus-clean-old-newsrc): Always remove 'unexist' marks === modified file 'lisp/gnus/gnus-art.el' --- lisp/gnus/gnus-art.el 2013-07-06 23:40:56 +0000 +++ lisp/gnus/gnus-art.el 2013-07-18 11:26:04 +0000 @@ -6197,9 +6197,14 @@ (defun gnus-shr-put-image (data alt &optional flags) "Put image DATA with a string ALT. Enable image to be deleted." - (let ((image (shr-put-image data (propertize (or alt "*") - 'gnus-image-category 'shr) - flags))) + (let ((image (if flags + (shr-put-image data (propertize (or alt "*") + 'gnus-image-category 'shr) + flags) + ;; Old `shr-put-image' doesn't take the optional `flags' + ;; argument. + (shr-put-image data (propertize (or alt "*") + 'gnus-image-category 'shr))))) (when image (gnus-add-image 'shr image)))) ------------------------------------------------------------ revno: 113448 author: Paul Eggert committer: Paul Eggert branch nick: trunk timestamp: Thu 2013-07-18 03:24:26 -0700 message: * filelock.c: Fix unlikely file descriptor leaks. (get_boot_time_1): Rework to avoid using emacs_open. This doesn't actually fix a leak, but is better anyway. (read_lock_data): Use read, not emacs_read. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-07-18 09:55:00 +0000 +++ src/ChangeLog 2013-07-18 10:24:26 +0000 @@ -1,5 +1,10 @@ 2013-07-18 Paul Eggert + * filelock.c: Fix unlikely file descriptor leaks. + (get_boot_time_1): Rework to avoid using emacs_open. + This doesn't actually fix a leak, but is better anyway. + (read_lock_data): Use read, not emacs_read. + * doc.c: Fix minor memory and file descriptor leaks. * doc.c (get_doc_string): Fix memory leak when doc file absent. (get_doc_string, Fsnarf_documentation): === modified file 'src/filelock.c' --- src/filelock.c 2013-07-14 23:12:42 +0000 +++ src/filelock.c 2013-07-18 10:24:26 +0000 @@ -257,18 +257,14 @@ get_boot_time_1 (const char *filename, bool newest) { struct utmp ut, *utp; - int desc; if (filename) { /* On some versions of IRIX, opening a nonexistent file name is likely to crash in the utmp routines. */ - desc = emacs_open (filename, O_RDONLY, 0); - if (desc < 0) + if (faccessat (AT_FDCWD, filename, R_OK, AT_EACCESS) != 0) return; - emacs_close (desc); - utmpname (filename); } @@ -512,7 +508,8 @@ int fd = emacs_open (lfname, O_RDONLY | O_BINARY | O_NOFOLLOW, 0); if (0 <= fd) { - ptrdiff_t read_bytes = emacs_read (fd, lfinfo, MAX_LFINFO + 1); + /* Use read, not emacs_read, since FD isn't unwind-protected. */ + ptrdiff_t read_bytes = read (fd, lfinfo, MAX_LFINFO + 1); int read_errno = errno; if (emacs_close (fd) != 0) return -1; ------------------------------------------------------------ revno: 113447 committer: Michael Albinus branch nick: trunk timestamp: Thu 2013-07-18 12:03:49 +0200 message: * filenotify.el (file-notify--library): Renamed from `file-notify-support'. Do not autoload. Adapt all uses. (file-notify-supported-p): New defun. * autorevert.el (auto-revert-use-notify): Use `file-notify-supported-p' instead of `file-notify-support'. Adapt docstring. (auto-revert-notify-add-watch): Use `file-notify-supported-p'. * net/tramp.el (tramp-file-name-for-operation): Add `file-notify-supported-p'. * net/tramp-sh.el (tramp-sh-handle-file-notify-supported-p): New defun. (tramp-sh-file-name-handler-alist): Add it as handler for `file-notify-supported-p '. * net/tramp-adb.el (tramp-adb-file-name-handler-alist): * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): * net/tramp-smb.el (tramp-smb-file-name-handler-alist): Add `ignore' as handler for `file-notify-*' functions. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-07-17 16:47:49 +0000 +++ lisp/ChangeLog 2013-07-18 10:03:49 +0000 @@ -1,3 +1,27 @@ +2013-07-18 Michael Albinus + + * filenotify.el (file-notify--library): Renamed from + `file-notify-support'. Do not autoload. Adapt all uses. + (file-notify-supported-p): New defun. + + * autorevert.el (auto-revert-use-notify): Use + `file-notify-supported-p' instead of `file-notify-support'. Adapt + docstring. + (auto-revert-notify-add-watch): Use `file-notify-supported-p'. + + * net/tramp.el (tramp-file-name-for-operation): + Add `file-notify-supported-p'. + + * net/tramp-sh.el (tramp-sh-handle-file-notify-supported-p): + New defun. + (tramp-sh-file-name-handler-alist): Add it as handler for + `file-notify-supported-p '. + + * net/tramp-adb.el (tramp-adb-file-name-handler-alist): + * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): + * net/tramp-smb.el (tramp-smb-file-name-handler-alist): + Add `ignore' as handler for `file-notify-*' functions. + 2013-07-17 Eli Zaretskii * simple.el (line-move-partial, line-move): Don't start vscroll or === modified file 'lisp/autorevert.el' --- lisp/autorevert.el 2013-07-04 09:39:36 +0000 +++ lisp/autorevert.el 2013-07-18 10:03:49 +0000 @@ -271,21 +271,20 @@ :type 'boolean :version "24.4") -(defcustom auto-revert-use-notify (and file-notify-support t) +(defcustom auto-revert-use-notify + ;; We use the support of the local filesystem as default. + (file-notify-supported-p temporary-file-directory) "If non-nil Auto Revert Mode uses file notification functions. -This requires Emacs being compiled with file notification -support (see `file-notify-support'). You should set this variable -through Custom." +You should set this variable through Custom." :group 'auto-revert :type 'boolean :set (lambda (variable value) - (set-default variable (and file-notify-support value)) + (set-default variable value) (unless (symbol-value variable) - (when file-notify-support - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (symbol-value 'auto-revert-notify-watch-descriptor) - (auto-revert-notify-rm-watch))))))) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (symbol-value 'auto-revert-notify-watch-descriptor) + (auto-revert-notify-rm-watch)))))) :initialize 'custom-initialize-default :version "24.4") @@ -513,7 +512,8 @@ (set (make-local-variable 'auto-revert-use-notify) nil)) (when (and buffer-file-name auto-revert-use-notify - (not auto-revert-notify-watch-descriptor)) + (not auto-revert-notify-watch-descriptor) + (file-notify-supported-p buffer-file-name)) (setq auto-revert-notify-watch-descriptor (ignore-errors (file-notify-add-watch === modified file 'lisp/filenotify.el' --- lisp/filenotify.el 2013-07-04 09:39:36 +0000 +++ lisp/filenotify.el 2013-07-18 10:03:49 +0000 @@ -27,8 +27,7 @@ ;;; Code: -;;;###autoload -(defconst file-notify-support +(defconst file-notify--library (cond ((featurep 'gfilenotify) 'gfilenotify) ((featurep 'inotify) 'inotify) @@ -191,6 +190,17 @@ (funcall callback (list desc action file file1)) (funcall callback (list desc action file))))))) +(defun file-notify-supported-p (file) + "Returns non-nil if filesystem pertaining to FILE could be watched." + (unless (stringp file) + (signal 'wrong-type-argument (list file))) + (setq file (expand-file-name file)) + + (let ((handler (find-file-name-handler file 'file-notify-supported-p))) + (if handler + (funcall handler 'file-notify-supported-p file) + (and file-notify--library t)))) + (defun file-notify-add-watch (file flags callback) "Add a watch for filesystem events pertaining to FILE. This arranges for filesystem events pertaining to FILE to be reported @@ -238,7 +248,7 @@ (let* ((handler (find-file-name-handler file 'file-notify-add-watch)) (dir (directory-file-name - (if (or (and (not handler) (eq file-notify-support 'w32notify)) + (if (or (and (not handler) (eq file-notify--library 'w32notify)) (file-directory-p file)) file (file-name-directory file)))) @@ -259,32 +269,32 @@ ;; Check, whether Emacs has been compiled with file ;; notification support. - (unless file-notify-support + (unless file-notify--library (signal 'file-notify-error '("No file notification package available"))) ;; Determine low-level function to be called. (setq func (cond - ((eq file-notify-support 'gfilenotify) 'gfile-add-watch) - ((eq file-notify-support 'inotify) 'inotify-add-watch) - ((eq file-notify-support 'w32notify) 'w32notify-add-watch))) + ((eq file-notify--library 'gfilenotify) 'gfile-add-watch) + ((eq file-notify--library 'inotify) 'inotify-add-watch) + ((eq file-notify--library 'w32notify) 'w32notify-add-watch))) ;; Determine respective flags. - (if (eq file-notify-support 'gfilenotify) + (if (eq file-notify--library 'gfilenotify) (setq l-flags '(watch-mounts send-moved)) (when (memq 'change flags) (setq l-flags (cond - ((eq file-notify-support 'inotify) '(create modify move delete)) - ((eq file-notify-support 'w32notify) + ((eq file-notify--library 'inotify) '(create modify move delete)) + ((eq file-notify--library 'w32notify) '(file-name directory-name size last-write-time))))) (when (memq 'attribute-change flags) (add-to-list 'l-flags (cond - ((eq file-notify-support 'inotify) 'attrib) - ((eq file-notify-support 'w32notify) 'attributes))))) + ((eq file-notify--library 'inotify) 'attrib) + ((eq file-notify--library 'w32notify) 'attributes))))) ;; Call low-level function. (setq desc (funcall func dir l-flags 'file-notify-callback)))) @@ -311,9 +321,9 @@ (funcall handler 'file-notify-rm-watch descriptor) (funcall (cond - ((eq file-notify-support 'gfilenotify) 'gfile-rm-watch) - ((eq file-notify-support 'inotify) 'inotify-rm-watch) - ((eq file-notify-support 'w32notify) 'w32notify-rm-watch)) + ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch) + ((eq file-notify--library 'inotify) 'inotify-rm-watch) + ((eq file-notify--library 'w32notify) 'w32notify-rm-watch)) descriptor))) (remhash descriptor file-notify-descriptors))) === modified file 'lisp/net/tramp-adb.el' --- lisp/net/tramp-adb.el 2013-06-19 13:14:24 +0000 +++ lisp/net/tramp-adb.el 2013-07-18 10:03:49 +0000 @@ -108,6 +108,9 @@ (file-writable-p . tramp-adb-handle-file-writable-p) (file-local-copy . tramp-adb-handle-file-local-copy) (file-modes . tramp-handle-file-modes) + (file-notify-add-watch . ignore) + (file-notify-rm-watch . ignore) + (file-notify-supported-p . ignore) (expand-file-name . tramp-adb-handle-expand-file-name) (find-backup-file-name . tramp-handle-find-backup-file-name) (directory-files . tramp-handle-directory-files) === modified file 'lisp/net/tramp-gvfs.el' --- lisp/net/tramp-gvfs.el 2013-07-11 09:52:54 +0000 +++ lisp/net/tramp-gvfs.el 2013-07-18 10:03:49 +0000 @@ -435,6 +435,9 @@ (file-name-nondirectory . tramp-handle-file-name-nondirectory) ;; `file-name-sans-versions' performed by default handler. (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) + (file-notify-add-watch . ignore) + (file-notify-rm-watch . ignore) + (file-notify-supported-p . ignore) (file-ownership-preserved-p . ignore) (file-readable-p . tramp-gvfs-handle-file-readable-p) (file-regular-p . tramp-handle-file-regular-p) === modified file 'lisp/net/tramp-sh.el' --- lisp/net/tramp-sh.el 2013-07-14 18:45:50 +0000 +++ lisp/net/tramp-sh.el 2013-07-18 10:03:49 +0000 @@ -867,7 +867,8 @@ (set-file-acl . tramp-sh-handle-set-file-acl) (vc-registered . tramp-sh-handle-vc-registered) (file-notify-add-watch . tramp-sh-handle-file-notify-add-watch) - (file-notify-rm-watch . tramp-sh-handle-file-notify-rm-watch)) + (file-notify-rm-watch . tramp-sh-handle-file-notify-rm-watch) + (file-notify-supported-p . tramp-sh-handle-file-notify-supported-p)) "Alist of handler functions. Operations not mentioned here will be handled by the normal Emacs functions.") @@ -3498,6 +3499,13 @@ (tramp-message proc 6 (format "Kill %S" proc)) (kill-process proc)) +(defun tramp-sh-handle-file-notify-supported-p (file-name) + "Like `file-notify-supported-p' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name file-name) nil + (and (or (tramp-get-remote-gvfs-monitor-dir v) + (tramp-get-remote-inotifywait v)) + t))) + ;;; Internal Functions: (defun tramp-maybe-send-script (vec script name) === modified file 'lisp/net/tramp-smb.el' --- lisp/net/tramp-smb.el 2013-01-21 09:49:43 +0000 +++ lisp/net/tramp-smb.el 2013-07-18 10:03:49 +0000 @@ -209,6 +209,9 @@ (file-name-nondirectory . tramp-handle-file-name-nondirectory) ;; `file-name-sans-versions' performed by default handler. (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) + (file-notify-add-watch . ignore) + (file-notify-rm-watch . ignore) + (file-notify-supported-p . ignore) (file-ownership-preserved-p . ignore) (file-readable-p . tramp-handle-file-exists-p) (file-regular-p . tramp-handle-file-regular-p) === modified file 'lisp/net/tramp.el' --- lisp/net/tramp.el 2013-07-11 09:52:54 +0000 +++ lisp/net/tramp.el 2013-07-18 10:03:49 +0000 @@ -1980,8 +1980,8 @@ ;; Emacs 22+ only. 'set-file-times ;; Emacs 24+ only. - 'file-acl 'file-notify-add-watch 'file-selinux-context - 'set-file-acl 'set-file-selinux-context + 'file-acl 'file-notify-add-watch 'file-notify-supported-p + 'file-selinux-context 'set-file-acl 'set-file-selinux-context ;; XEmacs only. 'abbreviate-file-name 'create-file-buffer 'dired-file-modtime 'dired-make-compressed-filename ------------------------------------------------------------ revno: 113446 author: Paul Eggert committer: Paul Eggert branch nick: trunk timestamp: Thu 2013-07-18 02:55:00 -0700 message: * doc.c: Fix minor memory and file descriptor leaks. * doc.c (get_doc_string): Fix memory leak when doc file absent. (get_doc_string, Fsnarf_documentation): Fix file descriptor leak on error. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-07-18 08:35:27 +0000 +++ src/ChangeLog 2013-07-18 09:55:00 +0000 @@ -1,5 +1,10 @@ 2013-07-18 Paul Eggert + * doc.c: Fix minor memory and file descriptor leaks. + * doc.c (get_doc_string): Fix memory leak when doc file absent. + (get_doc_string, Fsnarf_documentation): + Fix file descriptor leak on error. + * term.c: Fix minor fdopen-related file descriptor leaks. * term.c (Fresume_tty) [!MSDOS]: Close fd if fdopen (fd) fails. (init_tty) [!DOS_NT]: Likewise. Also close fd if isatty (fd) fails. === modified file 'src/doc.c' --- src/doc.c 2013-07-17 04:37:27 +0000 +++ src/doc.c 2013-07-18 09:55:00 +0000 @@ -85,6 +85,7 @@ int offset; EMACS_INT position; Lisp_Object file, tem, pos; + ptrdiff_t count; USE_SAFE_ALLOCA; if (INTEGERP (filepos)) @@ -144,9 +145,14 @@ } #endif if (fd < 0) - return concat3 (build_string ("Cannot open doc string file \""), - file, build_string ("\"\n")); + { + SAFE_FREE (); + return concat3 (build_string ("Cannot open doc string file \""), + file, build_string ("\"\n")); + } } + count = SPECPDL_INDEX (); + record_unwind_protect_int (close_file_unwind, fd); /* Seek only to beginning of disk block. */ /* Make sure we read at least 1024 bytes before `position' @@ -154,13 +160,8 @@ offset = min (position, max (1024, position % (8 * 1024))); if (TYPE_MAXIMUM (off_t) < position || lseek (fd, position - offset, 0) < 0) - { - emacs_close (fd); - error ("Position %"pI"d out of range in doc string file \"%s\"", - position, name); - } - - SAFE_FREE (); + error ("Position %"pI"d out of range in doc string file \"%s\"", + position, name); /* Read the doc string into get_doc_string_buffer. P points beyond the data just read. */ @@ -190,10 +191,7 @@ space_left = 1024 * 8; nread = emacs_read (fd, p, space_left); if (nread < 0) - { - emacs_close (fd); - error ("Read error on documentation file"); - } + report_file_error ("Read error on documentation file", file); p[nread] = 0; if (!nread) break; @@ -209,7 +207,8 @@ } p += nread; } - emacs_close (fd); + unbind_to (count, Qnil); + SAFE_FREE (); /* Sanity checking. */ if (CONSP (filepos)) @@ -574,6 +573,7 @@ Lisp_Object sym; char *p, *name; bool skip_file = 0; + ptrdiff_t count; CHECK_STRING (filename); @@ -615,6 +615,8 @@ report_file_errno ("Opening doc string file", build_string (name), open_errno); } + count = SPECPDL_INDEX (); + record_unwind_protect_int (close_file_unwind, fd); Vdoc_file_name = filename; filled = 0; pos = 0; @@ -692,8 +694,7 @@ filled -= end - buf; memmove (buf, end, filled); } - emacs_close (fd); - return Qnil; + return unbind_to (count, Qnil); } DEFUN ("substitute-command-keys", Fsubstitute_command_keys, ------------------------------------------------------------ revno: 113445 author: Paul Eggert committer: Paul Eggert branch nick: trunk timestamp: Thu 2013-07-18 01:35:27 -0700 message: * term.c: Fix minor fdopen-related file descriptor leaks. * term.c (Fresume_tty) [!MSDOS]: Close fd if fdopen (fd) fails. (init_tty) [!DOS_NT]: Likewise. Also close fd if isatty (fd) fails. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-07-18 02:12:59 +0000 +++ src/ChangeLog 2013-07-18 08:35:27 +0000 @@ -1,5 +1,9 @@ 2013-07-18 Paul Eggert + * term.c: Fix minor fdopen-related file descriptor leaks. + * term.c (Fresume_tty) [!MSDOS]: Close fd if fdopen (fd) fails. + (init_tty) [!DOS_NT]: Likewise. Also close fd if isatty (fd) fails. + * charset.c: Fix file descriptor leaks and errno issues. Include . (load_charset_map_from_file): Don't leak file descriptor on error. === modified file 'src/term.c' --- src/term.c 2013-07-12 02:03:47 +0000 +++ src/term.c 2013-07-18 08:35:27 +0000 @@ -2416,15 +2416,20 @@ t->display_info.tty->input = stdin; #else /* !MSDOS */ fd = emacs_open (t->display_info.tty->name, O_RDWR | O_NOCTTY, 0); + t->display_info.tty->input = t->display_info.tty->output + = fd < 0 ? 0 : fdopen (fd, "w+"); - if (fd == -1) - error ("Can not reopen tty device %s: %s", t->display_info.tty->name, strerror (errno)); + if (! t->display_info.tty->input) + { + int open_errno = errno; + emacs_close (fd); + report_file_errno ("Cannot reopen tty device", + build_string (t->display_info.tty->name), + open_errno); + } if (!O_IGNORE_CTTY && strcmp (t->display_info.tty->name, DEV_TTY) != 0) dissociate_if_controlling_tty (fd); - - t->display_info.tty->output = fdopen (fd, "w+"); - t->display_info.tty->input = t->display_info.tty->output; #endif add_keyboard_wait_descriptor (fd); @@ -2990,7 +2995,6 @@ { /* Open the terminal device. */ - FILE *file; /* If !ctty, don't recognize it as our controlling terminal, and don't make it the controlling tty if we don't have one now. @@ -3001,30 +3005,21 @@ open a frame on the same terminal. */ int flags = O_RDWR | O_NOCTTY | (ctty ? 0 : O_IGNORE_CTTY); int fd = emacs_open (name, flags, 0); + tty->input = tty->output = fd < 0 || ! isatty (fd) ? 0 : fdopen (fd, "w+"); + + if (! tty->input) + { + char const *diagnostic + = tty->input ? "Not a tty device: %s" : "Could not open file: %s"; + emacs_close (fd); + maybe_fatal (must_succeed, terminal, diagnostic, diagnostic, name); + } tty->name = xstrdup (name); terminal->name = xstrdup (name); - if (fd < 0) - maybe_fatal (must_succeed, terminal, - "Could not open file: %s", - "Could not open file: %s", - name); - if (!isatty (fd)) - { - emacs_close (fd); - maybe_fatal (must_succeed, terminal, - "Not a tty device: %s", - "Not a tty device: %s", - name); - } - if (!O_IGNORE_CTTY && !ctty) dissociate_if_controlling_tty (fd); - - file = fdopen (fd, "w+"); - tty->input = file; - tty->output = file; } tty->type = xstrdup (terminal_type); ------------------------------------------------------------ revno: 113444 committer: Paul Eggert branch nick: trunk timestamp: Wed 2013-07-17 19:12:59 -0700 message: * charset.c: Fix file descriptor leaks and errno issues. Include . (load_charset_map_from_file): Don't leak file descriptor on error. Use plain record_xmalloc since the allocation is larger than MAX_ALLOCA; that's simpler here. Simplify test for exhaustion of entries. * eval.c (record_unwind_protect_nothing): * fileio.c (fclose_unwind): New functions. * lread.c (load_unwind): Remove. All uses replaced by fclose_unwind. The replacement doesn't block input, but that no longer seems necessary. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-07-17 17:24:54 +0000 +++ src/ChangeLog 2013-07-18 02:12:59 +0000 @@ -1,3 +1,18 @@ +2013-07-18 Paul Eggert + + * charset.c: Fix file descriptor leaks and errno issues. + Include . + (load_charset_map_from_file): Don't leak file descriptor on error. + Use plain record_xmalloc since the allocation is larger than + MAX_ALLOCA; that's simpler here. Simplify test for exhaustion + of entries. + * eval.c (record_unwind_protect_nothing): + * fileio.c (fclose_unwind): + New functions. + * lread.c (load_unwind): Remove. All uses replaced by fclose_unwind. + The replacement doesn't block input, but that no longer seems + necessary. + 2013-07-17 Paul Eggert * lread.c: Fix file descriptor leaks and errno issues. === modified file 'src/charset.c' --- src/charset.c 2013-07-16 06:39:49 +0000 +++ src/charset.c 2013-07-18 02:12:59 +0000 @@ -28,6 +28,7 @@ #define CHARSET_INLINE EXTERN_INLINE +#include #include #include #include @@ -477,7 +478,8 @@ `file-name-handler-alist' to avoid running any Lisp code. */ static void -load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int control_flag) +load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, + int control_flag) { unsigned min_code = CHARSET_MIN_CODE (charset); unsigned max_code = CHARSET_MAX_CODE (charset); @@ -487,21 +489,26 @@ struct charset_map_entries *head, *entries; int n_entries; ptrdiff_t count; - USE_SAFE_ALLOCA; suffixes = list2 (build_string (".map"), build_string (".TXT")); count = SPECPDL_INDEX (); + record_unwind_protect_nothing (); specbind (Qfile_name_handler_alist, Qnil); fd = openp (Vcharset_map_path, mapfile, suffixes, NULL, Qnil); - unbind_to (count, Qnil); - if (fd < 0 - || ! (fp = fdopen (fd, "r"))) - error ("Failure in loading charset map: %s", SDATA (mapfile)); + fp = fd < 0 ? 0 : fdopen (fd, "r"); + if (!fp) + { + int open_errno = errno; + emacs_close (fd); + report_file_errno ("Loading charset map", mapfile, open_errno); + } + set_unwind_protect_ptr (count, fclose_unwind, fp); + unbind_to (count + 1, Qnil); - /* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is + /* Use record_xmalloc, as `charset_map_entries' is large (larger than MAX_ALLOCA). */ - head = SAFE_ALLOCA (sizeof *head); + head = record_xmalloc (sizeof *head); entries = head; memset (entries, 0, sizeof (struct charset_map_entries)); @@ -530,9 +537,9 @@ if (from < min_code || to > max_code || from > to || c > MAX_CHAR) continue; - if (n_entries > 0 && (n_entries % 0x10000) == 0) + if (n_entries == 0x10000) { - entries->next = SAFE_ALLOCA (sizeof *entries->next); + entries->next = record_xmalloc (sizeof *entries->next); entries = entries->next; memset (entries, 0, sizeof (struct charset_map_entries)); n_entries = 0; @@ -544,9 +551,10 @@ n_entries++; } fclose (fp); + clear_unwind_protect (count); load_charset_map (charset, head, n_entries, control_flag); - SAFE_FREE (); + unbind_to (count, Qnil); } static void === modified file 'src/eval.c' --- src/eval.c 2013-07-17 17:24:54 +0000 +++ src/eval.c 2013-07-18 02:12:59 +0000 @@ -3190,6 +3190,8 @@ } } +/* Push unwind-protect entries of various types. */ + void record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg) { @@ -3229,6 +3231,18 @@ do_nothing (void) {} +/* Push an unwind-protect entry that does nothing, so that + set_unwind_protect_ptr can overwrite it later. */ + +void +record_unwind_protect_nothing (void) +{ + record_unwind_protect_void (do_nothing); +} + +/* Clear the unwind-protect entry COUNT, so that it does nothing. + It need not be at the top of the stack. */ + void clear_unwind_protect (ptrdiff_t count) { @@ -3237,6 +3251,10 @@ p->unwind_void.func = do_nothing; } +/* Set the unwind-protect entry COUNT so that it invokes FUNC (ARG). + It need not be at the top of the stack. Discard the entry's + previous value without invoking it. */ + void set_unwind_protect_ptr (ptrdiff_t count, void (*func) (void *), void *arg) { @@ -3246,6 +3264,9 @@ p->unwind_ptr.arg = arg; } +/* Pop and execute entries from the unwind-protect stack until the + depth COUNT is reached. Return VALUE. */ + Lisp_Object unbind_to (ptrdiff_t count, Lisp_Object value) { === modified file 'src/fileio.c' --- src/fileio.c 2013-07-17 17:24:54 +0000 +++ src/fileio.c 2013-07-18 02:12:59 +0000 @@ -220,6 +220,13 @@ emacs_close (fd); } +void +fclose_unwind (void *arg) +{ + FILE *stream = arg; + fclose (stream); +} + /* Restore point, having saved it as a marker. */ void === modified file 'src/lisp.h' --- src/lisp.h 2013-07-17 17:24:54 +0000 +++ src/lisp.h 2013-07-18 02:12:59 +0000 @@ -3743,6 +3743,7 @@ extern void record_unwind_protect_int (void (*) (int), int); extern void record_unwind_protect_ptr (void (*) (void *), void *); extern void record_unwind_protect_void (void (*) (void)); +extern void record_unwind_protect_nothing (void); extern void clear_unwind_protect (ptrdiff_t); extern void set_unwind_protect_ptr (ptrdiff_t, void (*) (void *), void *); extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object); @@ -3827,6 +3828,7 @@ extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object); EXFUN (Fread_file_name, 6); /* Not a normal DEFUN. */ extern void close_file_unwind (int); +extern void fclose_unwind (void *); extern void restore_point_unwind (Lisp_Object); extern _Noreturn void report_file_errno (const char *, Lisp_Object, int); extern _Noreturn void report_file_error (const char *, Lisp_Object); === modified file 'src/lread.c' --- src/lread.c 2013-07-17 17:24:54 +0000 +++ src/lread.c 2013-07-18 02:12:59 +0000 @@ -145,7 +145,6 @@ static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); -static void load_unwind (void *); /* Functions that read one byte from the current source READCHARFUN or unreads one byte. If the integer argument C is -1, it returns @@ -1317,7 +1316,7 @@ } if (! stream) report_file_error ("Opening stdio stream", file); - set_unwind_protect_ptr (fd_index, load_unwind, stream); + set_unwind_protect_ptr (fd_index, fclose_unwind, stream); if (! NILP (Vpurify_flag)) Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list); @@ -1387,18 +1386,6 @@ return Qt; } - -static void -load_unwind (void *arg) -{ - FILE *stream = arg; - if (stream != NULL) - { - block_input (); - fclose (stream); - unblock_input (); - } -} static bool complete_filename_p (Lisp_Object pathname)