commit: Make sure (format "%b" 0) is non-zero length, print.c
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 5295:2474dce7304e
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Mon Oct 25 13:15:53 2010 +0100
files: src/ChangeLog src/print.c tests/ChangeLog tests/automated/lisp-tests.el
description:
Make sure (format "%b" 0) is non-zero length, print.c
src/ChangeLog addition:
2010-10-25 Aidan Kehoe <kehoea(a)parhasard.net>
* print.c (ulong_to_bit_string): If printing zero, actually print
a zero, don't return the empty string.
tests/ChangeLog addition:
2010-10-25 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
Test format strings with %b, too.
diff -r bbff29a01820 -r 2474dce7304e src/ChangeLog
--- a/src/ChangeLog Mon Oct 25 13:04:04 2010 +0100
+++ b/src/ChangeLog Mon Oct 25 13:15:53 2010 +0100
＠＠ -1,3 +1,8 ＠＠
+2010-10-25 Aidan Kehoe <kehoea(a)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(a)xemacs.org>
* emodules.c (emodules_load):
diff -r bbff29a01820 -r 2474dce7304e src/print.c
--- a/src/print.c Mon Oct 25 13:04:04 2010 +0100
+++ b/src/print.c Mon Oct 25 13:15:53 2010 +0100
＠＠ -1339,6 +1339,12 ＠＠
}
}
}
+
+ if (!seen_high_order)
+ {
+ *p++ = '0';
+ }
+
*p = '\0';
}
diff -r bbff29a01820 -r 2474dce7304e tests/ChangeLog
--- a/tests/ChangeLog Mon Oct 25 13:04:04 2010 +0100
+++ b/tests/ChangeLog Mon Oct 25 13:15:53 2010 +0100
＠＠ -1,3 +1,8 ＠＠
+2010-10-25 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el:
+ Test format strings with %b, too.
+
2010-06-14 Stephen J. Turnbull <stephen(a)xemacs.org>
* automated/lisp-reader-tests.el:
diff -r bbff29a01820 -r 2474dce7304e tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Mon Oct 25 13:04:04 2010 +0100
+++ b/tests/automated/lisp-tests.el Mon Oct 25 13:15:53 2010 +0100
＠＠ -1325,8 +1325,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.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Add compiler macros and compilation sanity-checks for functions with keywords.
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
I’m doing the work at the moment to move the heavy lifting of cl-seq.el into
C. This is part of that, but can be usefully committed before the bulk of
it.
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1288008244 -3600
# Node ID bbff29a018205278529d8f0fd7245c700c2c364e
# Parent 63f247c5da0a0e75755455c7540a2776bf999be9
Add compiler macros and compilation sanity-checks for functions with keywords.
2010-10-25 Aidan Kehoe <kehoea(a)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
diff -r 63f247c5da0a -r bbff29a01820 lisp/ChangeLog
--- a/lisp/ChangeLog Mon Oct 18 23:43:03 2010 +0900
+++ b/lisp/ChangeLog Mon Oct 25 13:04:04 2010 +0100
＠＠ -1,3 +1,41 ＠＠
+2010-10-25 Aidan Kehoe <kehoea(a)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(a)xemacs.org>
* term/vt100.el:
diff -r 63f247c5da0a -r bbff29a01820 lisp/byte-optimize.el
--- a/lisp/byte-optimize.el Mon Oct 18 23:43:03 2010 +0900
+++ b/lisp/byte-optimize.el Mon Oct 25 13:04:04 2010 +0100
＠＠ -1247,7 +1247,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
diff -r 63f247c5da0a -r bbff29a01820 lisp/bytecomp.el
--- a/lisp/bytecomp.el Mon Oct 18 23:43:03 2010 +0900
+++ b/lisp/bytecomp.el Mon Oct 25 13:04:04 2010 +0100
＠＠ -2838,7 +2838,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))
diff -r 63f247c5da0a -r bbff29a01820 lisp/cl-macs.el
--- a/lisp/cl-macs.el Mon Oct 18 23:43:03 2010 +0900
+++ b/lisp/cl-macs.el Mon Oct 25 13:04:04 2010 +0100
＠＠ -135,8 +135,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
＠＠ -3264,16 +3267,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)
＠＠ -3287,44 +3293,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)
＠＠ -3332,6 +3359,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)))
＠＠ -3362,106 +3495,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
＠＠ -3560,117 +3642,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))))
＠＠ -3773,6 +3744,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
diff -r 63f247c5da0a -r bbff29a01820 lisp/cl.el
--- a/lisp/cl.el Mon Oct 18 23:43:03 2010 +0900
+++ b/lisp/cl.el Mon Oct 25 13:04:04 2010 +0100
＠＠ -542,8 +542,8 ＠＠
(prog1
(setq result (list (car list)))
(while (and (setq list (cdr-safe list)) (not (eql list sublist)))
- (setf (cdr result) (if (consp list) (list (car list)) list)
- result (cdr result)
+ (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)))))))
--
“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: Add compiler macros and compilation sanity-checks for functions with keywords.
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 5294:bbff29a01820
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Mon Oct 25 13:04:04 2010 +0100
files: lisp/ChangeLog lisp/byte-optimize.el lisp/bytecomp.el lisp/cl-macs.el lisp/cl.el
description:
Add compiler macros and compilation sanity-checks for functions with keywords.
2010-10-25 Aidan Kehoe <kehoea(a)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
diff -r 63f247c5da0a -r bbff29a01820 lisp/ChangeLog
--- a/lisp/ChangeLog Mon Oct 18 23:43:03 2010 +0900
+++ b/lisp/ChangeLog Mon Oct 25 13:04:04 2010 +0100
＠＠ -1,3 +1,41 ＠＠
+2010-10-25 Aidan Kehoe <kehoea(a)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(a)xemacs.org>
* term/vt100.el:
diff -r 63f247c5da0a -r bbff29a01820 lisp/byte-optimize.el
--- a/lisp/byte-optimize.el Mon Oct 18 23:43:03 2010 +0900
+++ b/lisp/byte-optimize.el Mon Oct 25 13:04:04 2010 +0100
＠＠ -1247,7 +1247,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
diff -r 63f247c5da0a -r bbff29a01820 lisp/bytecomp.el
--- a/lisp/bytecomp.el Mon Oct 18 23:43:03 2010 +0900
+++ b/lisp/bytecomp.el Mon Oct 25 13:04:04 2010 +0100
＠＠ -2838,7 +2838,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))
diff -r 63f247c5da0a -r bbff29a01820 lisp/cl-macs.el
--- a/lisp/cl-macs.el Mon Oct 18 23:43:03 2010 +0900
+++ b/lisp/cl-macs.el Mon Oct 25 13:04:04 2010 +0100
＠＠ -135,8 +135,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
＠＠ -3264,16 +3267,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)
＠＠ -3287,50 +3293,177 ＠＠
(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)
(not (memq :key keys)))
(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)))
＠＠ -3362,106 +3495,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
＠＠ -3559,117 +3641,6 ＠＠
;; runtime (or both are, and equalp will be called from
;; 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))))
＠＠ -3773,6 +3744,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
diff -r 63f247c5da0a -r bbff29a01820 lisp/cl.el
--- a/lisp/cl.el Mon Oct 18 23:43:03 2010 +0900
+++ b/lisp/cl.el Mon Oct 25 13:04:04 2010 +0100
＠＠ -542,8 +542,8 ＠＠
(prog1
(setq result (list (car list)))
(while (and (setq list (cdr-safe list)) (not (eql list sublist)))
- (setf (cdr result) (if (consp list) (list (car list)) list)
- result (cdr result)
+ (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)))))))
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[21.5] make hexl-find-file use find-file-literally
14 years, 2 months
Stephen J. Turnbull
Stephen J. Turnbull
21.5
Followups to XEmacs Patches, please. Reply-To set.
Stephen J. Turnbull writes:
> Thanks for the report. I'm pretty sure I know what the problem is
> (yup, same basic problem, two symptoms), and I'll try to get to a
> quick fix later this week.
This is a fix for the easier hexl-mode problem. Maybe it's actually
good enough. ;-) I haven't looked at the archive-mode issue yet.
That's probably harder (since often you'll want to decompress the
tar.gz and similar, I think, so it's harder to fix than just appending
"-literally" and updating a docstring :-).
> Samuel Bronson writes:
>
> > I just tried to hexl-find-file a zip archive to figure out why
> > archive-mode wasn't able to parse it correctly, and I was rather
> > surprised to this tiny amount of text in my buffer:
>
> [elided]
>
> > If you look closely, you'll notice that this is a hexdump of an
> > `archive-mode' buffer -- not exactly very useful...
Untested patch. I'll get to testing later, but this is
straightforward enough to be "obviously correct" (famous last words).
If you could try this, I'd appreciate it.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/xemacs/XEmacs/packages/xemacs-packages/text-modes/ChangeLog,v
retrieving revision 1.179
diff -u -r1.179 ChangeLog
--- ChangeLog 19 Oct 2010 15:29:13 -0000 1.179
+++ ChangeLog 19 Oct 2010 16:10:33 -0000
＠＠ -0,0 +1,4 ＠＠
+2010-10-20 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * hexl.el (hexl-find-file): Defeat auto-mode and auto-coding magic.
+
Index: hexl.el
===================================================================
RCS file: /cvsroot/xemacs/XEmacs/packages/xemacs-packages/text-modes/hexl.el,v
retrieving revision 1.7
diff -u -r1.7 hexl.el
--- hexl.el 10 May 2005 18:20:06 -0000 1.7
+++ hexl.el 19 Oct 2010 16:10:33 -0000
＠＠ -296,11 +296,10 ＠＠
;;;###autoload
(defun hexl-find-file (filename)
"Edit file FILENAME in hexl-mode.
-Switch to a buffer visiting file FILENAME, creating one if none exists."
+Switch to a buffer visiting file FILENAME, creating one if none exists.
+See `find-file-literally' for limitations regarding existing buffers."
(interactive "fFilename: ")
- (if (featurep 'file-coding)
- (find-file filename 'binary)
- (find-file filename))
+ (find-file-literally filename)
(if (not (eq major-mode 'hexl-mode))
(hexl-mode)))
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 2 participants
- 1 comments
[21.5] Fix bug in htmlize.el
14 years, 2 months
Stephen J. Turnbull
Stephen J. Turnbull
Marcus,
Thanks for the patch. Would you please check that it works after
removing the dummy value (the hunk at 1440)? I suppose I could leave
it, but the incorrect comment has to go. Please also check the
ChangeLog for correct attribution. We don't obfuscate emails in the
logs; if that bothers you, something can be worked out.
BTW, this turns out to be a fairly recent change due to a sync
(January '09). Maybe plist-put doesn't need a setq in recent GNU
Emacs?
Index: ChangeLog
===================================================================
RCS file: /cvsroot/xemacs/XEmacs/packages/xemacs-packages/text-modes/ChangeLog,v
retrieving revision 1.178
diff -u -r1.178 ChangeLog
--- ChangeLog 6 Sep 2010 19:34:38 -0000 1.178
+++ ChangeLog 18 Oct 2010 15:06:22 -0000
＠＠ -0,0 +1,4 ＠＠
+2010-10-19 Marcus Harnisch <marcus.harnisch(a)gmx.net>
+
+ * htmlize.el (htmlize-buffer-1): Must setq plist after plist-put.
+
Index: htmlize.el
===================================================================
RCS file: /cvsroot/xemacs/XEmacs/packages/xemacs-packages/text-modes/htmlize.el,v
retrieving revision 1.15
diff -u -r1.15 htmlize.el
--- htmlize.el 6 Jan 2009 08:30:26 -0000 1.15
+++ htmlize.el 18 Oct 2010 15:06:22 -0000
＠＠ -1440,9 +1440,8 ＠＠
(file-name-nondirectory
(buffer-file-name)))
"*html*")))
- ;; Having a dummy value in the plist allows writing simply
- ;; (plist-put places foo bar).
- (places '(nil nil))
+ ;; XEmacs change; also, all plist-puts below are setq'd.
+ (places nil)
(title (if (buffer-file-name)
(file-name-nondirectory (buffer-file-name))
(buffer-name))))
＠＠ -1453,7 +1451,7 ＠＠
(format "<!-- Created by htmlize-%s in %s mode. -->\n"
htmlize-version htmlize-output-type)
"<html>\n ")
- (plist-put places 'head-start (point-marker))
+ (setq places (plist-put places 'head-start (point-marker)))
(insert "<head>\n"
" <title>" (htmlize-protect-string title) "</title>\n"
(if htmlize-html-charset
＠＠ -1464,12 +1463,12 ＠＠
htmlize-head-tags)
(htmlize-method insert-head buffer-faces face-map)
(insert " </head>")
- (plist-put places 'head-end (point-marker))
+ (setq places (plist-put places 'head-end (point-marker)))
(insert "\n ")
- (plist-put places 'body-start (point-marker))
+ (setq places (plist-put places 'body-start (point-marker)))
(insert (htmlize-method body-tag face-map)
"\n ")
- (plist-put places 'content-start (point-marker))
+ (setq places (plist-put places 'content-start (point-marker)))
(insert "<pre>\n"))
(let ((insert-text-method
;; Get the inserter method, so we can funcall it inside
＠＠ -1519,9 +1518,9 ＠＠
;; Insert the epilog and post-process the buffer.
(with-current-buffer htmlbuf
(insert "</pre>")
- (plist-put places 'content-end (point-marker))
+ (setq places (plist-put places 'content-end (point-marker)))
(insert "\n </body>")
- (plist-put places 'body-end (point-marker))
+ (setq places (plist-put places 'body-end (point-marker)))
(insert "\n</html>\n")
(when htmlize-generate-hyperlinks
(htmlize-make-hyperlinks))
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 2 participants
- 3 comments
commit: More permission consistency. (Opps, missed one.)
14 years, 2 months
Stephen J. Turnbull
Stephen J. Turnbull
changeset: 5288:061f4feaeefd
user: Stephen J. Turnbull <stephen(a)xemacs.org>
date: Mon Jun 14 15:14:20 2010 +0900
files: lisp/gnome.el
description:
More permission consistency. (Opps, missed one.)
diff -r cd167465bf69 -r 061f4feaeefd lisp/gnome.el
--- a/lisp/gnome.el Mon Jun 14 15:03:08 2010 +0900
+++ b/lisp/gnome.el Mon Jun 14 15:14:20 2010 +0900
＠＠ -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
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 2 participants
- 1 comments
commit: In emodules_load(), dereference f = dll_variable() once more.
14 years, 2 months
Stephen J. Turnbull
Stephen J. Turnbull
changeset: 5293:63f247c5da0a
tag: tip
user: Stephen J. Turnbull <stephen(a)xemacs.org>
date: Mon Oct 18 23:43:03 2010 +0900
files: src/ChangeLog src/emodules.c
description:
In emodules_load(), dereference f = dll_variable() once more.
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(a)fangorn.uio.no>.
diff -r e4305eb6fb8c -r 63f247c5da0a src/ChangeLog
--- a/src/ChangeLog Mon Oct 18 23:21:23 2010 +0900
+++ b/src/ChangeLog Mon Oct 18 23:43:03 2010 +0900
＠＠ -1,3 +1,12 ＠＠
+2010-07-06 Stephen J. Turnbull <stephen(a)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(a)fangorn.uio.no>.
+
2010-06-14 Stephen J. Turnbull <stephen(a)xemacs.org>
* ui-byhand.c:
diff -r e4305eb6fb8c -r 63f247c5da0a src/emodules.c
--- a/src/emodules.c Mon Oct 18 23:21:23 2010 +0900
+++ b/src/emodules.c Mon Oct 18 23:43:03 2010 +0900
＠＠ -390,11 +390,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);
＠＠ -403,21 +399,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);
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Merge some permissions corrections to trunk.
14 years, 2 months
Stephen J. Turnbull
Stephen J. Turnbull
changeset: 5292:e4305eb6fb8c
parent: 5291:85bd42a1e544
parent: 5285:99de5fd48e87
user: Stephen J. Turnbull <stephen(a)xemacs.org>
date: Mon Oct 18 23:21:23 2010 +0900
files: lisp/ChangeLog lisp/gtk-widget-accessors.el src/ChangeLog tests/ChangeLog
description:
Merge some permissions corrections to trunk.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: More permission consistency.
14 years, 2 months
Stephen J. Turnbull
Stephen J. Turnbull
changeset: 5291:85bd42a1e544
user: Stephen J. Turnbull <stephen(a)xemacs.org>
date: Mon Oct 18 23:03:27 2010 +0900
files: lisp/ChangeLog lisp/term/bg-mouse.el lisp/term/sup-mouse.el lisp/term/vt100.el
description:
More permission consistency.
diff -r e6508b64ee08 -r 85bd42a1e544 lisp/ChangeLog
--- a/lisp/ChangeLog Mon Jun 14 19:03:57 2010 +0900
+++ b/lisp/ChangeLog Mon Oct 18 23:03:27 2010 +0900
＠＠ -1,4 +1,12 ＠＠
2010-06-14 Stephen J. Turnbull <stephen(a)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.
diff -r e6508b64ee08 -r 85bd42a1e544 lisp/term/bg-mouse.el
--- a/lisp/term/bg-mouse.el Mon Jun 14 19:03:57 2010 +0900
+++ b/lisp/term/bg-mouse.el Mon Oct 18 23:03:27 2010 +0900
＠＠ -1,26 +1,26 ＠＠
;;; bg-mouse.el --- GNU Emacs code for BBN Bitgraph mouse.
-;; Copyright (C) Free Software Foundation, Inc. Oct 1985.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
;; Author: John Robinson <jr(a)bbn-unix.arpa>
;; Stephen Gildea <gildea(a)bbn.com>
;; Maintainer: FSF
;; Keywords: hardware
-;; This file is part of GNU Emacs.
+;; This file is part of XEmacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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.
-;; GNU Emacs is distributed in the hope that it will be useful,
+;; 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 GNU Emacs; see the file COPYING. If not, write to
+;; along with XEmacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Code:
diff -r e6508b64ee08 -r 85bd42a1e544 lisp/term/sup-mouse.el
--- a/lisp/term/sup-mouse.el Mon Jun 14 19:03:57 2010 +0900
+++ b/lisp/term/sup-mouse.el Mon Oct 18 23:03:27 2010 +0900
＠＠ -1,6 +1,6 ＠＠
;;; sup-mouse.el --- supdup mouse support for lisp machines
-;; Copyright (C) Free Software Foundation 1985, 1986
+;; Copyright (C) 1985, 1986 Free Software Foundation
;; Author: Wolfgang Rupprecht
;; Maintainer: FSF
＠＠ -9,20 +9,20 ＠＠
;; (from code originally written by John Robinson＠bbn for the bitgraph)
-;; This file is part of GNU Emacs.
+;; This file is part of XEmacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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.
-;; GNU Emacs is distributed in the hope that it will be useful,
+;; 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 GNU Emacs; see the file COPYING. If not, write to
+;; along with XEmacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Code:
diff -r e6508b64ee08 -r 85bd42a1e544 lisp/term/vt100.el
--- a/lisp/term/vt100.el Mon Jun 14 19:03:57 2010 +0900
+++ b/lisp/term/vt100.el Mon Oct 18 23:03:27 2010 +0900
＠＠ -5,20 +5,20 ＠＠
;; Author: FSF
;; Keywords: terminals
-;;; This file is part of GNU Emacs.
+;;; This file is part of XEmacs.
;;;
-;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; 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.
;;;
-;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; 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 GNU Emacs; see the file COPYING. If not, write to
+;;; along with XEmacs; see the file COPYING. If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Synched up with: FSF 21.0.103.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: More permission consistency.
14 years, 2 months
Stephen J. Turnbull
Stephen J. Turnbull
changeset: 5290:e6508b64ee08
user: Stephen J. Turnbull <stephen(a)xemacs.org>
date: Mon Jun 14 19:03:57 2010 +0900
files: ChangeLog aclocal.m4 lib-src/ChangeLog lib-src/config.values.sh lib-src/gnuserv.c lib-src/gnuserv.h lib-src/gnuslib.c lisp/ChangeLog lisp/site-load.el tests/ChangeLog tests/automated/lisp-reader-tests.el
description:
More permission consistency.
diff -r 9e51b172d50f -r e6508b64ee08 ChangeLog
--- a/ChangeLog Mon Jun 14 15:47:30 2010 +0900
+++ b/ChangeLog Mon Jun 14 19:03:57 2010 +0900
＠＠ -1,3 +1,7 ＠＠
+2010-06-14 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * aclocal.m4: Add standard permission boilerplate.
+
2010-06-02 Aidan Kehoe <kehoea(a)parhasard.net>
* version.sh.in:
diff -r 9e51b172d50f -r e6508b64ee08 aclocal.m4
--- a/aclocal.m4 Mon Jun 14 15:47:30 2010 +0900
+++ b/aclocal.m4 Mon Jun 14 19:03:57 2010 +0900
＠＠ -2,7 +2,21 ＠＠
dnl Copyright (C) 1998, 1999 J. Kean Johnston.
dnl Author: J. Kean Johnston <jkj(a)sco.com>, based on work in libtool.
dnl This file is part of XEmacs.
-
+dnl
+dnl XEmacs is free software; you can redistribute it and/or modify it
+dnl under the terms of the GNU General Public License as published by
+dnl the Free Software Foundation; either version 2, or (at your option)
+dnl any later version.
+dnl
+dnl XEmacs is distributed in the hope that it will be useful, but
+dnl WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+dnl General Public License for more details.
+dnl
+dnl You should have received a copy of the GNU General Public License
+dnl along with XEmacs; see the file COPYING. If not, write to the Free
+dnl Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+dnl Boston, MA 02110-1301, USA.
dnl
dnl There are several things we care about here. First, we need to find
dnl out how we create an executable that has its symbols exported, so
diff -r 9e51b172d50f -r e6508b64ee08 lib-src/ChangeLog
--- a/lib-src/ChangeLog Mon Jun 14 15:47:30 2010 +0900
+++ b/lib-src/ChangeLog Mon Jun 14 19:03:57 2010 +0900
＠＠ -1,4 +1,9 ＠＠
2010-06-14 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * gnuserv.c:
+ * gnuserv.h:
+ * gnuslib.c:
+ Add standard permission boilerplate.
* ad2c:
Add copyright notices based on internal evidence.
diff -r 9e51b172d50f -r e6508b64ee08 lib-src/config.values.sh
--- a/lib-src/config.values.sh Mon Jun 14 15:47:30 2010 +0900
+++ b/lib-src/config.values.sh Mon Jun 14 19:03:57 2010 +0900
＠＠ -3,6 +3,8 ＠＠
if 0;
# config.values.sh --- create config.values.in from ../configure
+
+# Copyright (C) 1997, 1999 Martin Buchholz
# Author: Martin Buchholz
# Maintainer: Martin Buchholz
diff -r 9e51b172d50f -r e6508b64ee08 lib-src/gnuserv.c
--- a/lib-src/gnuserv.c Mon Jun 14 15:47:30 2010 +0900
+++ b/lib-src/gnuserv.c Mon Jun 14 19:03:57 2010 +0900
＠＠ -2,12 +2,24 ＠＠
Server code for handling requests from clients and forwarding them
on to the XEmacs process.
+ 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(a)hplb.hpl.hp.com), based on 'etc/server.c'
from the 18.52 GNU Emacs distribution.
diff -r 9e51b172d50f -r e6508b64ee08 lib-src/gnuserv.h
--- a/lib-src/gnuserv.h Mon Jun 14 15:47:30 2010 +0900
+++ b/lib-src/gnuserv.h Mon Jun 14 19:03:57 2010 +0900
＠＠ -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(a)hplb.hpl.hp.com), based on
'etc/server.c' and 'etc/emacsclient.c' from the 18.52 GNU
diff -r 9e51b172d50f -r e6508b64ee08 lib-src/gnuslib.c
--- a/lib-src/gnuslib.c Mon Jun 14 15:47:30 2010 +0900
+++ b/lib-src/gnuslib.c Mon Jun 14 19:03:57 2010 +0900
＠＠ -1,12 +1,24 ＠＠
/* -*-C-*-
Common library code for the XEmacs server and client.
+ 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(a)hplb.hpl.hp.com), based on
'etc/server.c' and 'etc/emacsclient.c' from the 18.52 GNU
diff -r 9e51b172d50f -r e6508b64ee08 lisp/ChangeLog
--- a/lisp/ChangeLog Mon Jun 14 15:47:30 2010 +0900
+++ b/lisp/ChangeLog Mon Jun 14 19:03:57 2010 +0900
＠＠ -1,4 +1,7 ＠＠
2010-06-14 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * site-load.el:
+ Add permission boilerplate.
* mule/canna-leim.el:
* alist.el:
diff -r 9e51b172d50f -r e6508b64ee08 lisp/site-load.el
--- a/lisp/site-load.el Mon Jun 14 15:47:30 2010 +0900
+++ b/lisp/site-load.el Mon Jun 14 19:03:57 2010 +0900
＠＠ -5,6 +5,21 ＠＠
;; Keywords: internal
;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
diff -r 9e51b172d50f -r e6508b64ee08 tests/ChangeLog
--- a/tests/ChangeLog Mon Jun 14 15:47:30 2010 +0900
+++ b/tests/ChangeLog Mon Jun 14 19:03:57 2010 +0900
＠＠ -1,3 +1,8 ＠＠
+2010-06-14 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * automated/lisp-reader-tests.el:
+ Change references to SXEmacs to XEmacs.
+
2010-06-14 Stephen J. Turnbull <stephen(a)xemacs.org>
* gtk/xemacs-toolbar.el:
diff -r 9e51b172d50f -r e6508b64ee08 tests/automated/lisp-reader-tests.el
--- a/tests/automated/lisp-reader-tests.el Mon Jun 14 15:47:30 2010 +0900
+++ b/tests/automated/lisp-reader-tests.el Mon Jun 14 19:03:57 2010 +0900
＠＠ -5,20 +5,20 ＠＠
;; Created: 2005
;; Keywords: tests
-;; This file is NOT part of SXEmacs.
+;; This file is part of XEmacs.
-;; SXEmacs is free software; you can redistribute it and/or modify it
+;; 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.
-;; SXEmacs is distributed in the hope that it will be useful, but
+;; 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 SXEmacs; see the file COPYING. If not, write to the Free
+;; along with XEmacs; see the file COPYING. If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments