Mercurial > emacs

comparison lisp/faces.el @ 12651:4bb00f26c714

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(make-face-bold, make-face-italic, make-face-bold-italic) (make-face-unbold, make-face-unitalic): No error if font is already bold, italic, or whatever.
author Richard M. Stallman <rms@gnu.org>
date Tue, 25 Jul 1995 04:50:43 +0000
parents 8e4a75fa4b5b
children 7660e82d0346
comparison
equal deleted inserted replaced
12650:6f4785fee5cc 12651:4bb00f26c714
689 (interactive (list (read-face-name "Make which face bold: "))) 689 (interactive (list (read-face-name "Make which face bold: ")))
690 (if (and (eq frame t) (listp (face-font face t))) 690 (if (and (eq frame t) (listp (face-font face t)))
691 (set-face-font face (if (memq 'italic (face-font face t)) 691 (set-face-font face (if (memq 'italic (face-font face t))
692 '(bold italic) '(bold)) 692 '(bold italic) '(bold))
693 t) 693 t)
694 (let ((ofont (face-font face frame)) 694 (let (font)
695 font)
696 (if (null frame) 695 (if (null frame)
697 (let ((frames (frame-list))) 696 (let ((frames (frame-list)))
698 ;; Make this face bold in global-face-data. 697 ;; Make this face bold in global-face-data.
699 (make-face-bold face t noerror) 698 (make-face-bold face t noerror)
700 ;; Make this face bold in each frame. 699 ;; Make this face bold in each frame.
707 (if (listp font) 706 (if (listp font)
708 (setq font nil)) 707 (setq font nil))
709 (setq font (or font 708 (setq font (or font
710 (face-font 'default frame) 709 (face-font 'default frame)
711 (cdr (assq 'font (frame-parameters frame))))) 710 (cdr (assq 'font (frame-parameters frame)))))
712 (and font (make-face-bold-internal face frame font))) 711 (or (and font (make-face-bold-internal face frame font))
713 (or (not (equal ofont (face-font face))) 712 ;; We failed to find a bold version of the font.
714 (and (not noerror) 713 noerror
715 (error "No bold version of %S" font)))))) 714 (error "No bold version of %S" font))))))
716 715
717 (defun make-face-bold-internal (face frame font) 716 (defun make-face-bold-internal (face frame font)
718 (let (f2) 717 (let (f2)
719 (or (and (setq f2 (x-make-font-bold font)) 718 (or (and (setq f2 (x-make-font-bold font))
720 (internal-try-face-font face f2 frame)) 719 (internal-try-face-font face f2 frame))
727 (interactive (list (read-face-name "Make which face italic: "))) 726 (interactive (list (read-face-name "Make which face italic: ")))
728 (if (and (eq frame t) (listp (face-font face t))) 727 (if (and (eq frame t) (listp (face-font face t)))
729 (set-face-font face (if (memq 'bold (face-font face t)) 728 (set-face-font face (if (memq 'bold (face-font face t))
730 '(bold italic) '(italic)) 729 '(bold italic) '(italic))
731 t) 730 t)
732 (let ((ofont (face-font face frame)) 731 (let (font)
733 font)
734 (if (null frame) 732 (if (null frame)
735 (let ((frames (frame-list))) 733 (let ((frames (frame-list)))
736 ;; Make this face italic in global-face-data. 734 ;; Make this face italic in global-face-data.
737 (make-face-italic face t noerror) 735 (make-face-italic face t noerror)
738 ;; Make this face italic in each frame. 736 ;; Make this face italic in each frame.
745 (if (listp font) 743 (if (listp font)
746 (setq font nil)) 744 (setq font nil))
747 (setq font (or font 745 (setq font (or font
748 (face-font 'default frame) 746 (face-font 'default frame)
749 (cdr (assq 'font (frame-parameters frame))))) 747 (cdr (assq 'font (frame-parameters frame)))))
750 (and font (make-face-italic-internal face frame font))) 748 (or (and font (make-face-italic-internal face frame font))
751 (or (not (equal ofont (face-font face))) 749 ;; We failed to find an italic version of the font.
752 (and (not noerror) 750 noerror
753 (error "No italic version of %S" font)))))) 751 (error "No italic version of %S" font))))))
754 752
755 (defun make-face-italic-internal (face frame font) 753 (defun make-face-italic-internal (face frame font)
756 (let (f2) 754 (let (f2)
757 (or (and (setq f2 (x-make-font-italic font)) 755 (or (and (setq f2 (x-make-font-italic font))
758 (internal-try-face-font face f2 frame)) 756 (internal-try-face-font face f2 frame))
763 "Make the font of the given face be bold and italic, if possible. 761 "Make the font of the given face be bold and italic, if possible.
764 If NOERROR is non-nil, return nil on failure." 762 If NOERROR is non-nil, return nil on failure."
765 (interactive (list (read-face-name "Make which face bold-italic: "))) 763 (interactive (list (read-face-name "Make which face bold-italic: ")))
766 (if (and (eq frame t) (listp (face-font face t))) 764 (if (and (eq frame t) (listp (face-font face t)))
767 (set-face-font face '(bold italic) t) 765 (set-face-font face '(bold italic) t)
768 (let ((ofont (face-font face frame)) 766 (let (font)
769 font)
770 (if (null frame) 767 (if (null frame)
771 (let ((frames (frame-list))) 768 (let ((frames (frame-list)))
772 ;; Make this face bold-italic in global-face-data. 769 ;; Make this face bold-italic in global-face-data.
773 (make-face-bold-italic face t noerror) 770 (make-face-bold-italic face t noerror)
774 ;; Make this face bold in each frame. 771 ;; Make this face bold in each frame.
781 (if (listp font) 778 (if (listp font)
782 (setq font nil)) 779 (setq font nil))
783 (setq font (or font 780 (setq font (or font
784 (face-font 'default frame) 781 (face-font 'default frame)
785 (cdr (assq 'font (frame-parameters frame))))) 782 (cdr (assq 'font (frame-parameters frame)))))
786 (and font (make-face-bold-italic-internal face frame font))) 783 (or (and font (make-face-bold-italic-internal face frame font))
787 (or (not (equal ofont (face-font face))) 784 ;; We failed to find a bold italic version.
788 (and (not noerror) 785 noerror
789 (error "No bold italic version of %S" font)))))) 786 (error "No bold italic version of %S" font))))))
790 787
791 (defun make-face-bold-italic-internal (face frame font) 788 (defun make-face-bold-italic-internal (face frame font)
792 (let (f2 f3) 789 (let (f2 f3)
793 (or (and (setq f2 (x-make-font-italic font)) 790 (or (and (setq f2 (x-make-font-italic font))
794 (not (equal font f2)) 791 (not (equal font f2))
817 (interactive (list (read-face-name "Make which face non-bold: "))) 814 (interactive (list (read-face-name "Make which face non-bold: ")))
818 (if (and (eq frame t) (listp (face-font face t))) 815 (if (and (eq frame t) (listp (face-font face t)))
819 (set-face-font face (if (memq 'italic (face-font face t)) 816 (set-face-font face (if (memq 'italic (face-font face t))
820 '(italic) nil) 817 '(italic) nil)
821 t) 818 t)
822 (let ((ofont (face-font face frame)) 819 (let (font font1)
823 font font1)
824 (if (null frame) 820 (if (null frame)
825 (let ((frames (frame-list))) 821 (let ((frames (frame-list)))
826 ;; Make this face unbold in global-face-data. 822 ;; Make this face unbold in global-face-data.
827 (make-face-unbold face t noerror) 823 (make-face-unbold face t noerror)
828 ;; Make this face unbold in each frame. 824 ;; Make this face unbold in each frame.
836 (setq font1 nil)) 832 (setq font1 nil))
837 (setq font1 (or font1 833 (setq font1 (or font1
838 (face-font 'default frame) 834 (face-font 'default frame)
839 (cdr (assq 'font (frame-parameters frame))))) 835 (cdr (assq 'font (frame-parameters frame)))))
840 (setq font (and font1 (x-make-font-unbold font1))) 836 (setq font (and font1 (x-make-font-unbold font1)))
841 (if font (internal-try-face-font face font frame))) 837 (or (if font (internal-try-face-font face font frame))
842 (or (not (equal ofont (face-font face))) 838 noerror
843 (and (not noerror) 839 (error "No unbold version of %S" font1))))))
844 (error "No unbold version of %S" font1))))))
845 840
846 (defun make-face-unitalic (face &optional frame noerror) 841 (defun make-face-unitalic (face &optional frame noerror)
847 "Make the font of the given face be non-italic, if possible. 842 "Make the font of the given face be non-italic, if possible.
848 If NOERROR is non-nil, return nil on failure." 843 If NOERROR is non-nil, return nil on failure."
849 (interactive (list (read-face-name "Make which face non-italic: "))) 844 (interactive (list (read-face-name "Make which face non-italic: ")))
850 (if (and (eq frame t) (listp (face-font face t))) 845 (if (and (eq frame t) (listp (face-font face t)))
851 (set-face-font face (if (memq 'bold (face-font face t)) 846 (set-face-font face (if (memq 'bold (face-font face t))
852 '(bold) nil) 847 '(bold) nil)
853 t) 848 t)
854 (let ((ofont (face-font face frame)) 849 (let (font font1)
855 font font1)
856 (if (null frame) 850 (if (null frame)
857 (let ((frames (frame-list))) 851 (let ((frames (frame-list)))
858 ;; Make this face unitalic in global-face-data. 852 ;; Make this face unitalic in global-face-data.
859 (make-face-unitalic face t noerror) 853 (make-face-unitalic face t noerror)
860 ;; Make this face unitalic in each frame. 854 ;; Make this face unitalic in each frame.
868 (setq font1 nil)) 862 (setq font1 nil))
869 (setq font1 (or font1 863 (setq font1 (or font1
870 (face-font 'default frame) 864 (face-font 'default frame)
871 (cdr (assq 'font (frame-parameters frame))))) 865 (cdr (assq 'font (frame-parameters frame)))))
872 (setq font (and font1 (x-make-font-unitalic font1))) 866 (setq font (and font1 (x-make-font-unitalic font1)))
873 (if font (internal-try-face-font face font frame))) 867 (or (if font (internal-try-face-font face font frame))
874 (or (not (equal ofont (face-font face))) 868 noerror
875 (and (not noerror) 869 (error "No unitalic version of %S" font1))))))
876 (error "No unitalic version of %S" font1))))))
877 870
878 (defvar list-faces-sample-text 871 (defvar list-faces-sample-text
879 "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ" 872 "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ"
880 "*Text string to display as the sample text for `list-faces-display'.") 873 "*Text string to display as the sample text for `list-faces-display'.")
881 874