Mercurial > emacs
comparison lisp/faces.el @ 2800:a7b260d27c2c
(face-initialize): Don't create the `modeline' face.
Set region-face.
(invert-face): Really do use the default colors.
(x-initialize-frame-faces): Always try "gray" color for
primary-selection; always invert if that fails.
Similar changes for highlight, secondary-selection.
(make-face): Add interactive spec.
(set-default-font): Deleted.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sat, 15 May 1993 19:53:44 +0000 |
parents | 17c322204ce3 |
children | 9e8635dafd40 |
comparison
equal
deleted
inserted
replaced
2799:93a5aef19835 | 2800:a7b260d27c2c |
---|---|
199 | 199 |
200 (defun make-face (name) | 200 (defun make-face (name) |
201 "Define a new FACE on all frames. | 201 "Define a new FACE on all frames. |
202 You can modify the font, color, etc of this face with the set-face- functions. | 202 You can modify the font, color, etc of this face with the set-face- functions. |
203 If the face already exists, it is unmodified." | 203 If the face already exists, it is unmodified." |
204 (interactive "sMake face: ") | |
204 (or (internal-find-face name) | 205 (or (internal-find-face name) |
205 (let ((face (make-vector 8 nil))) | 206 (let ((face (make-vector 8 nil))) |
206 (aset face 0 'face) | 207 (aset face 0 'face) |
207 (aset face 1 name) | 208 (aset face 1 name) |
208 (let* ((frames (frame-list)) | 209 (let* ((frames (frame-list)) |
298 (setq frames (cdr frames))) | 299 (setq frames (cdr frames))) |
299 (copy-face old-face new-name t)) | 300 (copy-face old-face new-name t)) |
300 (set-face-font new-face (face-font old-face frame) frame) | 301 (set-face-font new-face (face-font old-face frame) frame) |
301 (set-face-foreground new-face (face-foreground old-face frame) frame) | 302 (set-face-foreground new-face (face-foreground old-face frame) frame) |
302 (set-face-background new-face (face-background old-face frame) frame) | 303 (set-face-background new-face (face-background old-face frame) frame) |
303 (set-face-background-pixmap | 304 ;;; (set-face-background-pixmap |
304 new-face (face-background-pixmap old-face frame) frame) | 305 ;;; new-face (face-background-pixmap old-face frame) frame) |
305 (set-face-underline-p new-face (face-underline-p old-face frame) | 306 (set-face-underline-p new-face (face-underline-p old-face frame) |
306 frame)) | 307 frame)) |
307 new-face)) | 308 new-face)) |
308 | 309 |
309 (defun face-equal (face1 face2 &optional frame) | 310 (defun face-equal (face1 face2 &optional frame) |
330 (or (equal (face-background default frame) | 331 (or (equal (face-background default frame) |
331 (face-background face frame)) | 332 (face-background face frame)) |
332 (null (face-background face frame))) | 333 (null (face-background face frame))) |
333 (or (equal (face-font default frame) (face-font face frame)) | 334 (or (equal (face-font default frame) (face-font face frame)) |
334 (null (face-font face frame))) | 335 (null (face-font face frame))) |
335 (or (equal (face-background-pixmap default frame) | 336 ;;; (or (equal (face-background-pixmap default frame) |
336 (face-background-pixmap face frame)) | 337 ;;; (face-background-pixmap face frame)) |
337 (null (face-background-pixmap face frame))) | 338 ;;; (null (face-background-pixmap face frame))) |
338 (equal (face-underline-p default frame) | 339 (equal (face-underline-p default frame) |
339 (face-underline-p face frame)) | 340 (face-underline-p face frame)) |
340 )))) | 341 )))) |
341 | 342 |
342 | 343 |
343 (defun invert-face (face &optional frame) | 344 (defun invert-face (face &optional frame) |
344 "Swap the foreground and background colors of face FACE. | 345 "Swap the foreground and background colors of face FACE. |
345 If the face doesn't specify both foreground and background, then | 346 If the face doesn't specify both foreground and background, then |
346 its foreground and background are set to the background and | 347 set its foreground and background to the default background and foreground." |
347 foreground of the default face." | |
348 (interactive (list (read-face-name "Invert face: "))) | 348 (interactive (list (read-face-name "Invert face: "))) |
349 (setq face (internal-get-face face frame)) | 349 (setq face (internal-get-face face frame)) |
350 (let ((fg (face-foreground face frame)) | 350 (let ((fg (face-foreground face frame)) |
351 (bg (face-background face frame))) | 351 (bg (face-background face frame))) |
352 (if (or fg bg) | 352 (if (or fg bg) |
353 (progn | 353 (progn |
354 (set-face-foreground face bg frame) | 354 (set-face-foreground face bg frame) |
355 (set-face-background face fg frame)) | 355 (set-face-background face fg frame)) |
356 (set-face-foreground face (face-background 'default frame) frame) | 356 (set-face-foreground face (or (face-background 'default frame) |
357 (set-face-background face (face-foreground 'default frame) frame))) | 357 (cdr (assq 'background-color (frame-parameters frame)))) |
358 frame) | |
359 (set-face-background face (or (face-foreground 'default frame) | |
360 (cdr (assq 'foreground-color (frame-parameters frame)))) | |
361 frame))) | |
358 face) | 362 face) |
359 | 363 |
360 | 364 |
361 (defun internal-try-face-font (face font &optional frame) | 365 (defun internal-try-face-font (face font &optional frame) |
362 "Like set-face-font, but returns nil on failure instead of an error." | 366 "Like set-face-font, but returns nil on failure instead of an error." |
363 (condition-case () | 367 (condition-case () |
364 (set-face-font face font frame) | 368 (set-face-font face font frame) |
365 (error nil))) | 369 (error nil))) |
366 | |
367 | |
368 (defun set-default-font (font) | |
369 "Sets the font used for normal text and the modeline to FONT in all frames. | |
370 For finer-grained control, use set-face-font." | |
371 (interactive (list (read-string "Set default font: " | |
372 (face-font 'default (selected-frame))))) | |
373 (set-face-font 'default font) | |
374 (set-face-font 'modeline font)) | |
375 | 370 |
376 ;; Manipulating font names. | 371 ;; Manipulating font names. |
377 | 372 |
378 (defconst x-font-regexp nil) | 373 (defconst x-font-regexp nil) |
379 (defconst x-font-regexp-head nil) | 374 (defconst x-font-regexp-head nil) |
604 ;;; Make the builtin faces; the C code knows these as faces 0, 1, and 2, | 599 ;;; Make the builtin faces; the C code knows these as faces 0, 1, and 2, |
605 ;;; respectively, so they must be the first three faces made. | 600 ;;; respectively, so they must be the first three faces made. |
606 | 601 |
607 (defun face-initialize () | 602 (defun face-initialize () |
608 (make-face 'default) | 603 (make-face 'default) |
609 (make-face 'modeline) | 604 ;;; (make-face 'modeline) |
610 (make-face 'highlight) | 605 (make-face 'highlight) |
611 ;; | 606 ;; |
612 ;; These aren't really special in any way, but they're nice to have around. | 607 ;; These aren't really special in any way, but they're nice to have around. |
613 ;; The X-specific code is clever at them. | 608 ;; The X-specific code is clever at them. |
614 ;; | 609 ;; |
615 (make-face 'bold) | 610 (make-face 'bold) |
616 (make-face 'italic) | 611 (make-face 'italic) |
617 (make-face 'bold-italic) | 612 (make-face 'bold-italic) |
618 (make-face 'primary-selection) | 613 (make-face 'primary-selection) |
619 (make-face 'secondary-selection) | 614 (make-face 'secondary-selection) |
615 | |
616 (setq region-face (face-id 'primary-selection)) | |
620 | 617 |
621 ;; Set up the faces of all existing X Window frames. | 618 ;; Set up the faces of all existing X Window frames. |
622 (let ((frames (frame-list))) | 619 (let ((frames (frame-list))) |
623 (while frames | 620 (while frames |
624 (if (eq (framep (car frames)) 'x) | 621 (if (eq (framep (car frames)) 'x) |
677 (internal-x-complain-about-font 'bold-italic frame)) | 674 (internal-x-complain-about-font 'bold-italic frame)) |
678 ) | 675 ) |
679 | 676 |
680 (or (face-differs-from-default-p 'highlight frame) | 677 (or (face-differs-from-default-p 'highlight frame) |
681 (condition-case () | 678 (condition-case () |
682 (if (x-display-color-p) | 679 (condition-case () |
683 (condition-case () | 680 (set-face-background 'highlight "darkseagreen2" frame) |
684 (set-face-background 'highlight "darkseagreen2" frame) | 681 (error (set-face-background 'highlight "green" frame))) |
685 (error (set-face-background 'highlight "green" frame))) | 682 ;;; (set-face-background-pixmap 'highlight "gray1" frame) |
686 (set-face-background-pixmap 'highlight "gray1" frame) | |
687 ) | |
688 (error (invert-face 'highlight frame)))) | 683 (error (invert-face 'highlight frame)))) |
689 | 684 |
690 (or (face-differs-from-default-p 'primary-selection frame) | 685 (or (face-differs-from-default-p 'primary-selection frame) |
691 (condition-case () | 686 (condition-case () |
692 (if (x-display-color-p) | 687 (set-face-background 'primary-selection "gray" frame) |
693 (set-face-background 'primary-selection "gray" frame) | |
694 (set-face-background-pixmap 'primary-selection "gray3" frame) | |
695 ) | |
696 (error (invert-face 'primary-selection frame)))) | 688 (error (invert-face 'primary-selection frame)))) |
697 | 689 |
698 (or (face-differs-from-default-p 'secondary-selection frame) | 690 (or (face-differs-from-default-p 'secondary-selection frame) |
699 (condition-case () | 691 (condition-case () |
700 (if (x-display-color-p) | 692 (condition-case () |
701 (condition-case () | 693 ;; some older X servers don't have this one. |
702 ;; some older X servers don't have this one. | 694 (set-face-background 'secondary-selection "paleturquoise" |
703 (set-face-background 'secondary-selection "paleturquoise" | 695 frame) |
704 frame) | 696 (error |
705 (error | 697 (set-face-background 'secondary-selection "green" frame))) |
706 (set-face-background 'secondary-selection "green" frame))) | 698 ;;; (set-face-background-pixmap 'secondary-selection "gray1" frame) |
707 (set-face-background-pixmap 'secondary-selection "gray1" frame) | |
708 ) | |
709 (error (invert-face 'secondary-selection frame)))) | 699 (error (invert-face 'secondary-selection frame)))) |
710 ) | 700 ) |
711 | 701 |
712 (defun internal-x-complain-about-font (face frame) | 702 (defun internal-x-complain-about-font (face frame) |
713 (message "No %s version of %S" | 703 ;;; It's annoying to bother the user about this, |
714 face | 704 ;;; since it happens under normal circumstances. |
715 (or (face-font face frame) | 705 ;;; (message "No %s version of %S" |
716 (face-font face t) | 706 ;;; face |
717 (face-font 'default frame) | 707 ;;; (or (face-font face frame) |
718 (cdr (assq 'font (frame-parameters frame))))) | 708 ;;; (face-font face t) |
719 (sit-for 1)) | 709 ;;; (face-font 'default frame) |
710 ;;; (cdr (assq 'font (frame-parameters frame))))) | |
711 ;;; (sit-for 1) | |
712 ) | |
720 | 713 |
721 ;; Like x-create-frame but also set up the faces. | 714 ;; Like x-create-frame but also set up the faces. |
722 | 715 |
723 (defun x-create-frame-with-faces (&optional parameters) | 716 (defun x-create-frame-with-faces (&optional parameters) |
724 (if (null global-face-data) | 717 (if (null global-face-data) |