Mercurial > hg > xemacs-beta

comparison lisp/font.el @ 4607:517f6887fbc0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 de0228446b18
children 90dbf8e772b6
comparison
equal deleted inserted replaced
4606:88ba7d18dc23 4607:517f6887fbc0
292 ; (setq func (cdr (cdr (car todo))) 292 ; (setq func (cdr (cdr (car todo)))
293 ; type (car (pop todo))) 293 ; type (car (pop todo)))
294 ; (if (funcall func fontobj) 294 ; (if (funcall func fontobj)
295 ; (setq retval (cons type retval)))) 295 ; (setq retval (cons type retval))))
296 ; retval)) 296 ; retval))
297
298 ;; #### only used in this file; maybe there's a cl.el function?
299 (defun font-unique (list)
300 (let ((retval)
301 (cur))
302 (while list
303 (setq cur (car list)
304 list (cdr list))
305 (if (member cur retval)
306 nil
307 (setq retval (cons cur retval))))
308 (nreverse retval)))
309 297
310 (defun font-higher-weight (w1 w2) 298 (defun font-higher-weight (w1 w2)
311 (let ((index1 (length (memq w1 font-possible-weights))) 299 (let ((index1 (length (memq w1 font-possible-weights)))
312 (index2 (length (memq w2 font-possible-weights)))) 300 (index2 (length (memq w2 font-possible-weights))))
313 (cond 301 (cond
422 (font-spatial-to-canonical (font-size fontobj-1)))) 410 (font-spatial-to-canonical (font-size fontobj-1))))
423 (size-2 (and (font-size fontobj-2) 411 (size-2 (and (font-size fontobj-2)
424 (font-spatial-to-canonical (font-size fontobj-2))))) 412 (font-spatial-to-canonical (font-size fontobj-2)))))
425 (set-font-weight retval (font-higher-weight (font-weight fontobj-1) 413 (set-font-weight retval (font-higher-weight (font-weight fontobj-1)
426 (font-weight fontobj-2))) 414 (font-weight fontobj-2)))
427 (set-font-family retval (font-unique (append (font-family fontobj-1) 415 (set-font-family retval
428 (font-family fontobj-2)))) 416 (delete-duplicates (append (font-family fontobj-1)
417 (font-family fontobj-2)))
418 :test #'equal)
429 (set-font-style retval (logior (font-style fontobj-1) 419 (set-font-style retval (logior (font-style fontobj-1)
430 (font-style fontobj-2))) 420 (font-style fontobj-2)))
431 (set-font-registry retval (or (font-registry fontobj-1) 421 (set-font-registry retval (or (font-registry fontobj-1)
432 (font-registry fontobj-2))) 422 (font-registry fontobj-2)))
433 (set-font-encoding retval (or (font-encoding fontobj-1) 423 (set-font-encoding retval (or (font-encoding fontobj-1)
649 (x-font-families-for-device device t)) 639 (x-font-families-for-device device t))
650 (let ((scaled (mapcar #'(lambda (x) (if x (aref x 0))) 640 (let ((scaled (mapcar #'(lambda (x) (if x (aref x 0)))
651 (aref menu 0))) 641 (aref menu 0)))
652 (normal (mapcar #'(lambda (x) (if x (aref x 0))) 642 (normal (mapcar #'(lambda (x) (if x (aref x 0)))
653 (aref menu 1)))) 643 (aref menu 1))))
654 (sort (font-unique (nconc scaled normal)) 'string-lessp)))) 644 (sort (delete-duplicates (nconc scaled normal) :test 'equal)
645 'string-lessp))))
655 (cons "monospace" (mapcar 'car font-x-family-mappings)))) 646 (cons "monospace" (mapcar 'car font-x-family-mappings))))
656 647
657 (defun x-font-create-name (fontobj &optional device) 648 (defun x-font-create-name (fontobj &optional device)
658 "Return a font name constructed from FONTOBJ, appropriate for X devices." 649 "Return a font name constructed from FONTOBJ, appropriate for X devices."
659 (if (and (not (or (font-family fontobj) 650 (if (and (not (or (font-family fontobj)
840 ;; #### FIXME clearly bogus for Xft 831 ;; #### FIXME clearly bogus for Xft
841 (let ((scaled (mapcar #'(lambda (x) (if x (aref x 0))) 832 (let ((scaled (mapcar #'(lambda (x) (if x (aref x 0)))
842 (aref menu 0))) 833 (aref menu 0)))
843 (normal (mapcar #'(lambda (x) (if x (aref x 0))) 834 (normal (mapcar #'(lambda (x) (if x (aref x 0)))
844 (aref menu 1)))) 835 (aref menu 1))))
845 (sort (font-unique (nconc scaled normal)) 'string-lessp)))) 836 (sort (delete-duplicates (nconc scaled normal) :test #'equal)
837 'string-lessp))))
846 ;; #### FIXME clearly bogus for Xft 838 ;; #### FIXME clearly bogus for Xft
847 (cons "monospace" (mapcar 'car font-xft-family-mappings)))) 839 (cons "monospace" (mapcar 'car font-xft-family-mappings))))
848 840
849 (defun xft-font-create-name (fontobj &optional device) 841 (defun xft-font-create-name (fontobj &optional device)
850 (let* ((pattern (make-fc-pattern))) 842 (let* ((pattern (make-fc-pattern)))
870 (ns-font-families-for-device device t)) 862 (ns-font-families-for-device device t))
871 (let ((scaled (mapcar #'(lambda (x) (if x (aref x 0))) 863 (let ((scaled (mapcar #'(lambda (x) (if x (aref x 0)))
872 (aref menu 0))) 864 (aref menu 0)))
873 (normal (mapcar #'(lambda (x) (if x (aref x 0))) 865 (normal (mapcar #'(lambda (x) (if x (aref x 0)))
874 (aref menu 1)))) 866 (aref menu 1))))
875 (sort (font-unique (nconc scaled normal)) 'string-lessp)))))) 867 (sort (delete-duplicates (nconc scaled normal) :test #'equal)
868 'string-lessp))))))
876 869
877 (defun ns-font-create-name (fontobj &optional device) 870 (defun ns-font-create-name (fontobj &optional device)
878 "Return a font name constructed from FONTOBJ, appropriate for NextSTEP devices." 871 "Return a font name constructed from FONTOBJ, appropriate for NextSTEP devices."
879 (let ((family (or (font-family fontobj) 872 (let ((family (or (font-family fontobj)
880 (ns-font-families-for-device device))) 873 (ns-font-families-for-device device)))