commit: Try again, s/usg5-4.h, this type with qxestrcpy_ascii(), etc.
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 5340:9dd4559b9e9a
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Jan 15 17:24:06 2011 +0000
files: src/ChangeLog src/s/usg5-4.h
description:
Try again, s/usg5-4.h, this type with qxestrcpy_ascii(), etc.
2011-01-15 Aidan Kehoe <kehoea(a)parhasard.net>
* s/usg5-4.h (PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF):
That didn't work; attempt with qxestrcpy_ascii(),
qxestrncpy_ascii().
diff -r ba62563ec7c7 -r 9dd4559b9e9a src/ChangeLog
--- a/src/ChangeLog Sat Jan 15 15:45:46 2011 +0000
+++ b/src/ChangeLog Sat Jan 15 17:24:06 2011 +0000
＠＠ -1,3 +1,9 ＠＠
+2011-01-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * s/usg5-4.h (PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF):
+ That didn't work; attempt with qxestrcpy_ascii(),
+ qxestrncpy_ascii().
+
2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
* s/hpux11.h (PTY_TTY_NAME_SPRINTF, PTY_NAME_SPRINTF):
diff -r ba62563ec7c7 -r 9dd4559b9e9a src/s/usg5-4.h
--- a/src/s/usg5-4.h Sat Jan 15 15:45:46 2011 +0000
+++ b/src/s/usg5-4.h Sat Jan 15 17:24:06 2011 +0000
＠＠ -124,7 +124,7 ＠＠
/* This sets the name of the master side of the PTY. */
-#define PTY_NAME_SPRINTF qxestrcpy (pty_name, "/dev/ptmx");
+#define PTY_NAME_SPRINTF qxestrcpy_ascii (pty_name, "/dev/ptmx");
/* This sets the name of the slave side of the PTY. On SysVr4,
grantpt(3) forks a subprocess, so keep sigchld_handler() from
＠＠ -150,7 +150,8 ＠＠
{ close (fd); return -1; } \
if (!(ptyname = ptsname (fd))) \
{ close (fd); return -1; } \
- qxestrncpy (pty_name, ptyname, sizeof (pty_name)); \
+ qxestrncpy_ascii (pty_name, ptyname, \
+ sizeof (pty_name)); \
pty_name[sizeof (pty_name) - 1] = 0; \
}
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Accept more complex TYPEs in #'concatenate, cl-extra.el
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1295106346 0
# Node ID ba62563ec7c707a37b3032a29ac6e3c3d60b85bc
# Parent 8608eadee6bab31ac0bbd166b55457ab69cd8f54
Accept more complex TYPEs in #'concatenate, cl-extra.el
lisp/ChangeLog addition:
2011-01-15 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el (concatenate): Accept more complicated TYPEs in this
function, handing the sequences over to #'coerce if we don't
understand them here.
* cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
compiler macro is more useful than doing that.
tests/ChangeLog addition:
2011-01-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (list): Test #'concatenate, especially
with more complicated TYPEs, which were previously not accepted by
the function.
diff -r 8608eadee6ba -r ba62563ec7c7 lisp/ChangeLog
--- a/lisp/ChangeLog Fri Jan 14 23:35:29 2011 +0000
+++ b/lisp/ChangeLog Sat Jan 15 15:45:46 2011 +0000
＠＠ -1,3 +1,11 ＠＠
+2011-01-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-extra.el (concatenate): Accept more complicated TYPEs in this
+ function, handing the sequences over to #'coerce if we don't
+ understand them here.
+ * cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
+ compiler macro is more useful than doing that.
+
2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
diff -r 8608eadee6ba -r ba62563ec7c7 lisp/cl-extra.el
--- a/lisp/cl-extra.el Fri Jan 14 23:35:29 2011 +0000
+++ b/lisp/cl-extra.el Sat Jan 15 15:45:46 2011 +0000
＠＠ -421,9 +421,9 ＠＠
(case type
(vector (apply 'vconcat seqs))
(string (apply 'concat seqs))
- (list (apply 'append (append seqs '(nil))))
+ (list (reduce 'append seqs :from-end t :initial-value nil))
(bit-vector (apply 'bvconcat seqs))
- (t (error 'invalid-argument "Not a sequence type name" type))))
+ (t (coerce (reduce 'append seqs :from-end t :initial-value nil) type))))
;;; List functions.
diff -r 8608eadee6ba -r ba62563ec7c7 lisp/cl-macs.el
--- a/lisp/cl-macs.el Fri Jan 14 23:35:29 2011 +0000
+++ b/lisp/cl-macs.el Sat Jan 15 15:45:46 2011 +0000
＠＠ -3831,10 +3831,9 ＠＠
(cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar)
(cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr)))
-;;; Things that are inline.
-(proclaim '(inline acons map concatenate
-;; XEmacs omission: gethash is builtin
- cl-set-elt revappend nreconc))
+;;; Things that are inline. XEmacs; the functions that used to be here have
+;;; compiler macros or are built-in.
+(proclaim '(inline cl-set-elt))
;;; Things that are side-effect-free. Moved to byte-optimize.el
;(mapcar (function (lambda (x) (put x 'side-effect-free t)))
diff -r 8608eadee6ba -r ba62563ec7c7 tests/ChangeLog
--- a/tests/ChangeLog Fri Jan 14 23:35:29 2011 +0000
+++ b/tests/ChangeLog Sat Jan 15 15:45:46 2011 +0000
＠＠ -1,3 +1,9 ＠＠
+2011-01-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el (list): Test #'concatenate, especially
+ with more complicated TYPEs, which were previously not accepted by
+ the function.
+
2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (list): Test #'find, especially the
diff -r 8608eadee6ba -r ba62563ec7c7 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Fri Jan 14 23:35:29 2011 +0000
+++ b/tests/automated/lisp-tests.el Sat Jan 15 15:45:46 2011 +0000
＠＠ -2814,6 +2814,20 ＠＠
(Assert (eq gensym (find 'not-in-it string :default gensym)))
(Assert (eq 'hi-there (find 'hi-there list)))
;; Different uninterned symbols with the same name.
- (Assert (not (eq '#1=#:everyone (find '#1# list)))))
+ (Assert (not (eq '#1=#:everyone (find '#1# list))))
+
+ ;; Test concatenate.
+ (Assert (equal list (concatenate 'list vector)))
+ (Assert (equal list (concatenate 'list (subseq vector 0 4)
+ (subseq list 4))))
+ (Assert (equal vector (concatenate 'vector list)))
+ (Assert (equal vector (concatenate `(vector * ,(length vector)) list)))
+ (Assert (equal string (concatenate `(vector character ,(length string))
+ (append string nil))))
+ (Assert (equal bit-vector (concatenate 'bit-vector (subseq bit-vector 0 4)
+ (append (subseq bit-vector 4) nil))))
+ (Assert (equal bit-vector (concatenate `(vector bit ,(length bit-vector))
+ (subseq bit-vector 0 4)
+ (append (subseq bit-vector 4) nil)))))
;;; end of lisp-tests.el
--
“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: Accept more complex TYPEs in #'concatenate, cl-extra.el
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 5339:ba62563ec7c7
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Jan 15 15:45:46 2011 +0000
files: lisp/ChangeLog lisp/cl-extra.el lisp/cl-macs.el tests/ChangeLog tests/automated/lisp-tests.el
description:
Accept more complex TYPEs in #'concatenate, cl-extra.el
lisp/ChangeLog addition:
2011-01-15 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el (concatenate): Accept more complicated TYPEs in this
function, handing the sequences over to #'coerce if we don't
understand them here.
* cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
compiler macro is more useful than doing that.
tests/ChangeLog addition:
2011-01-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (list): Test #'concatenate, especially
with more complicated TYPEs, which were previously not accepted by
the function.
diff -r 8608eadee6ba -r ba62563ec7c7 lisp/ChangeLog
--- a/lisp/ChangeLog Fri Jan 14 23:35:29 2011 +0000
+++ b/lisp/ChangeLog Sat Jan 15 15:45:46 2011 +0000
＠＠ -1,3 +1,11 ＠＠
+2011-01-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-extra.el (concatenate): Accept more complicated TYPEs in this
+ function, handing the sequences over to #'coerce if we don't
+ understand them here.
+ * cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
+ compiler macro is more useful than doing that.
+
2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
diff -r 8608eadee6ba -r ba62563ec7c7 lisp/cl-extra.el
--- a/lisp/cl-extra.el Fri Jan 14 23:35:29 2011 +0000
+++ b/lisp/cl-extra.el Sat Jan 15 15:45:46 2011 +0000
＠＠ -421,9 +421,9 ＠＠
(case type
(vector (apply 'vconcat seqs))
(string (apply 'concat seqs))
- (list (apply 'append (append seqs '(nil))))
+ (list (reduce 'append seqs :from-end t :initial-value nil))
(bit-vector (apply 'bvconcat seqs))
- (t (error 'invalid-argument "Not a sequence type name" type))))
+ (t (coerce (reduce 'append seqs :from-end t :initial-value nil) type))))
;;; List functions.
diff -r 8608eadee6ba -r ba62563ec7c7 lisp/cl-macs.el
--- a/lisp/cl-macs.el Fri Jan 14 23:35:29 2011 +0000
+++ b/lisp/cl-macs.el Sat Jan 15 15:45:46 2011 +0000
＠＠ -3831,10 +3831,9 ＠＠
(cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar)
(cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr)))
-;;; Things that are inline.
-(proclaim '(inline acons map concatenate
-;; XEmacs omission: gethash is builtin
- cl-set-elt revappend nreconc))
+;;; Things that are inline. XEmacs; the functions that used to be here have
+;;; compiler macros or are built-in.
+(proclaim '(inline cl-set-elt))
;;; Things that are side-effect-free. Moved to byte-optimize.el
;(mapcar (function (lambda (x) (put x 'side-effect-free t)))
diff -r 8608eadee6ba -r ba62563ec7c7 tests/ChangeLog
--- a/tests/ChangeLog Fri Jan 14 23:35:29 2011 +0000
+++ b/tests/ChangeLog Sat Jan 15 15:45:46 2011 +0000
＠＠ -1,3 +1,9 ＠＠
+2011-01-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el (list): Test #'concatenate, especially
+ with more complicated TYPEs, which were previously not accepted by
+ the function.
+
2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (list): Test #'find, especially the
diff -r 8608eadee6ba -r ba62563ec7c7 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Fri Jan 14 23:35:29 2011 +0000
+++ b/tests/automated/lisp-tests.el Sat Jan 15 15:45:46 2011 +0000
＠＠ -2814,6 +2814,20 ＠＠
(Assert (eq gensym (find 'not-in-it string :default gensym)))
(Assert (eq 'hi-there (find 'hi-there list)))
;; Different uninterned symbols with the same name.
- (Assert (not (eq '#1=#:everyone (find '#1# list)))))
+ (Assert (not (eq '#1=#:everyone (find '#1# list))))
+
+ ;; Test concatenate.
+ (Assert (equal list (concatenate 'list vector)))
+ (Assert (equal list (concatenate 'list (subseq vector 0 4)
+ (subseq list 4))))
+ (Assert (equal vector (concatenate 'vector list)))
+ (Assert (equal vector (concatenate `(vector * ,(length vector)) list)))
+ (Assert (equal string (concatenate `(vector character ,(length string))
+ (append string nil))))
+ (Assert (equal bit-vector (concatenate 'bit-vector (subseq bit-vector 0 4)
+ (append (subseq bit-vector 4) nil))))
+ (Assert (equal bit-vector (concatenate `(vector bit ,(length bit-vector))
+ (subseq bit-vector 0 4)
+ (append (subseq bit-vector 4) nil)))))
;;; 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
[PATCH] Move #'delq, #'delete to Lisp, adding support for sequences.
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
GNU have moved to accepting non-list sequences in #'delete. They don’t in
#'delq; the below approach means we can document #'delq, #'delete in terms
of #'delete*, and pre-empts any further widening of the API by GNU.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1294783925 0
# Node ID 7b62ebe57ae63f3bb9457bbe16018eaf297e0e69
# Parent c9d31263ab7db633744accb5195727a4a343a3d7
Move #'delq, #'delete to Lisp, adding support for sequences.
src/ChangeLog addition:
2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net>
* device-msw.c (Fmswindows_printer_list): Remove a Fdelete ()
call here, remove the necessity for it.
* fns.c (Fdelete, Fdelq):
* lisp.h:
Move #'delete, #'delq to Lisp, implemented in terms of #'delete*
* select.c (Fown_selection_internal):
* select.c (handle_selection_clear):
Use delq_no_quit() in these functions, don't reimplement it or use
Fdelq(), which is now gone.
lisp/ChangeLog addition:
2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
here, they don't belong in cl-seq.el; move #'delete, #'delq here
from fns.c, implement them in terms of #'delete*, allowing support
for sequences generally.
* update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
here, now the latter's no longer dumped.
* cl-macs.el (delete, delq): Add compiler macros transforming
#'delete and #'delq to #'delete* calls.
diff -r c9d31263ab7d -r 7b62ebe57ae6 lisp/ChangeLog
--- a/lisp/ChangeLog Tue Jan 11 13:39:35 2011 +0000
+++ b/lisp/ChangeLog Tue Jan 11 22:12:05 2011 +0000
＠＠ -1,3 +1,14 ＠＠
+2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * subr.el (delete, delq, remove, remq): Move #'remove, #'remq
+ here, they don't belong in cl-seq.el; move #'delete, #'delq here
+ from fns.c, implement them in terms of #'delete*, allowing support
+ for sequences generally.
+ * update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
+ here, now the latter's no longer dumped.
+ * cl-macs.el (delete, delq): Add compiler macros transforming
+ #'delete and #'delq to #'delete* calls.
+
2011-01-10 Aidan Kehoe <kehoea(a)parhasard.net>
* dialog.el (make-dialog-box): Correct a misplaced parenthesis
diff -r c9d31263ab7d -r 7b62ebe57ae6 lisp/cl-macs.el
--- a/lisp/cl-macs.el Tue Jan 11 13:39:35 2011 +0000
+++ b/lisp/cl-macs.el Tue Jan 11 22:12:05 2011 +0000
＠＠ -3342,6 +3342,12 ＠＠
(list 'if (list* 'member* a list keys) list (list 'cons a list))
form))
+(define-compiler-macro delete (item sequence)
+ `(delete* ,item ,sequence :test #'equal))
+
+(define-compiler-macro delq (item sequence)
+ `(delete* ,item ,sequence :test #'eq))
+
(define-compiler-macro remove (item sequence)
`(remove* ,item ,sequence :test #'equal))
diff -r c9d31263ab7d -r 7b62ebe57ae6 lisp/subr.el
--- a/lisp/subr.el Tue Jan 11 13:39:35 2011 +0000
+++ b/lisp/subr.el Tue Jan 11 22:12:05 2011 +0000
＠＠ -148,6 +148,40 ＠＠
(define-function ,＠args)))
+(defun delete (item sequence)
+ "Delete by side effect any occurrences of ITEM as a member of SEQUENCE.
+
+The modified SEQUENCE is returned. Comparison is done with `equal'.
+
+If the first member of a list SEQUENCE is ITEM, there is no way to remove it
+by side effect; therefore, write `(setq foo (delete element foo))' to be
+sure of changing the value of `foo'. Also see: `remove'."
+ (delete* item sequence :test #'equal))
+
+(defun delq (item sequence)
+ "Delete by side effect any occurrences of ITEM as a member of SEQUENCE.
+
+The modified SEQUENCE is returned. Comparison is done with `eq'. If
+SEQUENCE is a list and its first member is ITEM, there is no way to remove
+it by side effect; therefore, write `(setq foo (delq element foo))' to be
+sure of changing the value of `foo'."
+ (delete* item sequence :test #'eq))
+
+(defun remove (item sequence)
+ "Remove all occurrences of ITEM in SEQUENCE, testing with `equal'.
+
+This is a non-destructive function; it makes a copy of SEQUENCE if necessary
+to avoid corrupting the original SEQUENCE.
+Also see: `remove*', `delete', `delete*'"
+ (remove* item sequence :test #'equal))
+
+(defun remq (item sequence)
+ "Remove all occurrences of ITEM in SEQUENCE, comparing with `eq'.
+
+This is a non-destructive function; it makes a copy of SEQUENCE to avoid
+corrupting the original LIST. See also the more general `remove*'."
+ (remove* item sequence :test #'eq))
+
(defun assoc-default (key alist &optional test default)
"Find object KEY in a pseudo-alist ALIST.
ALIST is a list of conses or objects. Each element (or the element's car,
diff -r c9d31263ab7d -r 7b62ebe57ae6 lisp/update-elc.el
--- a/lisp/update-elc.el Tue Jan 11 13:39:35 2011 +0000
+++ b/lisp/update-elc.el Tue Jan 11 22:12:05 2011 +0000
＠＠ -383,7 +383,10 ＠＠
(mapc
#'(lambda (arg)
(setq update-elc-files-to-compile
- (delete arg update-elc-files-to-compile)))
+ (delete* arg update-elc-files-to-compile
+ :test (if default-file-system-ignore-case
+ #'equalp
+ #'equal))))
(append bc-bootstrap bootstrap-other))
(setq command-line-args
(append
diff -r c9d31263ab7d -r 7b62ebe57ae6 src/ChangeLog
--- a/src/ChangeLog Tue Jan 11 13:39:35 2011 +0000
+++ b/src/ChangeLog Tue Jan 11 22:12:05 2011 +0000
＠＠ -1,3 +1,15 ＠＠
+2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * device-msw.c (Fmswindows_printer_list): Remove a Fdelete ()
+ call here, remove the necessity for it.
+ * fns.c (Fdelete, Fdelq):
+ * lisp.h:
+ Move #'delete, #'delq to Lisp, implemented in terms of #'delete*
+ * select.c (Fown_selection_internal):
+ * select.c (handle_selection_clear):
+ Use delq_no_quit() in these functions, don't reimplement it or use
+ Fdelq(), which is now gone.
+
2011-01-10 Aidan Kehoe <kehoea(a)parhasard.net>
* mc-alloc.c (get_used_list_index):
diff -r c9d31263ab7d -r 7b62ebe57ae6 src/device-msw.c
--- a/src/device-msw.c Tue Jan 11 13:39:35 2011 +0000
+++ b/src/device-msw.c Tue Jan 11 22:12:05 2011 +0000
＠＠ -1329,9 +1329,12 ＠＠
GCPRO2 (result, def_printer);
+ def_printer = msprinter_default_printer ();
+
while (num_printers--)
{
Extbyte *printer_name;
+ Lisp_Object printer_name_lisp;
if (have_nt)
{
PRINTER_INFO_4 *info = (PRINTER_INFO_4 *) data_buf;
＠＠ -1343,12 +1346,15 ＠＠
printer_name = (Extbyte *) info->pPrinterName;
}
data_buf += enum_entry_size;
-
- result = Fcons (build_tstr_string (printer_name), result);
+
+ printer_name_lisp = build_tstr_string (printer_name);
+ if (0 != qxestrcasecmp (XSTRING_DATA (def_printer),
+ XSTRING_DATA (printer_name_lisp)))
+ {
+ result = Fcons (printer_name_lisp, result);
+ }
}
- def_printer = msprinter_default_printer ();
- result = Fdelete (def_printer, result);
result = Fcons (def_printer, result);
RETURN_UNGCPRO (result);
diff -r c9d31263ab7d -r 7b62ebe57ae6 src/fns.c
--- a/src/fns.c Tue Jan 11 13:39:35 2011 +0000
+++ b/src/fns.c Tue Jan 11 22:12:05 2011 +0000
＠＠ -3137,21 +3137,6 ＠＠
return object;
}
-DEFUN ("delete", Fdelete, 2, 2, 0, /*
-Delete by side effect any occurrences of ELT as a member of LIST.
-The modified LIST is returned. Comparison is done with `equal'.
-If the first member of LIST is ELT, there is no way to remove it by side
-effect; therefore, write `(setq foo (delete element foo))' to be sure
-of changing the value of `foo'.
-Also see: `remove'.
-*/
- (elt, list))
-{
- EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
- (internal_equal (elt, list_elt, 0)));
- return list;
-}
-
DEFUN ("old-delete", Fold_delete, 2, 2, 0, /*
Delete by side effect any occurrences of ELT as a member of LIST.
The modified LIST is returned. Comparison is done with `old-equal'.
＠＠ -3166,20 +3151,6 ＠＠
return list;
}
-DEFUN ("delq", Fdelq, 2, 2, 0, /*
-Delete by side effect any occurrences of ELT as a member of LIST.
-The modified LIST is returned. Comparison is done with `eq'.
-If the first member of LIST is ELT, there is no way to remove it by side
-effect; therefore, write `(setq foo (delq element foo))' to be sure of
-changing the value of `foo'.
-*/
- (elt, list))
-{
- EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
- (EQ_WITH_EBOLA_NOTICE (elt, list_elt)));
- return list;
-}
-
DEFUN ("old-delq", Fold_delq, 2, 2, 0, /*
Delete by side effect any occurrences of ELT as a member of LIST.
The modified LIST is returned. Comparison is done with `old-eq'.
＠＠ -11790,9 +11761,7 ＠＠
DEFSUBR (Fposition);
DEFSUBR (Ffind);
- DEFSUBR (Fdelete);
DEFSUBR (Fold_delete);
- DEFSUBR (Fdelq);
DEFSUBR (Fold_delq);
DEFSUBR (FdeleteX);
DEFSUBR (FremoveX);
diff -r c9d31263ab7d -r 7b62ebe57ae6 src/lisp.h
--- a/src/lisp.h Tue Jan 11 13:39:35 2011 +0000
+++ b/src/lisp.h Tue Jan 11 22:12:05 2011 +0000
＠＠ -5209,8 +5209,6 ＠＠
EXFUN (Fcopy_list, 1);
EXFUN (Fcopy_sequence, 1);
EXFUN (Fcopy_tree, 2);
-EXFUN (Fdelete, 2);
-EXFUN (Fdelq, 2);
EXFUN (Fdestructive_alist_to_plist, 1);
EXFUN (Felt, 2);
MODULE_API EXFUN (Fequal, 2);
diff -r c9d31263ab7d -r 7b62ebe57ae6 src/select.c
--- a/src/select.c Tue Jan 11 13:39:35 2011 +0000
+++ b/src/select.c Tue Jan 11 22:12:05 2011 +0000
＠＠ -183,19 +183,8 ＠＠
if (!NILP (local_selection_data))
{
owned_p = 1;
- /* Don't use Fdelq() as that may QUIT;. */
- if (EQ (local_selection_data, Fcar (Vselection_alist)))
- Vselection_alist = Fcdr (Vselection_alist);
- else
- {
- Lisp_Object rest;
- for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
- if (EQ (local_selection_data, Fcar (XCDR (rest))))
- {
- XCDR (rest) = Fcdr (XCDR (rest));
- break;
- }
- }
+ Vselection_alist
+ = delq_no_quit (local_selection_data, Vselection_alist);
}
}
else
＠＠ -412,21 +401,8 ＠＠
/* Well, we already believe that we don't own it, so that's just fine. */
if (NILP (local_selection_data)) return;
- /* Otherwise, we're really honest and truly being told to drop it.
- Don't use Fdelq() as that may QUIT;.
- */
- if (EQ (local_selection_data, Fcar (Vselection_alist)))
- Vselection_alist = Fcdr (Vselection_alist);
- else
- {
- Lisp_Object rest;
- for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
- if (EQ (local_selection_data, Fcar (XCDR (rest))))
- {
- XCDR (rest) = Fcdr (XCDR (rest));
- break;
- }
- }
+ /* Otherwise, we're really honest and truly being told to drop it. */
+ Vselection_alist = delq_no_quit (local_selection_data, Vselection_alist);
/* Let random lisp code notice that the selection has been stolen.
*/
diff -r c9d31263ab7d -r 7b62ebe57ae6 src/symbols.c
--- a/src/symbols.c Tue Jan 11 13:39:35 2011 +0000
+++ b/src/symbols.c Tue Jan 11 22:12:05 2011 +0000
＠＠ -2546,7 +2546,8 ＠＠
= buffer_local_alist_element (current_buffer, variable, bfwd);
if (!NILP (alist_element))
- current_buffer->local_var_alist = Fdelq (alist_element, alist);
+ current_buffer->local_var_alist = delq_no_quit (alist_element,
+ alist);
/* Make sure symbol does not think it is set up for this buffer;
force it to look once again for this buffer's value */
--
“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
- 1 comments
commit: Move #'delq, #'delete to Lisp, adding support for sequences.
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 5338:8608eadee6ba
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Fri Jan 14 23:35:29 2011 +0000
files: lisp/ChangeLog lisp/cl-macs.el lisp/subr.el lisp/update-elc.el src/ChangeLog src/device-msw.c src/fns.c src/lisp.h src/select.c src/symbols.c
description:
Move #'delq, #'delete to Lisp, adding support for sequences.
src/ChangeLog addition:
2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net>
* device-msw.c (Fmswindows_printer_list): Remove a Fdelete ()
call here, remove the necessity for it.
* fns.c (Fdelete, Fdelq):
* lisp.h:
Move #'delete, #'delq to Lisp, implemented in terms of #'delete*
* select.c (Fown_selection_internal):
* select.c (handle_selection_clear):
Use delq_no_quit() in these functions, don't reimplement it or use
Fdelq(), which is now gone.
lisp/ChangeLog addition:
2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
here, they don't belong in cl-seq.el; move #'delete, #'delq here
from fns.c, implement them in terms of #'delete*, allowing support
for sequences generally.
* update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
here, now the latter's no longer dumped.
* cl-macs.el (delete, delq): Add compiler macros transforming
#'delete and #'delq to #'delete* calls.
diff -r 906ccc7dcd70 -r 8608eadee6ba lisp/ChangeLog
--- a/lisp/ChangeLog Fri Jan 14 23:23:30 2011 +0000
+++ b/lisp/ChangeLog Fri Jan 14 23:35:29 2011 +0000
＠＠ -1,3 +1,14 ＠＠
+2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * subr.el (delete, delq, remove, remq): Move #'remove, #'remq
+ here, they don't belong in cl-seq.el; move #'delete, #'delq here
+ from fns.c, implement them in terms of #'delete*, allowing support
+ for sequences generally.
+ * update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
+ here, now the latter's no longer dumped.
+ * cl-macs.el (delete, delq): Add compiler macros transforming
+ #'delete and #'delq to #'delete* calls.
+
2011-01-10 Aidan Kehoe <kehoea(a)parhasard.net>
* dialog.el (make-dialog-box): Correct a misplaced parenthesis
diff -r 906ccc7dcd70 -r 8608eadee6ba lisp/cl-macs.el
--- a/lisp/cl-macs.el Fri Jan 14 23:23:30 2011 +0000
+++ b/lisp/cl-macs.el Fri Jan 14 23:35:29 2011 +0000
＠＠ -3342,12 +3342,44 ＠＠
(list 'if (list* 'member* a list keys) list (list 'cons a list))
form))
-(define-compiler-macro remove (item sequence)
- `(remove* ,item ,sequence :test #'equal))
+(define-compiler-macro delete (&whole form &rest args)
+ (symbol-macrolet
+ ((not-constant '#:not-constant))
+ (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+ (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+ (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val)
+ (characterp cl-const-expr-val)))
+ (cons 'delete* (cdr form))
+ `(delete* ,＠(cdr form) :test #'equal)))))
-(define-compiler-macro remq (item sequence)
- `(remove* ,item ,sequence :test #'eq))
+(define-compiler-macro delq (&whole form &rest args)
+ (symbol-macrolet
+ ((not-constant '#:not-constant))
+ (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+ (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+ (not (cl-non-fixnum-number-p cl-const-expr-val)))
+ (cons 'delete* (cdr form))
+ `(delete* ,＠(cdr form) :test #'eq)))))
+(define-compiler-macro remove (&whole form &rest args)
+ (symbol-macrolet
+ ((not-constant '#:not-constant))
+ (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+ (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+ (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val)
+ (characterp cl-const-expr-val)))
+ (cons 'remove* (cdr form))
+ `(remove* ,＠(cdr form) :test #'equal)))))
+
+(define-compiler-macro remq (&whole form &rest args)
+ (symbol-macrolet
+ ((not-constant '#:not-constant))
+ (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+ (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+ (not (cl-non-fixnum-number-p cl-const-expr-val)))
+ (cons 'remove* (cdr form))
+ `(remove* ,＠(cdr form) :test #'eq)))))
+
(macrolet
((define-foo-if-compiler-macros (&rest alist)
"Avoid the funcall, variable binding and keyword parsing overhead
diff -r 906ccc7dcd70 -r 8608eadee6ba lisp/subr.el
--- a/lisp/subr.el Fri Jan 14 23:23:30 2011 +0000
+++ b/lisp/subr.el Fri Jan 14 23:35:29 2011 +0000
＠＠ -148,6 +148,40 ＠＠
(define-function ,＠args)))
+(defun delete (item sequence)
+ "Delete by side effect any occurrences of ITEM as a member of SEQUENCE.
+
+The modified SEQUENCE is returned. Comparison is done with `equal'.
+
+If the first member of a list SEQUENCE is ITEM, there is no way to remove it
+by side effect; therefore, write `(setq foo (delete element foo))' to be
+sure of changing the value of `foo'. Also see: `remove'."
+ (delete* item sequence :test #'equal))
+
+(defun delq (item sequence)
+ "Delete by side effect any occurrences of ITEM as a member of SEQUENCE.
+
+The modified SEQUENCE is returned. Comparison is done with `eq'. If
+SEQUENCE is a list and its first member is ITEM, there is no way to remove
+it by side effect; therefore, write `(setq foo (delq element foo))' to be
+sure of changing the value of `foo'."
+ (delete* item sequence :test #'eq))
+
+(defun remove (item sequence)
+ "Remove all occurrences of ITEM in SEQUENCE, testing with `equal'.
+
+This is a non-destructive function; it makes a copy of SEQUENCE if necessary
+to avoid corrupting the original SEQUENCE.
+Also see: `remove*', `delete', `delete*'"
+ (remove* item sequence :test #'equal))
+
+(defun remq (item sequence)
+ "Remove all occurrences of ITEM in SEQUENCE, comparing with `eq'.
+
+This is a non-destructive function; it makes a copy of SEQUENCE to avoid
+corrupting the original SEQUENCE. See also the more general `remove*'."
+ (remove* item sequence :test #'eq))
+
(defun assoc-default (key alist &optional test default)
"Find object KEY in a pseudo-alist ALIST.
ALIST is a list of conses or objects. Each element (or the element's car,
diff -r 906ccc7dcd70 -r 8608eadee6ba lisp/update-elc.el
--- a/lisp/update-elc.el Fri Jan 14 23:23:30 2011 +0000
+++ b/lisp/update-elc.el Fri Jan 14 23:35:29 2011 +0000
＠＠ -383,7 +383,10 ＠＠
(mapc
#'(lambda (arg)
(setq update-elc-files-to-compile
- (delete arg update-elc-files-to-compile)))
+ (delete* arg update-elc-files-to-compile
+ :test (if default-file-system-ignore-case
+ #'equalp
+ #'equal))))
(append bc-bootstrap bootstrap-other))
(setq command-line-args
(append
diff -r 906ccc7dcd70 -r 8608eadee6ba src/ChangeLog
--- a/src/ChangeLog Fri Jan 14 23:23:30 2011 +0000
+++ b/src/ChangeLog Fri Jan 14 23:35:29 2011 +0000
＠＠ -9,6 +9,18 ＠＠
* fns.c (Ffind): Use the correct subr information here, pass in
the DEFAULT keyword argument value correctly.
+
+2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * device-msw.c (Fmswindows_printer_list): Remove a Fdelete ()
+ call here, remove the necessity for it.
+ * fns.c (Fdelete, Fdelq):
+ * lisp.h:
+ Move #'delete, #'delq to Lisp, implemented in terms of #'delete*
+ * select.c (Fown_selection_internal):
+ * select.c (handle_selection_clear):
+ Use delq_no_quit() in these functions, don't reimplement it or use
+ Fdelq(), which is now gone.
2011-01-10 Aidan Kehoe <kehoea(a)parhasard.net>
diff -r 906ccc7dcd70 -r 8608eadee6ba src/device-msw.c
--- a/src/device-msw.c Fri Jan 14 23:23:30 2011 +0000
+++ b/src/device-msw.c Fri Jan 14 23:35:29 2011 +0000
＠＠ -1329,9 +1329,12 ＠＠
GCPRO2 (result, def_printer);
+ def_printer = msprinter_default_printer ();
+
while (num_printers--)
{
Extbyte *printer_name;
+ Lisp_Object printer_name_lisp;
if (have_nt)
{
PRINTER_INFO_4 *info = (PRINTER_INFO_4 *) data_buf;
＠＠ -1343,12 +1346,15 ＠＠
printer_name = (Extbyte *) info->pPrinterName;
}
data_buf += enum_entry_size;
-
- result = Fcons (build_tstr_string (printer_name), result);
+
+ printer_name_lisp = build_tstr_string (printer_name);
+ if (0 != qxestrcasecmp (XSTRING_DATA (def_printer),
+ XSTRING_DATA (printer_name_lisp)))
+ {
+ result = Fcons (printer_name_lisp, result);
+ }
}
- def_printer = msprinter_default_printer ();
- result = Fdelete (def_printer, result);
result = Fcons (def_printer, result);
RETURN_UNGCPRO (result);
diff -r 906ccc7dcd70 -r 8608eadee6ba src/fns.c
--- a/src/fns.c Fri Jan 14 23:23:30 2011 +0000
+++ b/src/fns.c Fri Jan 14 23:35:29 2011 +0000
＠＠ -3137,21 +3137,6 ＠＠
return object;
}
-DEFUN ("delete", Fdelete, 2, 2, 0, /*
-Delete by side effect any occurrences of ELT as a member of LIST.
-The modified LIST is returned. Comparison is done with `equal'.
-If the first member of LIST is ELT, there is no way to remove it by side
-effect; therefore, write `(setq foo (delete element foo))' to be sure
-of changing the value of `foo'.
-Also see: `remove'.
-*/
- (elt, list))
-{
- EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
- (internal_equal (elt, list_elt, 0)));
- return list;
-}
-
DEFUN ("old-delete", Fold_delete, 2, 2, 0, /*
Delete by side effect any occurrences of ELT as a member of LIST.
The modified LIST is returned. Comparison is done with `old-equal'.
＠＠ -3163,20 +3148,6 ＠＠
{
EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
(internal_old_equal (elt, list_elt, 0)));
- return list;
-}
-
-DEFUN ("delq", Fdelq, 2, 2, 0, /*
-Delete by side effect any occurrences of ELT as a member of LIST.
-The modified LIST is returned. Comparison is done with `eq'.
-If the first member of LIST is ELT, there is no way to remove it by side
-effect; therefore, write `(setq foo (delq element foo))' to be sure of
-changing the value of `foo'.
-*/
- (elt, list))
-{
- EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
- (EQ_WITH_EBOLA_NOTICE (elt, list_elt)));
return list;
}
＠＠ -11790,9 +11761,7 ＠＠
DEFSUBR (Fposition);
DEFSUBR (Ffind);
- DEFSUBR (Fdelete);
DEFSUBR (Fold_delete);
- DEFSUBR (Fdelq);
DEFSUBR (Fold_delq);
DEFSUBR (FdeleteX);
DEFSUBR (FremoveX);
diff -r 906ccc7dcd70 -r 8608eadee6ba src/lisp.h
--- a/src/lisp.h Fri Jan 14 23:23:30 2011 +0000
+++ b/src/lisp.h Fri Jan 14 23:35:29 2011 +0000
＠＠ -5209,8 +5209,6 ＠＠
EXFUN (Fcopy_list, 1);
EXFUN (Fcopy_sequence, 1);
EXFUN (Fcopy_tree, 2);
-EXFUN (Fdelete, 2);
-EXFUN (Fdelq, 2);
EXFUN (Fdestructive_alist_to_plist, 1);
EXFUN (Felt, 2);
MODULE_API EXFUN (Fequal, 2);
diff -r 906ccc7dcd70 -r 8608eadee6ba src/select.c
--- a/src/select.c Fri Jan 14 23:23:30 2011 +0000
+++ b/src/select.c Fri Jan 14 23:35:29 2011 +0000
＠＠ -183,19 +183,8 ＠＠
if (!NILP (local_selection_data))
{
owned_p = 1;
- /* Don't use Fdelq() as that may QUIT;. */
- if (EQ (local_selection_data, Fcar (Vselection_alist)))
- Vselection_alist = Fcdr (Vselection_alist);
- else
- {
- Lisp_Object rest;
- for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
- if (EQ (local_selection_data, Fcar (XCDR (rest))))
- {
- XCDR (rest) = Fcdr (XCDR (rest));
- break;
- }
- }
+ Vselection_alist
+ = delq_no_quit (local_selection_data, Vselection_alist);
}
}
else
＠＠ -412,21 +401,8 ＠＠
/* Well, we already believe that we don't own it, so that's just fine. */
if (NILP (local_selection_data)) return;
- /* Otherwise, we're really honest and truly being told to drop it.
- Don't use Fdelq() as that may QUIT;.
- */
- if (EQ (local_selection_data, Fcar (Vselection_alist)))
- Vselection_alist = Fcdr (Vselection_alist);
- else
- {
- Lisp_Object rest;
- for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
- if (EQ (local_selection_data, Fcar (XCDR (rest))))
- {
- XCDR (rest) = Fcdr (XCDR (rest));
- break;
- }
- }
+ /* Otherwise, we're really honest and truly being told to drop it. */
+ Vselection_alist = delq_no_quit (local_selection_data, Vselection_alist);
/* Let random lisp code notice that the selection has been stolen.
*/
diff -r 906ccc7dcd70 -r 8608eadee6ba src/symbols.c
--- a/src/symbols.c Fri Jan 14 23:23:30 2011 +0000
+++ b/src/symbols.c Fri Jan 14 23:35:29 2011 +0000
＠＠ -2546,7 +2546,8 ＠＠
= buffer_local_alist_element (current_buffer, variable, bfwd);
if (!NILP (alist_element))
- current_buffer->local_var_alist = Fdelq (alist_element, alist);
+ current_buffer->local_var_alist = delq_no_quit (alist_element,
+ alist);
/* Make sure symbol does not think it is set up for this buffer;
force it to look once again for this buffer's value */
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Change to qxesprintf(), qxestrcpy(), s/hpux11.h, s/usg5-4.h
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1295047410 0
# Node ID 906ccc7dcd7001e28c65e63ebf91c8a53751addf
# Parent 287499ff4c5feb21a66f828fb698a9c2fcbfac48
Change to qxesprintf(), qxestrcpy(), s/hpux11.h, s/usg5-4.h
2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
* s/hpux11.h (PTY_TTY_NAME_SPRINTF, PTY_NAME_SPRINTF):
* s/usg5-4.h (PTY_TTY_NAME_SPRINTF, PTY_NAME_SPRINTF):
Replace sprintf() with qxesprintf(), strcpy with qxestrpy(),
hopefully fixing some platform-specific C++ builds.
diff -r 287499ff4c5f -r 906ccc7dcd70 src/ChangeLog
--- a/src/ChangeLog Fri Jan 14 23:16:25 2011 +0000
+++ b/src/ChangeLog Fri Jan 14 23:23:30 2011 +0000
＠＠ -1,3 +1,10 ＠＠
+2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * s/hpux11.h (PTY_TTY_NAME_SPRINTF, PTY_NAME_SPRINTF):
+ * s/usg5-4.h (PTY_TTY_NAME_SPRINTF, PTY_NAME_SPRINTF):
+ Replace sprintf() with qxesprintf(), strcpy with qxestrpy(),
+ hopefully fixing some platform-specific C++ builds.
+
2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Ffind): Use the correct subr information here, pass in
diff -r 287499ff4c5f -r 906ccc7dcd70 src/s/hpux11.h
--- a/src/s/hpux11.h Fri Jan 14 23:16:25 2011 +0000
+++ b/src/s/hpux11.h Fri Jan 14 23:23:30 2011 +0000
＠＠ -104,11 +104,11 ＠＠
/* This is how to get the device name of the tty end of a pty. */
#define PTY_TTY_NAME_SPRINTF \
- sprintf (pty_name, "/dev/pty/tty%c%x", c, i);
+ qxesprintf (pty_name, "/dev/pty/tty%c%x", c, i);
/* This is how to get the device name of the control end of a pty. */
#define PTY_NAME_SPRINTF \
- sprintf (pty_name, "/dev/ptym/pty%c%x", c, i);
+ qxesprintf (pty_name, "/dev/ptym/pty%c%x", c, i);
#ifdef HPUX_USE_SHLIBS
#define LD_SWITCH_SYSTEM
diff -r 287499ff4c5f -r 906ccc7dcd70 src/s/usg5-4.h
--- a/src/s/usg5-4.h Fri Jan 14 23:16:25 2011 +0000
+++ b/src/s/usg5-4.h Fri Jan 14 23:23:30 2011 +0000
＠＠ -124,7 +124,7 ＠＠
/* This sets the name of the master side of the PTY. */
-#define PTY_NAME_SPRINTF strcpy (pty_name, "/dev/ptmx");
+#define PTY_NAME_SPRINTF qxestrcpy (pty_name, "/dev/ptmx");
/* This sets the name of the slave side of the PTY. On SysVr4,
grantpt(3) forks a subprocess, so keep sigchld_handler() from
＠＠ -150,7 +150,7 ＠＠
{ close (fd); return -1; } \
if (!(ptyname = ptsname (fd))) \
{ close (fd); return -1; } \
- strncpy (pty_name, ptyname, sizeof (pty_name)); \
+ qxestrncpy (pty_name, ptyname, sizeof (pty_name)); \
pty_name[sizeof (pty_name) - 1] = 0; \
}
--
“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]
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1295046985 0
# Node ID 287499ff4c5feb21a66f828fb698a9c2fcbfac48
# Parent c9d31263ab7db633744accb5195727a4a343a3d7
Pass in the DEFAULT argument to position() as documented, #'find.
src/ChangeLog addition:
2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Ffind): Use the correct subr information here, pass in
the DEFAULT keyword argument value correctly.
tests/ChangeLog addition:
2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (list): Test #'find, especially the
:default keyword, not specified by Common Lisp.
diff -r c9d31263ab7d -r 287499ff4c5f src/ChangeLog
--- a/src/ChangeLog Tue Jan 11 13:39:35 2011 +0000
+++ b/src/ChangeLog Fri Jan 14 23:16:25 2011 +0000
＠＠ -1,3 +1,8 ＠＠
+2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (Ffind): Use the correct subr information here, pass in
+ the DEFAULT keyword argument value correctly.
+
2011-01-10 Aidan Kehoe <kehoea(a)parhasard.net>
* mc-alloc.c (get_used_list_index):
diff -r c9d31263ab7d -r 287499ff4c5f src/fns.c
--- a/src/fns.c Tue Jan 11 13:39:35 2011 +0000
+++ b/src/fns.c Fri Jan 14 23:16:25 2011 +0000
＠＠ -3123,7 +3123,7 ＠＠
Boolint test_not_unboundp = 1;
check_test_func_t check_test = NULL;
- PARSE_KEYWORDS (Fposition, nargs, args, 9,
+ PARSE_KEYWORDS (Ffind, nargs, args, 9,
(test, if_, test_not, if_not, key, start, end, from_end,
default_),
(start = Qzero));
＠＠ -3132,7 +3132,7 ＠＠
key, &test_not_unboundp);
position (&object, item, sequence, check_test, test_not_unboundp,
- test, key, start, end, from_end, Qnil, Qposition);
+ test, key, start, end, from_end, default_, Qposition);
return object;
}
diff -r c9d31263ab7d -r 287499ff4c5f tests/ChangeLog
--- a/tests/ChangeLog Tue Jan 11 13:39:35 2011 +0000
+++ b/tests/ChangeLog Fri Jan 14 23:16:25 2011 +0000
＠＠ -1,3 +1,8 ＠＠
+2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el (list): Test #'find, especially the
+ :default keyword, not specified by Common Lisp.
+
2011-01-02 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (test-fun): Test member*, assoc*,
diff -r c9d31263ab7d -r 287499ff4c5f tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Tue Jan 11 13:39:35 2011 +0000
+++ b/tests/automated/lisp-tests.el Fri Jan 14 23:16:25 2011 +0000
＠＠ -2790,4 +2790,30 ＠＠
(copy-sequence string)
:end1 (* 2 string-length))))))
+(let* ((list (list 1 2 3 4 5 6 7 120 'hi-there '#:everyone))
+ (vector (map 'vector #'identity list))
+ (bit-vector (map 'bit-vector
+ #'(lambda (object) (if (fixnump object) 1 0)) list))
+ (string (map 'string
+ #'(lambda (object) (or (and (fixnump object)
+ (int-char object))
+ (decode-char 'ucs #x20ac))) list))
+ (gensym (gensym)))
+ (Assert (null (find 'not-in-it list)))
+ (Assert (null (find 'not-in-it vector)))
+ (Assert (null (find 'not-in-it bit-vector)))
+ (Assert (null (find 'not-in-it string)))
+ (loop
+ for elt being each element in vector using (index position)
+ do
+ (Assert (eq elt (find elt list)))
+ (Assert (eq (elt list position) (find elt vector))))
+ (Assert (eq gensym (find 'not-in-it list :default gensym)))
+ (Assert (eq gensym (find 'not-in-it vector :default gensym)))
+ (Assert (eq gensym (find 'not-in-it bit-vector :default gensym)))
+ (Assert (eq gensym (find 'not-in-it string :default gensym)))
+ (Assert (eq 'hi-there (find 'hi-there list)))
+ ;; Different uninterned symbols with the same name.
+ (Assert (not (eq '#1=#:everyone (find '#1# list)))))
+
;;; end of lisp-tests.el
--
“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: Change to qxesprintf(), qxestrcpy(), s/hpux11.h, s/usg5-4.h
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 5337:906ccc7dcd70
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Fri Jan 14 23:23:30 2011 +0000
files: src/ChangeLog src/s/hpux11.h src/s/usg5-4.h
description:
Change to qxesprintf(), qxestrcpy(), s/hpux11.h, s/usg5-4.h
2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
* s/hpux11.h (PTY_TTY_NAME_SPRINTF, PTY_NAME_SPRINTF):
* s/usg5-4.h (PTY_TTY_NAME_SPRINTF, PTY_NAME_SPRINTF):
Replace sprintf() with qxesprintf(), strcpy with qxestrpy(),
hopefully fixing some platform-specific C++ builds.
diff -r 287499ff4c5f -r 906ccc7dcd70 src/ChangeLog
--- a/src/ChangeLog Fri Jan 14 23:16:25 2011 +0000
+++ b/src/ChangeLog Fri Jan 14 23:23:30 2011 +0000
＠＠ -1,3 +1,10 ＠＠
+2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * s/hpux11.h (PTY_TTY_NAME_SPRINTF, PTY_NAME_SPRINTF):
+ * s/usg5-4.h (PTY_TTY_NAME_SPRINTF, PTY_NAME_SPRINTF):
+ Replace sprintf() with qxesprintf(), strcpy with qxestrpy(),
+ hopefully fixing some platform-specific C++ builds.
+
2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Ffind): Use the correct subr information here, pass in
diff -r 287499ff4c5f -r 906ccc7dcd70 src/s/hpux11.h
--- a/src/s/hpux11.h Fri Jan 14 23:16:25 2011 +0000
+++ b/src/s/hpux11.h Fri Jan 14 23:23:30 2011 +0000
＠＠ -104,11 +104,11 ＠＠
/* This is how to get the device name of the tty end of a pty. */
#define PTY_TTY_NAME_SPRINTF \
- sprintf (pty_name, "/dev/pty/tty%c%x", c, i);
+ qxesprintf (pty_name, "/dev/pty/tty%c%x", c, i);
/* This is how to get the device name of the control end of a pty. */
#define PTY_NAME_SPRINTF \
- sprintf (pty_name, "/dev/ptym/pty%c%x", c, i);
+ qxesprintf (pty_name, "/dev/ptym/pty%c%x", c, i);
#ifdef HPUX_USE_SHLIBS
#define LD_SWITCH_SYSTEM
diff -r 287499ff4c5f -r 906ccc7dcd70 src/s/usg5-4.h
--- a/src/s/usg5-4.h Fri Jan 14 23:16:25 2011 +0000
+++ b/src/s/usg5-4.h Fri Jan 14 23:23:30 2011 +0000
＠＠ -124,7 +124,7 ＠＠
/* This sets the name of the master side of the PTY. */
-#define PTY_NAME_SPRINTF strcpy (pty_name, "/dev/ptmx");
+#define PTY_NAME_SPRINTF qxestrcpy (pty_name, "/dev/ptmx");
/* This sets the name of the slave side of the PTY. On SysVr4,
grantpt(3) forks a subprocess, so keep sigchld_handler() from
＠＠ -150,7 +150,7 ＠＠
{ close (fd); return -1; } \
if (!(ptyname = ptsname (fd))) \
{ close (fd); return -1; } \
- strncpy (pty_name, ptyname, sizeof (pty_name)); \
+ qxestrncpy (pty_name, ptyname, sizeof (pty_name)); \
pty_name[sizeof (pty_name) - 1] = 0; \
}
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Pass in the DEFAULT argument to position() as documented, #'find.
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 5336:287499ff4c5f
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Fri Jan 14 23:16:25 2011 +0000
files: src/ChangeLog src/fns.c tests/ChangeLog tests/automated/lisp-tests.el
description:
Pass in the DEFAULT argument to position() as documented, #'find.
src/ChangeLog addition:
2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Ffind): Use the correct subr information here, pass in
the DEFAULT keyword argument value correctly.
tests/ChangeLog addition:
2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (list): Test #'find, especially the
:default keyword, not specified by Common Lisp.
diff -r c9d31263ab7d -r 287499ff4c5f src/ChangeLog
--- a/src/ChangeLog Tue Jan 11 13:39:35 2011 +0000
+++ b/src/ChangeLog Fri Jan 14 23:16:25 2011 +0000
＠＠ -1,3 +1,8 ＠＠
+2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (Ffind): Use the correct subr information here, pass in
+ the DEFAULT keyword argument value correctly.
+
2011-01-10 Aidan Kehoe <kehoea(a)parhasard.net>
* mc-alloc.c (get_used_list_index):
diff -r c9d31263ab7d -r 287499ff4c5f src/fns.c
--- a/src/fns.c Tue Jan 11 13:39:35 2011 +0000
+++ b/src/fns.c Fri Jan 14 23:16:25 2011 +0000
＠＠ -3123,7 +3123,7 ＠＠
Boolint test_not_unboundp = 1;
check_test_func_t check_test = NULL;
- PARSE_KEYWORDS (Fposition, nargs, args, 9,
+ PARSE_KEYWORDS (Ffind, nargs, args, 9,
(test, if_, test_not, if_not, key, start, end, from_end,
default_),
(start = Qzero));
＠＠ -3132,7 +3132,7 ＠＠
key, &test_not_unboundp);
position (&object, item, sequence, check_test, test_not_unboundp,
- test, key, start, end, from_end, Qnil, Qposition);
+ test, key, start, end, from_end, default_, Qposition);
return object;
}
diff -r c9d31263ab7d -r 287499ff4c5f tests/ChangeLog
--- a/tests/ChangeLog Tue Jan 11 13:39:35 2011 +0000
+++ b/tests/ChangeLog Fri Jan 14 23:16:25 2011 +0000
＠＠ -1,3 +1,8 ＠＠
+2011-01-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el (list): Test #'find, especially the
+ :default keyword, not specified by Common Lisp.
+
2011-01-02 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (test-fun): Test member*, assoc*,
diff -r c9d31263ab7d -r 287499ff4c5f tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Tue Jan 11 13:39:35 2011 +0000
+++ b/tests/automated/lisp-tests.el Fri Jan 14 23:16:25 2011 +0000
＠＠ -2790,4 +2790,30 ＠＠
(copy-sequence string)
:end1 (* 2 string-length))))))
+(let* ((list (list 1 2 3 4 5 6 7 120 'hi-there '#:everyone))
+ (vector (map 'vector #'identity list))
+ (bit-vector (map 'bit-vector
+ #'(lambda (object) (if (fixnump object) 1 0)) list))
+ (string (map 'string
+ #'(lambda (object) (or (and (fixnump object)
+ (int-char object))
+ (decode-char 'ucs #x20ac))) list))
+ (gensym (gensym)))
+ (Assert (null (find 'not-in-it list)))
+ (Assert (null (find 'not-in-it vector)))
+ (Assert (null (find 'not-in-it bit-vector)))
+ (Assert (null (find 'not-in-it string)))
+ (loop
+ for elt being each element in vector using (index position)
+ do
+ (Assert (eq elt (find elt list)))
+ (Assert (eq (elt list position) (find elt vector))))
+ (Assert (eq gensym (find 'not-in-it list :default gensym)))
+ (Assert (eq gensym (find 'not-in-it vector :default gensym)))
+ (Assert (eq gensym (find 'not-in-it bit-vector :default gensym)))
+ (Assert (eq gensym (find 'not-in-it string :default gensym)))
+ (Assert (eq 'hi-there (find 'hi-there list)))
+ ;; Different uninterned symbols with the same name.
+ (Assert (not (eq '#1=#:everyone (find '#1# list)))))
+
;;; 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
Re: [COMMIT] Replace POSIX index(3) with C89 strchr(3), lwlib-fonts.c
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
Ar an t-aonú lá déag de mí Eanair, scríobh Jerry James:
> On Tue, Jan 11, 2011 at 6:41 AM, Aidan Kehoe <kehoea(a)parhasard.net> wrote:
>
> > 2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net>
> >
> > * lwlib-fonts.c (xft_open_font_by_name):
> > Replace the POSIX index(3), not universally available even today,
> > with the C89 strchr(3), hopefully fixing a few of the buildbots'
> > problems.
> >
>
> index(3) and rindex(3) are not supposed to be available. They were marked
> LEGACY in POSIX.1-2001, and removed altogether in POSIX.1-2008, with a
> recommendation to use strchr(3) and strrchr(3) instead. So systems that
> zealously follow the POSIX spec may not have those functions any longer,
> which is probably what you've encountered. Just out of curiosity, what
> system shows the problem?
http://www.lidell.nu/xemacs-buildbot/builders/amd64%20opensolaris%20cfg3/...
I have to say, I didn’t expect OpenSolaris to be leading the pack on
something like this!
--
“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