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