Mercurial > hg > xemacs-beta
changeset 4607:517f6887fbc0
Remove duplicate functions, chiefly #'delete-duplicates reimplementations.
lisp/ChangeLog addition:
2009-02-08 Aidan Kehoe <kehoea@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.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sun, 08 Feb 2009 18:45:22 +0000 |
parents | 88ba7d18dc23 |
children | 1e3cf11fa27d |
files | lisp/ChangeLog lisp/cl-macs.el lisp/font-lock.el lisp/font.el lisp/fontconfig.el lisp/format.el |
diffstat | 6 files changed, 71 insertions(+), 65 deletions(-) [+] |
line wrap: on
line diff
--- 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@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@parhasard.net> * descr-text.el (describe-text-sexp):
--- 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)
--- 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))))
--- 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."
--- 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
--- 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'."