This commit was generated by cvs2svn to compensate for changes in r4995,

[chise/xemacs-chise.git.1] / lisp / font-menu.el

diff --git a/lisp/font-menu.el b/lisp/font-menu.el
index 14c680d..c406ddc 100644 (file)
--- a/lisp/font-menu.el
+++ b/lisp/font-menu.el
@@ -42,7 +42,7 @@
 ;;; were always selectable, and selecting them would set the size to be the
 ;;; closest size to the current font's size.
 ;;;
-;;; This attempts to change all other faces in an analogous way to the change
+;;; This attempts to change all other faces in an analagous way to the change
 ;;; that was made to the default face; if it can't, it will skip over the face.
 ;;; However, this could leave incongruous font sizes around, which may cause
 ;;; some nonreversibility problems if further changes are made.  Perhaps it
@@ -168,6 +168,16 @@ the last entry in the menu."
                                              ((x) . 10))) t)
   "Scale factor used in defining font sizes.")
 
+(defun vassoc (key valist)
+  "Search VALIST for a vector whose first element is equal to KEY.
+See also `assoc'."
+  ;; by Stig@hackvan.com
+  (let (el)
+    (catch 'done
+      (while (setq el (pop valist))
+       (and (equal key (aref el 0))
+            (throw 'done el))))))
+
 ;; only call XListFonts (and parse) once per device.
 ;; ( (device . [parsed-list-fonts family-menu size-menu weight-menu]) ...)
 (defvar device-fonts-cache nil)
@@ -197,12 +207,12 @@ or if you change your font path, you can call this to re-initialize the menus."
     (message "Getting list of fonts from server... done.")))
 
 (defun font-menu-split-long-menu (menu)
-  "Split MENU according to `font-menu-max-items' and add accelerator specs."
+  "Split MENU according to `font-menu-max-items'."
   (let ((len (length menu)))
     (if (or (null font-menu-max-items)
            (null (featurep 'lisp-float-type))
            (<= len font-menu-max-items))
-       (submenu-generate-accelerator-spec menu)
+       menu
       ;; Submenu is max 2 entries longer than menu, never shorter, number of
       ;; entries in submenus differ by at most one (with longer submenus first)
       (let* ((outer (floor (sqrt len)))
@@ -221,20 +231,14 @@ or if you change your font path, you can call this to re-initialize the menus."
            (setq result
                  (cons (cons (if (stringp font-menu-submenu-name-format)
                                  (format font-menu-submenu-name-format
-                                         (menu-item-strip-accelerator-spec
-                                          (aref (car sub) 0))
-                                         (menu-item-strip-accelerator-spec
-                                          (aref to 0)))
+                                         (aref (car sub) 0) (aref to 0))
                                (funcall font-menu-submenu-name-format
-                                        (menu-item-strip-accelerator-spec
-                                         (aref (car sub) 0))
-                                        (menu-item-strip-accelerator-spec
-                                         (aref to 0))))
-                             (submenu-generate-accelerator-spec sub))
+                                        (aref (car sub) 0) (aref to 0)))
+                             sub)
                        result)
                  rest  (1+ rest))
            (if (= rest outer) (setq inner (1+ inner)))))
-       (submenu-generate-accelerator-spec result)))))
+       result))))
 
 ;;;###autoload
 (defun font-menu-family-constructor (ignored)
@@ -257,7 +261,7 @@ or if you change your font path, you can call this to re-initialize the menus."
       (font-menu-split-long-menu
        (mapcar
        (lambda (item)
-         (setq f (menu-item-strip-accelerator-spec (aref item 0))
+         (setq f (aref item 0)
                entry (vassoc f (aref dcache 0)))
          (if (and (or (member weight (aref entry 1))
                       ;; mswindows often allows any weight
@@ -305,7 +309,7 @@ or if you change your font path, you can call this to re-initialize the menus."
             (select-toggle-menu-item item)
           (deselect-toggle-menu-item item))
         item)
-       (submenu-generate-accelerator-spec (aref dcache 2))))))
+       (aref dcache 2)))))
 
 ;;;###autoload
 (defun font-menu-weight-constructor (ignored)
@@ -334,7 +338,7 @@ or if you change your font path, you can call this to re-initialize the menus."
             (select-toggle-menu-item item)
           (deselect-toggle-menu-item item))
         item)
-       (submenu-generate-accelerator-spec (aref dcache 3))))))
+       (aref dcache 3)))))
 
 \f
 ;;; Changing font sizes
@@ -347,10 +351,11 @@ or if you change your font path, you can call this to re-initialize the menus."
         (font-data (font-menu-font-data 'default dcache))
         (from-family (aref font-data 1))
         (from-size   (aref font-data 2))
-          (from-weight (aref font-data 3))
+        (from-weight (aref font-data 3))
         (from-slant  (aref font-data 4))
-        (face-list-to-change (delq 'default (face-list)))
-        new-default-face-font)
+        (face-list-to-change (delq 'default (face-list)))
+        new-default-face-font
+        new-props)
     (unless from-family
       (signal 'error '("couldn't parse font name for default face")))
     (when weight
@@ -390,15 +395,14 @@ or if you change your font path, you can call this to re-initialize the menus."
        (set-face-font 'default new-default-face-font
                       (and font-menu-this-frame-only-p (selected-frame)))
       ;; OK Let Customize do it.
-      (custom-set-face-update-spec 'default
-                                  (list (list 'type (device-type)))
-                                  (list :family family
-                                        :size (concat
-                                               (int-to-string
-                                                (/ (or size from-size)
-                                                   (specifier-instance font-menu-size-scaling
-                                                                       (selected-device))))
-                                               "pt")))          
+      (when (and family (not (equal family from-family)))
+       (setq new-props (append (list :family family) new-props)))
+      (when (and size (not (equal size from-size)))
+       (setq new-props (append
+          (list :size (concat (int-to-string (/ size (specifier-instance
+                                                      font-menu-size-scaling
+                                                      (selected-device)))) "pt")) new-props)))
+      (custom-set-face-update-spec 'default '((type x)) new-props)
       (message "Font %s" (face-font-name 'default)))))