Mercurial > hg > xemacs-beta
comparison lisp/x-faces.el @ 3918:049dc907c17a
[xemacs-hg @ 2007-04-22 19:58:27 by aidan]
Make the X11 font menu work again, server side X11 with Mule.
| author | aidan |
|---|---|
| date | Sun, 22 Apr 2007 19:58:59 +0000 |
| parents | c13b89ba4796 |
| children | cef5f57bb9e2 |
comparison
equal
deleted
inserted
replaced
| 3917:b8ded6c3f2a4 | 3918:049dc907c17a |
|---|---|
| 72 '(fc-font-name-weight-bold fc-font-name-weight-black | 72 '(fc-font-name-weight-bold fc-font-name-weight-black |
| 73 fc-font-name-weight-demibold fc-font-name-weight-medium | 73 fc-font-name-weight-demibold fc-font-name-weight-medium |
| 74 fc-font-name-slant-oblique fc-font-name-slant-italic | 74 fc-font-name-slant-oblique fc-font-name-slant-italic |
| 75 fc-font-name-slant-roman)) | 75 fc-font-name-slant-roman)) |
| 76 (globally-declare-fboundp | 76 (globally-declare-fboundp |
| 77 '(fc-pattern-del-size fc-pattern-get-size fc-pattern-add-size | 77 '(fc-font-match fc-pattern-del-size fc-pattern-get-size |
| 78 fc-pattern-del-style fc-pattern-duplicate fc-copy-pattern-partial | 78 fc-pattern-add-size fc-pattern-del-style fc-pattern-duplicate |
| 79 fc-pattern-add-weight fc-pattern-del-weight fc-try-font | 79 fc-copy-pattern-partial fc-pattern-add-weight fc-pattern-del-weight |
| 80 fc-pattern-del-slant fc-pattern-add-slant fc-name-unparse | 80 fc-try-font fc-pattern-del-slant fc-pattern-add-slant fc-name-parse |
| 81 fc-pattern-get-pixelsize))) | 81 fc-name-unparse fc-pattern-get-pixelsize))) |
| 82 | 82 |
| 83 (defconst x-font-regexp nil) | 83 (defconst x-font-regexp nil) |
| 84 (defconst x-font-regexp-head nil) | 84 (defconst x-font-regexp-head nil) |
| 85 (defconst x-font-regexp-head-2 nil) | 85 (defconst x-font-regexp-head-2 nil) |
| 86 (defconst x-font-regexp-weight nil) | 86 (defconst x-font-regexp-weight nil) |
| 651 ;;; | 651 ;;; |
| 652 ;;; This had better not signal an error. The frame is in an intermediate | 652 ;;; This had better not signal an error. The frame is in an intermediate |
| 653 ;;; state where signalling an error or entering the debugger would likely | 653 ;;; state where signalling an error or entering the debugger would likely |
| 654 ;;; result in a crash. | 654 ;;; result in a crash. |
| 655 | 655 |
| 656 ;; When we initialise a face from an X resource, note that we did so. | |
| 657 (define-specifier-tag 'x-resource) | |
| 658 | |
| 656 (defun x-init-face-from-resources (face &optional locale set-anyway) | 659 (defun x-init-face-from-resources (face &optional locale set-anyway) |
| 657 | 660 |
| 658 ;; | 661 ;; |
| 659 ;; These are things like "attributeForeground" instead of simply | 662 ;; These are things like "attributeForeground" instead of simply |
| 660 ;; "foreground" because people tend to do things like "*foreground", | 663 ;; "foreground" because people tend to do things like "*foreground", |
| 679 ;; function uses the list cdrs. We want to remove (x | 682 ;; function uses the list cdrs. We want to remove (x |
| 680 ;; default) and (default) specs, not (default x) and (x) | 683 ;; default) and (default) specs, not (default x) and (x) |
| 681 ;; specs. | 684 ;; specs. |
| 682 (x-tag-set '(x default)) | 685 (x-tag-set '(x default)) |
| 683 (tty-tag-set '(tty default)) | 686 (tty-tag-set '(tty default)) |
| 687 (our-tag-set '(x x-resource)) | |
| 684 (device-class nil) | 688 (device-class nil) |
| 685 (face-sym (face-name face)) | 689 (face-sym (face-name face)) |
| 686 (name (symbol-name face-sym)) | 690 (name (symbol-name face-sym)) |
| 687 (fn (x-get-resource-and-maybe-bogosity-check | 691 (fn (x-get-resource-and-maybe-bogosity-check |
| 688 (concat name ".attributeFont") | 692 (concat name ".attributeFont") |
| 736 (setq device-class (device-class locale)))) | 740 (setq device-class (device-class locale)))) |
| 737 | 741 |
| 738 (if device-class | 742 (if device-class |
| 739 (setq tag-set (cons device-class tag-set) | 743 (setq tag-set (cons device-class tag-set) |
| 740 x-tag-set (cons device-class x-tag-set) | 744 x-tag-set (cons device-class x-tag-set) |
| 741 tty-tag-set (cons device-class tty-tag-set))) | 745 tty-tag-set (cons device-class tty-tag-set) |
| 746 our-tag-set (cons device-class our-tag-set))) | |
| 742 | 747 |
| 743 ;; | 748 ;; |
| 744 ;; If this is the default face, then any unspecified properties should | 749 ;; If this is the default face, then any unspecified properties should |
| 745 ;; be defaulted from the global properties. Can't do this for | 750 ;; be defaulted from the global properties. Can't do this for |
| 746 ;; frames or devices because then, common resource specs like | 751 ;; frames or devices because then, common resource specs like |
| 780 x-tag-set) | 785 x-tag-set) |
| 781 ;; If there's no device class then we're initializing | 786 ;; If there's no device class then we're initializing |
| 782 ;; globally. This means we should override global | 787 ;; globally. This means we should override global |
| 783 ;; defaults for all X device classes. | 788 ;; defaults for all X device classes. |
| 784 (remove-specifier (face-font face) locale x-tag-set nil)) | 789 (remove-specifier (face-font face) locale x-tag-set nil)) |
| 785 (set-face-font face fn locale 'x append) | 790 (set-face-font face fn locale our-tag-set append) |
| 786 ; | 791 |
| 787 ; (debug-print "the face is %s, locale %s, specifier %s" | |
| 788 ; face locale (face-font face)) | |
| 789 ; | |
| 790 ;; And retain some of the fallbacks in the generated default face, | 792 ;; And retain some of the fallbacks in the generated default face, |
| 791 ;; since we don't want to try andale-mono's ISO-10646-1 encoding for | 793 ;; since we don't want to try andale-mono's ISO-10646-1 encoding for |
| 792 ;; Amharic or Thai. This is fragile; it depends on the code in | 794 ;; Amharic or Thai. |
| 793 ;; faces.c. | 795 (when (and (specifierp (face-font face)) |
| 794 (unless (featurep 'xft-fonts) | 796 (consp (specifier-fallback (face-font face)))) |
| 795 (dolist (assocked '((x encode-as-utf-8 initial) | 797 (loop |
| 796 (x two-dimensional initial) | 798 for (tag-set . instantiator) |
| 797 (x one-dimensional final) | 799 in (specifier-fallback (face-font face)) |
| 798 (x two-dimensional final))) | 800 if (memq 'x-coverage-instantiator tag-set) |
| 799 (when (and (specifierp (face-font face)) | 801 do (add-spec-list-to-specifier |
| 800 (consp (specifier-fallback (face-font face))) | 802 (face-font face) |
| 801 (setq assocked | 803 (list (cons (or locale 'global) |
| 802 (assoc assocked | 804 (list (cons tag-set instantiator)))) |
| 803 (specifier-fallback | 805 append)))) |
| 804 (face-font face))))) | |
| 805 (set-face-font face (cdr assocked) locale | |
| 806 (nreverse (car assocked)) append))))) | |
| 807 | 806 |
| 808 ;; Kludge-o-rooni. Set the foreground and background resources for | 807 ;; Kludge-o-rooni. Set the foreground and background resources for |
| 809 ;; X devices only -- otherwise things tend to get all messed up | 808 ;; X devices only -- otherwise things tend to get all messed up |
| 810 ;; if you start up an X frame and then later create a TTY frame. | 809 ;; if you start up an X frame and then later create a TTY frame. |
| 811 (when fg | 810 (when fg |
| 812 (if device-class | 811 (if device-class |
| 813 (remove-specifier-specs-matching-tag-set-cdrs (face-foreground face) | 812 (remove-specifier-specs-matching-tag-set-cdrs (face-foreground face) |
| 814 locale | 813 locale |
| 815 x-tag-set) | 814 x-tag-set) |
| 816 (remove-specifier (face-foreground face) locale x-tag-set nil)) | 815 (remove-specifier (face-foreground face) locale x-tag-set nil)) |
| 817 (set-face-foreground face fg locale 'x append)) | 816 (set-face-foreground face fg locale our-tag-set append)) |
| 818 (when bg | 817 (when bg |
| 819 (if device-class | 818 (if device-class |
| 820 (remove-specifier-specs-matching-tag-set-cdrs (face-background face) | 819 (remove-specifier-specs-matching-tag-set-cdrs (face-background face) |
| 821 locale | 820 locale |
| 822 x-tag-set) | 821 x-tag-set) |
| 823 (remove-specifier (face-background face) locale x-tag-set nil)) | 822 (remove-specifier (face-background face) locale x-tag-set nil)) |
| 824 (set-face-background face bg locale 'x append)) | 823 (set-face-background face bg locale our-tag-set append)) |
| 825 (when bgp | 824 (when bgp |
| 826 (if device-class | 825 (if device-class |
| 827 (remove-specifier-specs-matching-tag-set-cdrs (face-background-pixmap | 826 (remove-specifier-specs-matching-tag-set-cdrs (face-background-pixmap |
| 828 face) | 827 face) |
| 829 locale | 828 locale |
| 830 x-tag-set) | 829 x-tag-set) |
| 831 (remove-specifier (face-background-pixmap face) locale x-tag-set nil)) | 830 (remove-specifier (face-background-pixmap face) locale x-tag-set nil)) |
| 832 (set-face-background-pixmap face bgp locale nil append)) | 831 (set-face-background-pixmap face bgp locale our-tag-set append)) |
| 833 (when ulp | 832 (when ulp |
| 834 (if device-class | 833 (if device-class |
| 835 (remove-specifier-specs-matching-tag-set-cdrs (face-property | 834 (remove-specifier-specs-matching-tag-set-cdrs (face-property |
| 836 face 'underline) | 835 face 'underline) |
| 837 locale | 836 locale |
| 838 tty-tag-set) | 837 tty-tag-set) |
| 839 (remove-specifier (face-property face 'underline) locale | 838 (remove-specifier (face-property face 'underline) locale |
| 840 tty-tag-set nil)) | 839 tty-tag-set nil)) |
| 841 (set-face-underline-p face ulp locale nil append)) | 840 (set-face-underline-p face ulp locale our-tag-set append)) |
| 842 (when stp | 841 (when stp |
| 843 (if device-class | 842 (if device-class |
| 844 (remove-specifier-specs-matching-tag-set-cdrs (face-property | 843 (remove-specifier-specs-matching-tag-set-cdrs (face-property |
| 845 face 'strikethru) | 844 face 'strikethru) |
| 846 locale | 845 locale |
| 847 tty-tag-set) | 846 tty-tag-set) |
| 848 (remove-specifier (face-property face 'strikethru) | 847 (remove-specifier (face-property face 'strikethru) |
| 849 locale tty-tag-set nil)) | 848 locale tty-tag-set nil)) |
| 850 (set-face-strikethru-p face stp locale nil append)) | 849 (set-face-strikethru-p face stp locale our-tag-set append)) |
| 851 (when hp | 850 (when hp |
| 852 (if device-class | 851 (if device-class |
| 853 (remove-specifier-specs-matching-tag-set-cdrs (face-property | 852 (remove-specifier-specs-matching-tag-set-cdrs (face-property |
| 854 face 'highlight) | 853 face 'highlight) |
| 855 locale | 854 locale |
| 856 tty-tag-set) | 855 tty-tag-set) |
| 857 (remove-specifier (face-property face 'highlight) | 856 (remove-specifier (face-property face 'highlight) |
| 858 locale tty-tag-set nil)) | 857 locale tty-tag-set nil)) |
| 859 (set-face-highlight-p face hp locale nil append)) | 858 (set-face-highlight-p face hp locale our-tag-set append)) |
| 860 (when dp | 859 (when dp |
| 861 (if device-class | 860 (if device-class |
| 862 (remove-specifier-specs-matching-tag-set-cdrs (face-property | 861 (remove-specifier-specs-matching-tag-set-cdrs (face-property |
| 863 face 'dim) | 862 face 'dim) |
| 864 locale | 863 locale |
| 865 tty-tag-set) | 864 tty-tag-set) |
| 866 (remove-specifier (face-property face 'dim) locale tty-tag-set nil)) | 865 (remove-specifier (face-property face 'dim) locale tty-tag-set nil)) |
| 867 (set-face-dim-p face dp locale nil append)) | 866 (set-face-dim-p face dp locale our-tag-set append)) |
| 868 (when bp | 867 (when bp |
| 869 (if device-class | 868 (if device-class |
| 870 (remove-specifier-specs-matching-tag-set-cdrs (face-property | 869 (remove-specifier-specs-matching-tag-set-cdrs (face-property |
| 871 face 'blinking) | 870 face 'blinking) |
| 872 locale | 871 locale |
| 873 tty-tag-set) | 872 tty-tag-set) |
| 874 (remove-specifier (face-property face 'blinking) locale | 873 (remove-specifier (face-property face 'blinking) locale |
| 875 tty-tag-set nil)) | 874 tty-tag-set nil)) |
| 876 (set-face-blinking-p face bp locale nil append)) | 875 (set-face-blinking-p face bp locale our-tag-set append)) |
| 877 (when rp | 876 (when rp |
| 878 (if device-class | 877 (if device-class |
| 879 (remove-specifier-specs-matching-tag-set-cdrs (face-property | 878 (remove-specifier-specs-matching-tag-set-cdrs (face-property |
| 880 face 'reverse) | 879 face 'reverse) |
| 881 locale | 880 locale |
| 882 tty-tag-set) | 881 tty-tag-set) |
| 883 (remove-specifier (face-property face 'reverse) locale | 882 (remove-specifier (face-property face 'reverse) locale |
| 884 tty-tag-set nil)) | 883 tty-tag-set nil)) |
| 885 (set-face-reverse-p face rp locale nil append)) | 884 (set-face-reverse-p face rp locale our-tag-set append)) |
| 886 )) | 885 )) |
| 887 | 886 |
| 888 ;; GNU Emacs compatibility. (move to obsolete.el?) | 887 ;; GNU Emacs compatibility. (move to obsolete.el?) |
| 889 (defalias 'make-face-x-resource-internal 'x-init-face-from-resources) | 888 (defalias 'make-face-x-resource-internal 'x-init-face-from-resources) |
| 890 | 889 |