emacs-pretest-bug
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Aquamacs-bugs] Re: incorrect fontification of non-ascii chars on Ma


From: YAMAMOTO Mitsuharu
Subject: Re: [Aquamacs-bugs] Re: incorrect fontification of non-ascii chars on Mac OS X 10.4
Date: Tue, 05 Jul 2005 12:56:01 +0900
User-agent: Wanderlust/2.14.0 (Africa) SEMI/1.14.6 (Maruoka) FLIM/1.14.6 (Marutamachi) APEL/10.6 Emacs/22.0.50 (sparc-sun-solaris2.8) MULE/5.0 (SAKAKI)

>>>>> On Fri, 01 Jul 2005 17:02:49 +0900, YAMAMOTO Mitsuharu <address@hidden> 
>>>>> said:

> I'm now trying to make create-fontset-from-mac-roman-font faster by
> creating a template for character mapping and reusing it.  The code
> at the end of this mail makes it 5 times faster (without removing
> the Foptimize_char_table call).  Unfortunately, it introduces some
> wrong glyphs and I suspect there's a bug in fontset manipulation.

How about the patch below?  I think it does not introduce wrong
glyphs.  Originally it took 2.98sec for 10 calls of
create-fontset-from-mac-roman-font, now it becomes 0.34sec (on
PowerBook G4 677MHz, Mac OS X 10.3.9, compiled with -fast -mcpu=7450).

                                     YAMAMOTO Mitsuharu
                                address@hidden

Index: lisp/term/mac-win.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/term/mac-win.el,v
retrieving revision 1.48
diff -c -r1.48 mac-win.el
*** lisp/term/mac-win.el        4 Jul 2005 16:49:23 -0000       1.48
--- lisp/term/mac-win.el        5 Jul 2005 03:47:56 -0000
***************
*** 1603,1608 ****
--- 1621,1672 ----
               mac-font-encoder-list)
         font-ccl-encoder-alist))
  
+ (defconst mac-char-fontspec-list
+   ;; Directly operate on a char-table instead of a fontset so that it
+   ;; may not create a dummy fontset.
+   (let ((template (make-char-table 'fontset)))
+     (dolist
+       (font-encoder
+        (nreverse
+         (mapcar (lambda (lst)
+                   (cons (cons (nth 3 lst) (nth 0 lst)) (nth 1 lst)))
+                 mac-font-encoder-list)))
+       (let ((font (car font-encoder))
+           (encoder (cdr font-encoder)))
+       (map-char-table
+        (lambda (key val)
+          (or (null val)
+              (generic-char-p key)
+              (memq (char-charset key)
+                    '(ascii eight-bit-control eight-bit-graphic))
+              (aset template key font)))
+        (get encoder 'translation-table))))
+ 
+     ;; Like fontset-info, but extend a range only if its "to" part is
+     ;; the predecessor of the current char.
+     (let* ((first '((0 nil)))
+          (accumulator (cons first first))
+          last last-char-or-range last-char last-elt)
+       (map-char-table
+        (lambda (char elt)
+        (when elt
+          (setq last (car accumulator)
+                last-char-or-range (car (car last))
+                last-char (if (consp last-char-or-range)
+                              (cdr last-char-or-range)
+                            last-char-or-range)
+                last-elt (cdr (car last)))
+          (if (and (eq elt last-elt)
+                   (= char (1+ last-char))
+                   (eq (char-charset char) (char-charset last-char)))
+              (if (consp last-char-or-range)
+                  (setcdr last-char-or-range char)
+                (setcar (car last) (cons last-char char)))
+            (setcdr last (list (cons char elt)))
+            (setcar accumulator (cdr last)))))
+        template)
+       (cdr (cdr accumulator)))))
+ 
  (defun fontset-add-mac-fonts (fontset &optional base-family)
    (if base-family
        (setq base-family (downcase base-family))
***************
*** 1611,1637 ****
                      (fontset-font fontset (charset-id 'ascii))))))
        (setq base-family (aref (x-decompose-font-name ascii-font)
                              xlfd-regexp-family-subnum))))
! ;;  (if (not (string-match "^fontset-" fontset))
! ;;      (setq fontset
! ;;        (concat "fontset-" (aref (x-decompose-font-name fontset)
! ;;                                 xlfd-regexp-encoding-subnum))))
!   (dolist
!       (font-encoder
!        (nreverse
!       (mapcar (lambda (lst)
!                 (cons (cons (format (nth 3 lst) base-family) (nth 0 lst))
!                       (nth 1 lst)))
!               mac-font-encoder-list)))
!     (let ((font (car font-encoder))
!         (encoder (cdr font-encoder)))
!       (map-char-table
!        (lambda (key val)
!        (or (null val)
!            (generic-char-p key)
!            (memq (char-charset key)
!                  '(ascii eight-bit-control eight-bit-graphic))
!            (set-fontset-font fontset key font)))
!        (get encoder 'translation-table)))))
  
  (defun create-fontset-from-mac-roman-font (font &optional resolved-font
                                                fontset-name)
--- 1675,1689 ----
                      (fontset-font fontset (charset-id 'ascii))))))
        (setq base-family (aref (x-decompose-font-name ascii-font)
                              xlfd-regexp-family-subnum))))
!   (let (fontspec-cache fontspec)
!     (dolist (char-fontspec mac-char-fontspec-list)
!       (setq fontspec (cdr (assq (cdr char-fontspec) fontspec-cache)))
!       (when (null fontspec)
!       (setq fontspec (cons (format (car (cdr char-fontspec)) base-family)
!                            (cdr (cdr char-fontspec))))
!       (setq fontspec-cache (cons (cons (cdr char-fontspec) fontspec)
!                                  fontspec-cache)))
!       (set-fontset-font fontset (car char-fontspec) fontspec))))
  
  (defun create-fontset-from-mac-roman-font (font &optional resolved-font
                                                fontset-name)




reply via email to

[Prev in Thread] Current Thread [Next in Thread]