Mercurial > hg > xemacs-beta
comparison lisp/x11/x-font-menu.el @ 2:ac2d302a0011 r19-15b2
Import from CVS: tag r19-15b2
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:46:35 +0200 |
| parents | 376386a54a3c |
| children | b82b59fe008d |
comparison
equal
deleted
inserted
replaced
| 1:c0c6a60d29db | 2:ac2d302a0011 |
|---|---|
| 68 ;;; There are at least three kinds of fonts under X11r5: | 68 ;;; There are at least three kinds of fonts under X11r5: |
| 69 ;;; | 69 ;;; |
| 70 ;;; - bitmap fonts, which can be assumed to look as good as possible; | 70 ;;; - bitmap fonts, which can be assumed to look as good as possible; |
| 71 ;;; - bitmap fonts which have been (or can be) automatically scaled to | 71 ;;; - bitmap fonts which have been (or can be) automatically scaled to |
| 72 ;;; a new size, and which almost always look awful; | 72 ;;; a new size, and which almost always look awful; |
| 73 ;;; - and true outline fonts, which should look ok any any size, but in | 73 ;;; - and true outline fonts, which should look ok at any size, but in |
| 74 ;;; practice (on at least some systems) look awful at any size, and | 74 ;;; practice (on at least some systems) look awful at any size, and |
| 75 ;;; even in theory are unlikely ever to look as good as non-scaled | 75 ;;; even in theory are unlikely ever to look as good as non-scaled |
| 76 ;;; bitmap fonts. | 76 ;;; bitmap fonts. |
| 77 ;;; | 77 ;;; |
| 78 ;;; It would be nice to get this code to look for non-scaled bitmap fonts | 78 ;;; It would be nice to get this code to look for non-scaled bitmap fonts |
| 365 '(["Cannot parse current font" ding nil]) | 365 '(["Cannot parse current font" ding nil]) |
| 366 (setq size (string-to-number (match-string 6 name))) | 366 (setq size (string-to-number (match-string 6 name))) |
| 367 (and (string-match x-font-regexp-foundry-and-family name) | 367 (and (string-match x-font-regexp-foundry-and-family name) |
| 368 (setq family (capitalize (match-string 1 name)))) | 368 (setq family (capitalize (match-string 1 name)))) |
| 369 (setq entry (vassoc family (aref dcache 0))) | 369 (setq entry (vassoc family (aref dcache 0))) |
| 370 (mapcar #'(lambda (item) | 370 (mapcar |
| 371 ;; | 371 (lambda (item) |
| 372 ;; Items on the Size menu are enabled iff current font has | 372 ;; |
| 373 ;; that size. Only the size of the current font is | 373 ;; Items on the Size menu are enabled iff current font has |
| 374 ;; selected. (If the current font comes in size 0, it is | 374 ;; that size. Only the size of the current font is |
| 375 ;; scalable, and thus has every size.) | 375 ;; selected. (If the current font comes in size 0, it is |
| 376 ;; | 376 ;; scalable, and thus has every size.) |
| 377 (setq s (nth 3 (aref item 1))) | 377 ;; |
| 378 (if (or (member s (aref entry 2)) | 378 (setq s (nth 3 (aref item 1))) |
| 379 (and (not font-menu-ignore-scaled-fonts) | 379 (if (or (member s (aref entry 2)) |
| 380 (member 0 (aref entry 2)))) | 380 (and (not font-menu-ignore-scaled-fonts) |
| 381 (enable-menu-item item) | 381 (member 0 (aref entry 2)))) |
| 382 (disable-menu-item item)) | 382 (enable-menu-item item) |
| 383 (if (eq size s) | 383 (disable-menu-item item)) |
| 384 (select-toggle-menu-item item) | 384 (if (eq size s) |
| 385 (deselect-toggle-menu-item item)) | 385 (select-toggle-menu-item item) |
| 386 item) | 386 (deselect-toggle-menu-item item)) |
| 387 (aref dcache 2))) | 387 item) |
| 388 (aref dcache 2))) | |
| 388 ))) | 389 ))) |
| 389 | 390 |
| 390 ;;;###autoload | 391 ;;;###autoload |
| 391 (defun font-menu-weight-constructor (ignored) | 392 (defun font-menu-weight-constructor (ignored) |
| 392 ;; by Stig@hackvan.com | 393 ;; by Stig@hackvan.com |