diff --git a/scheme/xlib/font-type.scm b/scheme/xlib/font-type.scm
new file mode 100644
index 0000000..a8a2e77
--- /dev/null
+++ b/scheme/xlib/font-type.scm
@@ -0,0 +1,77 @@
+(define-record-type font :font
+  (really-make-font name Xfont Xfontstruct display)
+  font?
+  (name font-name font-set-name!)
+  (Xfont font-Xfont font-set-Xfont!)
+  (Xfontstruct font-Xfontstruct font-set-Xfontstruct!)
+  (display font-display font-set-display!))
+
+;; creates a font object. name can be #f. if Xfont is #f then it is obtained 
+;; from the Xfontstruct.
+
+(define (make-font name Xfont Xfontstruct display)
+  (let ((maybe-font (font-list-find Xfontstruct)))
+    (if maybe-font
+	maybe-font
+	(let* ((Xfont (if Xfont Xfont
+			  (%Get_Xfont Xfontstruct)))
+	       (font (really-make-font name Xfont Xfontstruct display)))
+	  (add-finalizer! font unload-font)
+	  (font-list-set! Xfontstruct font)
+	  font))))
+
+;; load-font loads a font by its name. See XLoadQueryFont.
+
+(define (load-font display font-name)
+  (let ((Xfontstruct (%load-font (display-Xdisplay display)
+				 (if (symbol? font-name)
+				     (symbol->string font-name)
+				     font-name))))
+    (make-font font-name #f Xfontstruct display)))
+
+(import-lambda-definition %load-font (Xdisplay font_name)
+  "Load_Font")
+
+;; for compatibility with Elk:
+
+(define open-font load-font)
+
+;; unload-font unloads a font. This is also automatically called on 
+;; garbage collection. See XUnloadFont.
+
+(define (unload-font font)
+  (let ((Xfontstruct (font-Xfontstruct font))
+	(Xdisplay (display-Xdisplay (font-display font))))
+    (if (integer? Xfontstruct)
+	(%free-font Xdisplay Xfontstruct))
+    (font-set-Xfontstruct! font 'already-freed)
+    (font-set-Xfont! font 'already-freed)
+    (font-list-delete! Xfont)))
+
+;; for compatibility with Elk:
+(define close-font unload-font)
+
+;; %free-font frees the Xfontstruct and also deletes the association between 
+;; the Xfont (the resource id) and the specified font. See XFreeFont.
+;; Elk uses only XUnloadFont, but then the XFontStruct is not freed ??
+
+(import-lambda-definition %free-font (Xdisplay Xfontstruct)
+  "Free_Font")
+
+;; All font records need to be saved in a weak-list, to have only one record
+;; for the same font in the heap.
+
+(define *weak-font-list* (make-integer-table))
+
+(define (font-list-find Xfont)
+  (let ((r (table-ref *weak-font-list* Xfont)))
+    (if r 
+	(weak-pointer-ref r)
+	r)))
+
+(define (font-list-set! Xfont font)
+  (let ((p (make-weak-pointer font)))
+    (table-set! *weak-font-list* Xfont p)))
+
+(define (font-list-delete! Xfont)
+  (table-set! *weak-font-list* Xfont #f))
diff --git a/scheme/xlib/font.scm b/scheme/xlib/font.scm
new file mode 100644
index 0000000..87b036b
--- /dev/null
+++ b/scheme/xlib/font.scm
@@ -0,0 +1,185 @@
+(define (gcontext-font gcontext)
+  (let* ((display (gcontext-display gcontext))
+	 (Xfontstruct (%gcontext-font 
+		       (display-Xdisplay display)
+		       (gcontext-Xgcontext gcontext))))
+    (make-font #f #f Xfontstruct display)))
+
+(import-lambda-definition %gcontext-font (Xdisplay Xgcontext)
+  "GContext_Font")
+
+(define (list-font-names display pattern)
+  (%list-font-names (display-Xdisplay)
+		    (if (symbol? pattern)
+			(symbol->string pattern)
+			pattern)))
+
+(import-lambda-definition %list-font-names (Xdisplay pattern)
+  "List_Font_Names")
+
+(define (list-fonts display pattern)
+  (let ((v (%list-fonts (display-Xdisplay display)
+			(if (symbol? pattern)
+			    (symbol->string pattern)
+			    pattern))))
+    (vector->list (vector-map! (lambda (name-Xfontstruct)
+				 (make-font (car name-Xfontstruct)
+					    #f 
+					    (cdr name-Xfontstruct)
+					    display))
+			       v))))
+
+(import-lambda-definition %list-fonts (Xdisplay pattern)
+  "List_Fonts")
+
+(define (font-properties font)
+  (let ((v (%font-properties (font-Xfontstruct font))))
+    (vector->list (vector-map! (lambda (XAtom-Val)
+				 (cons (make-atom (car XAtom-Val))
+				       (cdr XAtom-Val)))
+			       v))))
+
+(import-lambda-definition %font-properties (Xfontstruct)
+  "Font_Properties")
+
+(define (font-property font property-name)
+  (let ((atom (intern-atom (font-display font)
+			   property-name)))
+    (%font-property (font-Xfontstruct font)
+		    (atom-Xatom atom))))
+
+(import-lambda-definition %font-property (Xfontstruct Xatom)
+  "Font_Property")
+
+(define (font-path display)
+  (vector->list (%font-path (display-Xdisplay display))))
+
+(import-lambda-definition %font-path (Xdisplay)
+  "Font_Path")
+
+(define (set-font-path! display path)
+  (%set-font-path! (display-Xdisplay display)
+		   (map (lambda (s)
+			  (if (symbol? s)
+			      (symbol->string s)
+			      s))
+			(list->vector path))))
+
+(import-lambda-definition %set-font-path! (Xdisplay path)
+  "Set_Font_Path")
+
+;; ............
+
+(define (font-info font)
+  (%font-info (font-Xfontstruct font)))
+
+(import-lambda-definition %font-info (Xfontstruct)
+  "Font_Info")
+
+(define (font-info-getter num)
+  (lambda (font)
+    (vector-ref (font-info font)
+		num)))
+
+(define font-direction (font-info-getter 0))
+(define font-min-byte2 (font-info-getter 1))
+(define font-max-byte2 (font-info-getter 2))
+(define font-min-byte1 (font-info-getter 3))
+(define font-max-byte1 (font-info-getter 4))
+(define font-all-chars-exist? (font-info-getter 5))
+(define font-default-char (font-info-getter 6))
+(define font-ascent (font-info-getter 7))
+(define font-descent (font-info-getter 8))
+
+;; ..................
+
+(define (char-info font index)
+  (%char-info (font-Xfontstruct font)
+	      (cond
+	       ((eq? index 'min) #f)
+	       ((eq? index 'max) #t)
+	       (else (let ((i (if (char? index)
+				  (char->integer index)
+				  index)))
+		       (calc-index font i))))))
+
+(import-lambda-definition %char-info (Xfontstruct index)
+  "Char_Info")
+
+;; calc-index calculates the array-position in XFontStruct.per_char by giving 
+;; the character index which ranges between [font-min-byte2...font-max-byte2] 
+;; for one-byte fonts or for two-byte fonts the lower 8 bits must be between
+;; [font-min-byte1...font-max-byte1] and the higher 8 bits must be between
+;; [font-min-byte2...font-max-byte2]. An error is raised if the index does not
+;; fit into these boundaries.
+(define (calc-index font index)
+  (let ((min1 (font-min-byte1 font))
+	(max1 (font-max-byte1 font))
+	(min2 (font-min-byte2 font))
+	(max2 (font-max-byte2 font))
+	(check-bounds 
+	 (lambda (min max i s)
+	   (if (or (< i min)
+		   (> i max))
+	       (error (string-append s
+				     (integer->string min)
+				     " and "
+				     (integer->string max)
+				     "; given")
+		      index)))))
+    (if (and (= 0 min1) (= 0 max1))
+	;; two-byte font
+	(let ((b1 (bitwise-and index 255))
+	      (b2 (bitwise-and (arithmetic-shift index -8) 255)))
+	  (check-bounds min1 max1 b1
+			"expected an integer with lower 8 bits between ")
+	  (check-bounds min2 max2 b2
+			"expected an integer with higher 8 bits between ")
+	  (+ (* b1 (+ (- max2 min2) 1))
+	     b2))
+	;; one-byte font
+	(begin
+	  (check-bounds min2 max2 index
+			"expected an integer between ")
+	  index))))
+
+
+(define (char-info-getter num)
+  (lambda (font index)
+    (vector-ref (char-info font index)
+		num)))
+
+(define char-rbearing (char-info-getter 0))
+(define char-lbearing (char-info-getter 1))
+(define char-width (char-info-getter 2))
+(define char-ascent (char-info-getter 3))
+(define char-descent (char-info-getter 4))
+(define char-attributes (char-info-getter 5))
+
+(define (max-char-info-getter num)
+  (lambda (font)
+    (vector-ref (char-info font 'max)
+		num)))
+
+(define (max-char-info font)
+  (char-info font 'max))
+(define max-char-rbearing (max-char-info-getter 0))
+(define max-char-lbearing (max-char-info-getter 1))
+(define max-char-width (max-char-info-getter 2))
+(define max-char-ascent (max-char-info-getter 3))
+(define max-char-descent (max-char-info-getter 4))
+(define max-char-attributes (max-char-info-getter 5))
+
+(define (min-char-info-getter num)
+  (lambda (font)
+    (vector-ref (char-info font 'min)
+		num)))
+
+(define (min-char-info font)
+  (char-info font 'min))
+(define min-char-rbearing (min-char-info-getter 0))
+(define min-char-lbearing (min-char-info-getter 1))
+(define min-char-width (min-char-info-getter 2))
+(define min-char-ascent (min-char-info-getter 3))
+(define min-char-descent (min-char-info-getter 4))
+(define min-char-attributes (min-char-info-getter 5))