aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJim Blandy1993-05-09 23:38:29 +0000
committerJim Blandy1993-05-09 23:38:29 +0000
commitbb9a81fcdaeca9fbb65e9a70940528e2867b08cd (patch)
tree437c17487aca6005b1352dd0527d6181136ced14
parent9b54f2680c29949a2fc5ac24150644ff449166bf (diff)
downloademacs-bb9a81fcdaeca9fbb65e9a70940528e2867b08cd.tar.gz
emacs-bb9a81fcdaeca9fbb65e9a70940528e2867b08cd.zip
* faces.el (read-face-name): Call face-list, not list-faces.
Fail more gracefully if we can't build bold, italic, etc, versions of the default font. * faces.el (make-face-bold, make-face-italic, make-face-bold-italic, make-face-unbold, make-face-unitalic): Implement NOERROR argument. (x-initialize-frame-faces): Use the NOERROR argument to the font manipulation functions to avoid errors while starting up. Remove initialization of isearch font. * xfaces.c (internal-x-complain-about-font): Add new frame argument, so we can check the frame parameters to find the default font. Callers changed. * faces.el (x-create-frame-with-faces): Fix typo. Dyke out code to fully qualify the modeline font; we may not be able to do that correctly.
-rw-r--r--lisp/faces.el239
1 files changed, 120 insertions, 119 deletions
diff --git a/lisp/faces.el b/lisp/faces.el
index 0766894f488..60de2e84817 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -122,7 +122,7 @@ Otherwise report on the defaults for face FACE (for new frames)."
122 (while (= (length face) 0) 122 (while (= (length face) 0)
123 (setq face (completing-read prompt 123 (setq face (completing-read prompt
124 (mapcar '(lambda (x) (list (symbol-name x))) 124 (mapcar '(lambda (x) (list (symbol-name x)))
125 (list-faces)) 125 (face-list))
126 nil t))) 126 nil t)))
127 (intern face))) 127 (intern face)))
128 128
@@ -456,123 +456,137 @@ of it. If it fails, it returns nil."
456 456
457;;; non-X-specific interface 457;;; non-X-specific interface
458 458
459(defun make-face-bold (face &optional frame) 459(defun make-face-bold (face &optional frame noerror)
460 "Make the font of the given face be bold, if possible. 460 "Make the font of the given face be bold, if possible.
461Returns nil on failure." 461If NOERROR is non-nil, return nil on failure."
462 (interactive (list (read-face-name "Make which face bold: "))) 462 (interactive (list (read-face-name "Make which face bold: ")))
463 (let ((ofont (face-font face frame))) 463 (let ((ofont (face-font face frame))
464 font f2)
464 (if (null frame) 465 (if (null frame)
465 (let ((frames (frame-list))) 466 (let ((frames (frame-list)))
466 (while frames 467 (while frames
467 (make-face-bold face (car frames)) 468 (make-face-bold face (car frames))
468 (setq frames (cdr frames)))) 469 (setq frames (cdr frames))))
469 (setq face (internal-get-face face frame)) 470 (setq face (internal-get-face face frame))
470 (let ((font (or (face-font face frame) 471 (setq font (or (face-font face frame)
471 (face-font face t) 472 (face-font face t)
472 (face-font 'default frame))) 473 (face-font 'default frame)
473 f2) 474 (cdr (assq 'font (frame-parameters frame)))))
474 (or (and (setq f2 (x-make-font-bold font)) 475 (or (and (setq f2 (x-make-font-bold font))
475 (try-face-font face f2)) 476 (internal-try-face-font face f2))
476 (and (setq f2 (x-make-font-demibold font)) 477 (and (setq f2 (x-make-font-demibold font))
477 (try-face-font face f2))))) 478 (internal-try-face-font face f2))))
478 (not (equal ofont (face-font face))))) 479 (or (not (equal ofont (face-font face)))
479 480 (and (not noerror)
480(defun make-face-italic (face &optional frame) 481 (error "No %s version of %S" face ofont)))))
482
483(defun make-face-italic (face &optional frame noerror)
481 "Make the font of the given face be italic, if possible. 484 "Make the font of the given face be italic, if possible.
482Returns nil on failure." 485If NOERROR is non-nil, return nil on failure."
483 (interactive (list (read-face-name "Make which face italic: "))) 486 (interactive (list (read-face-name "Make which face italic: ")))
484 (let ((ofont (face-font face frame))) 487 (let ((ofont (face-font face frame))
488 font f2)
485 (if (null frame) 489 (if (null frame)
486 (let ((frames (frame-list))) 490 (let ((frames (frame-list)))
487 (while frames 491 (while frames
488 (make-face-italic face (car frames)) 492 (make-face-italic face (car frames))
489 (setq frames (cdr frames)))) 493 (setq frames (cdr frames))))
490 (setq face (internal-get-face face frame)) 494 (setq face (internal-get-face face frame))
491 (let ((font (or (face-font face frame) 495 (setq font (or (face-font face frame)
492 (face-font face t) 496 (face-font face t)
493 (face-font 'default frame))) 497 (face-font 'default frame)
494 f2) 498 (cdr (assq 'font (frame-parameters frame)))))
495 (or (and (setq f2 (x-make-font-italic font)) 499 (or (and (setq f2 (x-make-font-italic font))
496 (try-face-font face f2)) 500 (internal-try-face-font face f2))
497 (and (setq f2 (x-make-font-oblique font)) 501 (and (setq f2 (x-make-font-oblique font))
498 (try-face-font face f2))))) 502 (internal-try-face-font face f2))))
499 (not (equal ofont (face-font face))))) 503 (or (not (equal ofont (face-font face)))
500 504 (and (not noerror)
501(defun make-face-bold-italic (face &optional frame) 505 (error "No %s version of %S" face ofont)))))
506
507(defun make-face-bold-italic (face &optional frame noerror)
502 "Make the font of the given face be bold and italic, if possible. 508 "Make the font of the given face be bold and italic, if possible.
503Returns nil on failure." 509If NOERROR is non-nil, return nil on failure."
504 (interactive (list (read-face-name "Make which face bold-italic: "))) 510 (interactive (list (read-face-name "Make which face bold-italic: ")))
505 (let ((ofont (face-font face frame))) 511 (let ((ofont (face-font face frame))
512 font f2 f3)
506 (if (null frame) 513 (if (null frame)
507 (let ((frames (frame-list))) 514 (let ((frames (frame-list)))
508 (while frames 515 (while frames
509 (make-face-bold-italic face (car frames)) 516 (make-face-bold-italic face (car frames))
510 (setq frames (cdr frames)))) 517 (setq frames (cdr frames))))
511 (setq face (internal-get-face face frame)) 518 (setq face (internal-get-face face frame))
512 (let ((font (or (face-font face frame) 519 (setq font (or (face-font face frame)
513 (face-font face t) 520 (face-font face t)
514 (face-font 'default frame))) 521 (face-font 'default frame)
515 f2 f3) 522 (cdr (assq 'font (frame-parameters frame)))))
516 (or (and (setq f2 (x-make-font-italic font)) 523 (or (and (setq f2 (x-make-font-italic font))
517 (not (equal font f2)) 524 (not (equal font f2))
518 (setq f3 (x-make-font-bold f2)) 525 (setq f3 (x-make-font-bold f2))
519 (not (equal f2 f3)) 526 (not (equal f2 f3))
520 (try-face-font face f3)) 527 (internal-try-face-font face f3))
521 (and (setq f2 (x-make-font-oblique font)) 528 (and (setq f2 (x-make-font-oblique font))
522 (not (equal font f2)) 529 (not (equal font f2))
523 (setq f3 (x-make-font-bold f2)) 530 (setq f3 (x-make-font-bold f2))
524 (not (equal f2 f3)) 531 (not (equal f2 f3))
525 (try-face-font face f3)) 532 (internal-try-face-font face f3))
526 (and (setq f2 (x-make-font-italic font)) 533 (and (setq f2 (x-make-font-italic font))
527 (not (equal font f2)) 534 (not (equal font f2))
528 (setq f3 (x-make-font-demibold f2)) 535 (setq f3 (x-make-font-demibold f2))
529 (not (equal f2 f3)) 536 (not (equal f2 f3))
530 (try-face-font face f3)) 537 (internal-try-face-font face f3))
531 (and (setq f2 (x-make-font-oblique font)) 538 (and (setq f2 (x-make-font-oblique font))
532 (not (equal font f2)) 539 (not (equal font f2))
533 (setq f3 (x-make-font-demibold f2)) 540 (setq f3 (x-make-font-demibold f2))
534 (not (equal f2 f3)) 541 (not (equal f2 f3))
535 (try-face-font face f3))))) 542 (internal-try-face-font face f3))))
536 (not (equal ofont (face-font face frame))))) 543 (or (not (equal ofont (face-font face)))
537 544 (and (not noerror)
538(defun make-face-unbold (face &optional frame) 545 (error "No %s version of %S" face ofont)))))
546
547(defun make-face-unbold (face &optional frame noerror)
539 "Make the font of the given face be non-bold, if possible. 548 "Make the font of the given face be non-bold, if possible.
540Returns nil on failure." 549If NOERROR is non-nil, return nil on failure."
541 (interactive (list (read-face-name "Make which face non-bold: "))) 550 (interactive (list (read-face-name "Make which face non-bold: ")))
542 (let ((ofont (face-font face frame))) 551 (let ((ofont (face-font face frame))
552 font font1)
543 (if (null frame) 553 (if (null frame)
544 (let ((frames (frame-list))) 554 (let ((frames (frame-list)))
545 (while frames 555 (while frames
546 (make-face-unbold face (car frames)) 556 (make-face-unbold face (car frames))
547 (setq frames (cdr frames)))) 557 (setq frames (cdr frames))))
548 (setq face (internal-get-face face frame)) 558 (setq face (internal-get-face face frame))
549 (let ((font (x-make-font-unbold 559 (setq font1 (or (face-font face frame)
550 (or (face-font face frame) 560 (face-font face t)
551 (face-font face t) 561 (face-font 'default frame)
552 (face-font 'default frame))))) 562 (cdr (assq 'font (frame-parameters frame)))))
553 (if font (try-face-font face font)))) 563 (setq font (x-make-font-unbold font1))
554 (not (equal ofont (face-font face frame))))) 564 (if font (internal-try-face-font face font)))
555 565 (or (not (equal ofont (face-font face)))
556(defun make-face-unitalic (face &optional frame) 566 (and (not noerror)
567 (error "No %s version of %S" face ofont)))))
568
569(defun make-face-unitalic (face &optional frame noerror)
557 "Make the font of the given face be non-italic, if possible. 570 "Make the font of the given face be non-italic, if possible.
558Returns nil on failure." 571If NOERROR is non-nil, return nil on failure."
559 (interactive (list (read-face-name "Make which face non-italic: "))) 572 (interactive (list (read-face-name "Make which face non-italic: ")))
560 (let ((ofont (face-font face frame))) 573 (let ((ofont (face-font face frame))
574 font font1)
561 (if (null frame) 575 (if (null frame)
562 (let ((frames (frame-list))) 576 (let ((frames (frame-list)))
563 (while frames 577 (while frames
564 (make-face-unitalic face (car frames)) 578 (make-face-unitalic face (car frames))
565 (setq frames (cdr frames)))) 579 (setq frames (cdr frames))))
566 (setq face (internal-get-face face frame)) 580 (setq face (internal-get-face face frame))
567 (let ((font (x-make-font-unitalic 581 (setq font1 (or (face-font face frame)
568 (or (face-font face frame) 582 (face-font face t)
569 (face-font face t) 583 (face-font 'default frame)
570 (face-font 'default frame))))) 584 (cdr (assq 'font (frame-parameters frame)))))
571 (if font (try-face-font face font)))) 585 (setq font (x-make-font-unitalic font1))
572 (not (equal ofont (face-font face frame))))) 586 (if font (internal-try-face-font face font)))
573 587 (or (not (equal ofont (face-font face)))
574 588 (and (not noerror)
575 589 (error "No %s version of %S" face ofont)))))
576 590
577;;; Make the builtin faces; the C code knows these as faces 0, 1, and 2, 591;;; Make the builtin faces; the C code knows these as faces 0, 1, and 2,
578;;; respectively, so they must be the first three faces made. 592;;; respectively, so they must be the first three faces made.
@@ -614,33 +628,33 @@ Returns nil on failure."
614;;; 628;;;
615(defun x-initialize-frame-faces (frame) 629(defun x-initialize-frame-faces (frame)
616 (or (face-differs-from-default-p 'bold frame) 630 (or (face-differs-from-default-p 'bold frame)
617 (make-face-bold 'bold frame) 631 (make-face-bold 'bold frame t)
618 ;; if default font is bold, then make the `bold' face be unbold. 632 ;; if default font is bold, then make the `bold' face be unbold.
619 (make-face-unbold 'bold frame) 633 (make-face-unbold 'bold frame t)
620 ;; otherwise the luser specified one of the bogus font names 634 ;; otherwise the luser specified one of the bogus font names
621 (internal-x-complain-about-font 'bold) 635 (internal-x-complain-about-font 'bold frame)
622 ) 636 )
623 637
624 (or (face-differs-from-default-p 'italic frame) 638 (or (face-differs-from-default-p 'italic frame)
625 (make-face-italic 'italic frame) 639 (make-face-italic 'italic frame t)
626 (progn 640 (progn
627 (make-face-bold 'italic frame) 641 (make-face-bold 'italic frame t)
628 (internal-x-complain-about-font 'italic)) 642 (internal-x-complain-about-font 'italic frame))
629 ) 643 )
630 644
631 (or (face-differs-from-default-p 'bold-italic frame) 645 (or (face-differs-from-default-p 'bold-italic frame)
632 (make-face-bold-italic 'bold-italic frame) 646 (make-face-bold-italic 'bold-italic frame t)
633 ;; if we couldn't get a bold-italic version, try just bold. 647 ;; if we couldn't get a bold-italic version, try just bold.
634 (make-face-bold 'bold-italic frame) 648 (make-face-bold 'bold-italic frame t)
635 ;; if we couldn't get bold or bold-italic, then that's probably because 649 ;; if we couldn't get bold or bold-italic, then that's probably because
636 ;; the default font is bold, so make the `bold-italic' face be unbold. 650 ;; the default font is bold, so make the `bold-italic' face be unbold.
637 (and (make-face-unbold 'bold-italic frame) 651 (and (make-face-unbold 'bold-italic frame t)
638 (make-face-italic 'bold-italic frame)) 652 (make-face-italic 'bold-italic frame t))
639 ;; if that didn't work, try italic (can this ever happen? what the hell.) 653 ;; if that didn't work, try italic (can this ever happen? what the hell.)
640 (progn 654 (progn
641 (make-face-italic 'bold-italic frame) 655 (make-face-italic 'bold-italic frame t)
642 ;; then bitch and moan. 656 ;; then bitch and moan.
643 (internal-x-complain-about-font 'bold-italic)) 657 (internal-x-complain-about-font 'bold-italic frame))
644 ) 658 )
645 659
646 (or (face-differs-from-default-p 'highlight frame) 660 (or (face-differs-from-default-p 'highlight frame)
@@ -673,28 +687,15 @@ Returns nil on failure."
673 (set-face-background-pixmap 'secondary-selection "gray1" frame) 687 (set-face-background-pixmap 'secondary-selection "gray1" frame)
674 ) 688 )
675 (error (invert-face 'secondary-selection frame)))) 689 (error (invert-face 'secondary-selection frame))))
690 )
676 691
677 (or (face-differs-from-default-p 'isearch frame) 692(defun internal-x-complain-about-font (face frame)
678 (if (x-display-color-p) 693 (message "No %s version of %S"
679 (condition-case ()
680 (set-face-background 'isearch "paleturquoise" frame)
681 (error
682 (condition-case ()
683 (set-face-background 'isearch "green" frame)
684 (error nil))))
685 nil)
686 (make-face-bold 'isearch frame)
687 ;; if default font is bold, then make the `isearch' face be unbold.
688 (make-face-unbold 'isearch frame))
689 ))
690
691(defun internal-x-complain-about-font (face)
692 (if (symbolp face) (setq face (symbol-name face)))
693 (message "%s: couldn't deduce %s %s version of %S\n"
694 invocation-name
695 (if (string-match "\\`[aeiouAEIOU]" face) "an" "a")
696 face 694 face
697 (face-font 'default)) 695 (or (face-font face frame)
696 (face-font face t)
697 (face-font 'default frame)
698 (cdr (assq 'font (frame-parameters frame)))))
698 (sit-for 1)) 699 (sit-for 1))
699 700
700;; Like x-create-frame but also set up the faces. 701;; Like x-create-frame but also set up the faces.
@@ -710,7 +711,7 @@ Returns nil on failure."
710 ;; Also fill them in from X resources. 711 ;; Also fill them in from X resources.
711 (while rest 712 (while rest
712 (setcdr (car rest) (copy-sequence (cdr (car rest)))) 713 (setcdr (car rest) (copy-sequence (cdr (car rest))))
713 (make-face-x-resource-intenal (cdr (car rest)) frame t) 714 (make-face-x-resource-internal (cdr (car rest)) frame t)
714 (setq rest (cdr rest))) 715 (setq rest (cdr rest)))
715 716
716 (setq default (internal-get-face 'default frame) 717 (setq default (internal-get-face 'default frame)
@@ -718,15 +719,15 @@ Returns nil on failure."
718 719
719 (x-initialize-frame-faces frame) 720 (x-initialize-frame-faces frame)
720 721
721 ;; Make sure the modeline face is fully qualified. 722;;; ;; Make sure the modeline face is fully qualified.
722 (if (and (not (face-font modeline frame)) (face-font default frame)) 723;;; (if (and (not (face-font modeline frame)) (face-font default frame))
723 (set-face-font modeline (face-font default frame) frame)) 724;;; (set-face-font modeline (face-font default frame) frame))
724 (if (and (not (face-background modeline frame)) 725;;; (if (and (not (face-background modeline frame))
725 (face-background default frame)) 726;;; (face-background default frame))
726 (set-face-background modeline (face-background default frame) frame)) 727;;; (set-face-background modeline (face-background default frame) frame))
727 (if (and (not (face-foreground modeline frame)) 728;;; (if (and (not (face-foreground modeline frame))
728 (face-foreground default frame)) 729;;; (face-foreground default frame))
729 (set-face-foreground modeline (face-foreground default frame) frame)) 730;;; (set-face-foreground modeline (face-foreground default frame) frame))
730 frame)) 731 frame))
731 732
732(setq frame-creation-function 'x-create-frame-with-faces) 733(setq frame-creation-function 'x-create-frame-with-faces)