Changeset 2990

Timestamp:

02/12/03 21:41:06 (6 years ago)

Author:

miyoshi

Message:

* international/mw32misc.el (w32-regist-initial-font): Rename
w32-charset-encoding-alist mw32-charset-windows-font-info-alist.
(set-font-from-logfont): Ditto.
(w32-enum-logfont-from-charset): Ditto.
(w32-modify-logfont-from-request): Modify italic component too.
(mw32-build-font-spec): New function.
(create-fontset-from-request): Build strict-spec of font requests.
(change-fontset-from-request): Ditto.

* international/meadow.el: Add BMP to image-type-regexps and
image-file-name-extensions.
Cache the result of w32-enum-logfont().

Files:

• work/cvs2svn/lisp/ChangeLog.Meadow (modified) (1 diff)
• work/cvs2svn/lisp/international/meadow.el (modified) (2 diffs)
• work/cvs2svn/lisp/international/mw32misc.el (modified) (6 diffs)

work/cvs2svn/lisp/ChangeLog.Meadow

@@ +1 @@
+2003-02-12  MIYOSHI Masanori  <miyoshi@boreas.dti.ne.jp>
+
+        * international/mw32misc.el (w32-regist-initial-font): Rename
+        w32-charset-encoding-alist mw32-charset-windows-font-info-alist.
+        (set-font-from-logfont): Ditto.
+        (w32-enum-logfont-from-charset): Ditto.
+        (w32-modify-logfont-from-request): Modify italic component too.
+        (mw32-build-font-spec): New function.
+        (create-fontset-from-request): Build strict-spec of font requests.
+        (change-fontset-from-request): Ditto.
+
+        * international/meadow.el: Add BMP to image-type-regexps and
+        image-file-name-extensions.
+        Cache the result of w32-enum-logfont().
+
-2003-01-30  MIYOSHI Masanori  <miyoshi@boreas.dti.ne.jp>
-

work/cvs2svn/lisp/international/meadow.el

@@ -26 +26 @@
-       (fboundp 'image-mask-p)
-       (fboundp 'image-size)))
+
+;; BMP support
+(let (image-type)
+  (setq image-type
+        (cond ((memq 'bmp image-types) 'bmp) ; ImageMagick image decoder
+              ((memq 'BMP image-types) 'BMP))) ; built-in image decoder
+  (when image-type
+    (require 'image)
+    (require 'image-file)
+
+    (or (rassq 'bmp image-type-regexps)
+        (setq image-type-regexps
+              (cons (cons "\\`BM" image-type) image-type-regexps)))
+
+    (or (member "bmp" image-file-name-extensions)
+        (setq image-file-name-extensions
+              (cons "bmp" image-file-name-extensions)))))
-
-;;;
@@ -477 +494 @@
-                       "MW32 System IME")
-
+
+;;;
+;;; cache for enumerated logfonts
+;;;
+(defvar w32-enum-logfont-cache-file
+  nil
+  ;; "~/.w32_enum_logfont_cache"
+  "*The cache file that contains enumerated logfonts, if it is non-nil.")
+
+(defvar w32-enum-logfont-cache nil
+  "*The cache variable that contains enumerated logfonts.")
+
+(unless (fboundp 'w32-enum-logfont-original)
+  (fset 'w32-enum-logfont-original (symbol-function 'w32-enum-logfont))
+  (defun w32-enum-logfont (&optional family device)
+    (if (or family device)
+        (w32-enum-logfont-original family device)
+      (if w32-enum-logfont-cache
+          w32-enum-logfont-cache
+        (if (null w32-enum-logfont-cache-file)
+            (setq w32-enum-logfont-cache
+                  (w32-enum-logfont-original family device))
+          (setq w32-enum-logfont-cache-file
+                (expand-file-name w32-enum-logfont-cache-file))
+          (when (file-exists-p w32-enum-logfont-cache-file)
+            (with-temp-buffer
+              (let ((coding-system-for-read 'iso-2022-7bit))
+                (insert-file-contents w32-enum-logfont-cache-file))
+              (condition-case nil
+                  (setq w32-enum-logfont-cache
+                        (read (current-buffer)))
+                (error nil)))))
+        (when (null w32-enum-logfont-cache)
+          (setq w32-enum-logfont-cache
+                (w32-enum-logfont-original family device))
+          (with-temp-buffer
+            (let ((coding-system-for-write 'iso-2022-7bit)
+                  print-level print-length)
+              (prin1 w32-enum-logfont-cache (current-buffer))
+              (write-file w32-enum-logfont-cache-file))))
+        w32-enum-logfont-cache))))
+
-(provide 'meadow)
-

work/cvs2svn/lisp/international/mw32misc.el

@@ -448 +448 @@
-
-(defun w32-automatic-fontset-regist (name orgfont)
-w32-charset-encoding
+mw32-charset-windows-font-info
-        x ret)
-    (while encoding-alist
@@ -547 +547 @@
-        (progn
-          (setq w32-logfont-info
-w32-charset-encoding
+mw32-charset-windows-font-info
-          (setq w32-alist
-                (setq alist (nth 3 w32-logfont-info)))
@@ -599 +599 @@
-      (setq ms-charset
-            (nth 1
-w32-charset-encoding
+mw32-charset-windows-font-info
-      (if (null ms-charset)
-          nil
@@ -714 +714 @@
-        (weight (or (assq 'weight required)
-                    (assq 'weight recommended)))
+        (italic (or (assq 'italic required)
+                    (assq 'italic recommended)))
-        result)
-
@@ -743 +745 @@
-        (setcar (nthcdr 4 result)
-                (cdr weight)))
+    (if italic
+        (setcar (nthcdr 6 result)
+                (cdr italic)))
-    result))
-
@@ -759 +764 @@
-          (function w32-logfont-list-from-request))
-
+(defun mw32-build-font-spec (charset height weight slant)
+  (list :char-spec charset
+        :height (if height
+                    (/ (* height 720) 96) ; pixel -> 0.1 point
+                  'any)
+        :weight weight
+        :slant slant))
+
-(defun create-fontset-from-request
-  (name required recommended)
-  "Create fontset from your request."
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-(defun change-fontset-from-request
-  (name required recommended &optional property)
-  "Change fontset from your request."
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-