Mercurial > hg > xemacs-beta
annotate lisp/fontconfig.el @ 5292:e4305eb6fb8c
Merge some permissions corrections to trunk.
| author | Stephen J. Turnbull <stephen@xemacs.org> |
|---|---|
| date | Mon, 18 Oct 2010 23:21:23 +0900 |
| parents | cd167465bf69 |
| children | 3889ef128488 b9167d522a9a |
| rev | line source |
|---|---|
| 3094 | 1 ;;; fontconfig.el --- New font model, NG |
| 2 | |
| 3 ;; Copyright (c) 2003 Eric Knauel and Matthias Neubauer | |
| 4 ;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. | |
| 5 | |
| 6 ;; Authors: Eric Knauel <knauel@informatik.uni-tuebingen.de> | |
| 7 ;; Matthias Neubauer <neubauer@informatik.uni-freiburg.de> | |
| 8 ;; Stephen J. Turnbull <stephen@xemacs.org> | |
| 9 ;; Created: 27 Oct 2003 | |
| 10 ;; Updated: 05 Mar 2005 by Stephen J. Turnbull | |
| 11 ;; Keywords: faces | |
| 12 | |
|
5287
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4607
diff
changeset
|
13 ;; This file is part of XEmacs. |
|
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4607
diff
changeset
|
14 |
| 3094 | 15 ;; XEmacs is free software; you can redistribute it and/or modify it |
| 16 ;; under the terms of the GNU General Public License as published by | |
| 17 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 18 ;; any later version. | |
| 19 | |
| 20 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 23 ;; General Public License for more details. | |
| 24 | |
| 25 ;; You should have received a copy of the GNU General Public License | |
| 26 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
| 27 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
| 28 ;; 02111-1307, USA. | |
| 29 | |
| 30 ;;; Synched up with: Not in GNU | |
| 31 | |
| 32 ;;; Commentary: | |
| 33 | |
| 34 ;; This file is one of the pillars of the face refactoring effort | |
| 35 ;; (another will be colorconfig.el, and there may be others). | |
| 36 | |
| 37 ;; The overall plan is to have a sensible modern model for values of | |
| 38 ;; each of the components of a face (starting with fonts and colors), | |
| 39 ;; implemented in a single module. Of course we must be able to | |
| 40 ;; convert such values to appropriate descriptors for any device type | |
| 41 ;; on the one hand, but on the other it seems unreasonable to force | |
| 42 ;; users to deal with a large number of different (and arcane, in the | |
| 43 ;; case of XLFD) naming formats. | |
| 44 | |
| 45 ;; This file implements font specification. We call a specification a | |
| 46 ;; *pattern* to conform to fontconfig usage. The internal | |
| 47 ;; representation of a pattern will have Keith Packard's fontconfig | |
| 48 ;; API. For one, there is a robust and free C implementation, which | |
| 49 ;; is available as a package for all platforms supported by X.org or | |
| 50 ;; XFree86. For another, it seems to be capable of representing any | |
| 51 ;; specification of any of the font models I know. Third, on X | |
| 52 ;; platforms that internal representation can be passed verbatim to | |
| 53 ;; libXft to get high quality TrueType fonts rendered with | |
| 54 ;; anti-aliasing and hinting. | |
| 55 | |
| 56 ;; We will support the following user interfaces: | |
| 57 | |
| 58 ;; 1. fontconfig font names | |
| 59 ;; 2. X Logical Font Descriptions (XLFD) | |
| 60 ;; 3. MS Windows font names | |
| 61 ;; 4. Mac OS X font names | |
| 62 | |
| 63 ;; and possibly others (such as ad hoc abbreviations used in older X11 | |
| 64 ;; implementations). This is called the *fontname UI* (for the | |
| 65 ;; platform) to distinguish it from XEmacs's internal model | |
| 66 ;; (fontconfig patterns) and the API for rendering engines (called the | |
| 67 ;; *font API* for the engine). | |
| 68 | |
| 69 ;; We will support the following rendering engine APIs: | |
| 70 | |
| 71 ;; 1. fontconfig patterns (the native language of Xft); to emphasize | |
| 72 ;; the engine-specific nature, we will call these *Xft fonts* | |
| 73 ;; 2. XLFD strings | |
| 74 ;; 3. MS Windows font names | |
| 75 | |
| 76 ;; and possibly others (such as Mac OS X font names). This is called | |
| 77 ;; the *font API* (for the platform) to distinguish it from XEmacs's | |
| 78 ;; internal model (fontconfig *patterns*) and the names used by users | |
| 79 ;; (called the *fontname UI* for the platform). | |
| 80 | |
| 81 | |
| 82 ;; TODO (possible enhancements) | |
| 83 ;; 1. add a more complete docstring for properties as such (would be a | |
| 84 ;; hash table?) to describe things like special symbolic values, and | |
| 85 ;; Emacs-relevant semantics | |
| 86 ;; 2. add a special value defining macro for constants | |
| 87 | |
| 88 ;;; Code: | |
| 89 | |
| 90 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 91 ;; | |
| 92 ;; The fontconfig pattern API | |
| 93 ;; | |
| 3360 | 94 ;; The basic interfaces are defined as API wrappers in C in font-mgr.c. |
| 95 ;; These are prefixed with "fc-pattern-". These are | |
| 3094 | 96 ;; |
| 97 ;; fc-pattern-p | |
| 98 ;; fc-pattern-create | |
| 99 ;; fc-pattern-duplicate | |
| 100 ;; fc-pattern-add | |
| 101 ;; fc-pattern-del | |
| 102 ;; fc-pattern-get | |
| 103 ;; fc-pattern-destroy | |
| 104 | |
| 105 ;; We provide a LISP-y alias, `make-fc-pattern' for the pattern | |
| 106 ;; constructor function `fc-pattern-create'. #### It might make sense | |
| 107 ;; to generalize `make-fc-pattern' by allowing a plist of properties | |
| 108 ;; as an optional argument. We also provide accessors | |
| 3354 | 109 ;; `fc-pattern-get-PROPERTY' and mutators `fc-pattern-add-PROPERTY' and |
| 110 ;; `fc-pattern-del-PROPERTY' for each of the standard properties used by | |
| 111 ;; Xft, which overlap substantially with the properties defined by X11. | |
| 112 | |
| 113 (require 'font-mgr) | |
| 3094 | 114 |
| 115 (defalias 'make-fc-pattern 'fc-pattern-create) | |
| 116 | |
| 117 (defmacro fc-define-property (property type docfrag &optional obsolete-p) | |
| 118 "Define PROPERTY as a fontconfig font property of type TYPE using DOCFRAG. | |
| 119 | |
| 120 A font property is a key in a fontconfig pattern and is associated with | |
| 121 one or more values of a given type. This macro creates wrappers around | |
| 3354 | 122 `fc-pattern-get', `fc-pattern-add', and `fc-pattern-del' for PROPERTY. |
| 123 \(Wrappers are preferred to use of primitives with a string as the OBJECT | |
| 124 argument because typos in wrappers result in \"not fboundp\" errors, while | |
| 125 a typo in a string produces a silent null return.) | |
| 3094 | 126 |
| 127 PROPERTY is a string. | |
| 128 TYPE is a symbol indicating the type of the property value. It is used only | |
| 129 to modify formatting of the wrapper function docstrings. | |
| 130 DOCFRAG is a string which briefly describes the use of the property, and is | |
| 131 interpolated into a format to create the doctstrings. | |
| 132 OBSOLETE-P if non-nil marks the property as pertaining only to older versions | |
| 133 of fontconfig or Xft. This merely adds a deprecation to the docstrings. | |
| 134 | |
| 135 This macro defines an accessor named `fc-pattern-get-PROPERTY' which takes | |
| 136 a fontconfig pattern object and an integer as arguments, and returns the | |
| 137 value associated with PROPERTY and ID in the pattern object. Since it is | |
| 138 not possible to associate a value to PROPERTY for a particular ID, it is | |
| 139 not very useful to interpret the values associated with a given id for | |
| 140 different properties as being linked to each other in some way. | |
| 141 | |
| 142 A mutator `fc-pattern-add-PROPERTY' which takes a fontconfig pattern object | |
| 143 and a value as arguments, and adds the value to the property with the next | |
| 144 id. The type of the value is recognized by `fc-pattern-add', and the id | |
| 3354 | 145 is chosen by the fontconfig implementation. |
| 146 | |
| 147 A mutator `fc-pattern-del-PROPERTY' which takes a fontconfig pattern object, | |
| 148 and deletes all values of that property from the pattern." | |
| 3094 | 149 |
| 150 `(progn | |
| 151 (defsubst ,(intern (concat "fc-pattern-get-" property)) | |
| 152 (pattern id) | |
| 153 ,(format "\ | |
| 154 Return %s %s fc pattern PATTERN %s.%s | |
| 155 | |
| 156 This function is a convenience wrapper for `fc-pattern-get'. | |
| 157 See `fc-pattern-get' for documentation of patterns, ids, and error returns." | |
| 158 (if (eq type 'boolean) | |
| 159 "t" | |
| 160 docfrag) | |
| 161 (if (eq type 'boolean) | |
| 162 "if" | |
| 163 "associated with id ID in") | |
| 164 (if (eq type 'boolean) | |
| 165 docfrag | |
| 166 (format "as a%s %s" (if (eq type 'integer) "n" "") type)) | |
| 167 (if obsolete-p " | |
| 168 \(Obsolete, only available on systems using Xft version 1.)" | |
| 169 "")) | |
| 170 (fc-pattern-get pattern ,property id)) | |
| 171 | |
| 172 (defsubst ,(intern (concat "fc-pattern-add-" property)) | |
| 173 (pattern value) | |
| 174 ,(format "\ | |
| 175 Add VALUE to the %s property of fontconfig pattern PATTERN.%s | |
| 176 | |
| 177 The type of VALUE should be %s. | |
| 178 | |
| 179 This function is a convenience wrapper for `fc-pattern-add'. | |
| 180 See `fc-pattern-add' for documentation of patterns, values, and error returns." | |
| 181 property | |
| 182 (if obsolete-p " | |
| 183 \(Obsolete, only available on systems using Xft version 1.)" | |
| 184 "") | |
| 185 type) | |
| 186 (fc-pattern-add pattern ,property value)) | |
| 3354 | 187 |
| 188 (defsubst ,(intern (concat "fc-pattern-del-" property)) | |
| 189 (pattern) | |
| 190 ,(format "\ | |
| 191 Delete all values of the %s property of fontconfig pattern PATTERN.%s | |
| 192 | |
| 193 This function is a convenience wrapper for `fc-pattern-del'. | |
| 194 See `fc-pattern-del' for documentation of patterns and error returns." | |
| 195 property | |
| 196 (if obsolete-p " | |
| 197 \(Obsolete, only available on systems using Xft version 1.)" | |
| 198 "") | |
| 199 type) | |
| 200 (fc-pattern-del pattern ,property)) | |
| 3094 | 201 ,property)) |
| 202 | |
| 203 ;; define the standard properties for Xft v.2 here | |
| 204 (fc-define-property "antialias" boolean "the font supports antialiasing") | |
| 205 (fc-define-property "dpi" float "the design resolution") | |
| 206 (fc-define-property "family" string "the font family") | |
| 207 (fc-define-property "file" string "the file containing glyph data") | |
| 208 (fc-define-property "foundry" string "the vendor") | |
| 209 (fc-define-property "index" integer "the index of the glyph set") | |
| 210 (fc-define-property "minspace" boolean "has a minimum spacing") | |
| 211 (fc-define-property "outline" boolean "is an outline font") | |
| 212 (fc-define-property "pixelsize" float "the size in pixels") | |
| 213 (fc-define-property "rasterizer" string "the name of the rasterizing engine") | |
| 214 (fc-define-property "rgba" integer "the subpixel rendering capabilities") | |
| 215 (fc-define-property "scalable" boolean "is scalable") | |
| 216 (fc-define-property "scale" float "the scale factor") | |
| 217 (fc-define-property "size" float "the size in points") | |
| 218 (fc-define-property "slant" integer "the slant") | |
| 219 (fc-define-property "spacing" integer "the spacing model") | |
| 220 (fc-define-property "style" string "the typographic face or style") | |
| 221 (fc-define-property "weight" integer "the weight") | |
| 222 (fc-define-property "xlfd" string "the XLFD (full name in X11)") | |
| 223 | |
| 3354 | 224 ;; Xft v.1 properties (generally marked as obsolete) |
| 225 ;; had different semantics from XLFD "encoding" | |
| 3094 | 226 (fc-define-property "encoding" string "the encoding" t) |
| 3354 | 227 ;; also used by X11 XLFDs, so not obsolete |
| 228 (fc-define-property "charwidth" integer "the average character width") | |
| 3094 | 229 (fc-define-property "charheight" integer "the average character height" t) |
| 230 (fc-define-property "core" boolean "represents a core font" t) | |
| 231 (fc-define-property "render" boolean "represents a render (Xft) font" t) | |
| 232 | |
| 3354 | 233 ;; X11 XLFD and other standard properties |
| 234 (fc-define-property "x11-swidth" string "the 'set' width") | |
| 235 (fc-define-property "x11-adstyle" string "any additional style") | |
| 236 (fc-define-property "x11-resx" string "the horizontal design resolution") | |
| 237 (fc-define-property "x11-resy" string "the vertical design resolution") | |
| 238 ;; use "charwidth" instead of "x11-avgwidth" | |
| 239 (fc-define-property "x11-registry" string "the encoding registry") | |
| 240 ;; "x11-encoding" has different semantics from Xft v.1 "encoding" | |
| 241 (fc-define-property "x11-encoding" string "the encoding index") | |
| 3094 | 242 |
| 243 | |
| 244 (defvar fc-find-available-font-families-fc-fonts-only t | |
| 245 "If `fc-find-available-font-families-fc-fonts-only' is set to `t', | |
| 246 `fc-find-available-font-families' will ignore core fonts.") | |
| 247 | |
| 248 (defconst fc-font-name-slant-roman 0) | |
| 249 (defconst fc-font-name-slant-italic 100) | |
| 250 (defconst fc-font-name-slant-oblique 110) | |
| 251 | |
| 252 (defconst fc-font-name-slant-mapping | |
| 253 `((,fc-font-name-slant-roman . :roman) | |
| 254 (,fc-font-name-slant-italic . :italic) | |
| 255 (,fc-font-name-slant-oblique . :oblique))) | |
| 256 | |
| 257 (defconst fc-font-name-slant-mapping-string | |
| 258 `((,fc-font-name-slant-roman . "R") | |
| 259 (,fc-font-name-slant-roman . "I") | |
| 260 (,fc-font-name-slant-roman . "O"))) | |
| 261 | |
| 262 (defconst fc-font-name-slant-mapping-string-reverse | |
| 263 `(("R" . ,fc-font-name-slant-roman) | |
| 264 ("I" . ,fc-font-name-slant-italic) | |
| 265 ("O" . ,fc-font-name-slant-oblique))) | |
| 266 | |
| 267 (defconst fc-font-name-slant-mapping-reverse | |
| 268 `((:roman . ,fc-font-name-slant-roman) | |
| 269 (:italic . ,fc-font-name-slant-italic) | |
| 270 (:oblique . ,fc-font-name-slant-oblique))) | |
| 271 | |
| 272 (defun fc-font-slant-translate-from-constant (number) | |
| 273 "Translate the Xft font slant constant NUMBER to symbol." | |
| 274 (let ((pair (assoc number fc-font-name-slant-mapping))) | |
| 275 (if pair (cdr pair)))) | |
| 276 | |
| 277 (defun fc-font-slant-translate-from-symbol (symbol) | |
| 278 "Translate SYMBOL (`:roman', `:italic' or `:oblique') to the | |
| 279 corresponding Xft font slant constant." | |
| 280 (let ((pair (assoc symbol fc-font-name-slant-mapping-reverse))) | |
| 281 (if pair (cdr pair)))) | |
| 282 | |
| 283 (defun fc-font-slant-translate-to-string (num-or-sym) | |
| 284 (let* ((constant (if (symbolp num-or-sym) | |
| 285 (cdr (assoc num-or-sym fc-font-name-slant-mapping-reverse)) | |
| 286 num-or-sym)) | |
| 287 (pair (assoc constant fc-font-name-slant-mapping-string))) | |
| 288 (if pair (cdr pair)))) | |
| 289 | |
| 290 (defun fc-font-slant-translate-from-string (str) | |
| 291 (let ((pair (assoc str fc-font-name-slant-mapping-string-reverse))) | |
| 292 (if pair (cdr pair)))) | |
| 293 | |
| 294 (defconst fc-font-name-weight-light 0) | |
| 295 (defconst fc-font-name-weight-regular 80) | |
| 296 (defconst fc-font-name-weight-medium 100) | |
| 297 (defconst fc-font-name-weight-demibold 180) | |
| 298 (defconst fc-font-name-weight-bold 200) | |
| 299 (defconst fc-font-name-weight-black 210) | |
| 300 | |
| 301 (defconst fc-font-name-weight-mapping | |
| 302 `((,fc-font-name-weight-light . :light) | |
| 303 (,fc-font-name-weight-regular . :regular) | |
| 304 (,fc-font-name-weight-medium . :medium) | |
| 305 (,fc-font-name-weight-demibold . :demibold) | |
| 306 (,fc-font-name-weight-bold . :bold) | |
| 307 (,fc-font-name-weight-black . :black))) | |
| 308 | |
| 309 (defconst fc-font-name-weight-mapping-string | |
| 310 `((,fc-font-name-weight-light . "Light") | |
| 311 (,fc-font-name-weight-regular . "Regular") | |
| 312 (,fc-font-name-weight-medium . "Medium") | |
| 313 (,fc-font-name-weight-demibold . "Demibold") | |
| 314 (,fc-font-name-weight-bold . "Bold") | |
| 315 (,fc-font-name-weight-black . "Black"))) | |
| 316 | |
| 317 (defconst fc-font-name-weight-mapping-string-reverse | |
| 318 `(("Light" . ,fc-font-name-weight-light) | |
| 319 ("Regular" . ,fc-font-name-weight-regular) | |
| 320 ("Medium" . ,fc-font-name-weight-medium) | |
| 321 ("Demibold" . ,fc-font-name-weight-demibold) | |
| 322 ("Bold" . ,fc-font-name-weight-bold) | |
| 323 ("Black" . ,fc-font-name-weight-black))) | |
| 324 | |
| 325 (defconst fc-font-name-weight-mapping-reverse | |
| 326 `((:light . ,fc-font-name-weight-light) | |
| 327 (:regular . ,fc-font-name-weight-regular) | |
| 328 (:medium . ,fc-font-name-weight-medium) | |
| 329 (:demibold . ,fc-font-name-weight-demibold) | |
| 330 (:bold . ,fc-font-name-weight-bold) | |
| 331 (:black . ,fc-font-name-weight-black))) | |
| 332 | |
| 333 (defun fc-font-weight-translate-from-constant (number) | |
| 334 "Translate a Xft font weight constant NUMBER to symbol." | |
| 335 (let ((pair (assoc number fc-font-name-weight-mapping))) | |
| 336 (if pair (cdr pair)))) | |
| 337 | |
| 338 (defun fc-font-weight-translate-from-symbol (symbol) | |
| 339 "Translate SYMBOL (`:light', `:regular', `:medium', `:demibold', | |
| 340 `:bold' or `:black') to the corresponding Xft font weight constant." | |
| 341 (let ((pair (assoc symbol fc-font-name-weight-mapping-reverse))) | |
| 342 (if pair (cdr pair)))) | |
| 343 | |
| 344 (defun fc-font-weight-translate-to-string (num-or-sym) | |
| 345 (let* ((constant (if (symbolp num-or-sym) | |
| 346 (cdr (assoc num-or-sym fc-font-name-weight-mapping-reverse)) | |
| 347 num-or-sym)) | |
| 348 (pair (assoc constant fc-font-name-weight-mapping-string))) | |
| 349 (if pair (cdr pair)))) | |
| 350 | |
| 351 (defun fc-font-weight-translate-from-string (str) | |
| 352 (let ((pair (assoc str fc-font-name-weight-mapping-string-reverse))) | |
| 353 (if pair (cdr pair)))) | |
| 354 | |
|
4362
f5693b5f7f2d
Compute size for Xft fonts.
Mike Sperber <sperber@deinprogramm.de>
parents:
4021
diff
changeset
|
355 (defun fc-pattern-get-or-compute-size (pattern id) |
|
f5693b5f7f2d
Compute size for Xft fonts.
Mike Sperber <sperber@deinprogramm.de>
parents:
4021
diff
changeset
|
356 "Get the size from `pattern' associated with `id' or try to compute it. |
|
f5693b5f7f2d
Compute size for Xft fonts.
Mike Sperber <sperber@deinprogramm.de>
parents:
4021
diff
changeset
|
357 Returns 'fc-result-no-match if unsucessful." |
|
f5693b5f7f2d
Compute size for Xft fonts.
Mike Sperber <sperber@deinprogramm.de>
parents:
4021
diff
changeset
|
358 ;; Many font patterns don't have a "size" property, but do have a |
|
f5693b5f7f2d
Compute size for Xft fonts.
Mike Sperber <sperber@deinprogramm.de>
parents:
4021
diff
changeset
|
359 ;; "dpi" and a "pixelsize" property". |
|
f5693b5f7f2d
Compute size for Xft fonts.
Mike Sperber <sperber@deinprogramm.de>
parents:
4021
diff
changeset
|
360 (let ((maybe (fc-pattern-get-size pattern id))) |
|
f5693b5f7f2d
Compute size for Xft fonts.
Mike Sperber <sperber@deinprogramm.de>
parents:
4021
diff
changeset
|
361 (if (not (eq maybe 'fc-result-no-match)) |
|
f5693b5f7f2d
Compute size for Xft fonts.
Mike Sperber <sperber@deinprogramm.de>
parents:
4021
diff
changeset
|
362 maybe |
|
f5693b5f7f2d
Compute size for Xft fonts.
Mike Sperber <sperber@deinprogramm.de>
parents:
4021
diff
changeset
|
363 (let ((dpi (fc-pattern-get-dpi pattern id)) |
|
f5693b5f7f2d
Compute size for Xft fonts.
Mike Sperber <sperber@deinprogramm.de>
parents:
4021
diff
changeset
|
364 (pixelsize (fc-pattern-get-pixelsize pattern id))) |
|
f5693b5f7f2d
Compute size for Xft fonts.
Mike Sperber <sperber@deinprogramm.de>
parents:
4021
diff
changeset
|
365 (if (and (numberp dpi) |
|
f5693b5f7f2d
Compute size for Xft fonts.
Mike Sperber <sperber@deinprogramm.de>
parents:
4021
diff
changeset
|
366 (numberp pixelsize)) |
|
f5693b5f7f2d
Compute size for Xft fonts.
Mike Sperber <sperber@deinprogramm.de>
parents:
4021
diff
changeset
|
367 (* pixelsize (/ 72 dpi)) |
|
f5693b5f7f2d
Compute size for Xft fonts.
Mike Sperber <sperber@deinprogramm.de>
parents:
4021
diff
changeset
|
368 'fc-result-no-match))))) |
|
f5693b5f7f2d
Compute size for Xft fonts.
Mike Sperber <sperber@deinprogramm.de>
parents:
4021
diff
changeset
|
369 |
| 3094 | 370 (defun fc-copy-pattern-partial (pattern attribute-list) |
| 371 "Return a copy of PATTERN restricted to ATTRIBUTE-LIST. | |
| 372 | |
| 373 PATTERN is a fontconfig pattern object. | |
| 374 ATTRIBUTE-LIST is a list of strings denoting font properties. | |
| 375 A new object is allocated and returned." | |
| 376 (let ((new (make-fc-pattern)) | |
| 377 (attrs attribute-list)) | |
| 378 ;;; We demand proper tail recursion! | |
| 379 (while (not (null attrs)) | |
| 380 (let ((get (intern (concat "fc-pattern-get-" (car attrs)))) | |
| 381 (set (intern (concat "fc-pattern-add-" (car attrs))))) | |
| 382 (if (and (fboundp get) (fboundp set)) | |
| 383 (funcall set new (funcall get pattern 0)) | |
| 384 (warn "property '%s' not defined, ignoring" (car attrs)))) | |
| 385 (setq attrs (cdr attrs))) | |
| 386 new)) | |
| 387 | |
| 388 (defun fc-pattern-get-all-attributes (fc-pattern fc-pattern-get-function) | |
| 389 (let ((count 0) | |
| 390 res end val) | |
| 391 (while (not end) | |
| 392 (setq val (funcall fc-pattern-get-function fc-pattern count)) | |
| 393 (if (or (equal val 'fc-result-no-id) | |
| 394 (equal val 'fc-result-no-match)) | |
| 395 (setq end t) | |
| 396 (setq res (append res (list val)) | |
| 397 count (+ count 1)))) | |
| 398 res)) | |
| 399 | |
| 400 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 401 ;; | |
| 402 ;; The fontconfig fontname UI | |
| 403 ;; | |
| 3360 | 404 ;; The basic interfaces are defined as API wrappers in C in font-mgr.c |
| 405 ;; These are prefixed with "fc-name-". These are | |
| 3094 | 406 ;; |
| 407 ;; fc-name-parse | |
| 408 ;; fc-name-unparse | |
| 3354 | 409 ;; |
| 410 ;; For interfacing with various font rendering systems, we need to be able | |
| 411 ;; to convert the fontconfig patterns to names, and vice versa. The high- | |
| 412 ;; level API is | |
| 413 ;; | |
| 414 ;; font-default-name-syntax | |
| 415 ;; variable naming the default naming syntax | |
| 416 ;; maybe this could be a list to try in order? | |
| 417 ;; | |
| 418 ;; font-name-to-pattern NAME &optional SYNTAX | |
| 419 ;; returns a fontconfig pattern, or nil if the name could not be parsed | |
| 420 ;; NAME is a string | |
| 421 ;; SYNTAX is a name syntax symbol | |
| 422 ;; | |
| 423 ;; font-pattern-to-name PATTERN &optional SYNTAX | |
| 424 ;; returns a string | |
| 425 ;; PATTERN is a fontconfig pattern | |
| 426 ;; SYNTAX is a name syntax symbol | |
| 427 ;; | |
| 428 ;; A "name syntax symbol" is a symbol for a font naming syntax. This may be | |
| 429 ;; a rendering engine syntax or a font manager syntax. Initially, 'x and | |
| 430 ;; 'fontconfig will be supported. Patterns may be unambiguous (one value for | |
| 431 ;; each specified property) or ambiguous (multiple values are allowed for | |
| 432 ;; some specified properties). `font-name-to-pattern' should be unambiguous, | |
| 433 ;; but `font-pattern-to-name' may not be an exact conversion for some | |
| 434 ;; syntaxes, especially for ambiguous patterns. | |
| 3094 | 435 |
| 436 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 437 ;; | |
| 438 ;; The fontconfig font API | |
| 439 ;; | |
| 3360 | 440 ;; The basic interfaces are defined as API wrappers in C in font-mgr.c. |
| 441 ;; These are prefixed with "fc-font-". These are | |
| 3094 | 442 ;; |
| 443 ;; fc-font-match | |
| 444 ;; fc-list-fonts-pattern-objects | |
| 445 ;; fc-font-sort | |
| 3354 | 446 ;; |
| 447 ;; The high-level API is | |
| 448 ;; | |
| 449 ;; font-list &optional PATTERN DEVICE ATTRIBUTE-LIST OPTION-LIST | |
| 450 ;; returns a list of patterns matching pattern | |
| 451 ;; PATTERN is an ambiguous pattern, defaulting to the empty pattern | |
| 452 ;; DEVICE is the display device to query (default: selected device) | |
| 453 ;; ATTRIBUTE-LIST is a list of font attributes to restrict the patterns | |
| 454 ;; in the returned list to; other attributes will not be present in | |
| 455 ;; the patterns, and duplicates will be removed after pruning unwanted | |
| 456 ;; attributes; ATTRIBUTE-LIST has no necessary relation to the active | |
| 457 ;; attributes in PATTERN, both subset and superset make sense; if nil, | |
| 458 ;; the active attributes in PATTERN is used | |
| 459 ;; OPTION-LIST is a list of presentation options, such as sort order | |
| 460 ;; and refresh-cache (if any). | |
| 461 ;; | |
| 462 ;; font-match PATTERN &optional DEVICE | |
| 463 ;; returns a pattern representing the platform match for PATTERN, | |
| 464 ;; which should unambiguously select the same font | |
| 465 ;; PATTERN is an ambiguous pattern | |
| 466 ;; DEVICE is the display device to query (default: selected device) | |
| 467 ;; | |
| 468 ;; Maybe these APIs should get an error-behavior argument? | |
| 3094 | 469 |
| 470 ;; #### it might make sense to generalize `fc-try-font' by having a | |
| 471 ;; global variable that contains a list of font name parsers. They are | |
| 472 ;; tried in order, and the first one to return an fc-pattern is matched. | |
| 473 | |
| 474 (defun fc-try-font (font &optional device) | |
| 475 "Return list of pattern objects matching FONT on DEVICE. | |
| 476 | |
| 477 FONT may be a fontconfig pattern object or a fontconfig font name (a string). | |
| 478 Optional DEVICE is the device object to query, defaulting to the currently | |
| 479 selected device." | |
| 480 (fc-list-fonts-pattern-objects (or device (default-x-device)) | |
| 481 (if (fc-pattern-p font) | |
| 482 font | |
| 483 (fc-name-parse font)) | |
| 484 nil)) | |
| 485 | |
| 3354 | 486 ;; for example, we'd like these next two to be implementable as |
| 487 ;; (font-list (fc-create-pattern) device '("family" "style")) and | |
| 488 ;; (font-list (let ((p (fc-create-pattern))) (fc-pattern-add "family" family)) | |
| 489 ;; device | |
| 490 ;; '("weight")) | |
| 491 | |
| 3094 | 492 (defun fc-find-available-font-families (&optional device filter-fun) |
| 493 "Find all available font families." | |
| 494 (let ((device (or device (default-x-device))) | |
| 495 (pattern (make-fc-pattern)) | |
| 496 (objectset '("family" "style"))) | |
| 497 (let* ((all-fonts | |
| 498 (fc-list-fonts-pattern-objects device pattern objectset))) | |
|
4607
517f6887fbc0
Remove duplicate functions, chiefly #'delete-duplicates reimplementations.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4362
diff
changeset
|
499 (delete-duplicates |
| 3094 | 500 (mapcar |
| 4021 | 501 #'(lambda (pattern) |
| 502 (fc-pattern-get-family pattern 0)) | |
| 3094 | 503 (if filter-fun |
|
4607
517f6887fbc0
Remove duplicate functions, chiefly #'delete-duplicates reimplementations.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4362
diff
changeset
|
504 (delete-if-not filter-fun all-fonts) |
|
517f6887fbc0
Remove duplicate functions, chiefly #'delete-duplicates reimplementations.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4362
diff
changeset
|
505 all-fonts)) :test #'equal)))) |
| 3094 | 506 |
| 507 (defun fc-find-available-weights-for-family (family &optional style device) | |
| 508 "Find available weights for font FAMILY." | |
| 509 (let* ((device (or device (default-x-device))) | |
| 510 (pattern (make-fc-pattern)) | |
| 511 (objectset '("weight"))) | |
| 3354 | 512 (fc-pattern-add-family pattern family) |
| 3094 | 513 (if style |
| 3354 | 514 (fc-pattern-add-style pattern style)) |
| 3094 | 515 (mapcar |
| 4021 | 516 #'(lambda (pattern) |
| 517 (let ((fc-weight-constant (fc-pattern-get-weight pattern 0))) | |
| 518 (if fc-weight-constant | |
| 519 (fc-font-weight-translate-from-constant fc-weight-constant)))) | |
| 3094 | 520 (fc-list-fonts-pattern-objects device pattern objectset)))) |
| 521 | |
| 522 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 523 ;; | |
| 524 ;; The XLFD fontname UI | |
| 525 ;; | |
| 526 | |
| 527 ;; xlfd-font-name-p | |
| 528 | |
| 529 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 530 ;; | |
| 531 ;; Utility functions | |
| 532 ;; | |
| 533 | |
| 534 (defun fc-pattern-get-successp (result) | |
| 535 (and (not (equal result 'fc-result-no-match)) | |
| 536 (not (equal result 'fc-result-no-id)) | |
| 537 (not (equal result 'fc-internal-error)))) | |
| 538 | |
| 539 (provide 'fontconfig) | |
| 540 | |
| 541 ;;; fontconfig.el ends here |