Mercurial > hg > xemacs-beta

comparison lisp/font.el @ 4759:aa5ed11f473b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Remove support for obsolete systems. See xemacs-patches message with ID <870180fe0911101613m6b8efa4bpf083fd9013950807@mail.gmail.com>.
author Jerry James <james@xemacs.org>
date Wed, 18 Nov 2009 08:49:14 -0700
parents 90dbf8e772b6
children 32b358a240b0
comparison
equal deleted inserted replaced
4758:75975fd0b7fc 4759:aa5ed11f473b
110 (defconst font-window-system-mappings 110 (defconst font-window-system-mappings
111 '((x . (x-font-create-name x-font-create-object)) 111 '((x . (x-font-create-name x-font-create-object))
112 (gtk . (x-font-create-name x-font-create-object)) 112 (gtk . (x-font-create-name x-font-create-object))
113 ;; #### FIXME should this handle fontconfig font objects? 113 ;; #### FIXME should this handle fontconfig font objects?
114 (fc . (fc-font-create-name fc-font-create-object)) 114 (fc . (fc-font-create-name fc-font-create-object))
115 (ns . (ns-font-create-name ns-font-create-object))
116 (mswindows . (mswindows-font-create-name mswindows-font-create-object)) 115 (mswindows . (mswindows-font-create-name mswindows-font-create-object))
117 (pm . (x-font-create-name x-font-create-object)) ; Change? FIXME 116 (pm . (x-font-create-name x-font-create-object)) ; Change? FIXME
118 ;; #### what is this bogosity? 117 ;; #### what is this bogosity?
119 (tty . (tty-font-create-plist tty-font-create-object))) 118 (tty . (tty-font-create-plist tty-font-create-object)))
120 "An assoc list mapping device types to a list of translations. 119 "An assoc list mapping device types to a list of translations.
121 120
122 The first function creates a font name from a font descriptor object. 121 The first function creates a font name from a font descriptor object.
123 The second performs the reverse translation.") 122 The second performs the reverse translation.")
124
125 (defconst ns-font-weight-mappings
126 '((:extra-light . "extralight")
127 (:light . "light")
128 (:demi-light . "demilight")
129 (:medium . "medium")
130 (:normal . "medium")
131 (:demi-bold . "demibold")
132 (:bold . "bold")
133 (:extra-bold . "extrabold"))
134 "An assoc list mapping keywords to actual NeXTstep specific
135 information to use")
136 123
137 (defconst x-font-weight-mappings 124 (defconst x-font-weight-mappings
138 '((:extra-light . "extralight") 125 '((:extra-light . "extralight")
139 (:light . "light") 126 (:light . "light")
140 (:demi-light . "demilight") 127 (:demi-light . "demilight")
846 (fc-pattern-add-size pattern (font-size fontobj))) 833 (fc-pattern-add-size pattern (font-size fontobj)))
847 (fc-name-unparse pattern))) 834 (fc-name-unparse pattern)))
848 835
849 836
850 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 837 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
851 ;;; The window-system dependent code (NS-style)
852 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
853 (defun ns-font-families-for-device (&optional device no-resetp)
854 ;; For right now, assume we are going to have the same storage for
855 ;; device fonts for NS as we do for X. Is this a valid assumption?
856 (or device (setq device (selected-device)))
857 (if (boundp 'device-fonts-cache)
858 (let ((menu (or (cdr-safe (assq device device-fonts-cache)))))
859 (if (and (not menu) (not no-resetp))
860 (progn
861 (reset-device-font-menus device)
862 (ns-font-families-for-device device t))
863 (let ((scaled (mapcar #'(lambda (x) (if x (aref x 0)))
864 (aref menu 0)))
865 (normal (mapcar #'(lambda (x) (if x (aref x 0)))
866 (aref menu 1))))
867 (sort (delete-duplicates (nconc scaled normal) :test #'equal)
868 'string-lessp))))))
869
870 (defun ns-font-create-name (fontobj &optional device)
871 "Return a font name constructed from FONTOBJ, appropriate for NextSTEP devices."
872 (let ((family (or (font-family fontobj)
873 (ns-font-families-for-device device)))
874 (weight (or (font-weight fontobj) :medium))
875 (style (or (font-style fontobj) (list :normal)))
876 (size (font-size fontobj)))
877 ;; Create a font, wow!
878 (if (stringp family)
879 (setq family (list family)))
880 (if (or (symbolp style) (numberp style))
881 (setq style (list style)))
882 (setq weight (font-higher-weight weight (car-safe (memq :bold style))))
883 (if (stringp size)
884 (setq size (font-spatial-to-canonical size device)))
885 (setq weight (or (cdr-safe (assq weight ns-font-weight-mappings))
886 "medium"))
887 (let ((done nil) ; Did we find a good font yet?
888 (font-name nil) ; font name we are currently checking
889 (cur-family nil) ; current family we are checking
890 )
891 (while (and family (not done))
892 (setq cur-family (car family)
893 family (cdr family))
894 (if (assoc cur-family font-x-family-mappings)
895 ;; If the family name is an alias as defined by
896 ;; font-x-family-mappings, then append those families
897 ;; to the front of 'family' and continue in the loop.
898 ;; #### jhar: I don't know about ns font names, so using X mappings
899 (setq family (append
900 (cdr-safe (assoc cur-family
901 font-x-family-mappings))
902 family))
903 ;; CARL: Need help here - I am not familiar with the NS font
904 ;; model
905 (setq font-name "UNKNOWN FORMULA GOES HERE"
906 done (try-font-name font-name device))))
907 (if done font-name))))
908
909
910 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
911 ;;; The window-system dependent code (mswindows-style) 838 ;;; The window-system dependent code (mswindows-style)
912 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 839 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
913 840
914 (defconst mswindows-font-weight-mappings 841 (defconst mswindows-font-weight-mappings
915 '((:thin . "Thin") 842 '((:thin . "Thin")