Mercurial > hg > xemacs-beta
changeset 5420:b9167d522a9a
Rebase with 21.5 trunk.
line wrap: on
line diff
--- a/ChangeLog Wed Oct 27 23:36:14 2010 +0200 +++ b/ChangeLog Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,7 @@ +2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> + + * aclocal.m4: Add standard permission boilerplate. + 2010-06-02 Aidan Kehoe <kehoea@parhasard.net> * version.sh.in:
--- a/lib-src/ChangeLog Wed Oct 27 23:36:14 2010 +0200 +++ b/lib-src/ChangeLog Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,22 @@ +2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> + + * gnuserv.c: + * gnuserv.h: + * gnuslib.c: + Add standard permission boilerplate. + + * ad2c: + Add copyright notices based on internal evidence. + +2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> + + * cvtmail.c: + * fakemail.c: + * make-path.c: + * profile.c: + * tcp.c: + Fix typo (doubled phrase) in permission notice. + 2010-06-13 Stephen J. Turnbull <stephen@xemacs.org> * ad2c: Correct FSF address in permission notice.
--- a/lib-src/ad2c Wed Oct 27 23:36:14 2010 +0200 +++ b/lib-src/ad2c Thu Oct 28 23:53:24 2010 +0200 @@ -1,5 +1,9 @@ #!/bin/sh # +# Copyright (C) 1990, 1991 George Ferguson +# Copyright (C) 1992 Charles Hannum +# Copyright (C) 1992 Matthew Stier +# # ad2c : Convert app-defaults file to C strings decls. # # George Ferguson, ferguson@cs.rcohester.edu, 12 Nov 1990.
--- a/lib-src/config.values.sh Wed Oct 27 23:36:14 2010 +0200 +++ b/lib-src/config.values.sh Thu Oct 28 23:53:24 2010 +0200 @@ -4,6 +4,8 @@ # config.values.sh --- create config.values.in from ../configure +# Copyright (C) 1997, 1999 Martin Buchholz + # Author: Martin Buchholz # Maintainer: Martin Buchholz # Keywords: configure elisp report-xemacs-bugs
--- a/lib-src/gnuserv.h Wed Oct 27 23:36:14 2010 +0200 +++ b/lib-src/gnuserv.h Thu Oct 28 23:53:24 2010 +0200 @@ -2,12 +2,24 @@ Header file for the XEmacs server and client C code. + Copyright (C) 1989 Free Software Foundation, Inc. + This file is part of XEmacs. - Copying is permitted under those conditions described by the GNU - General Public License. + 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. - Copyright (C) 1989 Free Software Foundation, Inc. + 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, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. Author: Andy Norman (ange@hplb.hpl.hp.com), based on 'etc/server.c' and 'etc/emacsclient.c' from the 18.52 GNU
--- a/lib-src/gnuslib.c Wed Oct 27 23:36:14 2010 +0200 +++ b/lib-src/gnuslib.c Thu Oct 28 23:53:24 2010 +0200 @@ -1,6 +1,8 @@ /* -*-C-*- Common library code for the XEmacs server and client. + + This file is part of XEmacs. XEmacs is free software: you can redistribute it and/or modify it
--- a/lisp/ChangeLog Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/ChangeLog Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,147 @@ +2010-10-25 Aidan Kehoe <kehoea@parhasard.net> + + Add compiler macros and compilation sanity-checking for various + functions that take keywords. + + * byte-optimize.el (side-effect-free-fns): #'symbol-value is + side-effect free and not error free. + * bytecomp.el (byte-compile-normal-call): Check keyword argument + lists for sanity; store information about the positions where + keyword arguments start using the new byte-compile-keyword-start + property. + * cl-macs.el (cl-const-expr-val): Take a new optional argument, + cl-not-constant, defaulting to nil, in this function; return it if + the expression is not constant. + (cl-non-fixnum-number-p): Make this into a separate function, we + want to pass it to #'every. + (eql): Use it. + (define-star-compiler-macros): Use the same code to generate the + member*, assoc* and rassoc* compiler macros; special-case some + code in #'add-to-list in subr.el. + (remove, remq): Add compiler macros for these two functions, in + preparation for #'remove being in C. + (define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to + (remove ... :if-not) at compile time, which will be a real win + once the latter is in C. + (define-substitute-if-compiler-macros) + (define-subst-if-compiler-macros): Similarly for these functions. + (delete-duplicates): Change this compiler macro to use + #'plists-equal; if we don't have information about the type of + SEQUENCE at compile time, don't bother attempting to inline the + call, the function will be in C soon enough. + (equalp): Remove an old commented-out compiler macro for this, if + we want to see it it's in version control. + (subst-char-in-string): Transform this to a call to nsubstitute or + nsubstitute, if that is appropriate. + * cl.el (ldiff): Don't call setf here, this makes for a load-time + dependency problem in cl-macs.el + +2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> + + * term/vt100.el: + Refer to XEmacs, not GNU Emacs, in permissions. + + * term/bg-mouse.el: + * term/sup-mouse.el: + Put copyright notice in canonical "Copyright DATE AUTHOR" form. + Refer to XEmacs, not GNU Emacs, in permissions. + + * site-load.el: + Add permission boilerplate. + + * mule/canna-leim.el: + * alist.el: + Refer to XEmacs, not APEL/this program, in permissions. + + * mule/canna-leim.el: + Remove my copyright, I've assigned it to the FSF. + +2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> + + * gtk.el: + * gtk-widget-accessors.el: + * gtk-package.el: + * gtk-marshal.el: + * gtk-compose.el: + * gnome.el: + Add copyright notice based on internal evidence. + +2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> + + * easymenu.el: Add reference to COPYING to permission notice. + + * gutter.el: + * gutter-items.el: + * menubar-items.el: + Fix typo "Xmacs" in permissions notice. + +2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> + + * auto-save.el: + * font.el: + * fontconfig.el: + * mule/kinsoku.el: + Add "part of XEmacs" text to permission notice. + +2010-10-14 Aidan Kehoe <kehoea@parhasard.net> + + * byte-optimize.el (side-effect-free-fns): + * cl-macs.el (remf, getf): + * cl-extra.el (tailp, cl-set-getf, cl-do-remf): + * cl.el (ldiff, endp): + Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp; + add circularity checking for the first two. + + #'cl-set-getf and #'cl-do-remf were Lisp implementations of + #'plist-put and #'plist-remprop; change the names to aliases, + changes the macros that use them to using #'plist-put and + #'plist-remprop directly. + +2010-10-12 Aidan Kehoe <kehoea@parhasard.net> + + * abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table): + Create both these abbrev tables using the usual + #'define-abbrev-table calls, rather than attempting to + special-case them. + * cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is + being loaded interpreted. Previously other, later files would + redundantly call (load "cl-macs") when interpreted, it's more + reasonable to do it here, once. + * cmdloop.el (read-quoted-char-radix): Use defcustom here, we + don't have any dump-order dependencies that would prevent that. + * custom.el (eval-when-compile): Don't load cl-macs when + interpreted or when byte-compiling, rely on cl-extra.el in the + former case and the appropriate entry in bytecomp-load-hook in the + latter. Get rid of custom-declare-variable-list, we have no + dump-time dependencies that would require it. + * faces.el (eval-when-compile): Don't load cl-macs when + interpreted or when byte-compiling. + * packages.el: Remove some inaccurate comments. + * post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not + here, now the order of preloaded-file-list has been changed to + make it available. + * subr.el (custom-declare-variable-list): Remove. No need for it. + Also remove a stub define-abbrev-table from this file, given the + current order of preloaded-file-list there's no need for it. + +2010-10-10 Aidan Kehoe <kehoea@parhasard.net> + + * bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are + also constant. + (byte-compile-initial-macro-environment): In #'the, if FORM is + constant and does not match TYPE, warn at byte-compile time. + +2010-10-10 Aidan Kehoe <kehoea@parhasard.net> + + * backquote.el (bq-vector-contents, bq-list*): Remove; the former + is equivalent to (append VECTOR nil), the latter to (list* ...). + (bq-process-2): Use (append VECTOR nil) instead of using + #'bq-vector-contents to convert to a list. + (bq-process-1): Now we use list* instead of bq-list + * subr.el (list*): Moved from cl.el, since it is now required to + be available the first time a backquoted form is encountered. + * cl.el (list*): Move to subr.el. + 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * test-harness.el (Check-Message):
--- a/lisp/abbrev.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/abbrev.el Thu Oct 28 23:53:24 2010 +0200 @@ -118,31 +118,12 @@ (setplist sym (or count 0)) name)) +(define-abbrev-table 'fundamental-mode-abbrev-table nil) +(and (eq major-mode 'fundamental-mode) + (not local-abbrev-table) + (setq local-abbrev-table fundamental-mode-abbrev-table)) -;; Fixup stuff from bootstrap def of define-abbrev-table in subr.el -(let ((l abbrev-table-name-list)) - (while l - (let ((fixup (car l))) - (if (consp fixup) - (progn - (setq abbrev-table-name-list (delq fixup abbrev-table-name-list)) - (define-abbrev-table (car fixup) (cdr fixup)))) - (setq l (cdr l)))) - ;; These are no longer initialized by C code - (if (not global-abbrev-table) - (progn - (setq global-abbrev-table (make-abbrev-table)) - (setq abbrev-table-name-list (cons 'global-abbrev-table - abbrev-table-name-list)))) - (if (not fundamental-mode-abbrev-table) - (progn - (setq fundamental-mode-abbrev-table (make-abbrev-table)) - (setq abbrev-table-name-list (cons 'fundamental-mode-abbrev-table - abbrev-table-name-list)))) - (and (eq major-mode 'fundamental-mode) - (not local-abbrev-table) - (setq local-abbrev-table fundamental-mode-abbrev-table))) - +(define-abbrev-table 'global-abbrev-table nil) (defun define-global-abbrev (name expansion) "Define ABBREV as a global abbreviation for EXPANSION."
--- a/lisp/backquote.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/backquote.el Thu Oct 28 23:53:24 2010 +0200 @@ -184,19 +184,10 @@ ;;; ---------------------------------------------------------------- -(defun bq-vector-contents (vec) - (let ((contents nil) - (n (length vec))) - (while (> n 0) - (setq n (1- n)) - (setq contents (cons (aref vec n) contents))) - contents)) - ;;; This does the expansion from table 2. (defun bq-process-2 (code) (cond ((vectorp code) - (let* ((dflag-d - (bq-process-2 (bq-vector-contents code)))) + (let* ((dflag-d (bq-process-2 (append code nil)))) (cons 'vector (bq-process-1 (car dflag-d) (cdr dflag-d))))) ((atom code) (cond ((null code) (cons nil nil)) @@ -278,26 +269,7 @@ (list 'quote thing)) ((eq flag 'vector) (list 'apply '(function vector) thing)) - (t (cons (cdr - (assq flag - '((cons . cons) - (list* . bq-list*) - (list . list) - (append . append) - (nconc . nconc)))) - thing)))) - -;;; ---------------------------------------------------------------- - -(defmacro bq-list* (&rest args) - "Return a list of its arguments with last cons a dotted pair." - (setq args (reverse args)) - (let ((result (car args))) - (setq args (cdr args)) - (while args - (setq result (list 'cons (car args) result)) - (setq args (cdr args))) - result)) + (t (cons flag thing)))) (provide 'backquote)
--- a/lisp/byte-optimize.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/byte-optimize.el Thu Oct 28 23:53:24 2010 +0200 @@ -1223,7 +1223,7 @@ ;; coordinates-in-window-p not in XEmacs copy-marker cos count-lines default-boundp default-value denominator documentation downcase - elt exp expt fboundp featurep + elt endp exp expt fboundp featurep file-directory-p file-exists-p file-locked-p file-name-absolute-p file-newer-than-file-p file-readable-p file-symlink-p file-writable-p float floor format @@ -1245,7 +1245,8 @@ parse-colon-path plist-get previous-window radians-to-degrees rassq regexp-quote reverse round sin sqrt string< string= string-equal string-lessp string-to-char - string-to-int string-to-number substring symbol-plist + string-to-int string-to-number substring symbol-plist symbol-value + symbol-name symbol-function symbol tan upcase user-variable-p vconcat ;; XEmacs change: window-edges -> window-pixel-edges window-buffer window-dedicated-p window-pixel-edges window-height
--- a/lisp/bytecomp.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/bytecomp.el Thu Oct 28 23:53:24 2010 +0200 @@ -503,6 +503,10 @@ (cons 'progn body))) (the . ,#'(lambda (type form) + (if (cl-const-expr-p form) + (or (eval (cl-make-type-test form type)) + (byte-compile-warn + "%s is not of type %s" form type))) (if byte-compile-delete-errors form (funcall (cdr (symbol-function 'the)) type form))))) @@ -1389,7 +1393,7 @@ (defmacro byte-compile-constp (form) ;; Returns non-nil if FORM is a constant. - `(cond ((consp ,form) (eq (car ,form) 'quote)) + `(cond ((consp ,form) (memq (car ,form) '(quote function))) ((symbolp ,form) (byte-compile-constant-symbol-p ,form)) (t))) @@ -2832,7 +2836,83 @@ (when for-effect (byte-compile-discard))) +;; Generate the list of functions with keyword arguments like so: +;; +;; (delete-duplicates +;; (sort* +;; (loop +;; for symbol being each symbol in obarray +;; with arglist = nil +;; if (and (fboundp symbol) +;; (ignore-errors (setq symbol (indirect-function symbol))) +;; (cond +;; ((and (subrp symbol) (setq symbol (intern (subr-name symbol))))) +;; ((and (compiled-function-p symbol) +;; (setq symbol (compiled-function-annotation symbol))))) +;; (setq arglist (function-arglist symbol)) +;; (setq arglist (ignore-errors (read-from-string arglist))) +;; (setq arglist (car arglist)) +;; (setq arglist (position '&key arglist))) +;; collect (cons symbol arglist)) +;; #'string-lessp +;; :key #'car) :test #'eq :key #'car) +;; +;; That won't include those that take advantage of cl-seq.el's +;; cl-parsing-keywords macro, but the below list does. + +(map nil + (function* + (lambda ((function . nargs)) + ;; Document that the car of OBJECT, a symbol, describes a function + ;; taking keyword arguments from the argument index described by + ;; the cdr of OBJECT. + (put function 'byte-compile-keyword-start nargs))) + '((adjoin . 3) (assoc* . 3) (assoc-if . 3) (assoc-if-not . 3) + (count . 3) (count-if . 3) (count-if-not . 3) (define-behavior . 3) + (define-behavior-group . 2) (delete* . 3) (delete-duplicates . 2) + (delete-if . 3) (delete-if-not . 3) (fill . 3) (find . 3) (find-if . 3) + (find-if-not . 3) (internal-make-translation-table . 1) + (make-Print-context . 1) (make-hash-table . 1) (make-saved-window . 1) + (make-window-configuration . 1) (member* . 3) + (member-if . 3) (member-if-not . 3) (merge . 5) (nsublis . 3) + (nsubst . 4) (nsubst-if . 4) (nsubst-if-not . 4) (nsubstitute . 4) + (nsubstitute-if . 4) (nsubstitute-if-not . 4) (override-behavior . 2) + (position . 3) (position-if . 3) (position-if-not . 3) (rassoc* . 3) + (rassoc-if . 3) (rassoc-if-not . 3) (reduce . 3) (remove* . 3) + (remove-duplicates . 2) (remove-if . 3) (remove-if-not . 3) + (replace . 3) (sort* . 3) (stable-sort . 3) (sublis . 3) + (subsetp . 3) (subst . 4) (subst-if . 4) (subst-if-not . 4) + (substitute . 4) (substitute-if . 4) (substitute-if-not . 4) + (tree-equal . 3))) + (defun byte-compile-normal-call (form) + (and (get (car form) 'byte-compile-keyword-start) + (let ((plist (nthcdr (get (car form) 'byte-compile-keyword-start) + form))) + (symbol-macrolet + ((not-present '#:not-present)) + (if (not (valid-plist-p plist)) + (byte-compile-warn + "#'%s: ill-formed keyword argument list: %S" (car form) plist) + (and + (memq 'callargs byte-compile-warnings) + (map nil + (function* + (lambda ((function . nargs)) + (and (setq function (plist-get plist function + not-present)) + (not (eq function not-present)) + (byte-compile-constp function) + (byte-compile-callargs-warn + (cons (eval function) + (member* + nargs + ;; Dummy arguments. There's no need for + ;; it to be longer than even 2, now, but + ;; very little harm in it. + '(9 8 7 6 5 4 3 2 1))))))) + '((:key . 1) (:test . 2) (:test-not . 2) + (:if . 1) (:if-not . 1)))))))) (if byte-compile-generate-call-tree (byte-compile-annotate-call-tree form)) (byte-compile-push-constant (car form))
--- a/lisp/cl-extra.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/cl-extra.el Thu Oct 28 23:53:24 2010 +0200 @@ -403,11 +403,17 @@ "Equivalent to (nconc (nreverse X) Y)." (nconc (nreverse x) y)) +;; XEmacs; check LIST for type and circularity. (defun tailp (sublist list) "Return true if SUBLIST is a tail of LIST." - (while (and (consp list) (not (eq sublist list))) - (setq list (cdr list))) - (if (numberp sublist) (equal sublist list) (eq sublist list))) + (check-argument-type #'listp list) + (let ((before list) (evenp t)) + (while (and (consp list) (not (eq sublist list))) + (setq list (cdr list) + evenp (not evenp)) + (if evenp (setq before (cdr before))) + (if (eq before list) (error 'circular-list list))) + (eql sublist list))) (defalias 'cl-copy-tree 'copy-tree) @@ -417,17 +423,9 @@ (defalias 'get* 'get) (defalias 'getf 'plist-get) -(defun cl-set-getf (plist tag val) - (let ((p plist)) - (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p)))) - (if p (progn (setcar (cdr p) val) plist) (list* tag val plist)))) - -(defun cl-do-remf (plist tag) - (let ((p (cdr plist))) - (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) - (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) - -;; XEmacs change: we have a builtin remprop +;; XEmacs; these are built-in. +(defalias 'cl-set-getf 'plist-put) +(defalias 'cl-do-remf 'plist-remprop) (defalias 'cl-remprop 'remprop) (defun get-properties (plist indicator-list) @@ -655,6 +653,11 @@ (prog1 (cl-prettyprint form) (message "")))) +;; XEmacs addition; force cl-macs to be available from here on when +;; compiling files to be dumped. This is more reasonable than forcing other +;; files to do the same, multiple times. +(eval-when-compile (or (cl-compiling-file) (load "cl-macs"))) + (run-hooks 'cl-extra-load-hook) ;; XEmacs addition
--- a/lisp/cl-macs.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/cl-macs.el Thu Oct 28 23:53:24 2010 +0200 @@ -133,8 +133,11 @@ (setq xs (cdr xs))) (not xs)) -(defun cl-const-expr-val (x) - (and (eq (cl-const-expr-p x) t) (if (consp x) (nth 1 x) x))) +(defun cl-const-expr-val (x &optional cl-not-constant) + (let ((cl-const-expr-p (cl-const-expr-p x))) + (cond ((eq cl-const-expr-p t) (if (consp x) (nth 1 x) x)) + ((eq cl-const-expr-p 'func) (nth 1 x)) + (cl-not-constant)))) (defun cl-expr-access-order (x v) (if (cl-const-expr-p x) v @@ -2405,7 +2408,7 @@ (append (nth 1 method) (list tag def)) (list store-temp) (list 'let (list (list (car (nth 2 method)) - (list 'cl-set-getf (nth 4 method) + (list 'plist-put (nth 4 method) tag-temp store-temp))) (nth 3 method) store-temp) (list 'getf (nth 4 method) tag-temp def-temp)))) @@ -2595,7 +2598,7 @@ (list 'progn (cl-setf-do-store (nth 1 method) (list 'cddr tval)) t) - (list 'cl-do-remf tval ttag))))) + (list 'plist-remprop tval ttag))))) ;;;###autoload (defmacro shiftf (place &rest args) @@ -3262,16 +3265,19 @@ ;;; Note that cl.el arranges to force cl-macs to be loaded at compile-time, ;;; mainly to make sure these macros will be present. +(defun cl-non-fixnum-number-p (object) + (and (numberp object) (not (fixnump object)))) + (put 'eql 'byte-compile nil) (define-compiler-macro eql (&whole form a b) (cond ((eq (cl-const-expr-p a) t) (let ((val (cl-const-expr-val a))) - (if (and (numberp val) (not (fixnump val))) + (if (cl-non-fixnum-number-p val) (list 'equal a b) (list 'eq a b)))) ((eq (cl-const-expr-p b) t) (let ((val (cl-const-expr-val b))) - (if (and (numberp val) (not (fixnump val))) + (if (cl-non-fixnum-number-p val) (list 'equal a b) (list 'eq a b)))) ((cl-simple-expr-p a 5) @@ -3285,44 +3291,65 @@ (list 'eq a b))) (t form))) -(define-compiler-macro member* (&whole form a list &rest keys) - (let ((test (and (= (length keys) 2) (eq (car keys) :test) - (cl-const-expr-val (nth 1 keys)))) - a-val) - (cond ((eq test 'eq) (list 'memq a list)) - ((eq test 'equal) (list 'member a list)) - ((or (null keys) (eq test 'eql)) - (if (eq (cl-const-expr-p a) t) - (list (if (and (numberp (setq a-val (cl-const-expr-val a))) - (not (fixnump a-val))) - 'member - 'memq) - a list) - (if (eq (cl-const-expr-p list) t) - (let ((p (cl-const-expr-val list)) (mb nil) (mq nil)) - (if (not (cdr p)) - (and p (list 'eql a (list 'quote (car p)))) - (while p - (if (and (numberp (car p)) (not (fixnump (car p)))) - (setq mb t) - (or (fixnump (car p)) (symbolp (car p)) (setq mq t))) - (setq p (cdr p))) - (if (not mb) (list 'memq a list) - (if (not mq) (list 'member a list) form)))) - form))) - (t form)))) - -(define-compiler-macro assoc* (&whole form a list &rest keys) - (let ((test (and (= (length keys) 2) (eq (car keys) :test) - (cl-const-expr-val (nth 1 keys)))) - a-val) - (cond ((eq test 'eq) (list 'assq a list)) - ((eq test 'equal) (list 'assoc a list)) - ((and (eq (cl-const-expr-p a) t) (or (null keys) (eq test 'eql))) - (if (and (numberp (setq a-val (cl-const-expr-val a))) - (not (fixnump a-val))) - (list 'assoc a list) (list 'assq a list))) - (t form)))) +(macrolet + ((define-star-compiler-macros (&rest macros) + "For `member*', `assoc*' and `rassoc*' with constant ITEM or +:test arguments, use the versions with explicit tests if that makes sense." + (list* + 'progn + (mapcar + (function* + (lambda ((star-function eq-function equal-function)) + `(define-compiler-macro ,star-function (&whole form item list + &rest keys) + (condition-case nil + (symbol-macrolet ((not-constant '#:not-constant)) + (let* ((test-expr (plist-get keys :test ''eql)) + (test (cl-const-expr-val test-expr not-constant)) + (item-val (cl-const-expr-val item not-constant)) + (list-val (cl-const-expr-val list not-constant))) + (if (and keys + (not (and (eq :test (car keys)) + (eql 2 (length keys))))) + form + (cond ((eq test 'eq) `(,',eq-function ,item ,list)) + ((eq test 'equal) + `(,',equal-function ,item ,list)) + ((and (eq test 'eql) + (not (eq not-constant item-val))) + (if (cl-non-fixnum-number-p item-val) + `(,',equal-function ,item ,list) + `(,',eq-function ,item ,list))) + ((and (eq test 'eql) (not (eq not-constant + list-val))) + (if (some 'cl-non-fixnum-number-p list-val) + `(,',equal-function ,item ,list) + ;; This compiler macro used to limit calls + ;; to ,,eq-function to lists where all + ;; elements were either fixnums or + ;; symbols. There's no + ;; reason to do this. + `(,',eq-function ,item ,list))) + ;; This is a hilariously specific case; see + ;; add-to-list in subr.el. + ((and (eq test not-constant) + (eq 'or (car-safe test-expr)) + (eql 3 (length test-expr)) + (every #'cl-safe-expr-p (cdr form)) + `(if ,(second test-expr) + (,',star-function ,item ,list :test + ,(second test-expr)) + (,',star-function + ,item ,list :test ,(third test-expr))))) + (t form))))) + ;; No need to warn about a malformed property list, + ;; #'byte-compile-normal-call will do that for us. + (malformed-property-list form))))) + macros)))) + (define-star-compiler-macros + (member* memq member) + (assoc* assq assoc) + (rassoc* rassq rassoc))) (define-compiler-macro adjoin (&whole form a list &rest keys) (if (and (cl-simple-expr-p a) (cl-simple-expr-p list) @@ -3330,6 +3357,112 @@ (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 remq (item sequence) + `(remove* ,item ,sequence :test #'eq)) + +(macrolet + ((define-foo-if-compiler-macros (&rest alist) + "Avoid the funcall, variable binding and keyword parsing overhead +for the FOO-IF and FOO-IF-NOT functions, transforming to forms using the +non-standard :if and :if-not keywords at compile time." + (cons + 'progn + (mapcar + (function* + (lambda ((function-if . function)) + (let ((keyword (if (equal (substring (symbol-name function-if) -3) + "not") + :if-not + :if))) + `(define-compiler-macro ,function-if (&whole form &rest args) + (if (and (nthcdr 2 form) + (or (consp (cl-const-expr-val (second form))) + (cl-safe-expr-p (second form)))) + ;; It doesn't matter what the second argument is, it's + ;; ignored by FUNCTION. We know that the symbol + ;; FUNCTION is in the constants vector, so use it. + `(,',function ',',function ,(third form) ,,keyword + ,(second form) ,@(nthcdr 3 form)) + form))))) + alist)))) + (define-foo-if-compiler-macros + (remove-if . remove*) + (remove-if-not . remove*) + (delete-if . delete*) + (delete-if-not . delete*) + (find-if . find) + (find-if-not . find) + (position-if . position) + (position-if-not . position) + (count-if . count) + (count-if-not . count) + (member-if . member*) + (member-if-not . member*) + (assoc-if . assoc*) + (assoc-if-not . assoc*) + (rassoc-if . rassoc*) + (rassoc-if-not . rassoc*))) + +(macrolet + ((define-substitute-if-compiler-macros (&rest alist) + "Like the above, but for `substitute-if' and friends." + (cons + 'progn + (mapcar + (function* + (lambda ((function-if . function)) + (let ((keyword (if (equal (substring (symbol-name function-if) -3) + "not") + :if-not + :if))) + `(define-compiler-macro ,function-if (&whole form &rest args) + (if (and (nthcdr 3 form) + (or (consp (cl-const-expr-val (third form))) + (cl-safe-expr-p (third form)))) + `(,',function ,(second form) ',',function ,(fourth form) + ,,keyword ,(third form) ,@(nthcdr 4 form)) + form))))) + alist)))) + (define-substitute-if-compiler-macros + (substitute-if . substitute) + (substitute-if-not . substitute) + (nsubstitute-if . nsubstitute) + (nsubstitute-if-not . nsubstitute))) + +(macrolet + ((define-subst-if-compiler-macros (&rest alist) + "Like the above, but for `subst-if' and friends." + (cons + 'progn + (mapcar + (function* + (lambda ((function-if . function)) + (let ((keyword (if (equal (substring (symbol-name function-if) -3) + "not") + :if-not + :if))) + `(define-compiler-macro ,function-if (&whole form &rest args) + (if (and (nthcdr 3 form) + (or (consp (cl-const-expr-val (third form))) + (cl-safe-expr-p (third form)))) + `(,',function ,(if (cl-const-expr-p (second form)) + `'((nil . ,(cl-const-expr-val + (second form)))) + `(list (cons ',',function + ,(second form)))) + ,(fourth form) ,,keyword ,(third form) + ,@(nthcdr 4 form)) + form))))) + alist)))) + (define-subst-if-compiler-macros + (subst-if . sublis) + (subst-if-not . sublis) + (nsubst-if . nsublis) + (nsubst-if-not . nsublis))) + (define-compiler-macro list* (arg &rest others) (let* ((args (reverse (cons arg others))) (form (car args))) @@ -3360,106 +3493,55 @@ ;; 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) - (let ((listp-check - (cond - ((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)) - t) - ((and (listp cl-seq) (eq (first cl-seq) 'the) - (eq (second cl-seq) 'list)) - ;; Allow users to force this, if they really want to. - t) - (t - '(listp begin))))) - (cond ((loop - for relevant-key-values - in '((:test 'eq) - (:test #'eq) - (:test 'eq :from-end nil) - (:test #'eq :from-end nil)) - ;; One of the above corresponds exactly to CL-KEYS: - thereis (not (set-difference cl-keys relevant-key-values - :test #'equal))) - `(let* ((begin ,cl-seq) - cl-seq) - (if ,listp-check - (progn - (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) - ;; Call cl-delete-duplicates explicitly, to avoid the form - ;; getting compiler-macroexpanded again: - (cl-delete-duplicates begin ',cl-keys nil)))) - ((loop - for relevant-key-values - in '((:test 'eq :from-end t) - (:test #'eq :from-end t)) - ;; One of the above corresponds exactly to CL-KEYS: - thereis (not (set-difference cl-keys relevant-key-values - :test #'equal))) - `(let* ((begin ,cl-seq) - (cl-seq begin)) - (if ,listp-check - (progn - (while cl-seq - (setq cl-seq (setcdr cl-seq - (delq (car cl-seq) (cdr cl-seq))))) - begin) - ;; Call cl-delete-duplicates explicitly, to avoid the form - ;; getting compiler-macroexpanded again: - (cl-delete-duplicates begin ',cl-keys nil)))) - - ((loop - for relevant-key-values - in '((:test 'equal) - (:test #'equal) - (:test 'equal :from-end nil) - (:test #'equal :from-end nil)) - ;; One of the above corresponds exactly to CL-KEYS: - thereis (not (set-difference cl-keys relevant-key-values - :test #'equal))) - `(let* ((begin ,cl-seq) - cl-seq) - (if ,listp-check - (progn - (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) - ;; Call cl-delete-duplicates explicitly, to avoid the form - ;; getting compiler-macroexpanded again: - (cl-delete-duplicates begin ',cl-keys nil)))) - ((loop - for relevant-key-values - in '((:test 'equal :from-end t) - (:test #'equal :from-end t)) - ;; One of the above corresponds exactly to CL-KEYS: - thereis (not (set-difference cl-keys relevant-key-values - :test #'equal))) - `(let* ((begin ,cl-seq) - (cl-seq begin)) - (if ,listp-check - (progn - (while cl-seq - (setq cl-seq - (setcdr cl-seq (delete (car cl-seq) (cdr cl-seq))))) - begin) - ;; Call cl-delete-duplicates explicitly, to avoid the form - ;; getting compiler-macroexpanded again: - (cl-delete-duplicates begin ',cl-keys nil)))) - (t form)))) + (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)))) ;; XEmacs; it's perfectly reasonable, and often much clearer to those ;; reading the code, to call regexp-quote on a constant string, which is @@ -3558,117 +3640,6 @@ ;; byte-optimize.el). (t form))))) -;;(define-compiler-macro equalp (&whole form x y) -;; "Expand calls to `equalp' where X or Y is a constant expression. -;; -;;Much of the processing that `equalp' does is dependent on the types of both -;;of its arguments, and with type information for one of them, we can -;;eliminate much of the body of the function at compile time. -;; -;;Where both X and Y are constant expressions, `equalp' is evaluated at -;;compile time by byte-optimize.el--this compiler macro passes FORM through to -;;the byte optimizer in those cases." -;; ;; Cases where both arguments are constant are handled in -;; ;; byte-optimize.el, we only need to handle those cases where one is -;; ;; constant here. -;; (let* ((equalp-sym (eval-when-compile (gensym))) -;; (let-form '(progn)) -;; (check-bit-vector t) -;; (check-string t) -;; (original-y y) -;; equalp-temp checked) -;; (macrolet -;; ((unordered-check (check) -;; `(prog1 -;; (setq checked -;; (or ,check -;; (prog1 ,(sublis '((x . y) (y . x)) check :test #'eq) -;; (setq equalp-temp x x y y equalp-temp)))) -;; (when checked -;; (unless (symbolp y) -;; (setq let-form `(let ((,equalp-sym ,y))) y equalp-sym)))))) -;; ;; In the bodies of the below clauses, x is always a constant expression -;; ;; of the type we're interested in, and y is always a symbol that refers -;; ;; to the result non-constant side of the comparison. -;; (cond ((unordered-check (and (arrayp x) (not (cl-const-expr-p y)))) -;; ;; Strings and other arrays. A vector containing the same -;; ;; character elements as a given string is equalp to that string; -;; ;; a bit-vector can only be equalp to a string if both are -;; ;; zero-length. -;; (cond -;; ((member x '("" #* [])) -;; ;; No need to protect against multiple evaluation here: -;; `(and (member ,original-y '("" #* [])) t)) -;; ((stringp x) -;; `(,@let-form -;; (if (stringp ,y) -;; (eq t (compare-strings ,x nil nil -;; ,y nil nil t)) -;; (if (vectorp ,y) -;; (cl-string-vector-equalp ,x ,y))))) -;; ((bit-vector-p x) -;; `(,@let-form -;; (if (bit-vector-p ,y) -;; ;; No need to call equalp on each element here: -;; (equal ,x ,y) -;; (if (vectorp ,y) -;; (cl-bit-vector-vector-equalp ,x ,y))))) -;; (t -;; (loop -;; for elt across x -;; ;; We may not need to check the other argument if it's a -;; ;; string or bit vector, depending on the contents of x: -;; always (progn -;; (unless (characterp elt) (setq check-string nil)) -;; (unless (and (numberp elt) (or (= elt 0) (= elt 1))) -;; (setq check-bit-vector nil)) -;; (or check-string check-bit-vector))) -;; `(,@let-form -;; (cond -;; ,@(if check-string -;; `(((stringp ,y) -;; (cl-string-vector-equalp ,y ,x)))) -;; ,@(if check-bit-vector -;; `(((bit-vector-p ,y) -;; (cl-bit-vector-vector-equalp ,y ,x)))) -;; ((vectorp ,y) -;; (cl-vector-array-equalp ,x ,y))))))) -;; ((unordered-check (and (characterp x) (not (cl-const-expr-p y)))) -;; `(,@let-form -;; (or (eq ,x ,y) -;; ;; eq has a bytecode, char-equal doesn't. -;; (and (characterp ,y) -;; (eq (downcase ,x) (downcase ,y)))))) -;; ((unordered-check (and (numberp x) (not (cl-const-expr-p y)))) -;; `(,@let-form -;; (and (numberp ,y) -;; (= ,x ,y)))) -;; ((unordered-check (and (hash-table-p x) (not (cl-const-expr-p y)))) -;; ;; Hash tables; follow the CL spec. -;; `(,@let-form -;; (and (hash-table-p ,y) -;; (eq ',(hash-table-test x) (hash-table-test ,y)) -;; (= ,(hash-table-count x) (hash-table-count ,y)) -;; (cl-hash-table-contents-equalp ,x ,y)))) -;; ((unordered-check -;; ;; Symbols; eq. -;; (and (not (cl-const-expr-p y)) -;; (or (memq x '(nil t)) -;; (and (eq (car-safe x) 'quote) (symbolp (second x)))))) -;; (cons 'eq (cdr form))) -;; ((unordered-check -;; ;; Compare conses at runtime, there's no real upside to -;; ;; unrolling the function -> they fall through to the next -;; ;; clause in this function. -;; (and (cl-const-expr-p x) (not (consp x)) -;; (not (cl-const-expr-p y)))) -;; ;; All other types; use equal. -;; (cons 'equal (cdr form))) -;; ;; Neither side is a constant expression, do all our evaluation at -;; ;; runtime (or both are, and equalp will be called from -;; ;; byte-optimize.el). -;; (t form))))) - (define-compiler-macro notany (&whole form &rest cl-rest) `(not (some ,@(cdr form)))) @@ -3771,6 +3742,13 @@ (string (cons 'concat (cddr form)))) form)) +(define-compiler-macro subst-char-in-string (&whole form fromchar tochar + string &optional inplace) + (if (every #'cl-safe-expr-p (cdr form)) + `(funcall (if ,inplace #'nsubstitute #'substitute) ,tochar ,fromchar + (the string ,string) :test #'eq) + form)) + (map nil #'(lambda (function) ;; There are byte codes for the two-argument versions of these @@ -3803,7 +3781,7 @@ '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x) (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x) (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x) - (rest 'cdr x) (endp 'null x) (plusp '> x 0) (minusp '< x 0) + (rest 'cdr x) (plusp '> x 0) (minusp '< x 0) (oddp 'eq (list 'logand x 1) 1) (evenp 'eq (list 'logand x 1) 0) (caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr)
--- a/lisp/cl.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/cl.el Thu Oct 28 23:53:24 2010 +0200 @@ -363,7 +363,13 @@ (defalias 'first 'car) (defalias 'rest 'cdr) -(defalias 'endp 'null) + +;; XEmacs change; this needs to error if handed a non-list. +(defun endp (list) + "Return t if LIST is nil, or nil if LIST is a cons. Error otherwise." + (prog1 + (null list) + (and list (atom list) (error 'wrong-type-argument #'listp list)))) ;; XEmacs change: make it a real function (defun second (x) @@ -517,24 +523,28 @@ ;;; `last' is implemented as a C primitive, as of 1998-11 -(defun list* (arg &rest rest) ; See compiler macro in cl-macs.el - "Return a new list with specified args as elements, cons'd to last arg. -Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to -`(cons A (cons B (cons C D)))'." - (cond ((not rest) arg) - ((not (cdr rest)) (cons arg (car rest))) - (t (let* ((n (length rest)) - (copy (copy-sequence rest)) - (last (nthcdr (- n 2) copy))) - (setcdr last (car (cdr last))) - (cons arg copy))))) +;;; XEmacs: `list*' is in subr.el. + +;; XEmacs; handle dotted lists properly, error on circularity and if LIST is +;; not a list. +(defun ldiff (list sublist) + "Return a copy of LIST with the tail SUBLIST removed. -(defun ldiff (list sublist) - "Return a copy of LIST with the tail SUBLIST removed." - (let ((res nil)) - (while (and (consp list) (not (eq list sublist))) - (push (pop list) res)) - (nreverse res))) +If SUBLIST is the same Lisp object as LIST, return nil. If SUBLIST is +not present in the list structure of LIST (that is, it is not the cdr +of some cons making up LIST), this function is equivalent to +`copy-list'. LIST may be dotted." + (check-argument-type #'listp list) + (and list (not (eq list sublist)) + (let ((before list) (evenp t) result) + (prog1 + (setq result (list (car list))) + (while (and (setq list (cdr-safe list)) (not (eql list sublist))) + (setcdr result (if (consp list) (list (car list)) list)) + (setq result (cdr result) + evenp (not evenp)) + (if evenp (setq before (cdr before))) + (if (eq before list) (error 'circular-list list))))))) ;;; `copy-list' is implemented as a C primitive, as of 1998-11
--- a/lisp/cmdloop.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/cmdloop.el Thu Oct 28 23:53:24 2010 +0200 @@ -562,12 +562,7 @@ ;; BEGIN SYNCHED WITH FSF 21.2. -(defvar read-quoted-char-radix 8 - "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'. -Legitimate radix values are 8, 10 and 16.") - -(custom-declare-variable-early - 'read-quoted-char-radix 8 +(defcustom read-quoted-char-radix 8 "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'. Legitimate radix values are 8, 10 and 16." :type '(choice (const 8) (const 10) (const 16))
--- a/lisp/custom.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/custom.el Thu Oct 28 23:53:24 2010 +0200 @@ -42,12 +42,10 @@ (provide 'custom) (eval-when-compile - (load "cl-macs" nil t) ;; To elude warnings. (require 'cus-face)) (autoload 'custom-declare-face "cus-face") -(autoload 'defun* "cl-macs") (require 'widget) @@ -1054,12 +1052,7 @@ ;;; The End. -;; Process the defcustoms for variables loaded before this file. -;; `custom-declare-variable-list' is defvar'd in subr.el. Utility programs -;; run from temacs that do not load subr.el should defvar it themselves. -;; (As of 21.5.11, make-docfile.el.) -(while custom-declare-variable-list - (apply 'custom-declare-variable (car custom-declare-variable-list)) - (setq custom-declare-variable-list (cdr custom-declare-variable-list))) +;; XEmacs; we order preloaded-file-list such that there's no need for +;; custom-declare-variable-list. ;; custom.el ends here
--- a/lisp/dumped-lisp.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/dumped-lisp.el Thu Oct 28 23:53:24 2010 +0200 @@ -38,28 +38,19 @@ "backquote" ; needed for defsubst etc. "bytecomp-runtime" ; define defsubst - "find-paths" - "packages" ; Bootstrap run-time lisp environment - "setup-paths" - - ;; use custom-declare-variable-early, not defcustom, in these files - "subr" ; load the most basic Lisp functions + "cl" + "cl-extra" ; also loads cl-macs if we're running interpreted. + "cl-seq" "post-gc" - "replace" ; match-string used in version.el. - "version" - - "cl" - "cl-extra" - "cl-seq" + "custom" ; Before the world so everything can be customized + "cus-start" ; for customization of builtin variables + "find-paths" + "packages" + "setup-paths" + "replace" "widget" - "custom" ; Before the world so everything can be - ; customized - "cus-start" ; for customization of builtin variables - - ;; OK, you can use defcustom from here on - "cmdloop" "keymap" "syntax"
--- a/lisp/faces.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/faces.el Thu Oct 28 23:53:24 2010 +0200 @@ -47,9 +47,7 @@ ;; To elude the warnings for font functions. (Normally autoloaded when ;; font-create-object is called) -(eval-when-compile - (require 'font) - (load "cl-macs")) +(eval-when-compile (require 'font)) (defgroup faces nil "Support for multiple text attributes (fonts, colors, ...)
--- a/lisp/gnome.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/gnome.el Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,7 @@ +;; gnome.el --- GNOME integration for XEmacs/GTK +;; +;; Copyright (C) 2000, 2001 William M. Perry +;; ;; This file is part of XEmacs. ;; XEmacs is free software: you can redistribute it and/or modify it
--- a/lisp/gtk-compose.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/gtk-compose.el Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,7 @@ +;; gtk-compose.el --- provide compose-key handling to GTK +;; +;; Copyright (C) 2000, 2001 William M. Perry +;; ;; This file is part of XEmacs. ;; XEmacs is free software: you can redistribute it and/or modify it
--- a/lisp/gtk-marshal.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/gtk-marshal.el Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,7 @@ +;; gtk-marshal.el --- regenerate C wrappers for GTK +;; +;; Copyright (C) 2000, 2001 William M. Perry +;; ;; This file is part of XEmacs. ;; XEmacs is free software: you can redistribute it and/or modify it
--- a/lisp/gtk-package.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/gtk-package.el Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,7 @@ +;; gtk-package.el --- GTK version of package-ui +;; +;; Copyright (C) 2000, 2001 William M. Perry +;; ;; This file is part of XEmacs. ;; XEmacs is free software: you can redistribute it and/or modify it
--- a/lisp/gtk-widget-accessors.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/gtk-widget-accessors.el Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,7 @@ +;; gtk-widget-accessors.el --- GTK wrappers for widgets +;; +;; Copyright (C) 2000, 2001 William M. Perry +;; ;; This file is part of XEmacs. ;; XEmacs is free software: you can redistribute it and/or modify it
--- a/lisp/gtk.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/gtk.el Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,7 @@ +;; gtk.el --- provide information about GTK wrapping +;; +;; Copyright (C) 2000, 2001 William M. Perry +;; ;; This file is part of XEmacs. ;; XEmacs is free software: you can redistribute it and/or modify it
--- a/lisp/mule/canna-leim.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/mule/canna-leim.el Thu Oct 28 23:53:24 2010 +0200 @@ -13,6 +13,8 @@ ;; Keywords: japanese, input method, LEIM ;; Last Modified: 1997/10/27 10:08:49 +;; 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 3 of the License, or (at your
--- a/lisp/packages.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/packages.el Thu Oct 28 23:53:24 2010 +0200 @@ -29,23 +29,7 @@ ;; This file is dumped with XEmacs. ;; This file provides low level facilities for XEmacs startup -- -;; particularly regarding the package setup. This code has to run in -;; what we call "bare temacs" -- i.e. XEmacs without the usual Lisp -;; environment. Pay special attention: - -;; - not to use the `lambda' macro. Use #'(lambda ...) instead. -;; (this goes for any package loaded before `subr.el'.) -;; -;; - not to use macros, because they are not yet available (and this -;; file must be loadable uncompiled.) Built in macros, such as -;; `when' and `unless' are fine, of course. -;; -;; - not to use `defcustom'. If you must add user-customizable -;; variables here, use `defvar', and add the variable to -;; `cus-start.el'. - -;; Because of all this, make sure that the stuff you put here really -;; belongs here. +;; particularly regarding the package setup. ;; This file requires find-paths.el.
--- a/lisp/post-gc.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/post-gc.el Thu Oct 28 23:53:24 2010 +0200 @@ -54,15 +54,8 @@ (defun cleanup-simple-finalizers (alist) "Clean up `simple-finalizer-ephemerons'." - ;; We have to do this by hand because DELETE-IF isn't defined yet. - (let ((current simple-finalizer-ephemerons) - (prev nil)) - (while (not (null current)) - (if (not (ephemeron-ref (car current))) - (if (null prev) - (setq simple-finalizer-ephemerons (cdr current)) - (setcdr prev (cdr current))) - (setq prev current)) - (setq current (cdr current))))) + (and simple-finalizer-ephemerons + (setq simple-finalizer-ephemerons + (delete-if-not #'ephemeron-ref simple-finalizer-ephemerons)))) (add-hook 'post-gc-hook 'cleanup-simple-finalizers)
--- a/lisp/subr.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/subr.el Thu Oct 28 23:53:24 2010 +0200 @@ -37,18 +37,9 @@ ;; BEGIN SYNCHED WITH FSF 21.2 -;;; Code: -(defvar custom-declare-variable-list nil - "Record `defcustom' calls made before `custom.el' is loaded to handle them. -Each element of this list holds the arguments to one call to `defcustom'.") +;; XEmacs; no need for custom-declare-variable-list, preloaded-file-list is +;; ordered to make it unnecessary. -;; Use this, rather than defcustom, in subr.el and other files loaded -;; before custom.el. See dumped-lisp.el. -(defun custom-declare-variable-early (&rest arguments) - (setq custom-declare-variable-list - (cons arguments custom-declare-variable-list))) - - (defun macro-declaration-function (macro decl) "Process a declaration found in a macro definition. This is set as the value of the variable `macro-declaration-function'. @@ -64,7 +55,20 @@ (message "Unknown declaration %s" d))))) (setq macro-declaration-function 'macro-declaration-function) - + +;; XEmacs; this is here because we use it in backquote.el, so it needs to be +;; available the first time a `(...) form is expanded. +(defun list* (first &rest rest) ; See compiler macro in cl-macs.el + "Return a new list with specified args as elements, cons'd to last arg. +Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to +`(cons A (cons B (cons C D)))'." + (cond ((not rest) first) + ((not (cdr rest)) (cons first (car rest))) + (t (let* ((n (length rest)) + (copy (copy-sequence rest)) + (last (nthcdr (- n 2) copy))) + (setcdr last (car (cdr last))) + (cons first copy))))) ;;;; Lisp language features. @@ -1571,19 +1575,6 @@ (define-function 'eval-in-buffer 'with-current-buffer) (make-obsolete 'eval-in-buffer 'with-current-buffer) -;;; The real defn is in abbrev.el but some early callers -;;; (eg lisp-mode-abbrev-table) want this before abbrev.el is loaded... - -(if (not (fboundp 'define-abbrev-table)) - (progn - (setq abbrev-table-name-list '()) - (fset 'define-abbrev-table - (function (lambda (name defs) - ;; These are fixed-up when abbrev.el loads. - (setq abbrev-table-name-list - (cons (cons name defs) - abbrev-table-name-list))))))) - ;;; `functionp' has been moved into C. ;;(defun functionp (object)
--- a/nt/ChangeLog Wed Oct 27 23:36:14 2010 +0200 +++ b/nt/ChangeLog Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,7 @@ +2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> + + * compface.mak: More permission consistency. + 2010-06-13 Stephen J. Turnbull <stephen@xemacs.org> * tiff.mak:
--- a/src/ChangeLog Wed Oct 27 23:36:14 2010 +0200 +++ b/src/ChangeLog Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,49 @@ +2010-10-25 Aidan Kehoe <kehoea@parhasard.net> + + * specifier.c (specifier_instance_from_inst_list): + Call call_with_suspended_errors() with ERROR_ME_WARN, explicitly; + avoids the problem Giacomo Boffi describes in + http://mid.gmane.org/19617.52517.341117.388679@aiuole.stru.polimi.it + , but the specifier instantiation bug that makes XEmacs fail for + him is still visible. + +2010-10-25 Aidan Kehoe <kehoea@parhasard.net> + + * print.c (ulong_to_bit_string): If printing zero, actually print + a zero, don't return the empty string. + +2010-07-06 Stephen J. Turnbull <stephen@xemacs.org> + + * emodules.c (emodules_load): + Add one more dereference on f = dll_variable() in three places. + We then use EXTERNAL_TO_ITEXT on it, which returns an alloca'd + string, so I delete the unneeded alloca copy statements. + Fixes error reported by Anders Odberg, confirmed in + <rfawrpfhm3l.fsf@fangorn.uio.no>. + +2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> + + * ui-byhand.c: + * gtk-glue.c: + Add copyright notice based on internal evidence. + +2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> + + * number.h: Another permission consistency fix. + +2010-10-14 Aidan Kehoe <kehoea@parhasard.net> + + * fns.c (Fnbutlast, Fbutlast): + Tighten up Common Lisp compatibility for these two functions; they + need to operate on dotted lists without erroring. + +2010-10-12 Aidan Kehoe <kehoea@parhasard.net> + + * fns.c (list_merge): + Circularity checking here needs to be done independently for each + list, they can't share a loop counter. Thank you for the bug + report, Robert Pluim! + 2010-09-20 Aidan Kehoe <kehoea@parhasard.net> * lisp.h (GET_DEFUN_LISP_OBJECT): Make the NEW_GC version of this
--- a/src/emodules.c Wed Oct 27 23:36:14 2010 +0200 +++ b/src/emodules.c Thu Oct 28 23:53:24 2010 +0200 @@ -388,11 +388,7 @@ (const Ibyte *) "emodule_name"); if (f == NULL || *f == NULL) signal_error (Qdll_error, "Invalid dynamic module: Missing symbol `emodule_name'", Qunbound); - - mname = EXTERNAL_TO_ITEXT (f, Qemodule_string_encoding); - /* #### Not obvious we have to force an alloca copy here, but the old - code did so */ - IBYTE_STRING_TO_ALLOCA (mname, mname); + mname = EXTERNAL_TO_ITEXT (*f, Qemodule_string_encoding); if (mname[0] == '\0') signal_error (Qdll_error, "Invalid dynamic module: Empty value for `emodule_name'", Qunbound); @@ -401,21 +397,13 @@ (const Ibyte *) "emodule_version"); if (f == NULL || *f == NULL) signal_error (Qdll_error, "Missing symbol `emodule_version': Invalid dynamic module", Qunbound); - - mver = EXTERNAL_TO_ITEXT (f, Qemodule_string_encoding); - /* #### Not obvious we have to force an alloca copy here, but the old - code did so */ - IBYTE_STRING_TO_ALLOCA (mver, mver); + mver = EXTERNAL_TO_ITEXT (*f, Qemodule_string_encoding); f = (const Extbyte **) dll_variable (dlhandle, (const Ibyte *) "emodule_title"); if (f == NULL || *f == NULL) signal_error (Qdll_error, "Invalid dynamic module: Missing symbol `emodule_title'", Qunbound); - - mtitle = EXTERNAL_TO_ITEXT (f, Qemodule_string_encoding); - /* #### Not obvious we have to force an alloca copy here, but the old - code did so */ - IBYTE_STRING_TO_ALLOCA (mtitle, mtitle); + mtitle = EXTERNAL_TO_ITEXT (*f, Qemodule_string_encoding); symname = alloca_ibytes (qxestrlen (mname) + 15);
--- a/src/fns.c Wed Oct 27 23:36:14 2010 +0200 +++ b/src/fns.c Thu Oct 28 23:53:24 2010 +0200 @@ -1568,72 +1568,99 @@ DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /* Modify LIST to remove the last N (default 1) elements. + If LIST has N or fewer elements, nil is returned and LIST is unmodified. +Otherwise, LIST may be dotted, but not circular. */ (list, n)) { - EMACS_INT int_n; + Elemcount int_n = 1; CHECK_LIST (list); - if (NILP (n)) - int_n = 1; - else + if (!NILP (n)) { CHECK_NATNUM (n); int_n = XINT (n); } - { - Lisp_Object last_cons = list; - - EXTERNAL_LIST_LOOP_1 (list) - { - if (int_n-- < 0) - last_cons = XCDR (last_cons); - } - - if (int_n >= 0) - return Qnil; - - XCDR (last_cons) = Qnil; - return list; - } + if (CONSP (list)) + { + Lisp_Object last_cons = list; + + EXTERNAL_LIST_LOOP_3 (elt, list, tail) + { + if (int_n-- < 0) + { + last_cons = XCDR (last_cons); + } + + if (!CONSP (XCDR (tail))) + { + break; + } + } + + if (int_n >= 0) + { + return Qnil; + } + + XCDR (last_cons) = Qnil; + } + + return list; } DEFUN ("butlast", Fbutlast, 1, 2, 0, /* Return a copy of LIST with the last N (default 1) elements removed. + If LIST has N or fewer elements, nil is returned. +Otherwise, LIST may be dotted, but not circular, and `(butlast LIST 0)' +converts a dotted into a true list. */ (list, n)) { - EMACS_INT int_n; + Lisp_Object retval = Qnil, retval_tail = Qnil; + Elemcount int_n = 1; CHECK_LIST (list); - if (NILP (n)) - int_n = 1; - else + if (!NILP (n)) { CHECK_NATNUM (n); int_n = XINT (n); } - { - Lisp_Object retval = Qnil; - Lisp_Object tail = list; - - EXTERNAL_LIST_LOOP_1 (list) - { - if (--int_n < 0) - { - retval = Fcons (XCAR (tail), retval); - tail = XCDR (tail); - } - } - - return Fnreverse (retval); - } + if (CONSP (list)) + { + Lisp_Object tail = list; + + EXTERNAL_LIST_LOOP_3 (elt, list, list_tail) + { + if (--int_n < 0) + { + if (NILP (retval_tail)) + { + retval = retval_tail = Fcons (XCAR (tail), Qnil); + } + else + { + XSETCDR (retval_tail, Fcons (XCAR (tail), Qnil)); + retval_tail = XCDR (retval_tail); + } + + tail = XCDR (tail); + } + + if (!CONSP (XCDR (list_tail))) + { + break; + } + } + } + + return retval; } DEFUN ("member", Fmember, 2, 2, 0, /* @@ -2155,7 +2182,7 @@ Lisp_Object l1, l2; Lisp_Object tortoises[2]; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - int looped = 0; + int l1_count = 0, l2_count = 0; l1 = org_l1; l2 = org_l2; @@ -2201,37 +2228,56 @@ tem = l1; l1 = Fcdr (l1); org_l1 = l1; + + if (l1_count++ > CIRCULAR_LIST_SUSPICION_LENGTH) + { + if (l1_count & 1) + { + if (!CONSP (tortoises[0])) + { + mapping_interaction_error (Qmerge, tortoises[0]); + } + + tortoises[0] = XCDR (tortoises[0]); + } + + if (EQ (org_l1, tortoises[0])) + { + signal_circular_list_error (org_l1); + } + } } else { tem = l2; l2 = Fcdr (l2); org_l2 = l2; + + if (l2_count++ > CIRCULAR_LIST_SUSPICION_LENGTH) + { + if (l2_count & 1) + { + if (!CONSP (tortoises[1])) + { + mapping_interaction_error (Qmerge, tortoises[1]); + } + + tortoises[1] = XCDR (tortoises[1]); + } + + if (EQ (org_l2, tortoises[1])) + { + signal_circular_list_error (org_l2); + } + } } + if (NILP (tail)) value = tem; else Fsetcdr (tail, tem); + tail = tem; - - if (++looped > CIRCULAR_LIST_SUSPICION_LENGTH) - { - if (looped & 1) - { - tortoises[0] = XCDR (tortoises[0]); - tortoises[1] = XCDR (tortoises[1]); - } - - if (EQ (org_l1, tortoises[0])) - { - signal_circular_list_error (org_l1); - } - - if (EQ (org_l2, tortoises[1])) - { - signal_circular_list_error (org_l2); - } - } } }
--- a/src/gtk-glue.c Wed Oct 27 23:36:14 2010 +0200 +++ b/src/gtk-glue.c Thu Oct 28 23:53:24 2010 +0200 @@ -1,4 +1,7 @@ -/* +/* gtk-glue.c --- GTK interfaces with XEmacs + +Copyright (C) 2000, 2001 William M. Perry + This file is part of XEmacs. XEmacs is free software: you can redistribute it and/or modify it
--- a/src/print.c Wed Oct 27 23:36:14 2010 +0200 +++ b/src/print.c Thu Oct 28 23:53:24 2010 +0200 @@ -1337,6 +1337,12 @@ } } } + + if (!seen_high_order) + { + *p++ = '0'; + } + *p = '\0'; }
--- a/src/specifier.c Wed Oct 27 23:36:14 2010 +0200 +++ b/src/specifier.c Thu Oct 28 23:53:24 2010 +0200 @@ -2824,7 +2824,7 @@ if (HAS_SPECMETH_P (sp, instantiate)) val = call_with_suspended_errors ((lisp_fn_t) RAW_SPECMETH (sp, instantiate), - Qunbound, Qspecifier, errb, 5, specifier, + Qunbound, Qspecifier, ERROR_ME_WARN, 5, specifier, matchspec, domain, val, depth, no_fallback); if (!UNBOUNDP (val))
--- a/src/ui-byhand.c Wed Oct 27 23:36:14 2010 +0200 +++ b/src/ui-byhand.c Thu Oct 28 23:53:24 2010 +0200 @@ -1,4 +1,8 @@ -/* I really wish this entire file could go away, but there is +/* ui-byhand.c --- hand-coded GTK functions + +Copyright (C) 2000, 2001 William M. Perry + + I really wish this entire file could go away, but there is currently no way to do the following in the Foreign Function Interface:
--- a/tests/ChangeLog Wed Oct 27 23:36:14 2010 +0200 +++ b/tests/ChangeLog Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,41 @@ +2010-10-25 Aidan Kehoe <kehoea@parhasard.net> + + * automated/lisp-tests.el: + Test format strings with %b, too. + +2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> + + * automated/lisp-reader-tests.el: + Change references to SXEmacs to XEmacs. + +2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> + + * gtk/xemacs-toolbar.el: + * gtk/toolbar-test.el: + * gtk/statusbar-test.el: + * gtk/gtk-extra-test.el: + * gtk/gtk-embedded-test.el: + * gtk/gnome-test.el: + * gtk/event-stream-tests.el: + Add copyright notice based on internal evidence. + +2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> + + * reproduce-crashes.el: Amend "this file" to "XEmacs is free...". + +2010-10-14 Aidan Kehoe <kehoea@parhasard.net> + + * automated/lisp-tests.el (x): + Test #'nbutlast, #'butlast with dotted lists. + Check that #'ldiff and #'tailp don't hang on circular lists; check + that #'tailp returns t with circular lists when that is + appropriate. Test them both with dotted lists. + +2010-10-12 Aidan Kehoe <kehoea@parhasard.net> + + * automated/lisp-tests.el: + Make sure circularity checking with #'merge is sane. + 2010-08-15 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el:
--- a/tests/automated/lisp-tests.el Wed Oct 27 23:36:14 2010 +0200 +++ b/tests/automated/lisp-tests.el Thu Oct 28 23:53:24 2010 +0200 @@ -198,6 +198,14 @@ (Assert (equal y '(0 1 2 3))) (Assert (equal z y))) +(let* ((x (list* 0 1 2 3 4 5 6.0 ?7 ?8 (vector 'a 'b 'c))) + (y (butlast x 0)) + (z (nbutlast x 0))) + (Assert (eq z x)) + (Assert (not (eq y x))) + (Assert (equal y '(0 1 2 3 4 5 6.0 ?7 ?8))) + (Assert (equal z y))) + (Assert (eq (butlast '(x)) nil)) (Assert (eq (nbutlast '(x)) nil)) (Assert (eq (butlast '()) nil)) @@ -217,6 +225,58 @@ (Assert (and (equal x y) (not (eq x y)))))) ;;----------------------------------------------------- +;; Test `ldiff' +;;----------------------------------------------------- +(Check-Error wrong-type-argument (ldiff 'foo pi)) +(Check-Error wrong-number-of-arguments (ldiff)) +(Check-Error wrong-number-of-arguments (ldiff '(1 2))) +(Check-Error circular-list (ldiff (make-circular-list 1) nil)) +(Check-Error circular-list (ldiff (make-circular-list 2000) nil)) +(Assert (eq '() (ldiff '() pi))) +(dolist (x '((1) (1 2) (1 2 3) (1 2 . 3))) + (let ((y (ldiff x nil))) + (Assert (and (equal x y) (not (eq x y)))))) + +(let* ((vector (vector 'foo)) + (dotted `(1 2 3 ,pi 40 50 . ,vector)) + (dotted-pi `(1 2 3 . ,pi)) + without-vector without-pi) + (Assert (equal dotted (ldiff dotted nil)) + "checking ldiff handles dotted lists properly") + (Assert (equal (butlast dotted 0) (ldiff dotted vector)) + "checking ldiff discards dotted elements correctly") + (Assert (equal (butlast dotted-pi 0) (ldiff dotted-pi (* 4 (atan 1)))) + "checking ldiff handles float equivalence correctly")) + +;;----------------------------------------------------- +;; Test `tailp' +;;----------------------------------------------------- +(Check-Error wrong-type-argument (tailp pi 'foo)) +(Check-Error wrong-number-of-arguments (tailp)) +(Check-Error wrong-number-of-arguments (tailp '(1 2))) +(Check-Error circular-list (tailp nil (make-circular-list 1))) +(Check-Error circular-list (tailp nil (make-circular-list 2000))) +(Assert (null (tailp pi '())) + "checking pi is not a tail of the list nil") +(Assert (tailp 3 '(1 2 . 3)) + "checking #'tailp works with a dotted integer.") +(Assert (tailp pi `(1 2 . ,(* 4 (atan 1)))) + "checking tailp works with non-eq dotted floats.") +(let ((list (make-list 2048 nil))) + (Assert (tailp (nthcdr 2000 list) (nconc list list)) + "checking #'tailp succeeds with circular LIST containing SUBLIST")) + +;;----------------------------------------------------- +;; Test `endp' +;;----------------------------------------------------- +(Check-Error wrong-type-argument (endp 'foo)) +(Check-Error wrong-number-of-arguments (endp)) +(Check-Error wrong-number-of-arguments (endp '(1 2) 'foo)) +(Assert (endp nil) "checking nil is recognized as the end of a list") +(Assert (not (endp (list 200 200 4 0 9))) + "checking a cons is not recognised as the end of a list") + +;;----------------------------------------------------- ;; Arithmetic operations ;;----------------------------------------------------- @@ -1263,8 +1323,11 @@ ;;----------------------------------------------------- (Assert (string= (format "%d" 10) "10")) (Assert (string= (format "%o" 8) "10")) +(Assert (string= (format "%b" 2) "10")) (Assert (string= (format "%x" 31) "1f")) (Assert (string= (format "%X" 31) "1F")) +(Assert (string= (format "%b" 0) "0")) +(Assert (string= (format "%b" 3) "11")) ;; MS-Windows uses +002 in its floating-point numbers. #### We should ;; perhaps fix this, but writing our own floating-point support in doprnt.c ;; is very hard. @@ -2407,4 +2470,10 @@ (Assert (not (eql '1/5 (read (prin1-to-string (intern "2/10"))))) "checking symbol named \"2/10\" not eql to ratio 1/5 on read")) +(let* ((count 0) + (list (map-into (make-list 2048 nil) #'(lambda () (decf count)))) + (expected (append list '(1)))) + (Assert (equal expected (merge 'list list '(1) #'<)) + "checking merge's circularity checks are sane")) + ;;; end of lisp-tests.el
--- a/tests/gtk/event-stream-tests.el Wed Oct 27 23:36:14 2010 +0200 +++ b/tests/gtk/event-stream-tests.el Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,8 @@ +;; event-stream-tests.el --- test the GTK event stream +;; +;; Copyright 2000, 2001 William Perry +;; Seems to be based on the comment at the end of src/event-stream.c. +;; ;; This file is part of XEmacs. ;; XEmacs is free software: you can redistribute it and/or modify it
--- a/tests/gtk/gnome-test.el Wed Oct 27 23:36:14 2010 +0200 +++ b/tests/gtk/gnome-test.el Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,7 @@ +;; gnome-test.el --- test GNOME integration +;; +;; Copyright 2000, 2001 William Perry +;; ;; This file is part of XEmacs. ;; XEmacs is free software: you can redistribute it and/or modify it
--- a/tests/gtk/gtk-embedded-test.el Wed Oct 27 23:36:14 2010 +0200 +++ b/tests/gtk/gtk-embedded-test.el Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,7 @@ +;; gtk-embedded-test.el --- test GTK embedding in another window +;; +;; Copyright 2000, 2001 William Perry +;; ;; This file is part of XEmacs. ;; XEmacs is free software: you can redistribute it and/or modify it
--- a/tests/gtk/gtk-extra-test.el Wed Oct 27 23:36:14 2010 +0200 +++ b/tests/gtk/gtk-extra-test.el Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,7 @@ +;; gtk-extra-test.el --- test extra GTK widgets +;; +;; Copyright 2000, 2001 William Perry +;; ;; This file is part of XEmacs. ;; XEmacs is free software: you can redistribute it and/or modify it
--- a/tests/gtk/statusbar-test.el Wed Oct 27 23:36:14 2010 +0200 +++ b/tests/gtk/statusbar-test.el Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,7 @@ +;; statusbar-test.el --- test the GTK status bar +;; +;; Copyright 2000, 2001 William Perry +;; ;; This file is part of XEmacs. ;; XEmacs is free software: you can redistribute it and/or modify it
--- a/tests/gtk/toolbar-test.el Wed Oct 27 23:36:14 2010 +0200 +++ b/tests/gtk/toolbar-test.el Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,7 @@ +;; toolbar-test.el --- test the GTK toolbar +;; +;; Copyright 2000, 2001 William Perry +;; ;; This file is part of XEmacs. ;; XEmacs is free software: you can redistribute it and/or modify it
--- a/tests/gtk/xemacs-toolbar.el Wed Oct 27 23:36:14 2010 +0200 +++ b/tests/gtk/xemacs-toolbar.el Thu Oct 28 23:53:24 2010 +0200 @@ -1,3 +1,7 @@ +;; xemacs-toolbar.el --- test the XEmacs toolbar under GTK +;; +;; Copyright 2000, 2001 William Perry +;; ;; This file is part of XEmacs. ;; XEmacs is free software: you can redistribute it and/or modify it