Mercurial > hg > xemacs-beta
view lisp/x-misc.el @ 5241:d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
src/ChangeLog addition:
2010-07-24 Aidan Kehoe <kehoea@parhasard.net>
* lisp.h (PARSE_KEYWORDS):
Always accept a nil :allow-other-keys keyword argument, as
described in the ALLOW-OTHER-KEYS-NIL Common Lisp issue writeup,
and as necessary for Paul Dietz' tests for #'reduce.
* fns.c (mapping_interaction_error): New.
(Freduce): Call mapping_interaction_error when KEY or FUNCTION
have modified a string SEQUENCE such that the byte length of the
string has changed, or such that the current cursor pointer
doesn't point to the beginning of a character.
Cf. the MAPPING-DESTRUCTIVE-INTERACTION Common Lisp issue
writeup.
When traversing a list, GCPRO the part of it we still have to
traverse, to avoid any crashes if FUNCTION or KEY amputate it
behind us and force a garbage collection.
tests/ChangeLog addition:
2010-07-24 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test a couple of things #'reduce was just made more careful
about.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sat, 24 Jul 2010 15:56:57 +0100 |
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