Mercurial > hg > xemacs-beta

comparison lisp/x-faces.el @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents b2472a1930f2
children 57709be46d1b
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details. 20 ;; General Public License for more details.
21 21
22 ;; You should have received a copy of the GNU General Public License 22 ;; You should have received a copy of the GNU General Public License
23 ;; along with XEmacs; see the file COPYING. If not, write to the 23 ;; along with XEmacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA. 25 ;; Boston, MA 02111-1307, USA.
26 26
27 ;;; Synched up with: Not synched. 27 ;;; Synched up with: Not synched.
28 28
44 ;; Emacs.bold.attributeBackground: bg 44 ;; Emacs.bold.attributeBackground: bg
45 ;; Emacs.bold.attributeBackgroundPixmap: file 45 ;; Emacs.bold.attributeBackgroundPixmap: file
46 ;; Emacs.bold.attributeUnderline: true/false 46 ;; Emacs.bold.attributeUnderline: true/false
47 ;; Emacs.bold.attributeStrikethru: true/false 47 ;; Emacs.bold.attributeStrikethru: true/false
48 48
49 ;; You can specify the properties of a face on a per-frame basis. For 49 ;; You can specify the properties of a face on a per-frame basis. For
50 ;; example, to have the "isearch" face use a red foreground on frames 50 ;; example, to have the "isearch" face use a red foreground on frames
51 ;; named "emacs" (the default) but use a blue foreground on frames that 51 ;; named "emacs" (the default) but use a blue foreground on frames that
52 ;; you create named "debugger", you could do 52 ;; you create named "debugger", you could do
53 53
54 ;; Emacs*emacs.isearch.attributeForeground: red 54 ;; Emacs*emacs.isearch.attributeForeground: red
99 (registry "[^-]*") ; some fonts have omitted registries 99 (registry "[^-]*") ; some fonts have omitted registries
100 ; (encoding ".+") ; note that encoding may contain "-"... 100 ; (encoding ".+") ; note that encoding may contain "-"...
101 (encoding "[^-]+") ; false! 101 (encoding "[^-]+") ; false!
102 ) 102 )
103 (setq x-font-regexp 103 (setq x-font-regexp
104 (purecopy 104 (purecopy
105 (concat "\\`\\*?[-?*]" 105 (concat "\\`\\*?[-?*]"
106 foundry - family - weight\? - slant\? - swidth - adstyle - 106 foundry - family - weight\? - slant\? - swidth - adstyle -
107 pixelsize - pointsize - resx - resy - spacing - avgwidth - 107 pixelsize - pointsize - resx - resy - spacing - avgwidth -
108 registry - encoding "\\'" 108 registry - encoding "\\'"
109 ))) 109 )))
338 (setq last (car rest)) 338 (setq last (car rest))
339 (setq rest (cdr rest))) 339 (setq rest (cdr rest)))
340 (nth 2 result)))))) 340 (nth 2 result))))))
341 341
342 (defun x-find-smaller-font (font &optional device) 342 (defun x-find-smaller-font (font &optional device)
343 "Loads a new, slightly smaller version of the given font (or font name). 343 "Load a new, slightly smaller version of the given font (or font name).
344 Returns the font if it succeeds, nil otherwise. 344 Returns the font if it succeeds, nil otherwise.
345 If scalable fonts are available, this returns a font which is 1 point smaller. 345 If scalable fonts are available, this returns a font which is 1 point smaller.
346 Otherwise, it returns the next smaller version of this font that is defined." 346 Otherwise, it returns the next smaller version of this font that is defined."
347 (x-frob-font-size font nil device)) 347 (x-frob-font-size font nil device))
348 348
349 (defun x-find-larger-font (font &optional device) 349 (defun x-find-larger-font (font &optional device)
350 "Loads a new, slightly larger version of the given font (or font name). 350 "Load a new, slightly larger version of the given font (or font name).
351 Returns the font if it succeeds, nil otherwise. 351 Returns the font if it succeeds, nil otherwise.
352 If scalable fonts are available, this returns a font which is 1 point larger. 352 If scalable fonts are available, this returns a font which is 1 point larger.
353 Otherwise, it returns the next larger version of this font that is defined." 353 Otherwise, it returns the next larger version of this font that is defined."
354 (x-frob-font-size font t device)) 354 (x-frob-font-size font t device))
355 355
559 (if device-class 559 (if device-class
560 (remove-specifier-specs-matching-tag-set-cdrs (face-property 560 (remove-specifier-specs-matching-tag-set-cdrs (face-property
561 face 'underline) 561 face 'underline)
562 locale 562 locale
563 tty-tag-set) 563 tty-tag-set)
564 (remove-specifier (face-propery face 'underline) locale 564 (remove-specifier (face-property face 'underline) locale
565 tty-tag-set nil)) 565 tty-tag-set nil))
566 (set-face-underline-p face ulp locale nil append)) 566 (set-face-underline-p face ulp locale nil append))
567 (when stp 567 (when stp
568 (if device-class 568 (if device-class
569 (remove-specifier-specs-matching-tag-set-cdrs (face-property 569 (remove-specifier-specs-matching-tag-set-cdrs (face-property
570 face 'strikethru) 570 face 'strikethru)
571 locale 571 locale
572 tty-tag-set) 572 tty-tag-set)
573 (remove-specifier (face-propery face 'strikethru) 573 (remove-specifier (face-property face 'strikethru)
574 locale tty-tag-set nil)) 574 locale tty-tag-set nil))
575 (set-face-strikethru-p face stp locale nil append)) 575 (set-face-strikethru-p face stp locale nil append))
576 (when hp 576 (when hp
577 (if device-class 577 (if device-class
578 (remove-specifier-specs-matching-tag-set-cdrs (face-property 578 (remove-specifier-specs-matching-tag-set-cdrs (face-property
579 face 'highlight) 579 face 'highlight)
580 locale 580 locale
581 tty-tag-set) 581 tty-tag-set)
582 (remove-specifier (face-propery face 'highlight) 582 (remove-specifier (face-property face 'highlight)
583 locale tty-tag-set nil)) 583 locale tty-tag-set nil))
584 (set-face-highlight-p face hp locale nil append)) 584 (set-face-highlight-p face hp locale nil append))
585 (when dp 585 (when dp
586 (if device-class 586 (if device-class
587 (remove-specifier-specs-matching-tag-set-cdrs (face-property 587 (remove-specifier-specs-matching-tag-set-cdrs (face-property
594 (if device-class 594 (if device-class
595 (remove-specifier-specs-matching-tag-set-cdrs (face-property 595 (remove-specifier-specs-matching-tag-set-cdrs (face-property
596 face 'blinking) 596 face 'blinking)
597 locale 597 locale
598 tty-tag-set) 598 tty-tag-set)
599 (remove-specifier (face-propery face 'blinking) locale 599 (remove-specifier (face-property face 'blinking) locale
600 tty-tag-set nil)) 600 tty-tag-set nil))
601 (set-face-blinking-p face bp locale nil append)) 601 (set-face-blinking-p face bp locale nil append))
602 (when rp 602 (when rp
603 (if device-class 603 (if device-class
604 (remove-specifier-specs-matching-tag-set-cdrs (face-property 604 (remove-specifier-specs-matching-tag-set-cdrs (face-property
700 (if (not (face-font 'default 'global)) 700 (if (not (face-font 'default 'global))
701 (set-face-font 'default new-x-font) 701 (set-face-font 'default new-x-font)
702 (set-face-font 'default new-x-font device)))) 702 (set-face-font 'default new-x-font device))))
703 ;; 703 ;;
704 ;; If the "default" face didn't have both colors specified, then pick 704 ;; If the "default" face didn't have both colors specified, then pick
705 ;; some, taking into account whether one of the colors was specified. 705 ;; some, taking into account whether one of the colors was specified.
706 ;; 706 ;;
707 (let ((fg (face-foreground-instance 'default device)) 707 (let ((fg (face-foreground-instance 'default device))
708 (bg (face-background-instance 'default device))) 708 (bg (face-background-instance 'default device)))
709 (if (not (and fg bg)) 709 (if (not (and fg bg))
710 (if (or (and fg (equal (downcase (color-instance-name fg)) "white")) 710 (if (or (and fg (equal (downcase (color-instance-name fg)) "white"))
725 ;; adding hooks in a safe way. 725 ;; adding hooks in a safe way.
726 ;; 726 ;;
727 (x-init-pointer-shape device) ; from x-mouse.el 727 (x-init-pointer-shape device) ; from x-mouse.el
728 ) 728 )
729 729
730 ;;; This is called from `init-frame-faces', which is called from 730 ;;; This is called from `init-frame-faces', which is called from
731 ;;; init_frame_faces() which is called from Fmake_frame(), to perform 731 ;;; init_frame_faces() which is called from Fmake_frame(), to perform
732 ;;; any device-specific initialization. 732 ;;; any device-specific initialization.
733 ;;; 733 ;;;
734 (defun x-init-frame-faces (frame) 734 (defun x-init-frame-faces (frame)
735 ;; 735 ;;