(defconst font-window-system-mappings
'((x . (x-font-create-name x-font-create-object))
+ (gtk . (x-font-create-name x-font-create-object))
(ns . (ns-font-create-name ns-font-create-object))
(mswindows . (mswindows-font-create-name mswindows-font-create-object))
(pm . (x-font-create-name x-font-create-object)) ; Change? FIXME
(tty . (tty-font-create-plist tty-font-create-object)))
- "An assoc list mapping device types to the function used to create
-a font name from a font structure.")
+ "An assoc list mapping device types to a list of translations.
+
+The first function creates a font name from a font descriptor object.
+The second performs the reverse translation.")
(defconst ns-font-weight-mappings
'((:extra-light . "extralight")
(defvar font-maximum-slippage "1pt"
"How much a font is allowed to vary from the desired size.")
+;; Canonical (internal) sizes are in points.
+;; Registry
(define-font-keywords :family :style :size :registry :encoding)
(define-font-keywords
w2))))
(defun font-spatial-to-canonical (spec &optional device)
- "Convert SPEC (in inches, millimeters, points, or picas) into points."
- ;; 1 in = 6 pa = 25.4 mm = 72 pt
+ "Convert SPEC (in inches, millimeters, points, picas, or pixels) into points.
+
+Canonical sizes are in points. If SPEC is null, nil is returned. If SPEC is
+a number, it is interpreted as the desired point size and returned unchanged.
+Otherwise SPEC must be a string consisting of a number and an optional type.
+The type may be the strings \"px\", \"pix\", or \"pixel\" (pixels), \"pt\" or
+\"point\" (points), \"pa\" or \"pica\" (picas), \"in\" or \"inch\" (inches),
+\"cm\" (centimeters), or \"mm\" (millimeters).
+
+1 in = 2.54 cm = 6 pa = 25.4 mm = 72 pt. Pixel size is device-dependent."
(cond
((numberp spec)
spec)
(mm-width (float (or (device-mm-width device) 293)))
(retval nil))
(cond
+ ;; the following string-match is broken, there will never be a
+ ;; left operand detected
((string-match "^ *\\([-+*/]\\) *" spec) ; math! whee!
(let ((math-func (intern (match-string 1 spec)))
(other (font-spatial-to-canonical
(setq num (string-to-number spec))
(cond
((member type '("pixel" "px" "pix"))
- (setq retval (* num (/ pix-width mm-width) (/ 25.4 72.0))))
+ (setq retval (* num (/ mm-width pix-width) (/ 72.0 25.4))))
((member type '("point" "pt"))
(setq retval num))
((member type '("pica" "pa"))
(plist-get args :encoding)))
(defun font-create-name (fontobj &optional device)
+ "Return a font name constructed from FONTOBJ, appropriate for DEVICE."
(let* ((type (device-type device))
(func (car (cdr-safe (assq type font-window-system-mappings)))))
(and func (fboundp func) (funcall func fontobj device))))
;;;###autoload
(defun font-create-object (fontname &optional device)
+ "Return a font descriptor object for FONTNAME, appropriate for DEVICE."
(let* ((type (device-type device))
(func (car (cdr (cdr-safe (assq type font-window-system-mappings))))))
(and func (fboundp func) (funcall func fontname device))))
;;; The window-system dependent code (TTY-style)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun tty-font-create-object (fontname &optional device)
+ "Return a font descriptor object for FONTNAME, appropriate for TTY devices."
(make-font :size "12pt"))
(defun tty-font-create-plist (fontobj &optional device)
+ "Return a font name constructed from FONTOBJ, appropriate for TTY devices."
(list
(cons 'underline (font-underline-p fontobj))
(cons 'highlight (if (or (font-bold-p fontobj)
"A list of font family mappings on X devices.")
(defun x-font-create-object (fontname &optional device)
+ "Return a font descriptor object for FONTNAME, appropriate for X devices."
(let ((case-fold-search t))
(if (or (not (stringp fontname))
(not (string-match font-x-font-regexp fontname)))
(font-size (font-default-object-for-device (or device (selected-device)))))
(defun x-font-create-name (fontobj &optional device)
+ "Return a font name constructed from FONTOBJ, appropriate for X devices."
(if (and (not (or (font-family fontobj)
(font-weight fontobj)
(font-size fontobj)
(sort (font-unique (nconc scaled normal)) 'string-lessp))))))
(defun ns-font-create-name (fontobj &optional device)
+ "Return a font name constructed from FONTOBJ, appropriate for NextSTEP devices."
(let ((family (or (font-family fontobj)
(ns-font-families-for-device device)))
(weight (or (font-weight fontobj) :medium))
"A list of font family mappings on mswindows devices.")
(defun mswindows-font-create-object (fontname &optional device)
+ "Return a font descriptor object for FONTNAME, appropriate for MS Windows devices."
(let ((case-fold-search t)
(font (mswindows-font-canonicalize-name fontname)))
(if (or (not (stringp font))
retval))))
(defun mswindows-font-create-name (fontobj &optional device)
+ "Return a font name constructed from FONTOBJ, appropriate for MS Windows devices."
(if (and (not (or (font-family fontobj)
(font-weight fontobj)
(font-size fontobj)
The list (R G B) is returned, or an error is signaled if the lookup fails."
(let ((lib-list (if (boundp 'x-library-search-path)
x-library-search-path
- ;; This default is from XEmacs 19.13 - hope it covers
- ;; everyone.
(list "/usr/X11R6/lib/X11/"
"/usr/X11R5/lib/X11/"
"/usr/lib/X11R6/X11/"
"/usr/local/lib/X11R5/X11/"
"/usr/X11/lib/X11/"
"/usr/lib/X11/"
+ "/usr/share/X11/"
"/usr/local/lib/X11/"
+ "/usr/local/share/X11/"
"/usr/X386/lib/X11/"
"/usr/x386/lib/X11/"
"/usr/XFree86/lib/X11/"
projects / chise / xemacs-chise.git.1 / blobdiff