Mercurial > hg > xemacs-beta

comparison lisp/font-menu.el @ 771:943eaba38521

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents 1ccc32a20af4
children 79c6ff3eef26
comparison
equal deleted inserted replaced
770:336a418893b5 771:943eaba38521
134 "*If non-nil, then changing the default font from the font menu will only 134 "*If non-nil, then changing the default font from the font menu will only
135 affect one frame instead of all frames." 135 affect one frame instead of all frames."
136 :type 'boolean 136 :type 'boolean
137 :group 'font-menu) 137 :group 'font-menu)
138 138
139 (defcustom font-menu-max-items 25 139 (defvaralias 'font-menu-max-items 'menu-max-items)
140 "*Maximum number of items in the font menu 140 (defvaralias 'font-menu-submenu-name-format 'menu-submenu-name-format)
141 If number of entries in a menu is larger than this value, split menu
142 into submenus of nearly equal length. If nil, never split menu into
143 submenus."
144 :group 'font-menu
145 :type '(choice (const :tag "no submenus" nil)
146 (integer)))
147
148 (defcustom font-menu-submenu-name-format "%-12.12s ... %.12s"
149 "*Format specification of the submenu name.
150 Used by `font-menu-split-long-menu' if the number of entries in a menu is
151 larger than `font-menu-menu-max-items'.
152 This string should contain one %s for the name of the first entry and
153 one %s for the name of the last entry in the submenu.
154 If the value is a function, it should return the submenu name. The
155 function is be called with two arguments, the names of the first and
156 the last entry in the menu."
157 :group 'font-menu
158 :type '(choice (string :tag "Format string")
159 (function)))
160 141
161 (defvar font-menu-preferred-resolution 142 (defvar font-menu-preferred-resolution
162 (make-specifier-and-init 'generic '((global ((mswindows) . ":") 143 (make-specifier-and-init 'generic '((global ((mswindows) . ":")
163 ((x) . "*-*"))) t) 144 ((x) . "*-*"))) t)
164 "Preferred horizontal and vertical font menu resolution (e.g. \"75:75\").") 145 "Preferred horizontal and vertical font menu resolution (e.g. \"75:75\").")
193 (if (or noninteractive 174 (if (or noninteractive
194 (not (or device (setq device (selected-device))))) 175 (not (or device (setq device (selected-device)))))
195 nil 176 nil
196 (call-device-method 'reset-device-font-menus device device debug) 177 (call-device-method 'reset-device-font-menus device device debug)
197 (message "Getting list of fonts from server... done."))) 178 (message "Getting list of fonts from server... done.")))
198
199 (defun font-menu-split-long-menu (menu)
200 "Split MENU according to `font-menu-max-items' and add accelerator specs."
201 (let ((len (length menu)))
202 (if (or (null font-menu-max-items)
203 (null (featurep 'lisp-float-type))
204 (<= len font-menu-max-items))
205 (submenu-generate-accelerator-spec menu)
206 ;; Submenu is max 2 entries longer than menu, never shorter, number of
207 ;; entries in submenus differ by at most one (with longer submenus first)
208 (let* ((outer (floor (sqrt len)))
209 (inner (/ len outer))
210 (rest (% len outer))
211 (result nil))
212 (setq menu (reverse menu))
213 (while menu
214 (let ((in inner)
215 (sub nil)
216 (to (car menu)))
217 (while (> in 0)
218 (setq in (1- in)
219 sub (cons (car menu) sub)
220 menu (cdr menu)))
221 (setq result
222 (cons (cons (if (stringp font-menu-submenu-name-format)
223 (format font-menu-submenu-name-format
224 (menu-item-strip-accelerator-spec
225 (aref (car sub) 0))
226 (menu-item-strip-accelerator-spec
227 (aref to 0)))
228 (funcall font-menu-submenu-name-format
229 (menu-item-strip-accelerator-spec
230 (aref (car sub) 0))
231 (menu-item-strip-accelerator-spec
232 (aref to 0))))
233 (submenu-generate-accelerator-spec sub))
234 result)
235 rest (1+ rest))
236 (if (= rest outer) (setq inner (1+ inner)))))
237 (submenu-generate-accelerator-spec result)))))
238 179
239 ;;;###autoload 180 ;;;###autoload
240 (defun font-menu-family-constructor (ignored) 181 (defun font-menu-family-constructor (ignored)
241 (catch 'menu 182 (catch 'menu
242 (unless (console-on-window-system-p) 183 (unless (console-on-window-system-p)
252 (throw 'menu '(["Cannot parse current font" ding nil]))) 193 (throw 'menu '(["Cannot parse current font" ding nil])))
253 ;; Items on the Font menu are enabled iff that font exists in 194 ;; Items on the Font menu are enabled iff that font exists in
254 ;; the same size and weight as the current font (scalable fonts 195 ;; the same size and weight as the current font (scalable fonts
255 ;; exist in every size). Only the current font is marked as 196 ;; exist in every size). Only the current font is marked as
256 ;; selected. 197 ;; selected.
257 (font-menu-split-long-menu 198 (menu-split-long-menu
258 (mapcar 199 (mapcar
259 (lambda (item) 200 (lambda (item)
260 (setq f (menu-item-strip-accelerator-spec (aref item 0)) 201 (setq f (menu-item-strip-accelerator-spec (aref item 0))
261 entry (vassoc f (aref dcache 0))) 202 entry (vassoc f (aref dcache 0)))
262 (if (and (or (member weight (aref entry 1)) 203 (if (and (or (member weight (aref entry 1))