aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorRichard M. Stallman1995-07-25 04:50:43 +0000
committerRichard M. Stallman1995-07-25 04:50:43 +0000
commit488bedffb5efd9b361d25e80cd2129ce6aedeeb2 (patch)
tree705a3c7d38c6472d1a79f06b8b220f8e57b575cc /lisp
parentec3bba39c6fc4223963aaf20505446fa0dd48d3b (diff)
downloademacs-488bedffb5efd9b361d25e80cd2129ce6aedeeb2.tar.gz
emacs-488bedffb5efd9b361d25e80cd2129ce6aedeeb2.zip
(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.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/faces.el53
1 files changed, 23 insertions, 30 deletions
diff --git a/lisp/faces.el b/lisp/faces.el
index 04dc3c9a2fb..4b4896d2a4c 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -691,8 +691,7 @@ If NOERROR is non-nil, return nil on failure."
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.
@@ -709,10 +708,10 @@ If NOERROR is non-nil, return nil on failure."
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)
@@ -729,8 +728,7 @@ If NOERROR is non-nil, return nil on failure."
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.
@@ -747,10 +745,10 @@ If NOERROR is non-nil, return nil on failure."
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)
@@ -765,8 +763,7 @@ 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.
@@ -783,10 +780,10 @@ If NOERROR is non-nil, return nil on failure."
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)
@@ -819,8 +816,7 @@ If NOERROR is non-nil, return nil on failure."
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.
@@ -838,10 +834,9 @@ If NOERROR is non-nil, return nil on failure."
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.
@@ -851,8 +846,7 @@ If NOERROR is non-nil, return nil on failure."
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.
@@ -870,10 +864,9 @@ If NOERROR is non-nil, return nil on failure."
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"