diff lisp/font.el @ 707:a307f9a2021d

[xemacs-hg @ 2001-12-20 05:49:28 by andyp] sync with 21-4-6-windows
author andyp
date Thu, 20 Dec 2001 05:49:48 +0000
parents 4d7fdf497470
children 79940b592197
line wrap: on
line diff
--- a/lisp/font.el	Wed Dec 19 00:40:26 2001 +0000
+++ b/lisp/font.el	Thu Dec 20 05:49:48 2001 +0000
@@ -110,8 +110,10 @@
     (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")
@@ -148,6 +150,8 @@
 (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
@@ -304,8 +308,16 @@
       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)
@@ -320,6 +332,8 @@
 	  (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
@@ -379,12 +393,14 @@
 	  (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))))
@@ -437,9 +453,11 @@
 ;;; 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)
@@ -524,6 +542,7 @@
   "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)))
@@ -626,6 +645,7 @@
   (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)
@@ -717,6 +737,7 @@
 	    (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))
@@ -815,6 +836,7 @@
   "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))
@@ -853,6 +875,7 @@
 	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)