[COMMIT] Avoid some dynamic scope stupidity in interpreted code, #'notany, #'notevery.
13 years, 12 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1293665918 0
# Node ID f6471e4ae703ecb5f712c9dfcaabdc2a15f3bd65
# Parent 07d24b1f27a772c318f96263b8699cc21283d8a8
Avoid some dynamic scope stupidity in interpreted code, #'notany, #'notevery.
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el (notany, notevery): Avoid some dynamic scope
stupidity with local variable names in these functions, when they
weren't prefixed with cl-; go into some more detail in the doc
strings.
diff -r 07d24b1f27a7 -r f6471e4ae703 lisp/ChangeLog
--- a/lisp/ChangeLog Wed Dec 29 23:25:52 2010 +0000
+++ b/lisp/ChangeLog Wed Dec 29 23:38:38 2010 +0000
＠＠ -1,3 +1,10 ＠＠
+2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-extra.el (notany, notevery): Avoid some dynamic scope
+ stupidity with local variable names in these functions, when they
+ weren't prefixed with cl-; go into some more detail in the doc
+ strings.
+
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
diff -r 07d24b1f27a7 -r f6471e4ae703 lisp/cl-extra.el
--- a/lisp/cl-extra.el Wed Dec 29 23:25:52 2010 +0000
+++ b/lisp/cl-extra.el Wed Dec 29 23:38:38 2010 +0000
＠＠ -128,13 +128,23 ＠＠
`(lambda (&rest arguments) ,＠(if documentation (list documentation))
(not (apply ',function arguments))))
-(defun notany (cl-pred cl-seq &rest cl-rest)
- "Return true if PREDICATE is false of every element of SEQ or SEQs."
- (not (apply 'some cl-pred cl-seq cl-rest)))
+(defun notany (cl-predicate cl-seq &rest cl-rest)
+ "Return true if PREDICATE is false of every element of SEQUENCE.
-(defun notevery (cl-pred cl-seq &rest cl-rest)
- "Return true if PREDICATE is false of some element of SEQ or SEQs."
- (not (apply 'every cl-pred cl-seq cl-rest)))
+With optional SEQUENCES, call PREDICATE each time with as many arguments as
+there are SEQUENCES (plus one for the element from SEQUENCE).
+
+arguments: (PREDICATE SEQUENCES &rest SEQUENCES)"
+ (not (apply 'some cl-predicate cl-seq cl-rest)))
+
+(defun notevery (cl-predicate cl-seq &rest cl-rest)
+ "Return true if PREDICATE is false of some element of SEQUENCE.
+
+With optional SEQUENCES, call PREDICATE each time with as many arguments as
+there are SEQUENCES (plus one for the element from SEQUENCE).
+
+arguments: (PREDICATE SEQUENCES &rest SEQUENCES)"
+ (not (apply 'every cl-predicate cl-seq cl-rest)))
;;; Support for `loop'.
(defalias 'cl-map-keymap 'map-keymap)
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Mark #'remove, #'remq as free of side-effects.
13 years, 12 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1293665152 0
# Node ID 07d24b1f27a772c318f96263b8699cc21283d8a8
# Parent 317ebaee6e4f9941bf8b13bf73bb263d46c7e564
Mark #'remove, #'remq as free of side-effects.
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
free of side-effects.
(side-effect-and-error-free-fns):
Drop dot, dot-marker from the list.
diff -r 317ebaee6e4f -r 07d24b1f27a7 lisp/ChangeLog
--- a/lisp/ChangeLog Wed Dec 01 03:35:22 2010 +0900
+++ b/lisp/ChangeLog Wed Dec 29 23:25:52 2010 +0000
＠＠ -1,3 +1,10 ＠＠
+2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
+ free of side-effects.
+ (side-effect-and-error-free-fns):
+ Drop dot, dot-marker from the list.
+
2010-11-17 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el (coerce):
diff -r 317ebaee6e4f -r 07d24b1f27a7 lisp/byte-optimize.el
--- a/lisp/byte-optimize.el Wed Dec 01 03:35:22 2010 +0900
+++ b/lisp/byte-optimize.el Wed Dec 29 23:25:52 2010 +0000
＠＠ -1245,7 +1245,7 ＠＠
marker-buffer max member memq min mod
next-window nth nthcdr number-to-string numerator
parse-colon-path plist-get previous-window
- radians-to-degrees rassq regexp-quote reverse round
+ radians-to-degrees rassq rassoc remove remq regexp-quote reverse round
sin sqrt string< string= string-equal string-lessp string-to-char
string-to-int string-to-number substring symbol-plist symbol-value
symbol-name symbol-function symbol
＠＠ -1271,7 +1271,7 ＠＠
current-buffer
;; XEmacs: extent functions, frame-live-p, various other stuff
devicep device-live-p
- dot dot-marker eobp eolp eq eql equal eventp extentp
+ eobp eolp eq eql equal eventp extentp
extent-live-p fixnump floatingp floatp framep frame-live-p
get-largest-window get-lru-window
hash-table-p
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Test sanity-checking of :start, :end keyword arguments when appropriate.
13 years, 12 months
Aidan Kehoe
Aidan Kehoe
changeset: 5323:f87bb35a6b94
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Dec 30 01:14:13 2010 +0000
files: tests/ChangeLog tests/automated/lisp-tests.el
description:
Test sanity-checking of :start, :end keyword arguments when appropriate.
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (wrong-type-argument): Add a missing
parenthesis here.
Make sure #'count #'position #'find #'delete* #'remove* #'reduce
#'delete-duplicates #'remove-duplicates #'replace #'mismatch
#'search sanity check their :start and :end keyword arguments.
diff -r df125a42c50c -r f87bb35a6b94 tests/ChangeLog
--- a/tests/ChangeLog Thu Dec 30 01:04:38 2010 +0000
+++ b/tests/ChangeLog Thu Dec 30 01:14:13 2010 +0000
＠＠ -1,3 +1,11 ＠＠
+2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el (wrong-type-argument): Add a missing
+ parenthesis here.
+ Make sure #'count #'position #'find #'delete* #'remove* #'reduce
+ #'delete-duplicates #'remove-duplicates #'replace #'mismatch
+ #'search sanity check their :start and :end keyword arguments.
+
2010-11-20 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
diff -r df125a42c50c -r f87bb35a6b94 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Thu Dec 30 01:04:38 2010 +0000
+++ b/tests/automated/lisp-tests.el Thu Dec 30 01:14:13 2010 +0000
＠＠ -2549,7 +2549,7 ＠＠
(Check-Error wrong-type-argument
(fill "1 2 3 4 5" ?1 :start (float most-positive-fixnum)))
(Check-Error wrong-type-argument
- (fill #*10101010 1 :start (float most-positive-fixnum))
+ (fill #*10101010 1 :start (float most-positive-fixnum)))
(Check-Error wrong-type-argument
(fill '(1 2 3 4 5) 1 :end (float most-positive-fixnum)))
(Check-Error wrong-type-argument
＠＠ -2669,4 +2669,125 ＠＠
(replace '(1 2 3 4 5) [5 4 3 2 1]
:end2 (1+ most-positive-fixnum))))
+(symbol-macrolet
+ ((list-length 2048) (vector-length 512) (string-length (* 8192 2)))
+ (let ((list
+ ;; CIRCULAR_LIST_SUSPICION_LENGTH is 1024, it's helpful if this list
+ ;; is longer than that.
+ (make-list list-length 'make-list))
+ (vector (make-vector vector-length 'make-vector))
+ (bit-vector (make-bit-vector vector-length 1))
+ (string (make-string string-length
+ (or (decode-char 'ucs #x20ac) ?\xFF)))
+ (item 'cons))
+ (dolist (function '(count position find delete* remove* reduce))
+ (Check-Error args-out-of-range
+ (funcall function item list
+:start (1+ list-length) :end (1+ list-length)))
+ (Check-Error wrong-type-argument
+ (funcall function item list
+:start -1 :end list-length))
+ (Check-Error args-out-of-range
+ (funcall function item list :end (* 2 list-length)))
+ (Check-Error args-out-of-range
+ (funcall function item vector
+:start (1+ vector-length) :end (1+ vector-length)))
+ (Check-Error wrong-type-argument
+ (funcall function item vector :start -1))
+ (Check-Error args-out-of-range
+ (funcall function item vector :end (* 2 vector-length)))
+ (Check-Error args-out-of-range
+ (funcall function item bit-vector
+:start (1+ vector-length) :end (1+ vector-length)))
+ (Check-Error wrong-type-argument
+ (funcall function item bit-vector :start -1))
+ (Check-Error args-out-of-range
+ (funcall function item bit-vector :end (* 2 vector-length)))
+ (Check-Error args-out-of-range
+ (funcall function item string
+:start (1+ string-length) :end (1+ string-length)))
+ (Check-Error wrong-type-argument
+ (funcall function item string :start -1))
+ (Check-Error args-out-of-range
+ (funcall function item string :end (* 2 string-length))))
+ (dolist (function '(delete-duplicates remove-duplicates))
+ (Check-Error args-out-of-range
+ (funcall function (copy-sequence list)
+:start (1+ list-length) :end (1+ list-length)))
+ (Check-Error wrong-type-argument
+ (funcall function (copy-sequence list)
+:start -1 :end list-length))
+ (Check-Error args-out-of-range
+ (funcall function (copy-sequence list)
+:end (* 2 list-length)))
+ (Check-Error args-out-of-range
+ (funcall function (copy-sequence vector)
+:start (1+ vector-length) :end (1+ vector-length)))
+ (Check-Error wrong-type-argument
+ (funcall function (copy-sequence vector) :start -1))
+ (Check-Error args-out-of-range
+ (funcall function (copy-sequence vector)
+:end (* 2 vector-length)))
+ (Check-Error args-out-of-range
+ (funcall function (copy-sequence bit-vector)
+:start (1+ vector-length) :end (1+ vector-length)))
+ (Check-Error wrong-type-argument
+ (funcall function (copy-sequence bit-vector) :start -1))
+ (Check-Error args-out-of-range
+ (funcall function (copy-sequence bit-vector)
+:end (* 2 vector-length)))
+ (Check-Error args-out-of-range
+ (funcall function (copy-sequence string)
+:start (1+ string-length) :end (1+ string-length)))
+ (Check-Error wrong-type-argument
+ (funcall function (copy-sequence string) :start -1))
+ (Check-Error args-out-of-range
+ (funcall function (copy-sequence string)
+:end (* 2 string-length))))
+ (dolist (function '(replace mismatch search))
+ (Check-Error args-out-of-range
+ (funcall function (copy-sequence list) (copy-sequence list)
+:start1 (1+ list-length) :end1 (1+ list-length)))
+ (Check-Error wrong-type-argument
+ (funcall function (copy-sequence list) (copy-sequence list)
+:start1 -1 :end1 list-length))
+ (Check-Error args-out-of-range
+ (funcall function (copy-sequence list) (copy-sequence list)
+:end1 (* 2 list-length)))
+ (Check-Error args-out-of-range
+ (funcall function (copy-sequence vector)
+ (copy-sequence vector) :start1 (1+ vector-length)
+:end1 (1+ vector-length)))
+ (Check-Error wrong-type-argument
+ (funcall function (copy-sequence vector)
+ (copy-sequence vector) :start1 -1))
+ (Check-Error args-out-of-range
+ (funcall function (copy-sequence vector)
+ (copy-sequence vector)
+:end1 (* 2 vector-length)))
+ (Check-Error args-out-of-range
+ (funcall function (copy-sequence bit-vector)
+ (copy-sequence bit-vector)
+:start1 (1+ vector-length)
+:end1 (1+ vector-length)))
+ (Check-Error wrong-type-argument
+ (funcall function (copy-sequence bit-vector)
+ (copy-sequence bit-vector) :start1 -1))
+ (Check-Error args-out-of-range
+ (funcall function (copy-sequence bit-vector)
+ (copy-sequence bit-vector)
+:end1 (* 2 vector-length)))
+ (Check-Error args-out-of-range
+ (funcall function (copy-sequence string)
+ (copy-sequence string)
+:start1 (1+ string-length)
+:end1 (1+ string-length)))
+ (Check-Error wrong-type-argument
+ (funcall function (copy-sequence string)
+ (copy-sequence string) :start1 -1))
+ (Check-Error args-out-of-range
+ (funcall function (copy-sequence string)
+ (copy-sequence string)
+:end1 (* 2 string-length))))))
+
;;; end of lisp-tests.el
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Support up to nine keywords in the PARSE_KEYWORDS() macro.
13 years, 12 months
Aidan Kehoe
Aidan Kehoe
changeset: 5322:df125a42c50c
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Dec 30 01:04:38 2010 +0000
files: src/ChangeLog src/lisp.h
description:
Support up to nine keywords in the PARSE_KEYWORDS() macro.
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* lisp.h (DECLARE_N_KEYWORDS_8, DECLARE_N_KEYWORDS_9)
(CHECK_N_KEYWORDS_8, CHECK_N_KEYWORDS_9):
Support up to nine keywords in the PARSE_KEYWORDS() macro.
diff -r 57a64ab2ae45 -r df125a42c50c src/ChangeLog
--- a/src/ChangeLog Thu Dec 30 01:00:40 2010 +0000
+++ b/src/ChangeLog Thu Dec 30 01:04:38 2010 +0000
＠＠ -1,3 +1,9 ＠＠
+2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * lisp.h (DECLARE_N_KEYWORDS_8, DECLARE_N_KEYWORDS_9)
+ (CHECK_N_KEYWORDS_8, CHECK_N_KEYWORDS_9):
+ Support up to nine keywords in the PARSE_KEYWORDS() macro.
+
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* elhash.c (syms_of_elhash):
diff -r 57a64ab2ae45 -r df125a42c50c src/lisp.h
--- a/src/lisp.h Thu Dec 30 01:00:40 2010 +0000
+++ b/src/lisp.h Thu Dec 30 01:04:38 2010 +0000
＠＠ -3641,6 +3641,10 ＠＠
DECLARE_N_KEYWORDS_5(a,b,c,d,e), f = Qnil
#define DECLARE_N_KEYWORDS_7(a,b,c,d,e,f,g) \
DECLARE_N_KEYWORDS_6(a,b,c,d,e,f), g = Qnil
+#define DECLARE_N_KEYWORDS_8(a,b,c,d,e,f,g,h) \
+ DECLARE_N_KEYWORDS_7(a,b,c,d,e,f,g), h = Qnil
+#define DECLARE_N_KEYWORDS_9(a,b,c,d,e,f,g,h,i) \
+ DECLARE_N_KEYWORDS_8(a,b,c,d,e,f,g,h), i = Qnil
#define CHECK_N_KEYWORDS_1(a) \
else if (EQ (pk_key, Q_##a)) { a = pk_value; }
＠＠ -3656,6 +3660,12 ＠＠
else if (EQ (pk_key, Q_##f)) { f = pk_value; }
#define CHECK_N_KEYWORDS_7(a,b,c,d,e,f,g) CHECK_N_KEYWORDS_6(a,b,c,d,e,f) \
else if (EQ (pk_key, Q_##g)) { g = pk_value; }
+#define CHECK_N_KEYWORDS_8(a,b,c,d,e,f,g,h) \
+ CHECK_N_KEYWORDS_7(a,b,c,d,e,f,g) \
+ else if (EQ (pk_key, Q_##h)) { h = pk_value; }
+#define CHECK_N_KEYWORDS_9(a,b,c,d,e,f,g,h,i) \
+ CHECK_N_KEYWORDS_8(a,b,c,d,e,f,g,h) \
+ else if (EQ (pk_key, Q_##i)) { i = pk_value; }
Boolint non_nil_allow_other_keys_p (Elemcount offset, int nargs,
Lisp_Object *args);
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Implement some basic Lisp functions in terms of Common Lisp builtins.
13 years, 12 months
Aidan Kehoe
Aidan Kehoe
changeset: 5321:57a64ab2ae45
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Dec 30 01:00:40 2010 +0000
files: lisp/ChangeLog lisp/iso8859-1.el lisp/simple.el lisp/subr.el
description:
Implement some basic Lisp functions in terms of Common Lisp builtins.
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* simple.el (assoc-ignore-case): Remove a duplicate definition of
this function (it's already in subr.el).
* iso8859-1.el (char-width):
On non-Mule, make this function equivalent to that produced by
(constantly 1), but preserve its docstring.
* subr.el (subst-char-in-string): Define this in terms of
#'substitute, #'nsubstitute.
(string-width): Define this using #'reduce and #'char-width.
(char-width): Give this a simpler definition, it makes far more
sense to check for mule at load time and redefine, as we do in
iso8859-1.el.
(store-substring): Implement this in terms of #'replace, now
#'replace is cheap.
diff -r 31be2a3d121d -r 57a64ab2ae45 lisp/ChangeLog
--- a/lisp/ChangeLog Thu Dec 30 00:50:10 2010 +0000
+++ b/lisp/ChangeLog Thu Dec 30 01:00:40 2010 +0000
＠＠ -1,3 +1,19 ＠＠
+2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * simple.el (assoc-ignore-case): Remove a duplicate definition of
+ this function (it's already in subr.el).
+ * iso8859-1.el (char-width):
+ On non-Mule, make this function equivalent to that produced by
+ (constantly 1), but preserve its docstring.
+ * subr.el (subst-char-in-string): Define this in terms of
+ #'substitute, #'nsubstitute.
+ (string-width): Define this using #'reduce and #'char-width.
+ (char-width): Give this a simpler definition, it makes far more
+ sense to check for mule at load time and redefine, as we do in
+ iso8859-1.el.
+ (store-substring): Implement this in terms of #'replace, now
+ #'replace is cheap.
+
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
diff -r 31be2a3d121d -r 57a64ab2ae45 lisp/iso8859-1.el
--- a/lisp/iso8859-1.el Thu Dec 30 00:50:10 2010 +0000
+++ b/lisp/iso8859-1.el Thu Dec 30 01:00:40 2010 +0000
＠＠ -84,6 +84,17 ＠＠
;; by default.
(setq-default ctl-arrow #xA0)
+(when (and (compiled-function-p (symbol-function 'char-width))
+ (not (featurep 'mule)))
+ (defalias 'char-width
+ (let ((constantly (constantly 1)))
+ (make-byte-code (compiled-function-arglist constantly)
+ (compiled-function-instructions constantly)
+ (compiled-function-constants constantly)
+ (compiled-function-stack-depth constantly)
+ (compiled-function-doc-string
+ (symbol-function 'char-width))))))
+
;; Shouldn't be necessary, but one file in the packages uses it:
(provide 'iso8859-1)
diff -r 31be2a3d121d -r 57a64ab2ae45 lisp/simple.el
--- a/lisp/simple.el Thu Dec 30 00:50:10 2010 +0000
+++ b/lisp/simple.el Thu Dec 30 01:00:40 2010 +0000
＠＠ -3332,11 +3332,6 ＠＠
;; keyboard-quit
;; buffer-quit-function
;; keyboard-escape-quit
-
-(defun assoc-ignore-case (key alist)
- "Like `assoc', but assumes KEY is a string and ignores case when comparing."
- (assoc* key alist :test #'equalp))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; mail composition code ;;
diff -r 31be2a3d121d -r 57a64ab2ae45 lisp/subr.el
--- a/lisp/subr.el Thu Dec 30 00:50:10 2010 +0000
+++ b/lisp/subr.el Thu Dec 30 01:00:40 2010 +0000
＠＠ -765,14 +765,8 ＠＠
(defun subst-char-in-string (fromchar tochar string &optional inplace)
"Replace FROMCHAR with TOCHAR in STRING each time it occurs.
Unless optional argument INPLACE is non-nil, return a new string."
- (let ((i (length string))
- (newstr (if inplace string (copy-sequence string))))
- (while (> i 0)
- (setq i (1- i))
- (if (eq (aref newstr i) fromchar)
- (aset newstr i tochar)))
- newstr))
-
+ (funcall (if inplace #'nsubstitute #'substitute) tochar fromchar
+ (the string string) :test #'eq))
;; XEmacs addition:
(defun replace-in-string (str regexp newtext &optional literal)
＠＠ -961,23 +955,11 ＠＠
the characters in STRING, which may not accurately represent the actual
display width when using a window system. With no international support,
simply returns the length of the string."
- (if (featurep 'mule)
- (let ((col 0)
- (len (length string))
- (i 0))
- (with-fboundp '(charset-width char-charset)
- (while (< i len)
- (setq col (+ col (charset-width (char-charset (aref string i)))))
- (setq i (1+ i))))
- col)
- (length string)))
+ (reduce #'+ (the string string) :initial-value 0 :key #'char-width))
(defun char-width (character)
"Return number of columns a CHARACTER occupies when displayed."
- (if (featurep 'mule)
- (with-fboundp '(charset-width char-charset)
- (charset-width (char-charset character)))
- 1))
+ (charset-width (char-charset character)))
;; The following several functions are useful in GNU Emacs 20 because
;; of the multibyte "characters" the internal representation of which
＠＠ -1003,18 +985,9 ＠＠
(defun store-substring (string idx obj)
"Embed OBJ (string or character) at index IDX of STRING."
- (let* ((str (cond ((stringp obj) obj)
- ((characterp obj) (char-to-string obj))
- (t (error
- "Invalid argument (should be string or character): %s"
- obj))))
- (string-len (length string))
- (len (length str))
- (i 0))
- (while (and (< i len) (< idx string-len))
- (aset string idx (aref str i))
- (setq idx (1+ idx) i (1+ i)))
- string))
+ (if (stringp obj)
+ (replace (the string string) obj :start1 idx)
+ (prog1 string (aset string idx obj))))
;; From FSF 21.1; ELLIPSES is XEmacs addition.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
13 years, 12 months
Aidan Kehoe
Aidan Kehoe
changeset: 5320:31be2a3d121d
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Dec 30 00:50:10 2010 +0000
files: src/ChangeLog src/abbrev.c src/chartab.c src/elhash.c src/general-slots.h src/general.c src/lisp.h
description:
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* elhash.c (syms_of_elhash):
* chartab.c (syms_of_chartab):
* abbrev.c (syms_of_abbrev):
* general-slots.h:
Move Qcount, Q_default, Q_test to general-slots.h, they're about
to be used by other files. Rename Q_default to Q_default_, for the
sake of the PARSE_KEYWORDS macro (given that default is a reserved
identifier in C). Add SYMBOL_KEYWORD_GENERAL(), analogous to
SYMBOL_GENERAL() to make this easier.
diff -r ed5d4f081fa9 -r 31be2a3d121d src/ChangeLog
--- a/src/ChangeLog Thu Dec 30 00:18:50 2010 +0000
+++ b/src/ChangeLog Thu Dec 30 00:50:10 2010 +0000
＠＠ -1,3 +1,15 ＠＠
+2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * elhash.c (syms_of_elhash):
+ * chartab.c (syms_of_chartab):
+ * abbrev.c (syms_of_abbrev):
+ * general-slots.h:
+ Move Qcount, Q_default, Q_test to general-slots.h, they're about
+ to be used by other files. Rename Q_default to Q_default_, for the
+ sake of the PARSE_KEYWORDS macro (given that default is a reserved
+ identifier in C). Add SYMBOL_KEYWORD_GENERAL(), analogous to
+ SYMBOL_GENERAL() to make this easier.
+
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* floatfns.c (Ffloat): If we've been handed a bigfloat here, it's
diff -r ed5d4f081fa9 -r 31be2a3d121d src/abbrev.c
--- a/src/abbrev.c Thu Dec 30 00:18:50 2010 +0000
+++ b/src/abbrev.c Thu Dec 30 00:50:10 2010 +0000
＠＠ -75,7 +75,7 ＠＠
/* Hook to run before expanding any abbrev. */
Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;
-Lisp_Object Qsystem_type, Qcount;
+Lisp_Object Qsystem_type;
struct abbrev_match_mapper_closure
{
＠＠ -558,9 +558,6 ＠＠
void
syms_of_abbrev (void)
{
- DEFSYMBOL(Qcount);
- Qcount = intern ("count");
- staticpro (&Qcount);
DEFSYMBOL(Qsystem_type);
Qsystem_type = intern ("system-type");
DEFSYMBOL (Qpre_abbrev_expand_hook);
diff -r ed5d4f081fa9 -r 31be2a3d121d src/chartab.c
--- a/src/chartab.c Thu Dec 30 00:18:50 2010 +0000
+++ b/src/chartab.c Thu Dec 30 00:50:10 2010 +0000
＠＠ -42,7 +42,7 ＠＠
#include "chartab.h"
#include "syntax.h"
-Lisp_Object Qchar_tablep, Qchar_table, Q_default;
+Lisp_Object Qchar_tablep, Qchar_table;
Lisp_Object Vall_syntax_tables;
＠＠ -1581,7 +1581,7 ＠＠
{
type = value;
}
- else if (EQ (key, Q_default))
+ else if (EQ (key, Q_default_))
{
default_ = value;
}
＠＠ -1626,7 +1626,11 ＠＠
check_valid_char_table_value (default_, XCHAR_TABLE_TYPE (chartab),
ERROR_ME);
set_char_table_default (chartab, default_);
- set_char_table_default (XCHAR_TABLE (chartab)->mirror_table, default_);
+ if (!NILP (XCHAR_TABLE (chartab)->mirror_table))
+ {
+ set_char_table_default (XCHAR_TABLE (chartab)->mirror_table,
+ default_);
+ }
}
while (!NILP (dataval))
＠＠ -1902,7 +1906,6 ＠＠
DEFSYMBOL (Qchar_table);
DEFSYMBOL_MULTIWORD_PREDICATE (Qchar_tablep);
- DEFKEYWORD (Q_default);
DEFSUBR (Fchar_table_p);
DEFSUBR (Fchar_table_type_list);
＠＠ -1957,7 +1960,7 ＠＠
define_structure_type_keyword (st, Q_type, chartab_type_validate);
define_structure_type_keyword (st, Q_data, chartab_data_validate);
- define_structure_type_keyword (st, Q_default, chartab_default_validate);
+ define_structure_type_keyword (st, Q_default_, chartab_default_validate);
}
void
diff -r ed5d4f081fa9 -r 31be2a3d121d src/elhash.c
--- a/src/elhash.c Thu Dec 30 00:18:50 2010 +0000
+++ b/src/elhash.c Thu Dec 30 00:50:10 2010 +0000
＠＠ -93,7 +93,7 ＠＠
static Lisp_Object Qweakness, Qvalue, Qkey_or_value, Qkey_and_value;
static Lisp_Object Vall_weak_hash_tables;
static Lisp_Object Qrehash_size, Qrehash_threshold;
-static Lisp_Object Q_size, Q_test, Q_weakness, Q_rehash_size, Q_rehash_threshold;
+static Lisp_Object Q_size, Q_weakness, Q_rehash_size, Q_rehash_threshold;
static Lisp_Object Vhash_table_test_eq, Vhash_table_test_eql;
static Lisp_Object Vhash_table_test_weak_list;
＠＠ -2291,7 +2291,6 ＠＠
DEFSYMBOL (Qnon_weak); /* obsolete */
DEFKEYWORD (Q_data);
- DEFKEYWORD (Q_test);
DEFKEYWORD (Q_size);
DEFKEYWORD (Q_rehash_size);
DEFKEYWORD (Q_rehash_threshold);
diff -r ed5d4f081fa9 -r 31be2a3d121d src/general-slots.h
--- a/src/general-slots.h Thu Dec 30 00:18:50 2010 +0000
+++ b/src/general-slots.h Thu Dec 30 00:50:10 2010 +0000
＠＠ -32,6 +32,8 ＠＠
SYMBOL_KEYWORD (Q_foo); declares a keyword symbol ":foo"
SYMBOL_GENERAL (Qfoo, "bar"); declares a symbol named "bar" but stored in
the variable Qfoo
+ SYMBOL_KEYWORD_GENERAL (Q_foo_, ":bar"); declares a keyword named ":bar"
+ but stored in the variable Q_foo_.
To sort the crap in this file, use the following:
＠＠ -92,6 +94,7 ＠＠
SYMBOL (Qconsole);
SYMBOL (Qcontrol_1);
SYMBOL (Qcopies);
+SYMBOL (Qcount);
SYMBOL_MODULE_API (Qcritical);
SYMBOL (Qctext);
SYMBOL (Qcurrent);
＠＠ -102,6 +105,9 ＠＠
SYMBOL (Qdead);
SYMBOL (Qdebug);
SYMBOL (Qdefault);
+/* We name the C variable corresponding to the keyword Q_default_, not
+ Q_default, to allow it to be useful with PARSE_KEYWORDS (). */
+SYMBOL_KEYWORD_GENERAL (Q_default_, ":default");
SYMBOL_MODULE_API (Qdelete);
SYMBOL (Qdelq);
SYMBOL (Qdescription);
＠＠ -270,6 +276,7 ＠＠
SYMBOL_KEYWORD (Q_start);
SYMBOL (Qstream);
SYMBOL (Qstring);
+SYMBOL (Qstring_match);
SYMBOL_KEYWORD (Q_style);
SYMBOL_KEYWORD (Q_suffix);
SYMBOL (Qsubtype);
＠＠ -279,6 +286,7 ＠＠
SYMBOL (Qsystem_default);
SYMBOL (Qterminal);
SYMBOL (Qtest);
+SYMBOL_KEYWORD (Q_test);
SYMBOL (Qtext);
SYMBOL_KEYWORD (Q_text);
SYMBOL (Qthis_command);
diff -r ed5d4f081fa9 -r 31be2a3d121d src/general.c
--- a/src/general.c Thu Dec 30 00:18:50 2010 +0000
+++ b/src/general.c Thu Dec 30 00:50:10 2010 +0000
＠＠ -29,8 +29,9 ＠＠
#define SYMBOL(fou) Lisp_Object fou
#define SYMBOL_MODULE_API(fou) Lisp_Object fou
-#define SYMBOL_KEYWORD(la_cle_est_fou) Lisp_Object la_cle_est_fou
+#define SYMBOL_KEYWORD(la_cle_est_folle) Lisp_Object la_cle_est_folle
#define SYMBOL_GENERAL(tout_le_monde, est_fou) Lisp_Object tout_le_monde
+#define SYMBOL_KEYWORD_GENERAL(ponle, la_clave) Lisp_Object ponle
#include "general-slots.h"
＠＠ -38,6 +39,7 ＠＠
#undef SYMBOL_MODULE_API
#undef SYMBOL_KEYWORD
#undef SYMBOL_GENERAL
+#undef SYMBOL_KEYWORD_GENERAL
void
syms_of_general (void)
＠＠ -46,10 +48,13 ＠＠
#define SYMBOL_MODULE_API(loco) DEFSYMBOL (loco)
#define SYMBOL_KEYWORD(meshugeneh) DEFKEYWORD (meshugeneh)
#define SYMBOL_GENERAL(vachement, fou) defsymbol (&vachement, fou)
+#define SYMBOL_KEYWORD_GENERAL(bescheuert, gaaanz_bescheuert) \
+ defkeyword (&bescheuert, gaaanz_bescheuert)
#include "general-slots.h"
#undef SYMBOL
#undef SYMBOL_KEYWORD
#undef SYMBOL_GENERAL
+#undef SYMBOL_KEYWORD_GENERAL
}
diff -r ed5d4f081fa9 -r 31be2a3d121d src/lisp.h
--- a/src/lisp.h Thu Dec 30 00:18:50 2010 +0000
+++ b/src/lisp.h Thu Dec 30 00:50:10 2010 +0000
＠＠ -5305,9 +5305,11 ＠＠
/* Defined in general.c */
#define SYMBOL(fou) extern Lisp_Object fou
#define SYMBOL_MODULE_API(fou) extern MODULE_API Lisp_Object fou
-#define SYMBOL_KEYWORD(la_cle_est_fou) extern Lisp_Object la_cle_est_fou
+#define SYMBOL_KEYWORD(la_cle_est_folle) extern Lisp_Object la_cle_est_folle
#define SYMBOL_GENERAL(tout_le_monde, est_fou) \
extern Lisp_Object tout_le_monde
+#define SYMBOL_KEYWORD_GENERAL(y_compris_ben, mais_que_peut_on_faire) \
+ extern Lisp_Object y_compris_ben
#include "general-slots.h"
＠＠ -5315,6 +5317,7 ＠＠
#undef SYMBOL_MODULE_API
#undef SYMBOL_KEYWORD
#undef SYMBOL_GENERAL
+#undef SYMBOL_KEYWORD_GENERAL
extern Lisp_Object Qeq;
extern Lisp_Object Qeql;
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: cl-macs belongs in lisp-files-needed-for-byte-compilation.
13 years, 12 months
Aidan Kehoe
Aidan Kehoe
changeset: 5319:ed5d4f081fa9
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Dec 30 00:18:50 2010 +0000
files: lisp/ChangeLog lisp/update-elc.el
description:
cl-macs belongs in lisp-files-needed-for-byte-compilation.
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
(lisp-files-needing-early-byte-compilation):
cl-macs belongs in the former, not the latter, it is as
fundamental as bytecomp.el.
diff -r 203dcac81dae -r ed5d4f081fa9 lisp/ChangeLog
--- a/lisp/ChangeLog Thu Dec 30 00:15:37 2010 +0000
+++ b/lisp/ChangeLog Thu Dec 30 00:18:50 2010 +0000
＠＠ -1,3 +1,10 ＠＠
+2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * update-elc.el (lisp-files-needed-for-byte-compilation)
+ (lisp-files-needing-early-byte-compilation):
+ cl-macs belongs in the former, not the latter, it is as
+ fundamental as bytecomp.el.
+
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* cl.el:
diff -r 203dcac81dae -r ed5d4f081fa9 lisp/update-elc.el
--- a/lisp/update-elc.el Thu Dec 30 00:15:37 2010 +0000
+++ b/lisp/update-elc.el Thu Dec 30 00:18:50 2010 +0000
＠＠ -102,6 +102,7 ＠＠
;; .elc's.
(defvar lisp-files-needed-for-byte-compilation
'("bytecomp"
+ "cl-macs"
"byte-optimize"))
;; Lisp files not in `lisp-files-needed-for-byte-compilation' that need
＠＠ -110,8 +111,7 ＠＠
(defvar lisp-files-needing-early-byte-compilation
'("easy-mmode"
"autoload"
- "shadow"
- "cl-macs"))
+ "shadow"))
(defvar unbytecompiled-lisp-files
'("paths.el"
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Provide some milquetoast compatibility in our errors, type-error, program-error
13 years, 12 months
Aidan Kehoe
Aidan Kehoe
changeset: 5318:203dcac81dae
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Dec 30 00:15:37 2010 +0000
files: lisp/ChangeLog lisp/cl.el
description:
Provide some milquetoast compatibility in our errors, type-error, program-error
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* cl.el:
Provde the Common Lisp program-error, type-error as error
symbols. This doesn't nearly go far enough for anyone using the
Common Lisp errors.
diff -r 8aa511adfad6 -r 203dcac81dae lisp/ChangeLog
--- a/lisp/ChangeLog Wed Dec 29 23:56:57 2010 +0000
+++ b/lisp/ChangeLog Thu Dec 30 00:15:37 2010 +0000
＠＠ -1,3 +1,10 ＠＠
+2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl.el:
+ Provde the Common Lisp program-error, type-error as error
+ symbols. This doesn't nearly go far enough for anyone using the
+ Common Lisp errors.
+
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (delete-duplicates):
diff -r 8aa511adfad6 -r 203dcac81dae lisp/cl.el
--- a/lisp/cl.el Wed Dec 29 23:56:57 2010 +0000
+++ b/lisp/cl.el Thu Dec 30 00:15:37 2010 +0000
＠＠ -603,6 +603,19 ＠＠
;; XEmacs change
(define-error 'cl-assertion-failed "Assertion failed")
+;; XEmacs; provide a milquetoast amount of compatibility in our error symbols.
+(define-error 'type-error "Wrong type" 'wrong-type-argument)
+(define-error 'program-error "Error in your program" 'invalid-argument)
+
+(map-plist
+ #'(lambda (key value)
+ (mapc #'(lambda (error)
+ (put error 'error-conditions
+ (cons key (get error 'error-conditions))))
+ value))
+ '(program-error (wrong-number-of-arguments invalid-keyword-argument)
+ type-error (wrong-type-argument malformed-list circular-list)))
+
;; XEmacs change: omit the autoload rules; we handle those a different way
;;; Define data for indentation and edebug.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: #'delete-duplicates: don't attempt to compiler macroexpand with bad arguments
13 years, 12 months
Aidan Kehoe
Aidan Kehoe
changeset: 5317:8aa511adfad6
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Wed Dec 29 23:56:57 2010 +0000
files: lisp/ChangeLog lisp/cl-macs.el
description:
#'delete-duplicates: don't attempt to compiler macroexpand with bad arguments
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (delete-duplicates):
If the form has an incorrect number of arguments, don't attempt a
compiler macroexpansion.
diff -r 9ac28212c75a -r 8aa511adfad6 lisp/ChangeLog
--- a/lisp/ChangeLog Wed Dec 29 23:53:48 2010 +0000
+++ b/lisp/ChangeLog Wed Dec 29 23:56:57 2010 +0000
＠＠ -1,3 +1,9 ＠＠
+2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-macs.el (delete-duplicates):
+ If the form has an incorrect number of arguments, don't attempt a
+ compiler macroexpansion.
+
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (cl-safe-expr-p):
diff -r 9ac28212c75a -r 8aa511adfad6 lisp/cl-macs.el
--- a/lisp/cl-macs.el Wed Dec 29 23:53:48 2010 +0000
+++ b/lisp/cl-macs.el Wed Dec 29 23:56:57 2010 +0000
＠＠ -3487,56 +3487,60 ＠＠
;; XEmacs; inline delete-duplicates if it's called with one of the
;; common compile-time constant tests and an optional :from-end
;; argument, we want the speed in font-lock.el.
-(define-compiler-macro delete-duplicates (&whole form cl-seq &rest cl-keys)
- (if (not (or (memq (car-safe cl-seq)
- ;; No need to check for a list at runtime with
- ;; these. We could expand the list, but these are all
- ;; the functions in the relevant context at the moment.
- '(nreverse append nconc mapcan mapcar string-to-list))
- (and (listp cl-seq) (equal (butlast cl-seq) '(the list)))))
- form
- (cond
- ((or (plists-equal cl-keys '(:test 'eq) t)
- (plists-equal cl-keys '(:test #'eq) t))
- `(let* ((begin ,cl-seq)
- cl-seq)
- (while (memq (car begin) (cdr begin))
- (setq begin (cdr begin)))
- (setq cl-seq begin)
- (while (cddr cl-seq)
- (if (memq (cadr cl-seq) (cddr cl-seq))
- (setcdr (cdr cl-seq) (cddr cl-seq)))
- (setq cl-seq (cdr cl-seq)))
- begin))
- ((or (plists-equal cl-keys '(:test 'eq :from-end t) t)
- (plists-equal cl-keys '(:test #'eq :from-end t) t))
- `(let* ((begin ,cl-seq)
- (cl-seq begin))
- (while cl-seq
- (setq cl-seq (setcdr cl-seq
- (delq (car cl-seq) (cdr cl-seq)))))
- begin))
- ((or (plists-equal cl-keys '(:test 'equal) t)
- (plists-equal cl-keys '(:test #'equal) t))
- `(let* ((begin ,cl-seq)
- cl-seq)
- (while (member (car begin) (cdr begin))
- (setq begin (cdr begin)))
- (setq cl-seq begin)
- (while (cddr cl-seq)
- (if (member (cadr cl-seq) (cddr cl-seq))
- (setcdr (cdr cl-seq) (cddr cl-seq)))
- (setq cl-seq (cdr cl-seq)))
- begin))
- ((or (plists-equal cl-keys '(:test 'equal :from-end t) t)
- (plists-equal cl-keys '(:test #'equal :from-end t) t))
- `(let* ((begin ,cl-seq)
- (cl-seq begin))
- (while cl-seq
- (setq cl-seq (setcdr cl-seq (delete (car cl-seq)
- (cdr cl-seq)))))
- begin))
- (t form))))
+(define-compiler-macro delete-duplicates (&whole form &rest cl-keys)
+ (let ((cl-seq (if cl-keys (pop cl-keys))))
+ (if (or
+ (not (or (memq (car-safe cl-seq)
+ ;; No need to check for a list at runtime with
+ ;; these. We could expand the list, but these are all
+ ;; the functions in the relevant context at the moment.
+ '(nreverse append nconc mapcan mapcar string-to-list))
+ (and (listp cl-seq) (equal (butlast cl-seq) '(the list)))))
+ ;; Wrong number of arguments.
+ (not (cdr form)))
+ form
+ (cond
+ ((or (plists-equal cl-keys '(:test 'eq) t)
+ (plists-equal cl-keys '(:test #'eq) t))
+ `(let* ((begin ,cl-seq)
+ cl-seq)
+ (while (memq (car begin) (cdr begin))
+ (setq begin (cdr begin)))
+ (setq cl-seq begin)
+ (while (cddr cl-seq)
+ (if (memq (cadr cl-seq) (cddr cl-seq))
+ (setcdr (cdr cl-seq) (cddr cl-seq)))
+ (setq cl-seq (cdr cl-seq)))
+ begin))
+ ((or (plists-equal cl-keys '(:test 'eq :from-end t) t)
+ (plists-equal cl-keys '(:test #'eq :from-end t) t))
+ `(let* ((begin ,cl-seq)
+ (cl-seq begin))
+ (while cl-seq
+ (setq cl-seq (setcdr cl-seq
+ (delq (car cl-seq) (cdr cl-seq)))))
+ begin))
+ ((or (plists-equal cl-keys '(:test 'equal) t)
+ (plists-equal cl-keys '(:test #'equal) t))
+ `(let* ((begin ,cl-seq)
+ cl-seq)
+ (while (member (car begin) (cdr begin))
+ (setq begin (cdr begin)))
+ (setq cl-seq begin)
+ (while (cddr cl-seq)
+ (if (member (cadr cl-seq) (cddr cl-seq))
+ (setcdr (cdr cl-seq) (cddr cl-seq)))
+ (setq cl-seq (cdr cl-seq)))
+ begin))
+ ((or (plists-equal cl-keys '(:test 'equal :from-end t) t)
+ (plists-equal cl-keys '(:test #'equal :from-end t) t))
+ `(let* ((begin ,cl-seq)
+ (cl-seq begin))
+ (while cl-seq
+ (setq cl-seq (setcdr cl-seq (delete (car cl-seq)
+ (cdr cl-seq)))))
+ begin))
+ (t form)))))
;; XEmacs; it's perfectly reasonable, and often much clearer to those
;; reading the code, to call regexp-quote on a constant string, which is
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: #'cl-safe-expr-p, forms that start with the symbol lambda are also safe.
13 years, 12 months
Aidan Kehoe
Aidan Kehoe
changeset: 5316:9ac28212c75a
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Wed Dec 29 23:53:48 2010 +0000
files: lisp/ChangeLog lisp/cl-macs.el
description:
#'cl-safe-expr-p, forms that start with the symbol lambda are also safe.
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (cl-safe-expr-p):
Forms that start with the symbol lambda are also safe.
diff -r 2a7b6ddb8063 -r 9ac28212c75a lisp/ChangeLog
--- a/lisp/ChangeLog Wed Dec 29 23:51:08 2010 +0000
+++ b/lisp/ChangeLog Wed Dec 29 23:53:48 2010 +0000
＠＠ -1,3 +1,8 ＠＠
+2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-macs.el (cl-safe-expr-p):
+ Forms that start with the symbol lambda are also safe.
+
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (= < > <= >=):
diff -r 2a7b6ddb8063 -r 9ac28212c75a lisp/cl-macs.el
--- a/lisp/cl-macs.el Wed Dec 29 23:51:08 2010 +0000
+++ b/lisp/cl-macs.el Wed Dec 29 23:53:48 2010 +0000
＠＠ -111,7 +111,8 ＠＠
;;; Check if no side effects.
(defun cl-safe-expr-p (x)
- (or (not (and (consp x) (not (memq (car x) '(quote function function*)))))
+ (or (not (and (consp x) (not (memq (car x)
+ '(quote function function* lambda)))))
(and (symbolp (car x))
(or (memq (car x) cl-simple-funcs)
(memq (car x) cl-safe-funcs)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments