- make-font can now create a font from a font-id (Xfont)

- added %font->fontstruct, resp. scx_Font_ID_To_Font_Struct for that.
- removed gcontext-font (see gcontext.scm)
- added comments.

c/xlib/font.c

@@ -23,6 +23,11 @@ s48_value scx_GContext_Font(s48_value Xdisplay, s48_value Xgcontext) {
   return SCX_ENTER_FONTSTRUCT(XQueryFont(dpy, gc));
 }
 
+s48_value scx_Font_ID_To_Font(s48_value Xdisplay, s48_value Xfont) {
+  return SCX_ENTER_FONTSTRUCT(XQueryFont(SCX_EXTRACT_DISPLAY(Xdisplay), 
+					 SCX_EXTRACT_FONT(Xfont)));
+}
+
 s48_value scx_Font_Path(s48_value Xdisplay) {
   int n, i;
   char** sa;
@@ -191,4 +196,5 @@ void scx_init_font(void) {
   S48_EXPORT_FUNCTION(scx_List_Font_Names);
   S48_EXPORT_FUNCTION(scx_Font_Info);
   S48_EXPORT_FUNCTION(scx_Char_Info);
+  S48_EXPORT_FUNCTION(scx_Font_ID_To_Font);
 }

scheme/xlib/font-type.scm

@@ -11,25 +11,37 @@
       0
       (real-font-Xfont font)))
 
-;; creates a font object. name can be #f. if Xfont is #f then it is obtained 
+;; creates a font object. name can be #f. Either Xfont or Xfontstruct
-;; from the Xfontstruct.
+;; has to bes specified. if Xfont is #f then it is obtained from the
+;; Xfontstruct. if Xfontstruct is #f it queried with XQueryFont - but
+;; Xlib documentation says, that the resulting Font does not work
+;; properly in all functions.
 
 (define (make-font name Xfont Xfontstruct display finalize?)
-  (let ((maybe-font (font-list-find Xfontstruct)))
+  (if (not (or Xfont Xfontstruct))
-    (if maybe-font
+      (error "Not enough information the make the font. Either Xfont or Xfontstruct has to be specified." name Xfont Xfontstruct display finalize?))
-	maybe-font
+  (let ((Xfontstruct (if (not Xfontstruct)
-	(let* ((Xfont (if Xfont Xfont
+			 (%font->fontstruct (display-Xdisplay display)
-			  (%Get_Xfont Xfontstruct)))
+					    Xfont)
-	       (font (really-make-font name Xfont Xfontstruct display)))
+			 Xfontstruct)))
-	  (if finalize?
+    (let ((maybe-font (font-list-find Xfontstruct)))
-	      (add-finalizer! font unload-font)
+      (if maybe-font
-	      (add-finalizer! font font-list-delete!))
+	  maybe-font
-	  (font-list-set! Xfontstruct font)
+	  (let* ((Xfont (if Xfont Xfont
-	  font))))
+			    (%Get_Xfont Xfontstruct)))
+		 (font (really-make-font name Xfont Xfontstruct display)))
+	    (if finalize?
+		(add-finalizer! font unload-font)
+		(add-finalizer! font font-list-delete!))
+	    (font-list-set! Xfontstruct font)
+	    font)))))
 
 (import-lambda-definition %Get_Xfont (Xfontstruct)
   "scx_Get_Xfont")
 
+(import-lambda-definition %font->fontstruct (Xdisplay Xfont)
+  "scx_Font_ID_To_Font")
+
 ;; load-font loads a font by its name. See XLoadQueryFont.
 
 (define (load-font display font-name)

scheme/xlib/font.scm

@@ -1,12 +1,5 @@
-(define (gcontext-font gcontext)
+;; list-font-names returns the names of all available fonts that match
-  (let* ((display (gcontext-display gcontext))
+;; the pattern. pattern has to be a string. See XListFonts.
-	 (Xfontstruct (%gcontext-font 
-		       (display-Xdisplay display)
-		       (gcontext-Xgcontext gcontext))))
-    (make-font #f #f Xfontstruct display #f)))
-
-(import-lambda-definition %gcontext-font (Xdisplay Xgcontext)
-  "scx_GContext_Font")
 
 (define (list-font-names display pattern)
   (vector->list (%list-font-names (display-Xdisplay display)
@@ -17,6 +10,9 @@
 (import-lambda-definition %list-font-names (Xdisplay pattern)
   "scx_List_Font_Names")
 
+;; list-fonts returns all fonts that match the pattern. pattern has to
+;; be string. See XListFonts.
+
 (define (list-fonts display pattern)
   (let ((v (%list-fonts (display-Xdisplay display)
 			(if (symbol? pattern)
@@ -33,6 +29,9 @@
 (import-lambda-definition %list-fonts (Xdisplay pattern)
   "scx_List_Fonts")
 
+;; font-properties returns an alist that maps atoms to the
+;; corresponding values. See XFontStruct.
+
 (define (font-properties font)
   (let ((v (%font-properties (font-Xfontstruct font))))
     (vector->list (vector-map! (lambda (XAtom-Val)
@@ -43,6 +42,10 @@
 (import-lambda-definition %font-properties (Xfontstruct)
   "scx_Font_Properties")
 
+;; font-property returns the value of specified
+;; property. property-name has to be string or a symbol specifying an
+;; atom. See XGetFontProperty.
+
 (define (font-property font property-name)
   (let ((atom (intern-atom (font-display font)
 			   property-name)))
@@ -52,6 +55,9 @@
 (import-lambda-definition %font-property (Xfontstruct Xatom)
   "scx_Font_Property")
 
+;; font-path returns the (implementation and file system dependand)
+;; path to the font files. See XGetFontPath, and XSetFontPath.
+
 (define (font-path display)
   (vector->list (%font-path (display-Xdisplay display))))
 
@@ -69,7 +75,8 @@
 (import-lambda-definition %set-font-path! (Xdisplay path)
   "scx_Set_Font_Path")
 
-;; ............
+;; font-info returns a vector containing all information available for
+;; the font. See XFontStruct.
 
 (define (font-info font)
   (%font-info (font-Xfontstruct font)))
@@ -92,7 +99,8 @@
 (define font-ascent (font-info-getter 7))
 (define font-descent (font-info-getter 8))
 
-;; ..................
+;; char-info returns a vector containing font-dependand character
+;; information. See also min/max/char-* functions below. See XFontStruct.
 
 (define (char-info font index)
   (%char-info (font-Xfontstruct font)
@@ -144,7 +152,6 @@
 			"expected an integer between ")
 	  index))))
 
-
 (define (char-info-getter num)
   (lambda (font index)
     (vector-ref (char-info font index)