Mercurial > emacs
comparison lisp/facemenu.el @ 13433:21a9f15132d7
[win32] (face-menu-read-color, list-colors-display, facemenu-color-equal, face-menu-get-face):
Test for 'win32 window system as well as 'x.
author | Geoff Voelker <voelker@cs.washington.edu> |
---|---|
date | Tue, 07 Nov 1995 07:48:36 +0000 |
parents | 84acc3adcd63 |
children | fcfb5f397b49 |
comparison
equal
deleted
inserted
replaced
13432:c0c8b0a210e0 | 13433:21a9f15132d7 |
---|---|
410 ;;;###autoload | 410 ;;;###autoload |
411 (defun facemenu-read-color (&optional prompt) | 411 (defun facemenu-read-color (&optional prompt) |
412 "Read a color using the minibuffer." | 412 "Read a color using the minibuffer." |
413 (let ((col (completing-read (or prompt "Color: ") | 413 (let ((col (completing-read (or prompt "Color: ") |
414 (or facemenu-color-alist | 414 (or facemenu-color-alist |
415 (if (eq 'x window-system) | 415 (if (or (eq window-system 'x) (eq window-system 'win32)) |
416 (mapcar 'list (x-defined-colors)))) | 416 (mapcar 'list (x-defined-colors)))) |
417 nil t))) | 417 nil t))) |
418 (if (equal "" col) | 418 (if (equal "" col) |
419 nil | 419 nil |
420 col))) | 420 col))) |
424 "Display names of defined colors, and show what they look like. | 424 "Display names of defined colors, and show what they look like. |
425 If the optional argument LIST is non-nil, it should be a list of | 425 If the optional argument LIST is non-nil, it should be a list of |
426 colors to display. Otherwise, this command computes a list | 426 colors to display. Otherwise, this command computes a list |
427 of colors that the current display can handle." | 427 of colors that the current display can handle." |
428 (interactive) | 428 (interactive) |
429 (if (and (null list) (eq 'x window-system)) | 429 (if (and (null list) (or (eq window-system 'x) (eq window-system 'win32))) |
430 (progn | 430 (progn |
431 (setq list (x-defined-colors)) | 431 (setq list (x-defined-colors)) |
432 ;; Delete duplicate colors. | 432 ;; Delete duplicate colors. |
433 (let ((l list)) | 433 (let ((l list)) |
434 (while (cdr l) | 434 (while (cdr l) |
459 A and B should be strings naming colors. | 459 A and B should be strings naming colors. |
460 This function queries the window-system server to find out what the | 460 This function queries the window-system server to find out what the |
461 color names mean. It returns nil if the colors differ or if it can't | 461 color names mean. It returns nil if the colors differ or if it can't |
462 determine the correct answer." | 462 determine the correct answer." |
463 (cond ((equal a b) t) | 463 (cond ((equal a b) t) |
464 ((and (eq 'x window-system) | 464 ((and (or (eq window-system 'x) (eq window-system 'win32)) |
465 (equal (x-color-values a) (x-color-values b)))))) | 465 (equal (x-color-values a) (x-color-values b)))))) |
466 | 466 |
467 (defun facemenu-add-face (face start end) | 467 (defun facemenu-add-face (face start end) |
468 "Add FACE to text between START and END. | 468 "Add FACE to text between START and END. |
469 For each section of that region that has a different face property, FACE will | 469 For each section of that region that has a different face property, FACE will |
521 (let* ((face (make-face symbol)) | 521 (let* ((face (make-face symbol)) |
522 (name (symbol-name symbol)) | 522 (name (symbol-name symbol)) |
523 (color (substring name 3))) | 523 (color (substring name 3))) |
524 (cond ((string-match "^fg:" name) | 524 (cond ((string-match "^fg:" name) |
525 (set-face-foreground face color) | 525 (set-face-foreground face color) |
526 (and (eq 'x window-system) (x-color-defined-p color))) | 526 (and (or (eq window-system 'x) (eq window-system 'win32)) (x-color-defined-p color))) |
527 ((string-match "^bg:" name) | 527 ((string-match "^bg:" name) |
528 (set-face-background face color) | 528 (set-face-background face color) |
529 (and (eq 'x window-system) (x-color-defined-p color))) | 529 (and (or (eq window-system 'x) (eq window-system 'win32)) (x-color-defined-p color))) |
530 (t)))) | 530 (t)))) |
531 symbol)) | 531 symbol)) |
532 | 532 |
533 (defun facemenu-add-new-face (face) | 533 (defun facemenu-add-new-face (face) |
534 "Add a FACE to the appropriate Face menu. | 534 "Add a FACE to the appropriate Face menu. |