6:46 p.m.
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1234118722 0
# Node ID 517f6887fbc0255ca386afb68f87444f7e93840e
# Parent 88ba7d18dc23a2420806492cf296b6dcddad422d
Remove duplicate functions, chiefly #'delete-duplicates reimplementations.
lisp/ChangeLog addition:
2009-02-08 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (delete-duplicates):
Add a new compiler macro, inlining this function if it's called
with a literal #'eq or #'equal test arguments and no other
keywords.
* font-lock.el (font-lock-unique):
Remove this function.
* font-lock.el (font-lock-prepend-text-property):
(font-lock-append-text-property):
Use #'delete-duplicates instead of #'font-lock-unique.
* font.el (font-unique):
Remove this function.
* font.el (font-combine-fonts-internal):
(x-font-families-for-device):
(xft-font-families-for-device):
(ns-font-families-for-device):
Use #'delete-duplicates instead of #'font-unique.
* fontconfig.el (fc-delete-duplicates):
* fontconfig.el (fc-filter):
Remove these functions.
* fontconfig.el (fc-find-available-font-families):
Replace #'fc-delete-duplicates with #'delete-duplicates,
#'fc-filter with #'delete-if-not.
* format.el (format-make-relatively-unique):
Document that this is equivalent to #'nset-exclusive-or with a
test of #'equal.
diff -r 88ba7d18dc23 -r 517f6887fbc0 lisp/ChangeLog
--- a/lisp/ChangeLog Sat Feb 07 21:55:13 2009 +0100
+++ b/lisp/ChangeLog Sun Feb 08 18:45:22 2009 +0000
＠＠ -1,3 +1,31 ＠＠
+2009-02-08 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-macs.el (delete-duplicates):
+ Add a new compiler macro, inlining this function if it's called
+ with a literal #'eq or #'equal test arguments and no other
+ keywords.
+ * font-lock.el (font-lock-unique):
+ Remove this function.
+ * font-lock.el (font-lock-prepend-text-property):
+ (font-lock-append-text-property):
+ Use #'delete-duplicates instead of #'font-lock-unique.
+ * font.el (font-unique):
+ Remove this function.
+ * font.el (font-combine-fonts-internal):
+ (x-font-families-for-device):
+ (xft-font-families-for-device):
+ (ns-font-families-for-device):
+ Use #'delete-duplicates instead of #'font-unique.
+ * fontconfig.el (fc-delete-duplicates):
+ * fontconfig.el (fc-filter):
+ Remove these functions.
+ * fontconfig.el (fc-find-available-font-families):
+ Replace #'fc-delete-duplicates with #'delete-duplicates,
+ #'fc-filter with #'delete-if-not.
+ * format.el (format-make-relatively-unique):
+ Document that this is equivalent to #'nset-exclusive-or with a
+ test of #'equal.
+
2009-02-07 Aidan Kehoe <kehoea(a)parhasard.net>
* descr-text.el (describe-text-sexp):
diff -r 88ba7d18dc23 -r 517f6887fbc0 lisp/cl-macs.el
--- a/lisp/cl-macs.el Sat Feb 07 21:55:13 2009 +0100
+++ b/lisp/cl-macs.el Sun Feb 08 18:45:22 2009 +0000
＠＠ -3169,6 +3169,30 ＠＠
(list 'let (list (list temp val)) (subst temp val res)))))
form))
+;; XEmacs; inline delete-duplicates if it's called with a literal
+;; #'equal or #'eq and no other keywords, we want the speed in
+;; font-lock.el.
+(define-compiler-macro delete-duplicates (&whole form cl-seq &rest cl-keys)
+ (cond ((and (= 4 (length form))
+ (eq :test (third form))
+ (or (equal '(quote eq) (fourth form))
+ (equal '(function eq) (fourth form))))
+ `(let* ((begin ,cl-seq)
+ (cl-seq begin))
+ (while cl-seq
+ (setq cl-seq (setcdr cl-seq (delq (car cl-seq) (cdr cl-seq)))))
+ begin))
+ ((and (= 4 (length form))
+ (eq :test (third form))
+ (or (equal '(quote equal) (fourth form))
+ (equal '(function equal) (fourth form))))
+ `(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)))
(mapc
#'(lambda (y)
diff -r 88ba7d18dc23 -r 517f6887fbc0 lisp/font-lock.el
--- a/lisp/font-lock.el Sat Feb 07 21:55:13 2009 +0100
+++ b/lisp/font-lock.el Sun Feb 08 18:45:22 2009 +0000
＠＠ -1636,27 +1636,6 ＠＠
(put-nonduplicable-text-property start next markprop value object)
(setq start (text-property-any next end markprop nil object)))))
-;; This function (from simon's unique.el) is rewritten and inlined for speed.
-;(defun unique (list function)
-; "Uniquify LIST, deleting elements using FUNCTION.
-;Return the list with subsequent duplicate items removed by side effects.
-;FUNCTION is called with an element of LIST and a list of elements from LIST,
-;and should return the list of elements with occurrences of the element removed,
-;i.e., a function such as `delete' or `delq'.
-;This function will work even if LIST is unsorted. See also `uniq'."
-; (let ((list list))
-; (while list
-; (setq list (setcdr list (funcall function (car list) (cdr list))))))
-; list)
-
-(defsubst font-lock-unique (list)
- "Uniquify LIST, deleting elements using `delq'.
-Return the list with subsequent duplicate items removed by side effects."
- (let ((list list))
- (while list
- (setq list (setcdr list (delq (car list) (cdr list))))))
- list)
-
;; A generalisation of `facemenu-add-face' for any property, but without the
;; removal of inactive faces via `facemenu-discard-redundant-faces' and special
;; treatment of `default'. Uses `unique' to remove duplicate property values.
＠＠ -1671,7 +1650,8 ＠＠
prev (get-text-property start prop object))
(put-text-property
start next prop
- (font-lock-unique (append val (if (listp prev) prev (list prev))))
+ (delete-duplicates (append val (if (listp prev) prev (list prev)))
+:test #'eq)
object)
(setq start next))))
＠＠ -1686,7 +1666,8 ＠＠
prev (get-text-property start prop object))
(put-text-property
start next prop
- (font-lock-unique (append (if (listp prev) prev (list prev)) val))
+ (delete-duplicates (append (if (listp prev) prev (list prev)) val)
+:test #'eq)
object)
(setq start next))))
diff -r 88ba7d18dc23 -r 517f6887fbc0 lisp/font.el
--- a/lisp/font.el Sat Feb 07 21:55:13 2009 +0100
+++ b/lisp/font.el Sun Feb 08 18:45:22 2009 +0000
＠＠ -295,18 +295,6 ＠＠
; (setq retval (cons type retval))))
; retval))
-;; #### only used in this file; maybe there's a cl.el function?
-(defun font-unique (list)
- (let ((retval)
- (cur))
- (while list
- (setq cur (car list)
- list (cdr list))
- (if (member cur retval)
- nil
- (setq retval (cons cur retval))))
- (nreverse retval)))
-
(defun font-higher-weight (w1 w2)
(let ((index1 (length (memq w1 font-possible-weights)))
(index2 (length (memq w2 font-possible-weights))))
＠＠ -424,8 +412,10 ＠＠
(font-spatial-to-canonical (font-size fontobj-2)))))
(set-font-weight retval (font-higher-weight (font-weight fontobj-1)
(font-weight fontobj-2)))
- (set-font-family retval (font-unique (append (font-family fontobj-1)
- (font-family fontobj-2))))
+ (set-font-family retval
+ (delete-duplicates (append (font-family fontobj-1)
+ (font-family fontobj-2)))
+:test #'equal)
(set-font-style retval (logior (font-style fontobj-1)
(font-style fontobj-2)))
(set-font-registry retval (or (font-registry fontobj-1)
＠＠ -651,7 +641,8 ＠＠
(aref menu 0)))
(normal (mapcar #'(lambda (x) (if x (aref x 0)))
(aref menu 1))))
- (sort (font-unique (nconc scaled normal)) 'string-lessp))))
+ (sort (delete-duplicates (nconc scaled normal) :test 'equal)
+ 'string-lessp))))
(cons "monospace" (mapcar 'car font-x-family-mappings))))
(defun x-font-create-name (fontobj &optional device)
＠＠ -842,7 +833,8 ＠＠
(aref menu 0)))
(normal (mapcar #'(lambda (x) (if x (aref x 0)))
(aref menu 1))))
- (sort (font-unique (nconc scaled normal)) 'string-lessp))))
+ (sort (delete-duplicates (nconc scaled normal) :test #'equal)
+ 'string-lessp))))
;; #### FIXME clearly bogus for Xft
(cons "monospace" (mapcar 'car font-xft-family-mappings))))
＠＠ -872,7 +864,8 ＠＠
(aref menu 0)))
(normal (mapcar #'(lambda (x) (if x (aref x 0)))
(aref menu 1))))
- (sort (font-unique (nconc scaled normal)) 'string-lessp))))))
+ (sort (delete-duplicates (nconc scaled normal) :test #'equal)
+ 'string-lessp))))))
(defun ns-font-create-name (fontobj &optional device)
"Return a font name constructed from FONTOBJ, appropriate for NextSTEP
devices."
diff -r 88ba7d18dc23 -r 517f6887fbc0 lisp/fontconfig.el
--- a/lisp/fontconfig.el Sat Feb 07 21:55:13 2009 +0100
+++ b/lisp/fontconfig.el Sun Feb 08 18:45:22 2009 +0000
＠＠ -494,13 +494,13 ＠＠
(objectset '("family" "style")))
(let* ((all-fonts
(fc-list-fonts-pattern-objects device pattern objectset)))
- (fc-delete-duplicates
+ (delete-duplicates
(mapcar
#'(lambda (pattern)
(fc-pattern-get-family pattern 0))
(if filter-fun
- (fc-filter all-fonts filter-fun)
- all-fonts))))))
+ (delete-if-not filter-fun all-fonts)
+ all-fonts)) :test #'equal))))
(defun fc-find-available-weights-for-family (family &optional style device)
"Find available weights for font FAMILY."
＠＠ -534,28 +534,6 ＠＠
(not (equal result 'fc-result-no-id))
(not (equal result 'fc-internal-error))))
-;;; DELETE-DUPLICATES and REMOVE-DUPLICATES from cl-seq.el do not
-;;; seem to work on list of strings...
-;;; #### Presumably just use :test 'equal!
-(defun fc-delete-duplicates (l)
- (let ((res nil)
- (in l))
- (while (not (null in))
- (if (not (member (car in) res))
- (setq res (append res (list (car in)))))
- (setq in (cdr in)))
- res))
-
-;; #### Use delete-if with :test 'equal.
-(defun fc-filter (l fun)
- (let ((res nil)
- (in l))
- (while (not (null in))
- (if (funcall fun (car in))
- (setq res (append res (list (car in)))))
- (setq in (cdr in)))
- res))
-
(provide 'fontconfig)
;;; fontconfig.el ends here
diff -r 88ba7d18dc23 -r 517f6887fbc0 lisp/format.el
--- a/lisp/format.el Sat Feb 07 21:55:13 2009 +0100
+++ b/lisp/format.el Sun Feb 08 18:45:22 2009 +0000
＠＠ -454,6 +454,8 ＠＠
(setcdr p (cdr cons))
list)))
+;; XEmacs: this is #'nset-exclusive-or with a :test of #'equal, though we
+;; probably don't want to replace it right now.
(defun format-make-relatively-unique (a b)
"Delete common elements of lists A and B, return as pair.
Compares using `equal'."
--
¿Dónde estará ahora mi sobrino Yoghurtu Nghe, que tuvo que huir
precipitadamente de la aldea por culpa de la escasez de rinocerontes?
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches