diff --git a/c/xlib/font.c b/c/xlib/font.c index e6afb58..f1b4c10 100644 --- a/c/xlib/font.c +++ b/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); } diff --git a/scheme/xlib/font-type.scm b/scheme/xlib/font-type.scm index 17545d6..fa57a41 100644 --- a/scheme/xlib/font-type.scm +++ b/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 -;; from the Xfontstruct. +;; creates a font object. name can be #f. Either Xfont or 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 maybe-font - maybe-font - (let* ((Xfont (if Xfont Xfont - (%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)))) + (if (not (or Xfont Xfontstruct)) + (error "Not enough information the make the font. Either Xfont or Xfontstruct has to be specified." name Xfont Xfontstruct display finalize?)) + (let ((Xfontstruct (if (not Xfontstruct) + (%font->fontstruct (display-Xdisplay display) + Xfont) + Xfontstruct))) + (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))) + (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) diff --git a/scheme/xlib/font.scm b/scheme/xlib/font.scm index 57d5671..5cfc1f6 100644 --- a/scheme/xlib/font.scm +++ b/scheme/xlib/font.scm @@ -1,12 +1,5 @@ -(define (gcontext-font gcontext) - (let* ((display (gcontext-display gcontext)) - (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") +;; list-font-names returns the names of all available fonts that match +;; the pattern. pattern has to be a string. See XListFonts. (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)