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) |