carbon2-commit: Add a couple of extra docstring backslashes, #'format-time-string
13 years, 5 months
Aidan Kehoe
Aidan Kehoe
changeset: 5314:1ed4cefddd12
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Sep 05 19:22:37 2010 +0100
files: src/ChangeLog src/editfns.c
description:
Add a couple of extra docstring backslashes, #'format-time-string
2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
* editfns.c (Fformat_time_string):
Use two backslashes so that there is at least one present in the
output of describe function, when describing the Roman month
number syntax in this function's docstring. Thanks for provoking
me to look at this, Stephen Turnbull.
diff -r 30bf66dd3ca0 -r 1ed4cefddd12 src/ChangeLog
--- a/src/ChangeLog Fri Sep 03 17:14:10 2010 +0100
+++ b/src/ChangeLog Sun Sep 05 19:22:37 2010 +0100
＠＠ -1,3 +1,11 ＠＠
+2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * editfns.c (Fformat_time_string):
+ Use two backslashes so that there is at least one present in the
+ output of describe function, when describing the Roman month
+ number syntax in this function's docstring. Thanks for provoking
+ me to look at this, Stephen Turnbull.
+
2010-09-03 Aidan Kehoe <kehoea(a)parhasard.net>
* symsinit.h: Declare reinit_process_early() here, fixing the C++
diff -r 30bf66dd3ca0 -r 1ed4cefddd12 src/editfns.c
--- a/src/editfns.c Fri Sep 03 17:14:10 2010 +0100
+++ b/src/editfns.c Sun Sep 05 19:22:37 2010 +0100
＠＠ -1044,8 +1044,8 ＠＠
%Y is replaced by the year with century.
%z is replaced by the time zone as a numeric offset (e.g +0530, -0800 etc.)
%Z is replaced by the time zone abbreviation.
-%\xe6 is replaced by the month as a lowercase Roman number (i-xii)
-%\xc6 is replaced by the month as an uppercase Roman number (I-XII)
+%\\xe6 is replaced by the month as a lowercase Roman number (i-xii)
+%\\xc6 is replaced by the month as an uppercase Roman number (I-XII)
The number of options reflects the `strftime' function.
*/
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Add fixnum as an accepted destination type, #'coerce
13 years, 5 months
Aidan Kehoe
Aidan Kehoe
changeset: 5313:30bf66dd3ca0
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Fri Sep 03 17:14:10 2010 +0100
files: lisp/ChangeLog lisp/cl-extra.el
description:
Add fixnum as an accepted destination type, #'coerce
2010-09-03 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el (coerce):
Add fixnum as an accepted destination type.
diff -r 6c8f5574d4a1 -r 30bf66dd3ca0 lisp/ChangeLog
--- a/lisp/ChangeLog Fri Sep 03 15:35:53 2010 +0100
+++ b/lisp/ChangeLog Fri Sep 03 17:14:10 2010 +0100
＠＠ -1,3 +1,8 ＠＠
+2010-09-03 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-extra.el (coerce):
+ Add fixnum as an accepted destination type.
+
2010-09-02 Aidan Kehoe <kehoea(a)parhasard.net>
* obsolete.el (process-get):
diff -r 6c8f5574d4a1 -r 30bf66dd3ca0 lisp/cl-extra.el
--- a/lisp/cl-extra.el Fri Sep 03 15:35:53 2010 +0100
+++ b/lisp/cl-extra.el Fri Sep 03 17:14:10 2010 +0100
＠＠ -64,11 +64,11 ＠＠
((and (eq type 'character) (symbolp x)) (coerce (symbol-name x) type))
;; XEmacs addition character <-> integer coercions
((and (eq type 'character) (char-int-p x)) (int-char x))
- ((and (eq type 'integer) (characterp x)) (char-int x))
+ ((and (memq type '(integer fixnum)) (characterp x)) (char-int x))
((eq type 'float) (float x))
;; XEmacs addition: enhanced numeric type coercions
((and-fboundp 'coerce-number
- (memq type '(integer ratio bigfloat))
+ (memq type '(integer ratio bigfloat fixnum))
(coerce-number x type)))
;; XEmacs addition: bit-vector coercion
((or (eq type 'bit-vector)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Fix the C++, Visual Studio 2005 builds.
13 years, 5 months
Aidan Kehoe
Aidan Kehoe
changeset: 5312:6c8f5574d4a1
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Fri Sep 03 15:35:53 2010 +0100
files: src/ChangeLog src/fontcolor-msw.c src/symsinit.h
description:
Fix the C++, Visual Studio 2005 builds.
src/ChangeLog addition:
2010-09-03 Aidan Kehoe <kehoea(a)parhasard.net>
* symsinit.h: Declare reinit_process_early() here, fixing the C++
build; thank you for pointing this out, Adam Sjogren!
* fontcolor-msw.c (mswindows_string_to_color):
Cast the result of bsearch() to a colormap_t pointer, fixing the
Visual Studio 2005 build.
diff -r b5611afbcc76 -r 6c8f5574d4a1 src/ChangeLog
--- a/src/ChangeLog Thu Sep 02 12:23:11 2010 +0100
+++ b/src/ChangeLog Fri Sep 03 15:35:53 2010 +0100
＠＠ -1,3 +1,11 ＠＠
+2010-09-03 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * symsinit.h: Declare reinit_process_early() here, fixing the C++
+ build; thank you for pointing this out, Adam Sjøgren!
+ * fontcolor-msw.c (mswindows_string_to_color):
+ Cast the result of bsearch() to a colormap_t pointer, fixing the
+ Visual Studio 2005 build.
+
2010-09-02 Aidan Kehoe <kehoea(a)parhasard.net>
* strftime.c (roman_upper, roman_lower, strftime):
diff -r b5611afbcc76 -r 6c8f5574d4a1 src/fontcolor-msw.c
--- a/src/fontcolor-msw.c Thu Sep 02 12:23:11 2010 +0100
+++ b/src/fontcolor-msw.c Fri Sep 03 15:35:53 2010 +0100
＠＠ -1022,10 +1022,10 ＠＠
}
*c = '\0';
- if ((res = bsearch (&key, mswindows_X_color_map,
- countof (mswindows_X_color_map),
- sizeof (mswindows_X_color_map[0]),
- colormap_t_compare)) != NULL)
+ if ((res = (colormap_t *) bsearch (&key, mswindows_X_color_map,
+ countof (mswindows_X_color_map),
+ sizeof (mswindows_X_color_map[0]),
+ colormap_t_compare)) != NULL)
{
return res->colorref;
}
diff -r b5611afbcc76 -r 6c8f5574d4a1 src/symsinit.h
--- a/src/symsinit.h Thu Sep 02 12:23:11 2010 +0100
+++ b/src/symsinit.h Fri Sep 03 15:35:53 2010 +0100
＠＠ -54,6 +54,7 ＠＠
void init_errors_once_early (void);
void reinit_opaque_early (void);
void init_opaque_once_early (void);
+void reinit_process_early (void);
void reinit_symbols_early (void);
void init_symbols_once_early (void);
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Support process plists, for greater GNU compatibility.
13 years, 5 months
Aidan Kehoe
Aidan Kehoe
changeset: 5311:b5611afbcc76
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Sep 02 12:23:11 2010 +0100
files: lisp/ChangeLog lisp/obsolete.el src/ChangeLog src/emacs.c src/fns.c src/lrecord.h src/process-slots.h src/process.c src/symbols.c
description:
Support process plists, for greater GNU compatibility.
src/ChangeLog addition:
2010-09-02 Aidan Kehoe <kehoea(a)parhasard.net>
* process.c (process_getprop, process_putprop, process_remprop)
(process_plist, process_setplist, reinit_process_early):
Add functions to modify a process's property list.
* process-slots.h (MARKED_SLOT): Add a plist slot.
* fns.c (Fobject_setplist): New function, analogous to #'setplist,
but more general.
Update the documentation in the other plist functions to reflect
that processes now have property lists.
* emacs.c (main_1): Call reinit_process_early(), now processes have
plist methods that need to be initialised.
* symbols.c (reinit_symbol_objects_early): Fsetplist is the named
setplist method for symbols.
lisp/ChangeLog addition:
2010-09-02 Aidan Kehoe <kehoea(a)parhasard.net>
* obsolete.el (process-get):
Make #'process-get, #'process-put, #'process-plist,
#'set-process-plist available as aliases to the more general
functions #'get, #'put, #'object-plist, #'object-setplist, for GNU
compatibility.
diff -r 1537701f08a1 -r b5611afbcc76 lisp/ChangeLog
--- a/lisp/ChangeLog Thu Sep 02 12:00:06 2010 +0100
+++ b/lisp/ChangeLog Thu Sep 02 12:23:11 2010 +0100
＠＠ -1,3 +1,11 ＠＠
+2010-09-02 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * obsolete.el (process-get):
+ Make #'process-get, #'process-put, #'process-plist,
+ #'set-process-plist available as aliases to the more general
+ functions #'get, #'put, #'object-plist, #'object-setplist, for GNU
+ compatibility.
+
2010-08-20 Mike Sperber <mike(a)xemacs.org>
* files.el (save-some-buffers-action-alist): Add.
diff -r 1537701f08a1 -r b5611afbcc76 lisp/obsolete.el
--- a/lisp/obsolete.el Thu Sep 02 12:00:06 2010 +0100
+++ b/lisp/obsolete.el Thu Sep 02 12:23:11 2010 +0100
＠＠ -428,5 +428,10 ＠＠
(define-function 'purecopy 'identity)
(make-obsolete 'purecopy "purespace is not available in XEmacs.")
+(define-compatible-function-alias 'process-get 'get)
+(define-compatible-function-alias 'process-put 'put)
+(define-compatible-function-alias 'process-plist 'object-plist)
+(define-compatible-function-alias 'set-process-plist 'object-setplist)
+
(provide 'obsolete)
;;; obsolete.el ends here
diff -r 1537701f08a1 -r b5611afbcc76 src/ChangeLog
--- a/src/ChangeLog Thu Sep 02 12:00:06 2010 +0100
+++ b/src/ChangeLog Thu Sep 02 12:23:11 2010 +0100
＠＠ -38,6 +38,22 ＠＠
case, despite what the comments said.
(Fmaplist, Fmapl, Fmapcon):
Call maplist() with its new arguments.
+
+2010-09-02 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * process.c (process_getprop, process_putprop, process_remprop)
+ (process_plist, process_setplist, reinit_process_early):
+ Add functions to modify a process's property list.
+ * process-slots.h (MARKED_SLOT): Add a plist slot.
+
+ * fns.c (Fobject_setplist): New function, analogous to #'setplist,
+ but more general.
+ Update the documentation in the other plist functions to reflect
+ that processes now have property lists.
+ * emacs.c (main_1): Call reinit_process_early(), now processes have
+ plist methods that need to be initialised.
+ * symbols.c (reinit_symbol_objects_early): Fsetplist is the named
+ setplist method for symbols.
2010-08-30 Aidan Kehoe <kehoea(a)parhasard.net>
diff -r 1537701f08a1 -r b5611afbcc76 src/emacs.c
--- a/src/emacs.c Thu Sep 02 12:00:06 2010 +0100
+++ b/src/emacs.c Thu Sep 02 12:23:11 2010 +0100
＠＠ -1468,6 +1468,7 ＠＠
reinit_alloc_early ();
reinit_gc_early ();
reinit_symbols_early ();
+ reinit_process_early ();
#ifndef NEW_GC
reinit_opaque_early ();
#endif /* not NEW_GC */
diff -r 1537701f08a1 -r b5611afbcc76 src/fns.c
--- a/src/fns.c Thu Sep 02 12:00:06 2010 +0100
+++ b/src/fns.c Thu Sep 02 12:23:11 2010 +0100
＠＠ -3545,7 +3545,8 ＠＠
This is the last VALUE stored with `(put OBJECT PROPERTY VALUE)'.
If there is no such property, return optional third arg DEFAULT
\(which defaults to `nil'). OBJECT can be a symbol, string, extent,
-face, or glyph. See also `put', `remprop', and `object-plist'.
+face, glyph, or process. See also `put', `remprop', `object-plist', and
+`object-setplist'.
*/
(object, property, default_))
{
＠＠ -3589,9 +3590,10 ＠＠
DEFUN ("remprop", Fremprop, 2, 2, 0, /*
Remove, from OBJECT's property list, PROPERTY and its corresponding value.
-OBJECT can be a symbol, string, extent, face, or glyph. Return non-nil
-if the property list was actually modified (i.e. if PROPERTY was present
-in the property list). See also `get', `put', and `object-plist'.
+OBJECT can be a symbol, string, extent, face, glyph, or process.
+Return non-nil if the property list was actually modified (i.e. if PROPERTY
+was present in the property list). See also `get', `put', `object-plist',
+and `object-setplist'.
*/
(object, property))
{
＠＠ -3627,6 +3629,26 ＠＠
return Qnil;
}
+
+DEFUN ("object-setplist", Fobject_setplist, 2, 2, 0, /*
+Set OBJECT's property list to NEWPLIST, and return NEWPLIST.
+For a symbol, this is equivalent to `setplist'.
+
+OBJECT can be a symbol or a process, other objects with visible plists do
+not allow their modification with `object-setplist'.
+*/
+ (object, newplist))
+{
+ if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->setplist)
+ {
+ return XRECORD_LHEADER_IMPLEMENTATION (object)->setplist (object,
+ newplist);
+ }
+
+ invalid_operation ("Not possible to set object's plist", object);
+ return Qnil;
+}
+
static Lisp_Object
＠＠ -6015,6 +6037,7 ＠＠
DEFSUBR (Fput);
DEFSUBR (Fremprop);
DEFSUBR (Fobject_plist);
+ DEFSUBR (Fobject_setplist);
DEFSUBR (Fequal);
DEFSUBR (Fequalp);
DEFSUBR (Fold_equal);
diff -r 1537701f08a1 -r b5611afbcc76 src/lrecord.h
--- a/src/lrecord.h Thu Sep 02 12:00:06 2010 +0100
+++ b/src/lrecord.h Thu Sep 02 12:23:11 2010 +0100
＠＠ -525,6 +525,7 ＠＠
int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val);
int (*remprop) (Lisp_Object obj, Lisp_Object prop);
Lisp_Object (*plist) (Lisp_Object obj);
+ Lisp_Object (*setplist) (Lisp_Object obj, Lisp_Object newplist);
/* `disksave' is called at dump time. It is used for objects that
contain pointers or handles to objects created in external libraries,
diff -r 1537701f08a1 -r b5611afbcc76 src/process-slots.h
--- a/src/process-slots.h Thu Sep 02 12:00:06 2010 +0100
+++ b/src/process-slots.h Thu Sep 02 12:23:11 2010 +0100
＠＠ -68,4 +68,6 ＠＠
all of the Lisp objects, including in process-type-specific data. */
MARKED_SLOT (tty_name)
+ MARKED_SLOT (plist)
+
#undef MARKED_SLOT
diff -r 1537701f08a1 -r b5611afbcc76 src/process.c
--- a/src/process.c Thu Sep 02 12:00:06 2010 +0100
+++ b/src/process.c Thu Sep 02 12:23:11 2010 +0100
＠＠ -169,6 +169,42 ＠＠
MAYBE_PROCMETH (print_process_data, (process, printcharfun));
write_ascstring (printcharfun, ">");
}
+}
+/* Process plists are directly accessible, so we need to protect against
+ invalid property list structure */
+
+static Lisp_Object
+process_getprop (Lisp_Object process, Lisp_Object property)
+{
+ return external_plist_get (&XPROCESS (process)->plist, property, 0,
+ ERROR_ME);
+}
+
+static int
+process_putprop (Lisp_Object process, Lisp_Object property, Lisp_Object value)
+{
+ external_plist_put (&XPROCESS (process)->plist, property, value, 0,
+ ERROR_ME);
+ return 1;
+}
+
+static int
+process_remprop (Lisp_Object process, Lisp_Object property)
+{
+ return external_remprop (&XPROCESS (process)->plist, property, 0, ERROR_ME);
+}
+
+static Lisp_Object
+process_plist (Lisp_Object process)
+{
+ return XPROCESS (process)->plist;
+}
+
+static Lisp_Object
+process_setplist (Lisp_Object process, Lisp_Object newplist)
+{
+ XPROCESS (process)->plist = newplist;
+ return newplist;
}
#ifdef HAVE_WINDOW_SYSTEM
＠＠ -2405,6 +2441,16 ＠＠
}
+void
+reinit_process_early (void)
+{
+ OBJECT_HAS_METHOD (process, getprop);
+ OBJECT_HAS_METHOD (process, putprop);
+ OBJECT_HAS_METHOD (process, remprop);
+ OBJECT_HAS_METHOD (process, plist);
+ OBJECT_HAS_METHOD (process, setplist);
+}
+
/* This is not named init_process in order to avoid a conflict with NS 3.3 */
void
init_xemacs_process (void)
＠＠ -2481,6 +2527,8 ＠＠
Vshell_file_name = build_istring (shell);
}
+
+ reinit_process_early ();
}
void
diff -r 1537701f08a1 -r b5611afbcc76 src/symbols.c
--- a/src/symbols.c Thu Sep 02 12:00:06 2010 +0100
+++ b/src/symbols.c Thu Sep 02 12:23:11 2010 +0100
＠＠ -3530,6 +3530,7 ＠＠
OBJECT_HAS_METHOD (symbol, putprop);
OBJECT_HAS_METHOD (symbol, remprop);
OBJECT_HAS_NAMED_METHOD (symbol, plist, Fsymbol_plist);
+ OBJECT_HAS_NAMED_METHOD (symbol, setplist, Fsetplist);
}
void
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Support Roman month numbers, #'format-time-string
13 years, 5 months
Aidan Kehoe
Aidan Kehoe
changeset: 5310:1537701f08a1
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Sep 02 12:00:06 2010 +0100
files: man/ChangeLog man/lispref/os.texi src/ChangeLog src/editfns.c src/strftime.c src/text.h
description:
Support Roman month numbers, #'format-time-string
src/ChangeLog addition:
2010-09-02 Aidan Kehoe <kehoea(a)parhasard.net>
* strftime.c (roman_upper, roman_lower, strftime):
Implement Roman month numbers, as used in central and eastern
Europe.
* editfns.c (Fformat_time_string):
Document two new escapes, to allow uppercase and lowercase Roman
month numbers. Remove documentation of a bug that we didn't
actually have.
* text.h (Qtime_function_encoding): We know the text encoding
coming from strftime(), because we always use the one in
strftime.c. Don't use Qnative.
man/ChangeLog addition:
2010-09-02 Aidan Kehoe <kehoea(a)parhasard.net>
* lispref/os.texi (Time Conversion):
Document the new #'format-time-string flags for Roman month
numbers.
diff -r b6a398dbb403 -r 1537701f08a1 man/ChangeLog
--- a/man/ChangeLog Wed Sep 01 12:51:32 2010 +0100
+++ b/man/ChangeLog Thu Sep 02 12:00:06 2010 +0100
＠＠ -1,3 +1,9 ＠＠
+2010-09-02 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * lispref/os.texi (Time Conversion):
+ Document the new #'format-time-string flags for Roman month
+ numbers.
+
2010-08-30 Aidan Kehoe <kehoea(a)parhasard.net>
* lispref/eval.texi (Evaluation, Multiple values):
diff -r b6a398dbb403 -r 1537701f08a1 man/lispref/os.texi
--- a/man/lispref/os.texi Wed Sep 01 12:51:32 2010 +0100
+++ b/man/lispref/os.texi Thu Sep 02 12:00:06 2010 +0100
＠＠ -1026,6 +1026,10 ＠＠
This stands for the year with century.
＠item %Z
This stands for the time zone abbreviation.
+＠item %\xe6 (the ISO-8859-1 lowercase ae character)
+This stands for the month as a lowercase Roman number (i-xii)
+＠item %\xc6 (the ISO-8859-1 uppercase AE character)
+This stands for the month as an uppercase Roman number (I-XII)
＠end table
＠end defun
diff -r b6a398dbb403 -r 1537701f08a1 src/ChangeLog
--- a/src/ChangeLog Wed Sep 01 12:51:32 2010 +0100
+++ b/src/ChangeLog Thu Sep 02 12:00:06 2010 +0100
＠＠ -1,3 +1,16 ＠＠
+2010-09-02 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * strftime.c (roman_upper, roman_lower, strftime):
+ Implement Roman month numbers, as used in central and eastern
+ Europe.
+ * editfns.c (Fformat_time_string):
+ Document two new escapes, to allow uppercase and lowercase Roman
+ month numbers. Remove documentation of a bug that we didn't
+ actually have.
+ * text.h (Qtime_function_encoding): We know the text encoding
+ coming from strftime(), because we always use the one in
+ strftime.c. Don't use Qnative.
+
2010-09-01 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (list_merge, list_array_merge_into_list)
diff -r b6a398dbb403 -r 1537701f08a1 src/editfns.c
--- a/src/editfns.c Wed Sep 01 12:51:32 2010 +0100
+++ b/src/editfns.c Thu Sep 02 12:00:06 2010 +0100
＠＠ -1044,11 +1044,10 ＠＠
%Y is replaced by the year with century.
%z is replaced by the time zone as a numeric offset (e.g +0530, -0800 etc.)
%Z is replaced by the time zone abbreviation.
+%\xe6 is replaced by the month as a lowercase Roman number (i-xii)
+%\xc6 is replaced by the month as an uppercase Roman number (I-XII)
The number of options reflects the `strftime' function.
-
-BUG: If the charset used by the current locale is not ISO 8859-1, the
-characters appearing in the day and month names may be incorrect.
*/
(format_string, time_))
{
diff -r b6a398dbb403 -r 1537701f08a1 src/strftime.c
--- a/src/strftime.c Wed Sep 01 12:51:32 2010 +0100
+++ b/src/strftime.c Thu Sep 02 12:00:06 2010 +0100
＠＠ -130,6 +130,16 ＠＠
{
"January", "February", "March", "April", "May", "June",
"July", "August", "September", "October", "November", "December"
+};
+
+static char const * const roman_upper[] =
+{
+ "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX", "X", "XI", "XII"
+};
+
+static char const * const roman_lower[] =
+{
+ "i", "ii", "iii", "iv", "v", "vi", "vii", "viii", "ix", "x", "xi", "xii"
};
/* Add character C to STRING and increment LENGTH,
＠＠ -601,6 +611,16 ＠＠
add_num3 (&string[length],
(1900 + tm->tm_year) % 1000, max - length, zero);
break;
+ case '\xe6':
+ length +=
+ add_str (&string[length], roman_lower[tm->tm_mon],
+ max - length);
+ break;
+ case '\xC6':
+ length +=
+ add_str (&string[length], roman_upper[tm->tm_mon],
+ max - length);
+ break;
}
}
}
diff -r b6a398dbb403 -r 1537701f08a1 src/text.h
--- a/src/text.h Wed Sep 01 12:51:32 2010 +0100
+++ b/src/text.h Thu Sep 02 12:00:06 2010 +0100
＠＠ -3095,7 +3095,7 ＠＠
#endif
#define Qunix_host_name_encoding Qnative
#define Qunix_service_name_encoding Qnative
-#define Qtime_function_encoding Qnative
+#define Qtime_function_encoding Qbinary
#define Qtime_zone_encoding Qtime_function_encoding
#define Qmswindows_host_name_encoding Qmswindows_multibyte
#define Qmswindows_service_name_encoding Qmswindows_multibyte
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
13 years, 5 months
Aidan Kehoe
Aidan Kehoe
changeset: 5309:b6a398dbb403
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Wed Sep 01 12:51:32 2010 +0100
files: src/ChangeLog src/fns.c
description:
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
src/ChangeLog addition:
2010-09-01 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (list_merge, list_array_merge_into_list)
(list_array_merge_into_array):
Avoid algorithmic complexity surprises when checking for
circularity in these functions.
(Freduce): Fix some formatting, in passing.
(mapcarX): Drop the SOME_OR_EVERY argument to this function;
instead, take CALLER, a symbol reflecting the Lisp-visible
function that called mapcarX(). Use CALLER with
mapping_interaction_error() when sequences are modified
illegally. Don't cons with #'some, #'every, not even a little.
(Fmapconcat, FmapcarX, Fmapvector, Fmapcan, Fmapc, Fmap)
(Fmap_into, Fsome, Fevery): Call mapcarX() with its new
arguments.
(Fmapcan): Don't unnecessarily complicate the nconc call.
(maplist): Take CALLER, a symbol reflecting the Lisp-visible
function that called maplist(), rather than having separate
arguments to indicate mapl vs. mapcon.
Avoid algorithmic complexity surprises when checking for
circularity. In #'mapcon, check a given stretch of
result for well-formedness once, which was not previously the
case, despite what the comments said.
(Fmaplist, Fmapl, Fmapcon):
Call maplist() with its new arguments.
diff -r 378a34562cbe -r b6a398dbb403 src/ChangeLog
--- a/src/ChangeLog Mon Aug 30 15:23:42 2010 +0100
+++ b/src/ChangeLog Wed Sep 01 12:51:32 2010 +0100
＠＠ -1,3 +1,31 ＠＠
+2010-09-01 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (list_merge, list_array_merge_into_list)
+ (list_array_merge_into_array):
+ Avoid algorithmic complexity surprises when checking for
+ circularity in these functions.
+ (Freduce): Fix some formatting, in passing.
+
+ (mapcarX): Drop the SOME_OR_EVERY argument to this function;
+ instead, take CALLER, a symbol reflecting the Lisp-visible
+ function that called mapcarX(). Use CALLER with
+ mapping_interaction_error() when sequences are modified
+ illegally. Don't cons with #'some, #'every, not even a little.
+ (Fmapconcat, FmapcarX, Fmapvector, Fmapcan, Fmapc, Fmap)
+ (Fmap_into, Fsome, Fevery): Call mapcarX() with its new
+ arguments.
+ (Fmapcan): Don't unnecessarily complicate the nconc call.
+
+ (maplist): Take CALLER, a symbol reflecting the Lisp-visible
+ function that called maplist(), rather than having separate
+ arguments to indicate mapl vs. mapcon.
+ Avoid algorithmic complexity surprises when checking for
+ circularity. In #'mapcon, check a given stretch of
+ result for well-formedness once, which was not previously the
+ case, despite what the comments said.
+ (Fmaplist, Fmapl, Fmapcon):
+ Call maplist() with its new arguments.
+
2010-08-30 Aidan Kehoe <kehoea(a)parhasard.net>
* floatfns.c (ceiling_one_mundane_arg, floor_one_mundane_arg)
diff -r 378a34562cbe -r b6a398dbb403 src/fns.c
--- a/src/fns.c Mon Aug 30 15:23:42 2010 +0100
+++ b/src/fns.c Wed Sep 01 12:51:32 2010 +0100
＠＠ -56,7 +56,9 ＠＠
Lisp_Object Qstring_lessp, Qsort, Qmerge, Qfill;
Lisp_Object Qidentity;
-Lisp_Object Qvector, Qarray, Qbit_vector, QsortX, Qreduce, Q_from_end, Q_initial_value;
+Lisp_Object Qvector, Qarray, Qbit_vector, QsortX, Q_from_end, Q_initial_value;
+Lisp_Object Qmapconcat, QmapcarX, Qmapvector, Qmapcan, Qmapc, Qmap, Qmap_into;
+Lisp_Object Qsome, Qevery, Qmaplist, Qmapl, Qmapcon, Qreduce;
Lisp_Object Qbase64_conversion_error;
＠＠ -2063,13 +2065,16 ＠＠
Lisp_Object tail;
Lisp_Object tem;
Lisp_Object l1, l2;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ Lisp_Object tortoises[2];
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
int looped = 0;
l1 = org_l1;
l2 = org_l2;
tail = Qnil;
value = Qnil;
+ tortoises[0] = org_l1;
+ tortoises[1] = org_l2;
if (NULL == c_predicate)
{
＠＠ -2081,7 +2086,8 ＠＠
When l1 and l2 are updated, we copy the new values
back into the org_ vars. */
- GCPRO4 (org_l1, org_l2, predicate, value);
+ GCPRO5 (org_l1, org_l2, predicate, value, tortoises[0]);
+ gcpro5.nvars = 2;
while (1)
{
＠＠ -2120,19 +2126,24 ＠＠
Fsetcdr (tail, tem);
tail = tem;
- if (++looped % CIRCULAR_LIST_SUSPICION_LENGTH) continue;
-
- /* Just check the lists aren't circular:*/
- {
- EXTERNAL_LIST_LOOP_1 (l1)
- {
- }
- }
- {
- EXTERNAL_LIST_LOOP_1 (l2)
- {
- }
- }
+ if (++looped > CIRCULAR_LIST_SUSPICION_LENGTH)
+ {
+ if (looped & 1)
+ {
+ tortoises[0] = XCDR (tortoises[0]);
+ tortoises[1] = XCDR (tortoises[1]);
+ }
+
+ if (EQ (org_l1, tortoises[0]))
+ {
+ signal_circular_list_error (org_l1);
+ }
+
+ if (EQ (org_l2, tortoises[1]))
+ {
+ signal_circular_list_error (org_l2);
+ }
+ }
}
}
＠＠ -2230,12 +2241,12 ＠＠
Lisp_Object predicate, Lisp_Object key_func,
Boolint reverse_order)
{
- Lisp_Object tail = Qnil, value = Qnil;
- struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object tail = Qnil, value = Qnil, tortoise = list;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Elemcount array_index = 0;
int looped = 0;
- GCPRO3 (list, tail, value);
+ GCPRO4 (list, tail, value, tortoise);
while (1)
{
＠＠ -2297,13 +2308,18 ＠＠
++array_index;
}
- if (++looped % CIRCULAR_LIST_SUSPICION_LENGTH) continue;
-
- {
- EXTERNAL_LIST_LOOP_1 (list)
- {
- }
- }
+ if (++looped > CIRCULAR_LIST_SUSPICION_LENGTH)
+ {
+ if (looped & 1)
+ {
+ tortoise = XCDR (tortoise);
+ }
+
+ if (EQ (list, tortoise))
+ {
+ signal_circular_list_error (list);
+ }
+ }
}
}
＠＠ -2377,7 +2393,7 ＠＠
{
if (array_len - array_index != output_len - output_index)
{
- invalid_state ("List length modified during merge", Qunbound);
+ mapping_interaction_error (Qmerge, list);
}
while (array_index < array_len)
＠＠ -4105,35 +4121,34 ＠＠
so FUNCTION cannot insert a non-cons into SEQUENCES[0] and throw off
mapcarX.
- Otherwise, mapcarX signals a wrong-type-error if it encounters a
- non-cons, non-array when traversing SEQUENCES. Common Lisp specifies in
+ Otherwise, mapcarX signals an invalid state error (see
+ mapping_interaction_error(), above) if it encounters a non-cons,
+ non-array when traversing SEQUENCES. Common Lisp specifies in
MAPPING-DESTRUCTIVE-INTERACTION that it is an error when FUNCTION
destructively modifies SEQUENCES in a way that might affect the ongoing
traversal operation.
- If SOME_OR_EVERY is SOME_OR_EVERY_SOME, return the (possibly multiple)
- values given by FUNCTION the first time it is non-nil, and abandon the
- iterations. LISP_VALS must be a cons, and the return value will be
- stored in its car. If SOME_OR_EVERY is SOME_OR_EVERY_EVERY, store Qnil
- in the car of LISP_VALS if FUNCTION gives nil; otherwise leave it
- alone. */
-
-#define SOME_OR_EVERY_NEITHER 0
-#define SOME_OR_EVERY_SOME 1
-#define SOME_OR_EVERY_EVERY 2
+ CALLER is a symbol describing the Lisp-visible function that was called,
+ and any errors thrown because SEQUENCES was modified will reflect it.
+
+ If CALLER is Qsome, return the (possibly multiple) values given by
+ FUNCTION the first time it is non-nil, and abandon the iterations.
+ LISP_VALS must be the result of calling STORE_VOID_IN_LISP on the address
+ of a Lisp object, and the return value will be stored at that address.
+ If CALLER is Qevery, LISP_VALS must also reflect a pointer to a Lisp
+ object, and Qnil will be stored at that address if FUNCTION gives nil;
+ otherwise it will be left alone. */
static void
mapcarX (Elemcount call_count, Lisp_Object *vals, Lisp_Object lisp_vals,
Lisp_Object function, int nsequences, Lisp_Object *sequences,
- int some_or_every)
+ Lisp_Object caller)
{
Lisp_Object called, *args;
struct gcpro gcpro1, gcpro2;
int i, j;
- enum lrecord_type lisp_vals_type;
-
- assert (LRECORDP (lisp_vals));
- lisp_vals_type = (enum lrecord_type) XRECORD_LHEADER (lisp_vals)->type;
+
+ assert ((EQ (caller, Qsome) || EQ (caller, Qevery)) ? vals == NULL : 1);
args = alloca_array (Lisp_Object, nsequences + 1);
args[0] = function;
＠＠ -4177,11 +4192,20 ＠＠
}
else
{
+ enum lrecord_type lisp_vals_type;
Binbyte *sequence_types = alloca_array (Binbyte, nsequences);
for (j = 0; j < nsequences; ++j)
{
sequence_types[j] = XRECORD_LHEADER (sequences[j])->type;
}
+
+ if (!EQ (caller, Qsome) && !EQ (caller, Qevery))
+ {
+ assert (LRECORDP (lisp_vals));
+ lisp_vals_type
+ = (enum lrecord_type) XRECORD_LHEADER (lisp_vals)->type;
+ assert (NILP (lisp_vals) || lisp_vals_type != lrecord_type_symbol);
+ }
for (i = 0; i < call_count; ++i)
{
＠＠ -4193,13 +4217,12 ＠＠
{
if (!CONSP (sequences[j]))
{
- /* This means FUNCTION has probably messed
- around with a cons in one of the sequences,
- since we checked the type
- (CHECK_SEQUENCE()) and the length and
+ /* This means FUNCTION has messed around with a cons
+ in one of the sequences, since we checked the
+ type (CHECK_SEQUENCE()) and the length and
structure (with Flength()) correctly in our
callers. */
- dead_wrong_type_argument (Qconsp, sequences[j]);
+ mapping_interaction_error (caller, sequences[j]);
}
args[j + 1] = XCAR (sequences[j]);
sequences[j] = XCDR (sequences[j]);
＠＠ -4232,91 +4255,82 ＠＠
vals[i] = IGNORE_MULTIPLE_VALUES (called);
gcpro2.nvars += 1;
}
- else
- {
- switch (lisp_vals_type)
- {
- case lrecord_type_symbol:
- break;
- case lrecord_type_cons:
- {
- if (SOME_OR_EVERY_NEITHER == some_or_every)
- {
- called = IGNORE_MULTIPLE_VALUES (called);
- if (!CONSP (lisp_vals))
- {
- /* If FUNCTION has inserted a non-cons non-nil
- cdr into the list before we've processed the
- relevant part, error. */
- dead_wrong_type_argument (Qconsp, lisp_vals);
- }
-
- XSETCAR (lisp_vals, called);
- lisp_vals = XCDR (lisp_vals);
- break;
- }
-
- if (SOME_OR_EVERY_SOME == some_or_every)
- {
- if (!NILP (IGNORE_MULTIPLE_VALUES (called)))
- {
- XCAR (lisp_vals) = called;
- UNGCPRO;
- return;
- }
- break;
- }
-
- if (SOME_OR_EVERY_EVERY == some_or_every)
- {
- called = IGNORE_MULTIPLE_VALUES (called);
- if (NILP (called))
- {
- XCAR (lisp_vals) = Qnil;
- UNGCPRO;
- return;
- }
- break;
- }
-
- goto bad_some_or_every_flag;
- }
- case lrecord_type_vector:
- {
- called = IGNORE_MULTIPLE_VALUES (called);
- i < XVECTOR_LENGTH (lisp_vals) ?
- (XVECTOR_DATA (lisp_vals)[i] = called) :
- /* Let #'aset error. */
- Faset (lisp_vals, make_int (i), called);
- break;
- }
- case lrecord_type_string:
- {
- /* If this ever becomes a code hotspot, we can keep
- around pointers into the data of the string, checking
- each time that it hasn't been relocated. */
- called = IGNORE_MULTIPLE_VALUES (called);
- Faset (lisp_vals, make_int (i), called);
- break;
- }
- case lrecord_type_bit_vector:
- {
- called = IGNORE_MULTIPLE_VALUES (called);
- (BITP (called) &&
- i < bit_vector_length (XBIT_VECTOR (lisp_vals))) ?
- set_bit_vector_bit (XBIT_VECTOR (lisp_vals), i,
- XINT (called)) :
- (void) Faset (lisp_vals, make_int (i), called);
- break;
- }
- bad_some_or_every_flag:
- default:
- {
- ABORT();
- break;
- }
- }
- }
+ else if (EQ (Qsome, caller))
+ {
+ if (!NILP (IGNORE_MULTIPLE_VALUES (called)))
+ {
+ Lisp_Object *result
+ = (Lisp_Object *) GET_VOID_FROM_LISP (lisp_vals);
+ *result = called;
+ UNGCPRO;
+ return;
+ }
+ }
+ else if (EQ (Qevery, caller))
+ {
+ if (NILP (IGNORE_MULTIPLE_VALUES (called)))
+ {
+ Lisp_Object *result
+ = (Lisp_Object *) GET_VOID_FROM_LISP (lisp_vals);
+ *result = Qnil;
+ UNGCPRO;
+ return;
+ }
+ }
+ else
+ {
+ called = IGNORE_MULTIPLE_VALUES (called);
+ switch (lisp_vals_type)
+ {
+ case lrecord_type_symbol:
+ /* This is #'mapc; the result of the funcall is
+ discarded. */
+ break;
+ case lrecord_type_cons:
+ {
+ if (!CONSP (lisp_vals))
+ {
+ /* If FUNCTION has inserted a non-cons non-nil
+ cdr into the list before we've processed the
+ relevant part, error. */
+ mapping_interaction_error (caller, lisp_vals);
+ }
+ XSETCAR (lisp_vals, called);
+ lisp_vals = XCDR (lisp_vals);
+ break;
+ }
+ case lrecord_type_vector:
+ {
+ i < XVECTOR_LENGTH (lisp_vals) ?
+ (XVECTOR_DATA (lisp_vals)[i] = called) :
+ /* Let #'aset error. */
+ Faset (lisp_vals, make_int (i), called);
+ break;
+ }
+ case lrecord_type_string:
+ {
+ /* If this ever becomes a code hotspot, we can keep
+ around pointers into the data of the string, checking
+ each time that it hasn't been relocated. */
+ Faset (lisp_vals, make_int (i), called);
+ break;
+ }
+ case lrecord_type_bit_vector:
+ {
+ (BITP (called) &&
+ i < bit_vector_length (XBIT_VECTOR (lisp_vals))) ?
+ set_bit_vector_bit (XBIT_VECTOR (lisp_vals), i,
+ XINT (called)) :
+ (void) Faset (lisp_vals, make_int (i), called);
+ break;
+ }
+ default:
+ {
+ ABORT();
+ break;
+ }
+ }
+ }
}
}
UNGCPRO;
＠＠ -4373,8 +4387,7 ＠＠
}
else
{
- mapcarX (len, args0, Qnil, function, nargs - 2, args + 2,
- SOME_OR_EVERY_NEITHER);
+ mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, Qmapconcat);
}
for (i = len - 1; i >= 0; i--)
＠＠ -4412,8 +4425,7 ＠＠
}
args0 = alloca_array (Lisp_Object, len);
- mapcarX (len, args0, Qnil, function, nargs - 1, args + 1,
- SOME_OR_EVERY_NEITHER);
+ mapcarX (len, args0, Qnil, function, nargs - 1, args + 1, QmapcarX);
return Flist ((int) len, args0);
}
＠＠ -4449,10 +4461,8 ＠＠
/* Don't pass result as the lisp_object argument, we want mapcarX to protect
a single list argument's elements from being garbage-collected. */
mapcarX (len, XVECTOR_DATA (result), Qnil, function, nargs - 1, args +1,
- SOME_OR_EVERY_NEITHER);
- UNGCPRO;
-
- return result;
+ Qmapvector);
+ RETURN_UNGCPRO (result);
}
DEFUN ("mapcan", Fmapcan, 2, MANY, 0, /*
＠＠ -4470,40 +4480,21 ＠＠
*/
(int nargs, Lisp_Object *args))
{
- Lisp_Object function = args[0], nconcing;
- Elemcount len = EMACS_INT_MAX;
- Lisp_Object *args0;
- struct gcpro gcpro1;
- int i;
-
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
-
- args0 = alloca_array (Lisp_Object, len + 1);
- mapcarX (len, args0 + 1, Qnil, function, nargs - 1, args + 1,
- SOME_OR_EVERY_NEITHER);
-
- if (len < 2)
- {
- return len ? args0[1] : Qnil;
- }
-
- /* bytecode_nconc2 can signal and return, we need to GCPRO the args, since
- mapcarX is no longer doing this for us. */
- args0[0] = Fcons (Qnil, Qnil);
- GCPRO1 (args0[0]);
- gcpro1.nvars = len + 1;
-
- for (i = 0; i < len; ++i)
- {
- nconcing = bytecode_nconc2 (args0 + i);
- args0[i + 1] = nconcing;
- }
-
- RETURN_UNGCPRO (XCDR (nconcing));
+ Lisp_Object function = args[0], *result;
+ Elemcount result_len = EMACS_INT_MAX;
+ int i;
+
+ for (i = 1; i < nargs; ++i)
+ {
+ CHECK_SEQUENCE (args[i]);
+ result_len = min (result_len, XINT (Flength (args[i])));
+ }
+
+ result = alloca_array (Lisp_Object, result_len);
+ mapcarX (result_len, result, Qnil, function, nargs - 1, args + 1, Qmapcan);
+
+ /* #'nconc GCPROs its args in case of signals and error. */
+ return Fnconc (result_len, result);
}
DEFUN ("mapc", Fmapc, 2, MANY, 0, /*
＠＠ -4539,8 +4530,7 ＠＠
elements of the args array handed to it, and this may involve
elements of sequence getting garbage collected. */
GCPRO1 (sequence);
- mapcarX (len, NULL, Qnil, args[0], nargs - 1, args + 1,
- SOME_OR_EVERY_NEITHER);
+ mapcarX (len, NULL, Qnil, args[0], nargs - 1, args + 1, Qmapc);
RETURN_UNGCPRO (sequence);
}
＠＠ -4580,8 +4570,7 ＠＠
args0 = alloca_array (Lisp_Object, len);
}
- mapcarX (len, args0, Qnil, function, nargs - 2, args + 2,
- SOME_OR_EVERY_NEITHER);
+ mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, Qmap);
if (EQ (type, Qnil))
{
＠＠ -4646,7 +4635,7 ＠＠
}
mapcarX (len, NULL, result_sequence, function, nargs - 2, args + 2,
- SOME_OR_EVERY_NEITHER);
+ Qmap_into);
return result_sequence;
}
＠＠ -4663,23 +4652,20 ＠＠
*/
(int nargs, Lisp_Object *args))
{
- Lisp_Object result_box = Fcons (Qnil, Qnil);
- struct gcpro gcpro1;
- Elemcount len = EMACS_INT_MAX;
- int i;
-
- GCPRO1 (result_box);
-
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
-
- mapcarX (len, NULL, result_box, args[0], nargs - 1, args +1,
- SOME_OR_EVERY_SOME);
-
- RETURN_UNGCPRO (XCAR (result_box));
+ Lisp_Object result = Qnil,
+ result_ptr = STORE_VOID_IN_LISP ((void *) &result);
+ Elemcount len = EMACS_INT_MAX;
+ int i;
+
+ for (i = 1; i < nargs; ++i)
+ {
+ CHECK_SEQUENCE (args[i]);
+ len = min (len, XINT (Flength (args[i])));
+ }
+
+ mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qsome);
+
+ return result;
}
DEFUN ("every", Fevery, 2, MANY, 0, /*
＠＠ -4694,43 +4680,42 ＠＠
*/
(int nargs, Lisp_Object *args))
{
- Lisp_Object result_box = Fcons (Qt, Qnil);
- struct gcpro gcpro1;
- Elemcount len = EMACS_INT_MAX;
- int i;
-
- GCPRO1 (result_box);
-
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
-
- mapcarX (len, NULL, result_box, args[0], nargs - 1, args +1,
- SOME_OR_EVERY_EVERY);
-
- RETURN_UNGCPRO (XCAR (result_box));
+ Lisp_Object result = Qt, result_ptr = STORE_VOID_IN_LISP ((void *) &result);
+ Elemcount len = EMACS_INT_MAX;
+ int i;
+
+ for (i = 1; i < nargs; ++i)
+ {
+ CHECK_SEQUENCE (args[i]);
+ len = min (len, XINT (Flength (args[i])));
+ }
+
+ mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qevery);
+
+ return result;
}
/* Call FUNCTION with NLISTS arguments repeatedly, each Nth argument
corresponding to the result of calling (nthcdr ITERATION-COUNT LISTS[N]),
until that #'nthcdr expression gives nil for some element of LISTS.
- If MAPLP is zero, return LISTS[0]. Otherwise, return a list of the return
- values from FUNCTION; if NCONCP is non-zero, nconc them together.
+ CALLER is a symbol reflecting the Lisp-visible function that was called,
+ and any errors thrown because SEQUENCES was modified will reflect it.
+
+ If CALLER is Qmapl, return LISTS[0]. Otherwise, return a list of the
+ return values from FUNCTION; if caller is Qmapcan, nconc them together.
In contrast to mapcarX, we don't require our callers to check LISTS for
well-formedness, we signal wrong-type-argument if it's not a list, or
circular-list if it's circular. */
static Lisp_Object
-maplist (Lisp_Object function, int nlists, Lisp_Object *lists, int maplp,
- int nconcp)
-{
- Lisp_Object result = maplp ? lists[0] : Fcons (Qnil, Qnil), funcalled;
- Lisp_Object nconcing[2], accum = result, *args;
- struct gcpro gcpro1, gcpro2, gcpro3;
+maplist (Lisp_Object function, int nlists, Lisp_Object *lists,
+ Lisp_Object caller)
+{
+ Lisp_Object nconcing[2], accum = Qnil, *args, *tortoises, funcalled;
+ Lisp_Object result = EQ (caller, Qmapl) ? lists[0] : Qnil;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
int i, j, continuing = (nlists > 0), called_count = 0;
args = alloca_array (Lisp_Object, nlists + 1);
＠＠ -4740,18 +4725,23 ＠＠
args[i] = Qnil;
}
- if (nconcp)
- {
- nconcing[0] = result;
+ tortoises = alloca_array (Lisp_Object, nlists);
+ memcpy (tortoises, lists, nlists * sizeof (Lisp_Object));
+
+ if (EQ (caller, Qmapcon))
+ {
+ nconcing[0] = Qnil;
nconcing[1] = Qnil;
- GCPRO3 (args[0], nconcing[0], result);
+ GCPRO4 (args[0], nconcing[0], tortoises[0], result);
gcpro1.nvars = 1;
gcpro2.nvars = 2;
- }
- else
- {
- GCPRO2 (args[0], result);
+ gcpro3.nvars = nlists;
+ }
+ else
+ {
+ GCPRO3 (args[0], tortoises[0], result);
gcpro1.nvars = 1;
+ gcpro2.nvars = nlists;
}
while (continuing)
＠＠ -4770,45 +4760,64 ＠＠
}
else
{
- dead_wrong_type_argument (Qlistp, lists[j]);
+ lists[j] = wrong_type_argument (Qlistp, lists[j]);
}
}
if (!continuing) break;
funcalled = IGNORE_MULTIPLE_VALUES (Ffuncall (nlists + 1, args));
- if (!maplp)
- {
- if (nconcp)
- {
- /* This order of calls means we check that each list is
- well-formed once and once only. The last result does
- not have to be a list. */
- nconcing[1] = funcalled;
- nconcing[0] = bytecode_nconc2 (nconcing);
- }
- else
- {
- /* Add to the end, avoiding the need to call nreverse
- once we're done: */
- XSETCDR (accum, Fcons (funcalled, Qnil));
- accum = XCDR (accum);
- }
- }
-
- if (++called_count % CIRCULAR_LIST_SUSPICION_LENGTH) continue;
-
- for (j = 0; j < nlists; ++j)
- {
- EXTERNAL_LIST_LOOP_1 (lists[j])
- {
- /* Just check the lists aren't circular, using the
- EXTERNAL_LIST_LOOP_1 macro. */
- }
- }
- }
-
- if (!maplp)
- {
- result = XCDR (result);
+
+ if (EQ (caller, Qmapl))
+ {
+ DO_NOTHING;
+ }
+ else if (EQ (caller, Qmapcon))
+ {
+ nconcing[1] = funcalled;
+ accum = bytecode_nconc2 (nconcing);
+ if (NILP (result))
+ {
+ result = accum;
+ }
+ /* Only check a given stretch of result for well-formedness
+ once: */
+ nconcing[0] = funcalled;
+ }
+ else if (NILP (accum))
+ {
+ accum = result = Fcons (funcalled, Qnil);
+ }
+ else
+ {
+ /* Add to the end, avoiding the need to call nreverse
+ once we're done: */
+ XSETCDR (accum, Fcons (funcalled, Qnil));
+ accum = XCDR (accum);
+ }
+
+ if (++called_count > CIRCULAR_LIST_SUSPICION_LENGTH)
+ {
+ if (called_count & 1)
+ {
+ for (j = 0; j < nlists; ++j)
+ {
+ tortoises[j] = XCDR (tortoises[j]);
+ if (EQ (lists[j], tortoises[j]))
+ {
+ signal_circular_list_error (lists[j]);
+ }
+ }
+ }
+ else
+ {
+ for (j = 0; j < nlists; ++j)
+ {
+ if (EQ (lists[j], tortoises[j]))
+ {
+ signal_circular_list_error (lists[j]);
+ }
+ }
+ }
+ }
}
RETURN_UNGCPRO (result);
＠＠ -4823,7 +4832,7 ＠＠
*/
(int nargs, Lisp_Object *args))
{
- return maplist (args[0], nargs - 1, args + 1, 0, 0);
+ return maplist (args[0], nargs - 1, args + 1, Qmaplist);
}
DEFUN ("mapl", Fmapl, 2, MANY, 0, /*
＠＠ -4833,7 +4842,7 ＠＠
*/
(int nargs, Lisp_Object *args))
{
- return maplist (args[0], nargs - 1, args + 1, 1, 0);
+ return maplist (args[0], nargs - 1, args + 1, Qmapl);
}
DEFUN ("mapcon", Fmapcon, 2, MANY, 0, /*
＠＠ -4846,7 +4855,7 ＠＠
*/
(int nargs, Lisp_Object *args))
{
- return maplist (args[0], nargs - 1, args + 1, 0, 1);
+ return maplist (args[0], nargs - 1, args + 1, Qmapcon);
}
/* Extra random functions */
＠＠ -5149,7 +5158,8 ＠＠
Elemcount counting = 0, len = 0;
struct gcpro gcpro1;
- if (ending - starting && starting < ending && EMACS_INT_MAX == ending)
+ if (ending - starting && starting < ending
+ && EMACS_INT_MAX == ending)
{
ending = XINT (Flength (sequence));
}
＠＠ -5915,6 +5925,19 ＠＠
DEFSYMBOL (Qbit_vector);
defsymbol (&QsortX, "sort*");
DEFSYMBOL (Qreduce);
+
+ DEFSYMBOL (Qmapconcat);
+ defsymbol (&QmapcarX, "mapcar*");
+ DEFSYMBOL (Qmapvector);
+ DEFSYMBOL (Qmapcan);
+ DEFSYMBOL (Qmapc);
+ DEFSYMBOL (Qmap);
+ DEFSYMBOL (Qmap_into);
+ DEFSYMBOL (Qsome);
+ DEFSYMBOL (Qevery);
+ DEFSYMBOL (Qmaplist);
+ DEFSYMBOL (Qmapl);
+ DEFSYMBOL (Qmapcon);
DEFKEYWORD (Q_from_end);
DEFKEYWORD (Q_initial_value);
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Fix style, documentation for rounding functions and multiple values.
13 years, 5 months
Aidan Kehoe
Aidan Kehoe
changeset: 5308:378a34562cbe
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Mon Aug 30 15:23:42 2010 +0100
files: man/ChangeLog man/cl.texi man/lispref/eval.texi man/lispref/numbers.texi src/ChangeLog src/doprnt.c src/floatfns.c
description:
Fix style, documentation for rounding functions and multiple values.
src/ChangeLog addition:
2010-08-30 Aidan Kehoe <kehoea(a)parhasard.net>
* floatfns.c (ceiling_one_mundane_arg, floor_one_mundane_arg)
(round_one_mundane_arg, truncate_one_mundane_arg):
INTEGERP is always available, no need to wrap calls to it with
#ifdef HAVE_BIGNUM.
(Fceiling, Ffloor, Fround, Ftruncate, Ffceiling, Fffloor)
(Ffround, Fftruncate):
Correct some code formatting here.
* doprnt.c (emacs_doprnt_1):
Remove some needless #ifdef WITH_NUMBER_TYPES, now number.h is
always #included.
man/ChangeLog addition:
2010-08-30 Aidan Kehoe <kehoea(a)parhasard.net>
* lispref/eval.texi (Evaluation, Multiple values):
Document our implementation of multiple values; point the reader
to the CLTL or the Hyperspec for details of exactly when values
are discarded.
* lispref/numbers.texi (Numeric Conversions): Document the
optional DIVISOR arguments to the rounding functions, and
document that they all return multiple values.
(Rounding Operations): Ditto.
* cl.texi (Multiple Values):
Document that we've moved the multiple values implementation to
core code, and cross-reference to the Lispref.
(Numerical Functions): The various rounding functions are now
identical to the built-in rounding functions, with the exception
that they return lists, not multiple values; document this.
diff -r b0ba3598beb1 -r 378a34562cbe man/ChangeLog
--- a/man/ChangeLog Mon Aug 30 15:21:04 2010 +0100
+++ b/man/ChangeLog Mon Aug 30 15:23:42 2010 +0100
＠＠ -1,3 +1,22 ＠＠
+2010-08-30 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * lispref/eval.texi (Evaluation, Multiple values):
+ Document our implementation of multiple values; point the reader
+ to the CLTL or the Hyperspec for details of exactly when values
+ are discarded.
+
+ * lispref/numbers.texi (Numeric Conversions): Document the
+ optional DIVISOR arguments to the rounding functions, and
+ document that they all return multiple values.
+ (Rounding Operations): Ditto.
+
+ * cl.texi (Multiple Values):
+ Document that we've moved the multiple values implementation to
+ core code, and cross-reference to the Lispref.
+ (Numerical Functions): The various rounding functions are now
+ identical to the built-in rounding functions, with the exception
+ that they return lists, not multiple values; document this.
+
2010-08-21 Aidan Kehoe <kehoea(a)parhasard.net>
* lispref/objects.texi (Character Type):
diff -r b0ba3598beb1 -r 378a34562cbe man/cl.texi
--- a/man/cl.texi Mon Aug 30 15:21:04 2010 +0100
+++ b/man/cl.texi Mon Aug 30 15:23:42 2010 +0100
＠＠ -2987,44 +2987,8 ＠＠
＠node Multiple Values, , Loop Facility, Control Structure
＠section Multiple Values
-＠noindent
-Common Lisp functions can return zero or more results. Emacs Lisp
-functions, by contrast, always return exactly one result. This
-package makes no attempt to emulate Common Lisp multiple return
-values; Emacs versions of Common Lisp functions that return more
-than one value either return just the first value (as in
-＠code{compiler-macroexpand}) or return a list of values (as in
-＠code{get-setf-method}). This package ＠emph{does} define placeholders
-for the Common Lisp functions that work with multiple values, but
-in Emacs Lisp these functions simply operate on lists instead.
-The ＠code{values} form, for example, is a synonym for ＠code{list}
-in Emacs.
-
-＠defspec multiple-value-bind (var＠dots{}) values-form forms＠dots{}
-This form evaluates ＠var{values-form}, which must return a list of
-values. It then binds the ＠var{var}s to these respective values,
-as if by ＠code{let}, and then executes the body ＠var{forms}.
-If there are more ＠var{var}s than values, the extra ＠var{var}s
-are bound to ＠code{nil}. If there are fewer ＠var{var}s than
-values, the excess values are ignored.
-＠end defspec
-
-＠defspec multiple-value-setq (var＠dots{}) form
-This form evaluates ＠var{form}, which must return a list of values.
-It then sets the ＠var{var}s to these respective values, as if by
-＠code{setq}. Extra ＠var{var}s or values are treated the same as
-in ＠code{multiple-value-bind}.
-＠end defspec
-
-The older Quiroz package attempted a more faithful (but still
-imperfect) emulation of Common Lisp multiple values. The old
-method ``usually'' simulated true multiple values quite well,
-but under certain circumstances would leave spurious return
-values in memory where a later, unrelated ＠code{multiple-value-bind}
-form would see them.
-
-Since a perfect emulation is not feasible in Emacs Lisp, this
-package opts to keep it as simple and predictable as possible.
+This functionality has been moved to core XEmacs, and is documented in
+the XEmacs Lisp reference, ＠pxref{(lispref.info)Multiple values}.
＠node Macros, Declarations, Control Structure, Top
＠chapter Macros
＠＠ -3506,58 +3470,6 ＠＠
square root of the argument.
＠end defun
-＠defun floor* number &optional divisor
-This function implements the Common Lisp ＠code{floor} function.
-It is called ＠code{floor*} to avoid name conflicts with the
-simpler ＠code{floor} function built-in to Emacs 19.
-
-With one argument, ＠code{floor*} returns a list of two numbers:
-The argument rounded down (toward minus infinity) to an integer,
-and the ``remainder'' which would have to be added back to the
-first return value to yield the argument again. If the argument
-is an integer ＠var{x}, the result is always the list ＠code{(＠var{x} 0)}.
-If the argument is an Emacs 19 floating-point number, the first
-result is a Lisp integer and the second is a Lisp float between
-0 (inclusive) and 1 (exclusive).
-
-With two arguments, ＠code{floor*} divides ＠var{number} by
-＠var{divisor}, and returns the floor of the quotient and the
-corresponding remainder as a list of two numbers. If
-＠code{(floor* ＠var{x} ＠var{y})} returns ＠code{(＠var{q} ＠var{r})},
-then ＠code{＠var{q}*＠var{y} + ＠var{r} = ＠var{x}}, with ＠var{r}
-between 0 (inclusive) and ＠var{r} (exclusive). Also, note
-that ＠code{(floor* ＠var{x})} is exactly equivalent to
-＠code{(floor* ＠var{x} 1)}.
-
-This function is entirely compatible with Common Lisp's ＠code{floor}
-function, except that it returns the two results in a list since
-Emacs Lisp does not support multiple-valued functions.
-＠end defun
-
-＠defun ceiling* number &optional divisor
-This function implements the Common Lisp ＠code{ceiling} function,
-which is analogous to ＠code{floor} except that it rounds the
-argument or quotient of the arguments up toward plus infinity.
-The remainder will be between 0 and minus ＠var{r}.
-＠end defun
-
-＠defun truncate* number &optional divisor
-This function implements the Common Lisp ＠code{truncate} function,
-which is analogous to ＠code{floor} except that it rounds the
-argument or quotient of the arguments toward zero. Thus it is
-equivalent to ＠code{floor*} if the argument or quotient is
-positive, or to ＠code{ceiling*} otherwise. The remainder has
-the same sign as ＠var{number}.
-＠end defun
-
-＠defun round* number &optional divisor
-This function implements the Common Lisp ＠code{round} function,
-which is analogous to ＠code{floor} except that it rounds the
-argument or quotient of the arguments to the nearest integer.
-In the case of a tie (the argument or quotient is exactly
-halfway between two integers), it rounds to the even integer.
-＠end defun
-
＠defun mod* number divisor
This function returns the same value as the second return value
of ＠code{floor}.
＠＠ -3568,7 +3480,24 ＠＠
of ＠code{truncate}.
＠end defun
-These definitions are compatible with those in the Quiroz
+＠noindent
+The following functions are identical to their built-in counterparts,
+without the trailing ＠code{*} in their names, but they return lists
+instead of multiple values. ＠pxref{(lispref.info)Rounding Operations}
+
+＠defun floor* number &optional divisor
+＠end defun
+
+＠defun ceiling* number &optional divisor
+＠end defun
+
+＠defun truncate* number &optional divisor
+＠end defun
+
+＠defun round* number &optional divisor
+＠end defun
+
+All the above definitions are compatible with those in the Quiroz
＠file{cl.el} package, except that this package appends ＠samp{*}
to certain function names to avoid conflicts with existing
Emacs 19 functions, and that the mechanism for returning
diff -r b0ba3598beb1 -r 378a34562cbe man/lispref/eval.texi
--- a/man/lispref/eval.texi Mon Aug 30 15:21:04 2010 +0100
+++ b/man/lispref/eval.texi Mon Aug 30 15:23:42 2010 +0100
＠＠ -24,6 +24,7 ＠＠
* Eval:: How to invoke the Lisp interpreter explicitly.
* Forms:: How various sorts of objects are evaluated.
* Quoting:: Avoiding evaluation (to put constants in the program).
+* Multiple values:: Functions may return more than one result.
＠end menu
＠node Intro Eval
＠＠ -708,3 +709,102 ＠＠
Functions}), which causes an anonymous lambda expression written in Lisp
to be compiled, and ＠samp{`} (＠pxref{Backquote}), which is used to quote
only part of a list, while computing and substituting other parts.
+
+＠node Multiple values
+＠section Multiple values
+＠cindex multiple values
+
+＠noindent
+Under XEmacs, expressions can return zero or more results, using the
+＠code{values} and ＠code{values-list} functions. Results other than the
+first are typically discarded, but special operators are provided to
+access them.
+
+＠defun values arguments＠dots{}
+This function returns ＠var{arguments} as multiple values. Callers will
+always receive the first element of ＠var{arguments}, but must use
+various special operators, described below, to access other elements of
+＠var{arguments}.
+
+The idiom ＠code{(values (function-call argument))}, with one
+argument, is the normal mechanism to avoid passing multiple values to
+the calling form where that is not desired.
+
+XEmacs implements the Common Lisp specification when it comes to the
+exact details of when to discard and when to preserve multiple values;
+see Common Lisp the Language or the Common Lisp hyperspec for more
+details. The most important thing to keep in mind is when multiple
+values are passed as an argument to a function, all but the first are
+discarded.
+＠end defun
+
+＠defun values-list argument
+This function returns the elements of the lst ＠var{argument} as multiple
+values.
+＠end defun
+
+＠defspec multiple-value-bind (var＠dots{}) values-form forms＠dots{}
+This special operator evaluates ＠var{values-form}, which may return
+multiple values. It then binds the ＠var{var}s to these respective values,
+as if by ＠code{let}, and then executes the body ＠var{forms}.
+If there are more ＠var{var}s than values, the extra ＠var{var}s
+are bound to ＠code{nil}. If there are fewer ＠var{var}s than
+values, the excess values are ignored.
+＠end defspec
+
+＠defspec multiple-value-setq (var＠dots{}) form
+This special operator evaluates ＠var{form}, which may return multiple
+values. It then sets the ＠var{var}s to these respective values, as if by
+＠code{setq}. Extra ＠var{var}s or values are treated the same as
+in ＠code{multiple-value-bind}.
+＠end defspec
+
+＠defspec multiple-value-call function forms＠dots{}
+This special operator evaluates function, discarding any multiple
+values. It then evaluates ＠var{forms}, preserving any multiple values,
+and calls ＠var{function} as a function with the results. Conceptually, this
+function is a version of ＠code{apply'}that by-passes the multiple values
+infrastructure, treating multiple values as intercalated lists.
+＠end defspec
+
+＠defspec multiple-value-list form
+This special operator evaluates ＠var{form} and returns a list of the
+multiple values given by it.
+＠end defspec
+
+＠defspec multiple-value-prog1 first body＠dots{}
+This special operator evaluates the form ＠var{first}, then the
+forms ＠var{body}. It returns the value given by ＠var{first}, preserving
+any multiple values. This is identical to ＠code{prog1}, except that
+＠code{prog1} always discards multiple values.
+＠end defspec
+
+＠defspec nth-value n form
+This special operator evaluates ＠var{form} and returns the ＠var{n}th
+value it gave. ＠var{n} must be an integer of value zero or more.
+If ＠var{form} gave insufficient multiple values, ＠code{nth-value}
+returns ＠code{nil}.
+＠end defspec
+
+＠defvar multiple-values-limit
+This constant describes the exclusive upper bound on the number of
+multiple values that ＠code{values} accepts and that
+＠code{multiple-value-bind}, etc. will consume.
+＠end defvar
+
+To take full advantage of multiple values, Emacs Lisp code must have
+been compiled by XEmacs 21.5 or later, which is not yet true of the
+XEmacs packages. Matched ＠code{values} and ＠code{multiple-value-bind}
+calls will work in code included in the XEmacs packages when run on
+21.5, though the following incantation may be necessary at the start of
+your file, until appropriate code is included in XEmacs 21.4:
+
+＠example
+(eval-when-compile (when (eq 'list (symbol-function 'values))
+ (define-compiler-macro values (&rest args)
+ (cons 'list args))
+ (define-compiler-macro values-list (list) list)))
+＠end example
+
+Such code cannot, unfortunately, rely on XEmacs to discard multiple
+values where that is appropriate.
diff -r b0ba3598beb1 -r 378a34562cbe man/lispref/numbers.texi
--- a/man/lispref/numbers.texi Mon Aug 30 15:21:04 2010 +0100
+++ b/man/lispref/numbers.texi Mon Aug 30 15:23:42 2010 +0100
＠＠ -871,9 +871,15 ＠＠
There are four functions to convert floating point numbers to integers;
they differ in how they round. These functions accept integer arguments
-also, and return such arguments unchanged.
+also, and return such arguments unchanged. They return multiple values,
+(a)pxref{(cl.info)Multiple values}.
-＠defun truncate number
+All these functions take optional ＠var{divisor} arguments, and if this
+argument is specified, the ＠var{number} argument is divided by
+＠var{divisor} before the calculation is made. An ＠code{arith-error}
+results if ＠var{divisor} is 0.
+
+＠defun truncate number &optional divisor
This returns ＠var{number}, converted to an integer by rounding towards
zero.
＠end defun
＠＠ -881,23 +887,21 ＠＠
＠defun floor number &optional divisor
This returns ＠var{number}, converted to an integer by rounding downward
(towards negative infinity).
-
-If ＠var{divisor} is specified, ＠var{number} is divided by ＠var{divisor}
-before the floor is taken; this is the division operation that
-corresponds to ＠code{mod}. An ＠code{arith-error} results if
-＠var{divisor} is 0.
＠end defun
-＠defun ceiling number
+＠defun ceiling number &optional divisor
This returns ＠var{number}, converted to an integer by rounding upward
(towards positive infinity).
＠end defun
-＠defun round number
+＠defun round number &optional divisor
This returns ＠var{number}, converted to an integer by rounding towards the
-nearest integer. Rounding a value equidistant between two integers
-may choose the integer closer to zero, or it may prefer an even integer,
-depending on your machine.
+nearest integer.
+
+Rounding a value equidistant between two integers chooses the even
+integer. GNU Emacs and older XEmacs did not guarantee this, and the
+direction of rounding depended on the underlying machine and the C
+implementation.
＠end defun
＠node Arithmetic Operations
＠＠ -1154,24 +1158,35 ＠＠
＠code{ftruncate}, the nearest integer in the direction towards zero;
＠code{fround}, the nearest integer.
-＠defun ffloor number
+All these functions take optional ＠var{divisor} arguments, and if this
+argument is specified, the ＠var{number} argument is divided by
+＠var{divisor} before the calculation is made. An ＠code{arith-error}
+results if ＠var{divisor} is 0. Also, they return multiple values,
+(a)pxref{(cl.info)Multiple values}; the second value is the remainder.
+
+＠defun ffloor number &optional divisor
This function rounds ＠var{number} to the next lower integral value, and
returns that value as a floating point number.
＠end defun
-＠defun fceiling number
+＠defun fceiling number &optional divisor
This function rounds ＠var{number} to the next higher integral value, and
returns that value as a floating point number.
＠end defun
-＠defun ftruncate number
+＠defun ftruncate number &optional divisor
This function rounds ＠var{number} towards zero to an integral value, and
returns that value as a floating point number.
＠end defun
-＠defun fround number
+＠defun fround number &optional divisor
This function rounds ＠var{number} to the nearest integral value,
and returns that value as a floating point number.
+
+Rounding a value equidistant between two integral values chooses the
+even value. While this is specified by Common Lisp, GNU Emacs and older
+XEmacs did not make this guarantee, and the direction of rounding
+depended on the underlying machine and the C implementation.
＠end defun
＠node Bitwise Operations
diff -r b0ba3598beb1 -r 378a34562cbe src/ChangeLog
--- a/src/ChangeLog Mon Aug 30 15:21:04 2010 +0100
+++ b/src/ChangeLog Mon Aug 30 15:23:42 2010 +0100
＠＠ -1,3 +1,16 ＠＠
+2010-08-30 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * floatfns.c (ceiling_one_mundane_arg, floor_one_mundane_arg)
+ (round_one_mundane_arg, truncate_one_mundane_arg):
+ INTEGERP is always available, no need to wrap calls to it with
+ #ifdef HAVE_BIGNUM.
+ (Fceiling, Ffloor, Fround, Ftruncate, Ffceiling, Fffloor)
+ (Ffround, Fftruncate):
+ Correct some code formatting here.
+ * doprnt.c (emacs_doprnt_1):
+ Remove some needless #ifdef WITH_NUMBER_TYPES, now number.h is
+ always #included.
+
2010-08-26 Adam Sjøgren <asjo(a)koldfront.dk>
* glyphs-eimage.c (gif_instantiate): Try harder to find an
diff -r b0ba3598beb1 -r 378a34562cbe src/doprnt.c
--- a/src/doprnt.c Mon Aug 30 15:21:04 2010 +0100
+++ b/src/doprnt.c Mon Aug 30 15:23:42 2010 +0100
＠＠ -591,11 +591,7 ＠＠
Lisp_Object obj = largs[spec->argnum - 1];
if (CHARP (obj))
obj = make_int (XCHAR (obj));
-#ifdef WITH_NUMBER_TYPES
if (!NUMBERP (obj))
-#else
- if (!INT_OR_FLOATP (obj))
-#endif
{
/* WARNING! This MUST be big enough for the sprintf below */
CIbyte msg[48];
＠＠ -606,9 +602,10 ＠＠
}
else if (strchr (double_converters, ch))
{
-#ifdef WITH_NUMBER_TYPES
- if (INTP (obj) || FLOATP (obj))
- arg.d = XFLOATINT (obj);
+ if (INTP (obj))
+ arg.d = XINT (obj);
+ else if (FLOATP (obj))
+ arg.d = XFLOAT_DATA (obj);
#ifdef HAVE_BIGNUM
else if (BIGNUMP (obj))
arg.d = bignum_to_double (XBIGNUM_DATA (obj));
＠＠ -631,9 +628,6 ＠＠
}
}
#endif
-#else /* !WITH_NUMBER_TYPES */
- arg.d = XFLOATINT (obj);
-#endif /* WITH_NUMBER_TYPES */
}
else
{
diff -r b0ba3598beb1 -r 378a34562cbe src/floatfns.c
--- a/src/floatfns.c Mon Aug 30 15:21:04 2010 +0100
+++ b/src/floatfns.c Mon Aug 30 15:23:42 2010 +0100
＠＠ -1300,11 +1300,7 ＠＠
}
else
{
-#ifdef HAVE_BIGNUM
if (INTEGERP (number))
-#else
- if (INTP (number))
-#endif
{
return values2 (number, Qzero);
}
＠＠ -1566,11 +1562,7 ＠＠
floor_one_mundane_arg (Lisp_Object number, Lisp_Object divisor,
int return_float)
{
-#ifdef HAVE_BIGNUM
if (INTEGERP (number))
-#else
- if (INTP (number))
-#endif
{
if (return_float)
{
＠＠ -1971,11 +1963,7 ＠＠
round_one_mundane_arg (Lisp_Object number, Lisp_Object divisor,
int return_float)
{
-#ifdef HAVE_BIGNUM
if (INTEGERP (number))
-#else
- if (INTP (number))
-#endif
{
if (return_float)
{
＠＠ -2258,11 +2246,7 ＠＠
truncate_one_mundane_arg (Lisp_Object number, Lisp_Object divisor,
int return_float)
{
-#ifdef HAVE_BIGNUM
if (INTEGERP (number))
-#else
- if (INTP (number))
-#endif
{
if (return_float)
{
＠＠ -2301,7 +2285,7 ＠＠
*/
(number, divisor))
{
- ROUNDING_CONVERT(ceiling, 0);
+ ROUNDING_CONVERT (ceiling, 0);
}
DEFUN ("floor", Ffloor, 1, 2, 0, /*
＠＠ -2316,7 +2300,7 ＠＠
*/
(number, divisor))
{
- ROUNDING_CONVERT(floor, 0);
+ ROUNDING_CONVERT (floor, 0);
}
DEFUN ("round", Fround, 1, 2, 0, /*
＠＠ -2333,7 +2317,7 ＠＠
*/
(number, divisor))
{
- ROUNDING_CONVERT(round, 0);
+ ROUNDING_CONVERT (round, 0);
}
DEFUN ("truncate", Ftruncate, 1, 2, 0, /*
＠＠ -2347,7 +2331,7 ＠＠
*/
(number, divisor))
{
- ROUNDING_CONVERT(truncate, 0);
+ ROUNDING_CONVERT (truncate, 0);
}
/* Float-rounding functions. */
＠＠ -2364,7 +2348,7 ＠＠
*/
(number, divisor))
{
- ROUNDING_CONVERT(ceiling, 1);
+ ROUNDING_CONVERT (ceiling, 1);
}
DEFUN ("ffloor", Fffloor, 1, 2, 0, /*
＠＠ -2379,7 +2363,7 ＠＠
*/
(number, divisor))
{
- ROUNDING_CONVERT(floor, 1);
+ ROUNDING_CONVERT (floor, 1);
}
DEFUN ("fround", Ffround, 1, 2, 0, /*
＠＠ -2395,7 +2379,7 ＠＠
*/
(number, divisor))
{
- ROUNDING_CONVERT(round, 1);
+ ROUNDING_CONVERT (round, 1);
}
DEFUN ("ftruncate", Fftruncate, 1, 2, 0, /*
＠＠ -2410,7 +2394,7 ＠＠
*/
(number, divisor))
{
- ROUNDING_CONVERT(truncate, 1);
+ ROUNDING_CONVERT (truncate, 1);
}
#ifdef FLOAT_CATCH_SIGILL
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Correct the encoding of asjo@koldfront.dk's name, src/ChangeLog is in
13 years, 5 months
Aidan Kehoe
Aidan Kehoe
changeset: 5307:b0ba3598beb1
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Mon Aug 30 15:21:04 2010 +0100
files: src/ChangeLog
description:
Correct the encoding of asjo(a)koldfront.dk's name, src/ChangeLog is in
ISO-8859-1, not yet UTF-8.
diff -r db84c9d41437 -r b0ba3598beb1 src/ChangeLog
--- a/src/ChangeLog Thu Aug 26 22:45:58 2010 -0400
+++ b/src/ChangeLog Mon Aug 30 15:21:04 2010 +0100
＠＠ -1,4 +1,4 ＠＠
-2010-08-26 Adam SjÞgren <asjo(a)koldfront.dk>
+2010-08-26 Adam Sjøgren <asjo(a)koldfront.dk>
* glyphs-eimage.c (gif_instantiate): Try harder to find an
appropriate GIF colormap and then flag an error if one can't be
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Apply GIF colormap fix from Adam Sjogren for issues 150 and 713
13 years, 5 months
Vin Shelton
Vin Shelton
changeset: 5306:db84c9d41437
user: Vin Shelton <acs(a)xemacs.org>
date: Thu Aug 26 22:45:58 2010 -0400
files: src/ChangeLog src/glyphs-eimage.c
description:
Apply GIF colormap fix from Adam Sjogren for issues 150 and 713
diff -r d4fae3ebf26a -r db84c9d41437 src/ChangeLog
--- a/src/ChangeLog Fri Aug 20 13:04:54 2010 +0200
+++ b/src/ChangeLog Thu Aug 26 22:45:58 2010 -0400
＠＠ -1,3 +1,9 ＠＠
+2010-08-26 Adam Sjøgren <asjo(a)koldfront.dk>
+
+ * glyphs-eimage.c (gif_instantiate): Try harder to find an
+ appropriate GIF colormap and then flag an error if one can't be
+ found.
+
2010-08-21 Aidan Kehoe <kehoea(a)parhasard.net>
* lread.c (read_escape):
diff -r d4fae3ebf26a -r db84c9d41437 src/glyphs-eimage.c
--- a/src/glyphs-eimage.c Fri Aug 20 13:04:54 2010 +0200
+++ b/src/glyphs-eimage.c Thu Aug 26 22:45:58 2010 -0400
＠＠ -694,7 +694,7 ＠＠
/* 3. Now create the EImage(s) */
{
- ColorMapObject *cmo = unwind.giffile->SColorMap;
+ ColorMapObject *cmo = (unwind.giffile->Image.ColorMap ? unwind.giffile->Image.ColorMap : unwind.giffile->SColorMap);
int i, j, row, pass, interlace, slice;
UINT_64_BIT pixels_sq;
Binbyte *eip;
＠＠ -702,6 +702,9 ＠＠
0, 8, 16, ..., 4, 12, 20, ..., 2, 6, 10, ..., 1, 3, 5, ... */
static int InterlacedOffset[] = { 0, 4, 2, 1 };
static int InterlacedJumps[] = { 8, 8, 4, 2 };
+
+ if (cmo == NULL)
+ signal_image_error ("GIF image has no color map", instantiator);
height = unwind.giffile->SHeight;
width = unwind.giffile->SWidth;
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Add `save-some-buffers-action-alist'.
13 years, 5 months
Michael Sperber
Michael Sperber
changeset: 5305:d4fae3ebf26a
user: Mike Sperber <sperber(a)deinprogramm.de>
date: Fri Aug 20 13:04:54 2010 +0200
files: lisp/ChangeLog lisp/files.el
description:
Add `save-some-buffers-action-alist'.
2010-08-20 Mike Sperber <mike(a)xemacs.org>
* files.el (save-some-buffers-action-alist): Add.
(save-some-buffers-1): Use (synching with (GPLv2) FSF Emacs.
diff -r 9d8aaa5ac16e -r d4fae3ebf26a lisp/ChangeLog
--- a/lisp/ChangeLog Sat Aug 21 19:03:15 2010 +0100
+++ b/lisp/ChangeLog Fri Aug 20 13:04:54 2010 +0200
＠＠ -1,3 +1,8 ＠＠
+2010-08-20 Mike Sperber <mike(a)xemacs.org>
+
+ * files.el (save-some-buffers-action-alist): Add.
+ (save-some-buffers-1): Use (synching with (GPLv2) FSF Emacs.
+
2010-08-18 Mike Sperber <mike(a)xemacs.org>
* files.el (diff-files-for-recover): Abstract this out out
diff -r 9d8aaa5ac16e -r d4fae3ebf26a lisp/files.el
--- a/lisp/files.el Sat Aug 21 19:03:15 2010 +0100
+++ b/lisp/files.el Fri Aug 20 13:04:54 2010 +0200
＠＠ -3086,6 +3086,45 ＠＠
;; over to the next unsaved buffer when calling `d'.
nil)
+(defvar save-some-buffers-action-alist
+ ;;instead of this we just say "yes all", "no all", etc.
+ ;;"save all the rest"
+ ;;"save only this buffer" "save no more buffers")
+ ;; this is rather bogus. --ben
+ ;; (it makes the dialog box too big, and you get an error
+ ;; "wrong type argument: framep, nil" when you hit q after
+ ;; choosing the option from the dialog box)
+
+ ;; We should fix the dialog box rather than disabling
+ ;; this! --hniksic
+ (list (list ?\C-r (lambda (buf)
+ ;; #### FSF has an EXIT-ACTION argument
+ ;; to `view-buffer'.
+ (view-buffer buf
+; (function
+; (lambda (ignore)
+; (exit-recursive-edit))))
+ )
+ (with-boundp 'view-exit-action
+ (setq view-exit-action
+ (lambda (ignore)
+ (exit-recursive-edit))))
+ (recursive-edit)
+ ;; Return nil to ask about BUF again.
+ nil)
+ "%_Display Buffer")
+ (list ?d (lambda (buf)
+ (save-window-excursion (diff-buffer-with-file buf))
+ (view-buffer (get-buffer-create "*File Diff*") t)
+ (with-boundp 'view-exit-action
+ (setq view-exit-action
+ (lambda (ignore)
+ (exit-recursive-edit))))
+ (recursive-edit)
+ ;; Return nil to ask about BUF again.
+ nil)
+ "View %_Changes in Buffer")))
+
(defun diff-files-for-recover (purpose file-1 file-2
failed-file-1 failed-file-2
coding-system)
＠＠ -3215,32 +3254,7 ＠＠
(error nil)))
(buffer-list)
'("buffer" "buffers" "save")
- ;;instead of this we just say "yes all", "no all", etc.
- ;;"save all the rest"
- ;;"save only this buffer" "save no more buffers")
- ;; this is rather bogus. --ben
- ;; (it makes the dialog box too big, and you get an error
- ;; "wrong type argument: framep, nil" when you hit q after
- ;; choosing the option from the dialog box)
-
- ;; We should fix the dialog box rather than disabling
- ;; this! --hniksic
- (list (list ?\C-r (lambda (buf)
- ;; #### FSF has an EXIT-ACTION argument
- ;; to `view-buffer'.
- (view-buffer buf
-; (function
-; (lambda (ignore)
-; (exit-recursive-edit))))
- )
- (with-boundp 'view-exit-action
- (setq view-exit-action
- (lambda (ignore)
- (exit-recursive-edit))))
- (recursive-edit)
- ;; Return nil to ask about BUF again.
- nil)
- "%_Display Buffer"))))
+ save-some-buffers-action-alist))
(abbrevs-done
(and save-abbrevs abbrevs-changed
(progn
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments