[developers] Partial success with unicode fonts

Berthold Crysmann crysmann at ifk.uni-bonn.de
Mon Mar 16 10:27:18 CET 2009


On Mon, 2009-03-16 at 03:23 +0000, Ann Copestake wrote:
> do you have access to an Allegro licence so you can compile the LKB?
> 
Yes. 

> We'll get nowhere with Franz unless we have a way of reproducing the
> problems which amounts to a few lines of code, and even then I am not
> optimistic. So it seems better to try and develop workarounds. 

Ok. 

>  I can
> easily tell you where the LKB font settings are, so you can try out
> various options, 

That would be great. So far I have mostly commented out selection of
bold face in a few functions (I have attached my patches file).  
Also, all fonts need to be set to the default font size 12pt. At other
sizes, Clim picks the iso8859-1 font instead. 

But hopefully there is a better workaround, e.g. by telling Clim
explicitly what encoding is required. 

Thanks a lot,

Berthold

> but I don't have time to do these experiments myself.
> 
> Ann
> 



> 
> > Dear  all,=20
> > 
> > a few weeks ago I posted a question regarding unicode fonts in
> > LKB/LOGON.=20
> > 
> > Meanwhile I have partial success with display of unicode characters in
> > LOGON: if the ISO-10646-1 encoded font appears before the ISO-8859-1
> > font in my font path, display of unicode characters works at *standard*
> > display size (Helvetica, Roman 12pt).=20
> > 
> > What does not work at present is:
> > 
> > 1. Display of bold face.=20
> > 
> > 	- Simple MRS
> > 	- Chart display
> > 	- Leaf nodes in tree display
> > 	- Values (e.g. ORTH) in feature structures
> > 
> > 2. Display of sizes other than 12pt
> > 
> > 	- Input dialogues (Parse|Parse input, View|Word entries)
> > 
> > 3. Display in LUI
> > 
> >         - yzlui does not show the glyphs
> >         - pangolui has layout problems (bar only displays lower half of
> > each char)
> > 
> > Internally, processing of the characters =C6=99, =C9=93 and =C9=97 is fin=
> > e, even
> > uppercasing works.=20
> > 
> > It seems the LKB (or CLIM) insists on using an iso8859-1 encoded font
> > here. If I remove the iso8859-1 fonts (but not the iso10646 font, of
> > course), I get an error message saying that the helvetica iso8859-1 font
> > could not be loaded and fixed is used instead (also with iso8859-1, not
> > iso10646-1).
> > 
> > Apparently there is a problem with font initialisation, either on the
> > part of the LKB or the underlying CLIM.
> > 
> > Any help/comments/advice on the following questions would be
> > appreciated:
> > 
> > 1. I currently have a set of patched LKB function that disable use of
> > bold face. Although this is not ideal, it works except for dialogues.=20
> > 
> > So: How can I make CLIM dialogues use the default 12pt roman font
> > instead of 10pt?
> > 
> > 2. Is it possible to fix font initialisation on the LKB side? Or is that
> > an upstream CLIM bug?=20
> > 
> > If it is an LKB problem, who would be able to fix it? I can provide the
> > fonts (with installation instructions) and some description to reproduce
> > the bug. Anything else needed?
> > 
> > If it is a problem with CLIM, can you pass this bug report on to Franz?
> > If you need any more detail, please let me know.   =20
> > 
> > 
> > 
> > Thanks a lot in advance for your help.=20
> > =20
> > 
> > Cheers,=20
> > 
> > Berthold
> > 
> > 
> > --=-DzmbjNI89XLdFpTfrgze
> > Content-Type: text/html; charset="utf-8"
> > Content-Transfer-Encoding: 7bit
> > 
> > <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 TRANSITIONAL//EN">
> > <HTML>
> > <HEAD>
> >   <META HTTP-EQUIV="Content-Type" CONTENT="text/html; CHARSET=UTF-8">
> >   <META NAME="GENERATOR" CONTENT="GtkHTML/3.24.5">
> > </HEAD>
> > <BODY>
> > Dear&nbsp; all, <BR>
> > <BR>
> > a few weeks ago I posted a question regarding unicode fonts in&nbsp; LKB/LOGON. <BR>
> > <BR>
> > Meanwhile I have partial success with display of unicode characters in LOGON: if the ISO-10646-1 encoded font appears before the ISO-8859-1 font in my font path, display of unicode characters works at *standard* display size (Helvetica, Roman 12pt). <BR>
> > <BR>
> > What does not work at present is:<BR>
> > <BR>
> > 1. Display of bold face. <BR>
> > <BR>
> > 	- Simple MRS<BR>
> > 	- Chart display<BR>
> > 	- Leaf nodes in tree display<BR>
> > 	- Values (e.g. ORTH) in feature structures<BR>
> > <BR>
> > 2. Display of sizes other than 12pt<BR>
> > <BR>
> > 	- Input dialogues (Parse|Parse input, View|Word entries)<BR>
> > <BR>
> > 3. Display in LUI<BR>
> > <BR>
> > &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; - yzlui does not show the glyphs<BR>
> > &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; - pangolui has layout problems (bar only displays lower half of each char)<BR>
> > <BR>
> > Internally, processing of the characters &#409;, &#595; and &#599; is fine, even uppercasing works. <BR>
> > <BR>
> > It seems the LKB (or CLIM) insists on using an iso8859-1 encoded font here. If I remove the iso8859-1 fonts (but not the iso10646 font, of course), I get an error message saying that the helvetica iso8859-1 font could not be loaded and fixed is used instead (also with iso8859-1, not iso10646-1).<BR>
> > <BR>
> > Apparently there is a problem with font initialisation, either on the part of the LKB or the underlying CLIM.<BR>
> > <BR>
> > Any help/comments/advice on the following questions would be appreciated:<BR>
> > <BR>
> > 1. I currently have a set of patched LKB function that disable use of bold face. Although this is not ideal, it works except for dialogues. <BR>
> > <BR>
> > So: How can I make CLIM dialogues use the default 12pt roman font instead of 10pt?<BR>
> > <BR>
> > 2. Is it possible to fix font initialisation on the LKB side? Or is that an upstream CLIM bug? <BR>
> > <BR>
> > If it is an LKB problem, who would be able to fix it? I can provide the fonts (with installation instructions) and some description to reproduce the bug. Anything else needed?<BR>
> > <BR>
> > If it is a problem with CLIM, can you pass this bug report on to Franz? If you need any more detail, please let me know.&nbsp;&nbsp;&nbsp; <BR>
> > <BR>
> > <BR>
> > <BR>
> > Thanks a lot in advance for your help. <BR>
> >  <BR>
> > <BR>
> > Cheers, <BR>
> > <BR>
> > Berthold<BR>
> > <BR>
> > </BODY>
> > </HTML>
> > 
> > --=-DzmbjNI89XLdFpTfrgze--
> > 
-------------- next part --------------
;;; Patches to disable bold fonts in the LKB
;;; Copyright (c) 1997-2004 John Carroll, Ann Copestake, Robert Malouf, Stephan Oepen, Frederik Fouvry
;;; see licence.txt for conditions



(in-package :lkb)



(defun draw-chart-window (window stream &key max-width max-height)
  (declare (ignore max-width max-height))
  (let ((*chart-edges* nil))
    (declare (special *chart-edges*))
    ;; Don't bother if there's no chart
    (unless (null (get (chart-window-root window) 'chart-edge-descendents))
      (clim:format-graph-from-root
       (chart-window-root window) 
       #'(lambda (node stream)
           (multiple-value-bind (s bold-p)
               (chart-node-text-string node)
             (clim:with-text-face (stream 
					;  (if bold-p :bold :roman)
					  )
               (let ((cont (get node 'chart-edge-contents)))
                 (if cont
                     (progn
                       (push cont *chart-edges*)
                       (clim:with-output-as-presentation 
                           (stream cont 'edge)
                         (write-string s stream)))
		   (clim:with-output-as-presentation 
		       (stream (symbol-name node) 'word)
		     (write-string s stream)))))))
       #'(lambda (node) 
           (get node 'chart-edge-descendents))
       ;; This trickery is to avoid drawing the connections from the dummy
       ;; root node to the lexical edges
       :arc-drawer #'(lambda (stream from to x1 y1 x2 y2 &rest args)
                       (when (or (not (symbolp to))
                                 (not (get from 'root)))
			 (apply #'clim-internals::draw-linear-arc
			        (append (list stream from to x1 y1 x2 y2)
			                args))))   
       :stream stream 
       :graph-type :dag
       :merge-duplicates t
       :orientation :horizontal
       :maximize-generations t
       :generation-separation *tree-level-sep*
       :within-generation-separation *tree-node-sep*
       :center-nodes nil)
      (setf (chart-window-edges window) *chart-edges*))))

(defun display-basic-fs-really (fs title parents paths id)
  (let ((fs-window 
         (clim:make-application-frame 'active-fs-window)))
    (setf (active-fs-window-fs fs-window) 
      (make-fs-display-record :fs fs :title title :paths paths 
			      :parents parents
			      :type-fs-display *type-fs-display*
                              :id id))
    (setf (clim:frame-pretty-name fs-window) title)
    ;; Initialize fonts
    (setf *normal* (clim:parse-text-style (list :sans-serif :roman *fs-type-font-size*)))
    (setf *bold* (clim:parse-text-style (list :sans-serif :roman *fs-type-font-size*)))
 ;     (clim:merge-text-styles '(nil :bold nil) *normal*))
    ;; Set up path display
    (let ((path-pane 
	   (find :path (clim:frame-current-panes fs-window)
		 :test #'eq :key #'clim:pane-name)))
      (setf (lkb-window-doc-pane fs-window) path-pane)
      #+:allegro
      (clim:change-space-requirements 
       path-pane
       :resize-frame t
       :height (clim:text-style-height *normal* path-pane)
       :max-height (clim:text-style-height *normal* path-pane)))
    ; Run it
    (clim:run-frame-top-level fs-window)))


(defun draw-parse-tree (ptree-frame stream &key max-width max-height)
  (declare (ignore max-width max-height))
  (let ((node-tree (parse-tree-nodes ptree-frame)))
    (clim:with-text-style (stream (lkb-parse-tree-font))
      (clim:format-graph-from-root
       node-tree
       #'(lambda (node stream)
	   (multiple-value-bind (s bold-p) 
	       (get-string-for-edge node)
	     (clim:with-text-face (stream 
					;(if bold-p :bold :roman)
				   )
	       (if (get node 'edge-record)
		   (clim:with-output-as-presentation (stream node 'symbol)
		     (write-string s stream))
		 (write-string s stream)))))
       #'find-children
       :graph-type :parse-tree
       :stream stream 
       :merge-duplicates nil
       :orientation :vertical
       :generation-separation *ptree-level-sep*
       :within-generation-separation *ptree-node-sep*
       :center-nodes nil))))

(defun draw-res-trees-window (window stream &key max-width max-height)
  (declare (ignore max-width max-height))
  (dolist (tree (parse-tree-frame-trees window))
    (setf (prtree-output-record tree)
    (clim:with-text-style (stream (lkb-summary-tree-font))
      (clim:with-new-output-record (stream)
	(clim:with-output-recording-options (stream :record t)
	  (clim:with-output-as-presentation 
	      (stream tree 'prtree :single-box t)
	    (clim:format-graph-from-root
	     (prtree-top tree)
	     #'(lambda (node stream)
		 (multiple-value-bind (s bold-p) 
		     (get-string-for-edge node)
		   (clim:with-text-face (stream 
					;(if bold-p :bold :roman)
					 )
		     (write-string s stream))))
	     #'find-children
	     :graph-type :parse-tree
	     :stream stream 
	     :merge-duplicates nil
	     :orientation :vertical
	     :generation-separation 5
	     :move-cursor t
	     :within-generation-separation 5
	     :center-nodes nil)))
	(terpri stream))))))


(defun draw-trees-window (frame stream &rest rest)

  (declare (ignore rest))
  ;;
  ;; in case we were displaying the window with an uninitialized frame
  ;;
  (when (null (compare-frame-edges frame))
    (return-from draw-trees-window))

  (setf (compare-frame-tstream frame) stream)
  (unless (and (integerp *tree-display-threshold*)
               (eq (compare-frame-view frame) :classic)
               (> (length (compare-frame-trees frame)) 
                  *tree-display-threshold*))
    (clim:formatting-table (stream :x-spacing "X")
      (loop
          for tree in (compare-frame-trees frame)
          do
            (setf (ctree-ink tree) clim:+foreground-ink+)
            (setf (ctree-record tree)
              (clim:with-new-output-record (stream)
                (clim:with-text-style (stream (comparison-tree-font))
                  (clim:with-output-recording-options (stream :record t)
                    (clim:formatting-row (stream)
                      (clim:formatting-cell 
                          (stream :align-x :center :align-y :top)
                        (clim:with-text-style 
                            (stream 
                             (clim:parse-text-style '(:sans-serif :roman 12)))
                          (format stream "~%[~a]" (ctree-id tree))))
                      (clim:formatting-cell 
                          (stream :align-x :left :align-y :center)
                        (clim:formatting-row (stream)
                          (clim:formatting-cell 
                              (stream :align-x :left :align-y :top)
                            (format stream "~@[(~a)~]~%" (ctree-score tree)))
                          (clim:formatting-cell 
                              (stream :align-x :center :align-y :top)
                            (clim:with-output-as-presentation 
                                (stream tree 'ctree :single-box t)
                              (if (eq (compare-frame-view frame) :classic)
                                (clim:format-graph-from-root
                                 (or (ctree-symbol tree)
                                     (setf (ctree-symbol tree)
                                       (make-new-parse-tree 
                                        (ctree-edge tree) 1)))
                                 #'(lambda (node stream)
                                     (multiple-value-bind (s bold-p) 
                                         (get-string-for-edge node)
                                       (clim:with-text-face
                                           (stream 
					    ;(if bold-p :bold :roman)
					    )
                                         (write-string s stream))))
                                 #'(lambda (node) (get node 'daughters))
                                 :graph-type :parse-tree
                                 :stream stream 
                                 :merge-duplicates nil
                                 :orientation :vertical
                                 :generation-separation 7
                                 :move-cursor t
                                 :within-generation-separation 7
                                 :center-nodes nil)
                                (let ((mrs (edge-mrs (ctree-edge tree))))
                                  (when mrs
                                    (mrs::ed-output-psoa
                                     mrs :stream stream))))))))
                      (terpri stream)))))))
      (when (and (compare-frame-trees frame)
                 (null (rest (compare-frame-trees frame))))
        (draw-trees-window-completion frame stream)))
    (update-tree-colours frame)))


(defun draw-trees-window-completion (frame stream)
  (let* ((hook *tree-completion-hook*)
         (hook (typecase hook
                 (null nil)
                 (function hook)
                 (symbol (and (fboundp hook) (symbol-function hook)))
                 (string (ignore-errors 
                          (symbol-function (read-from-string hook))))))
         (tree (first (compare-frame-trees frame)))
         (edge (ctree-edge tree))
         (mrs (or (edge-mrs edge)
                  (ignore-errors (mrs::extract-mrs edge))))
         (eds (when mrs (ignore-errors (mrs::ed-convert-psoa mrs)))))
    
    (multiple-value-bind (result condition) 
        (when (functionp hook) (ignore-errors (funcall hook edge mrs)))
      (when condition
        (clim:beep)
        (format
         #+:allegro excl:*initial-terminal-io* #-:allegro *terminal-io*
         "tree-completion-hook(): error `~a'.~%"
         (normalize-string (format nil "~a" condition))))
      (let* ((comment (if (stringp result)
                        result
                        (rest (assoc :comment result))))
             (result (unless (stringp result) result))
             (font (rest (assoc :font result)))
             (face (rest (assoc :face result)))
             (size (rest (assoc :size result)))
             (style (when (or font face size)
                      (clim:merge-text-styles
                       (list font face size) '(:sans-serif :bold 12))))
             (color (rest (assoc :color result)))
             (color (ignore-errors (apply #'clim:make-rgb-color color)))
             (bottomp (rest (assoc :bottom result)))
             (align (or (rest (assoc :align result)) :center)))
        (when (and comment (null bottomp))
          (clim:formatting-row (stream)
            (clim:formatting-cell (stream :align-x :center :align-y :top)
              (format stream " ")))
          (let ((record
                 (clim:with-new-output-record (stream)
                   (clim:formatting-row (stream)
                     (clim:formatting-cell 
                         (stream :align-x :center :align-y :top)
                       (format stream "" (ctree-id tree)))
                     (clim:formatting-cell (stream :align-x align)
                       (clim:with-text-style (stream style)
                         (format stream "~%~a" comment)))))))
            (when color (recolor-record record color))
            (clim:replay record stream)))
        (when (and eds (not (eq (compare-frame-view frame) :modern)))
          (clim:formatting-row (stream)
            (clim:formatting-cell (stream :align-x :center :align-y :top)
              (format stream " ")))
          (let ((record 
                 (clim:with-new-output-record (stream)
                   (clim:formatting-row (stream)
                     (clim:formatting-cell 
                         (stream :align-x :center :align-y :top)
                       (clim:with-text-style 
                           (stream 
                            (clim:parse-text-style '(:sans-serif :roman 12)))
                         (format stream "[~a]" (ctree-id tree))))
                     (clim:formatting-cell (stream :align-x :left)
                       (clim:formatting-column (stream)
                         (clim:formatting-cell (stream :align-x :left)
                           (format stream "~@[(~a)~]~%" (ctree-score tree)))
                         (clim:formatting-cell (stream :align-x :center)
                           (clim:with-text-style 
                               (stream (comparison-dependencies-font))
                             (format stream "~a" eds)))))))))
            (recolor-record 
             record
             (let ((status (mrs::ed-suspicious-p eds))
                   (orange (or (clim:find-named-color
                                "orange" (clim:frame-palette frame) 
                                :errorp nil)
                               clim:+yellow+)))
               (cond
                ((member :cyclic status) clim:+red+)
                ((member :fragmented status) orange)
                (t (if (update-match-p frame) clim:+magenta+ clim:+blue+)))))
            (clim:replay record stream)))
        (when (and comment bottomp)
          (clim:formatting-row (stream)
            (clim:formatting-cell (stream :align-x :center :align-y :top)
              (format stream " ")))
          (let ((record
                 (clim:with-new-output-record (stream)
                   (clim:formatting-row (stream)
                     (clim:formatting-cell 
                         (stream :align-x :center :align-y :top)
                       (format stream "" (ctree-id tree)))
                     (clim:formatting-cell (stream :align-x align)
                       (clim:with-text-style (stream style)
                         (format stream "~%~a" comment)))))))
            (when color (recolor-record record color))
            (clim:replay record stream)))))))

(defun add-mrs-pred-region (stream val)
  (let ((pred-rec
         (make-mrs-type-thing :value val)))
    (clim:with-text-style (stream (clim:parse-text-style
    (make-active-fs-type-font-spec)))
      (clim:with-output-as-presentation 
	  (stream pred-rec 'mrs-type-thing)
        (if (stringp val)
          (format stream "~s" val)
          (format stream "~(~a~)" val))))))

(defun show-mrs-window-really (edge &optional mrs title)
  (let ((mframe (clim:make-application-frame 'mrs-simple)))
    (setf *normal* (clim:parse-text-style (make-active-fs-type-font-spec)))
    (setf *bold* (clim:merge-text-styles '(nil :roman nil) *normal*))
    (setf (mrs-simple-mrsstruct mframe) 
      (or mrs (and edge (mrs::extract-mrs edge))))
    (setf (clim:frame-pretty-name mframe) (or title "Simple MRS"))
    (clim:run-frame-top-level mframe)))

(in-package :mt)
(defun mrs-transfer-font ()
  '(:sans-serif :roman 12))




More information about the developers mailing list