X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Ffont.el;h=b0e002fa308d96f4a9d1ec5fd7a4b7cba0732135;hb=75768a78e26cfa47c7071a0239cd01cc7f81e5a4;hp=db52f882b2b72c8a0b9ee4ceb162d99f517c1034;hpb=98a6e4055a1fa624c592ac06f79287d55196ca37;p=chise%2Fxemacs-chise.git.1

diff --git a/lisp/font.el b/lisp/font.el
index db52f88..b0e002f 100644
--- a/lisp/font.el
+++ b/lisp/font.el
@@ -99,12 +99,15 @@
 
 (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")
@@ -141,6 +144,8 @@ for use in the 'weight' field of an X font string.")
 (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
@@ -299,8 +304,16 @@ for use in the 'weight' field of an X font string.")
       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)
@@ -315,6 +328,8 @@ for use in the 'weight' field of an X font string.")
 	  (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
@@ -335,7 +350,7 @@ for use in the 'weight' field of an X font string.")
       (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"))
@@ -374,12 +389,14 @@ for use in the 'weight' field of an X font string.")
 	  (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))))
@@ -431,9 +448,11 @@ for use in the 'weight' field of an X font string.")
 ;;; 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)
@@ -518,6 +537,7 @@ for use in the 'weight' field of an X font string.")
   "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)))
@@ -621,6 +641,7 @@ for use in the 'weight' field of an X font string.")
   (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)
@@ -713,6 +734,7 @@ for use in the 'weight' field of an X font string.")
 	    (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))
@@ -813,6 +835,7 @@ for use in the 'weight' field of an mswindows font string.")
   "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))
@@ -851,6 +874,7 @@ for use in the 'weight' field of an mswindows font string.")
 	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)
@@ -1054,8 +1078,6 @@ for use in the 'weight' field of an mswindows font string.")
 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/"
@@ -1066,7 +1088,9 @@ The list (R G B) is returned, or an error is signaled if the lookup fails."
 			  "/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/"