Mercurial > hg > xemacs-beta
view lisp/x-misc.el @ 5307:c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
src/ChangeLog addition:
2010-11-20 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.c (Fexpand_abbrev):
* alloc.c:
* alloc.c (Fmake_list):
* alloc.c (Fmake_vector):
* alloc.c (Fmake_bit_vector):
* alloc.c (Fmake_byte_code):
* alloc.c (Fmake_string):
* alloc.c (vars_of_alloc):
* bytecode.c (UNUSED):
* bytecode.c (Fbyte_code):
* chartab.c (decode_char_table_range):
* cmds.c (Fself_insert_command):
* data.c (check_integer_range):
* data.c (Fnatnump):
* data.c (Fnonnegativep):
* data.c (Fstring_to_number):
* elhash.c (hash_table_size_validate):
* elhash.c (decode_hash_table_size):
* eval.c (Fbacktrace_frame):
* event-stream.c (lisp_number_to_milliseconds):
* event-stream.c (Faccept_process_output):
* event-stream.c (Frecent_keys):
* event-stream.c (Fdispatch_event):
* events.c (Fmake_event):
* events.c (Fevent_timestamp):
* events.c (Fevent_timestamp_lessp):
* events.h:
* events.h (struct command_builder):
* file-coding.c (gzip_putprop):
* fns.c:
* fns.c (check_sequence_range):
* fns.c (Frandom):
* fns.c (Fnthcdr):
* fns.c (Flast):
* fns.c (Fnbutlast):
* fns.c (Fbutlast):
* fns.c (Fmember):
* fns.c (Ffill):
* fns.c (Freduce):
* fns.c (replace_string_range_1):
* fns.c (Freplace):
* font-mgr.c (Ffc_pattern_get):
* frame-msw.c (msprinter_set_frame_properties):
* glyphs.c (check_valid_xbm_inline):
* indent.c (Fmove_to_column):
* intl-win32.c (mswindows_multibyte_to_unicode_putprop):
* lisp.h:
* lisp.h (ARRAY_DIMENSION_LIMIT):
* lread.c (decode_mode_1):
* mule-ccl.c (ccl_get_compiled_code):
* number.h:
* process-unix.c (unix_open_multicast_group):
* process.c (Fset_process_window_size):
* profile.c (Fstart_profiling):
* unicode.c (Funicode_to_char):
Change NATNUMP to return 1 for positive bignums; changes uses of
it and of CHECK_NATNUM appropriately, usually by checking for an
integer in an appropriate range.
Add array-dimension-limit and use it in #'make-vector,
#'make-string. Add array-total-size-limit, array-rank-limit while
we're at it, for the sake of any Common Lisp-oriented code that
uses these limits.
Rename check_int_range to check_integer_range, have it take
Lisp_Objects (and thus bignums) instead.
Remove bignum_butlast(), just set int_n to an appropriately large
integer if N is a bignum.
Accept bignums in check_sequence_range(), change the functions
that use check_sequence_range() appropriately.
Move the definition of NATNUMP() to number.h; document why it's a
reasonable name, contradicting an old comment.
tests/ChangeLog addition:
2010-11-20 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
* automated/lisp-tests.el (featurep):
* automated/lisp-tests.el (wrong-type-argument):
* automated/mule-tests.el (featurep):
Check for args-out-of-range errors instead of wrong-type-argument
errors in various places when code is handed a large bignum
instead of a fixnum.
Also check for the wrong-type-argument errors when giving the same
code a non-integer value.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 20 Nov 2010 16:49:11 +0000 |
| parents | e29fcfd8df5f |
| children | d0bb90d90736 308d34e9f07d |
line wrap: on
line source
;;; x-misc.el --- miscellaneous X functions. ;; Copyright (C) 1997 Free Software Foundation, Inc. ;; Copyright (C) 1995 Sun Microsystems. ;; Copyright (C) 1995, 1996 Ben Wing. ;; Author: Ben Wing <ben@xemacs.org> ;; Maintainer: XEmacs Development Team ;; Keywords: extensions, dumped ;; This file is part of XEmacs. ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; XEmacs is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; This file is dumped with XEmacs (when X support is compiled in). ;;; Code: (globally-declare-fboundp '(x-get-resource)) (defun x-bogosity-check-resource (name class type) "Check for a bogus resource specification." (let ((bogus (x-get-resource (concat "__no-such-friggin-locale__." name) (concat "__No-such-friggin-widget__." class) type 'global nil t))) (if bogus (display-warning 'resource (format "Bad resource specification encountered: something like Emacs*%s: %s You should replace the * with a . in order to get proper behavior when you use the specifier and/or `set-face-*' functions." name bogus))))) (defun x-init-specifier-from-resources (specifier type locale &rest resource-list) "Initialize a specifier from the resource database. LOCALE specifies the locale that is to be initialized and should be a frame, a device, or 'global. TYPE is the type of the resource and should be one of 'string, 'boolean, 'integer, or 'natnum. The remaining args should be conses of names and classes of resources to be examined. The first resource with a value specified becomes the spec for SPECIFIER in LOCALE. (However, if SPECIFIER already has a spec in LOCALE, nothing is done.) Finally, if LOCALE is 'global, a check is done for bogus resource specifications." (if (eq locale 'global) (mapc #'(lambda (x) (x-bogosity-check-resource (car x) (cdr x) type)) resource-list)) (if (not (specifier-spec-list specifier locale)) (catch 'done (while resource-list (let* ((name (caar resource-list)) (class (cdar resource-list)) (resource (x-get-resource name class type locale nil 'warn))) (if resource (progn (add-spec-to-specifier specifier resource locale) (throw 'done t)))) (setq resource-list (cdr resource-list)))))) (defun x-get-resource-and-bogosity-check (name class type &optional locale) (x-bogosity-check-resource name class type) (x-get-resource name class type locale nil 'warn)) (defun x-get-resource-and-maybe-bogosity-check (name class type &optional locale) (if (eq locale 'global) (x-bogosity-check-resource name class type)) (x-get-resource name class type locale nil 'warn)) ;;; x-misc.el ends here
