Mercurial > hg > xemacs-beta
diff lisp/w3/font.el @ 82:6a378aca36af r20-0b91
Import from CVS: tag r20-0b91
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:07:36 +0200 |
parents | 1ce6082ce73f |
children | 821dec489c24 |
line wrap: on
line diff
--- a/lisp/w3/font.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/w3/font.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,12 +1,12 @@ ;;; font.el --- New font model ;; Author: wmperry -;; Created: 1997/01/03 16:43:49 -;; Version: 1.22 +;; Created: 1997/01/22 19:31:17 +;; Version: 1.26 ;; Keywords: faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996 Free Software Foundation, Inc. +;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. ;;; ;;; This file is part of GNU Emacs. ;;; @@ -48,13 +48,20 @@ (defconst font-running-xemacs (string-match "XEmacs" (emacs-version)) "Whether we are running in XEmacs or not.") -(defmacro defkeyword (keyword &optional docstring) - (list 'defconst keyword (list 'quote keyword) - (or docstring "A keyword"))) +(defmacro define-font-keywords (&rest keys) + (` + (eval-and-compile + (let ((keywords (quote (, keys)))) + (while keywords + (or (boundp (car keywords)) + (set (car keywords) (car keywords))) + (setq keywords (cdr keywords))))))) (defconst font-window-system-mappings '((x . (x-font-create-name x-font-create-object)) (ns . (ns-font-create-name ns-font-create-object)) + (win32 . (x-font-create-name x-font-create-object)) ; Change? FIXME + (pm . (x-font-create-name x-font-create-object)) ; Change? FIXME (tty . (tty-font-create-plist tty-font-create-object))) "An assoc list mapping device types to the function used to create a font name from a font structure.") @@ -127,22 +134,11 @@ ) "A list of font family mappings.") -(defkeyword :family "Keyword specifying the font family of a FONTOBJ.") +(define-font-keywords :family :style :size :registry :encoding) -(defkeyword :weight "Keyword specifying the font weight of a FONTOBJ.") - (defkeyword :extra-light) - (defkeyword :light) - (defkeyword :demi-light) - (defkeyword :medium) - (defkeyword :normal) - (defkeyword :demi-bold) - (defkeyword :bold) - (defkeyword :extra-bold) - -(defkeyword :style "Keyword specifying the font style of a FONTOBJ.") -(defkeyword :size "Keyword specifying the font size of a FONTOBJ.") -(defkeyword :registry "Keyword specifying the registry of a FONTOBJ.") -(defkeyword :encoding "Keyword specifying the encoding of a FONTOBJ.") +(define-font-keywords + :weight :extra-light :light :demi-light :medium :normal :demi-bold + :bold :extra-bold) (defvar font-style-keywords nil) @@ -1058,16 +1054,16 @@ (defun font-normalize-color (color &optional device) "Return an RGB tuple, given any form of input. If an error occurs, black is returned." - (cond - ((eq (device-type device) 'x) + (case (device-type device) + ((x pm win32) (apply 'format "#%02x%02x%02x" (font-color-rgb-components color))) - ((eq (device-type device) 'tty) + (tty (apply 'font-tty-find-closest-color (font-color-rgb-components color))) - ((eq (device-type device) 'ns) + (ns (let ((vals (mapcar (function (lambda (x) (>> x 8))) (font-color-rgb-components color)))) (apply 'format "RGB%02x%02x%02xff" vals))) - (t "black"))) + (otherwise "black"))) (defun font-set-face-background (&optional face color &rest args) (interactive)