]> code.delx.au - gnu-emacs/blobdiff - lisp/faces.el
merge trunk
[gnu-emacs] / lisp / faces.el
index 9904cf674f0b4f913c1034906d15d09742f126b9..900e96ed048e587d6558589e69f0b4e7ff047ec8 100644 (file)
@@ -1,7 +1,7 @@
 ;;; faces.el --- Lisp faces
 
 ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
-;;   2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+;;   2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
 ;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
@@ -70,10 +70,11 @@ a font height that isn't optimal."
 ;; unavailable, and we fall back on the courier and helv families,
 ;; which are generally available.
 (defcustom face-font-family-alternatives
+  (mapcar (lambda (arg) (mapcar 'purecopy arg))
   '(("Monospace" "courier" "fixed")
     ("courier" "CMU Typewriter Text" "fixed")
     ("Sans Serif" "helv" "helvetica" "arial" "fixed")
-    ("helv" "helvetica" "arial" "fixed"))
+    ("helv" "helvetica" "arial" "fixed")))
   "Alist of alternative font family names.
 Each element has the form (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...).
 If fonts of family FAMILY can't be loaded, try ALTERNATIVE1, then
@@ -88,6 +89,7 @@ ALTERNATIVE2 etc."
 
 ;; This is defined originally in xfaces.c.
 (defcustom face-font-registry-alternatives
+  (mapcar (lambda (arg) (mapcar 'purecopy arg))
   (if (eq system-type 'windows-nt)
       '(("iso8859-1" "ms-oemlatin")
        ("gb2312.1980" "gb2312" "gbk" "gb18030")
@@ -97,7 +99,7 @@ ALTERNATIVE2 etc."
     '(("gb2312.1980" "gb2312.80&gb8565.88" "gbk" "gb18030")
       ("jisx0208.1990" "jisx0208.1983" "jisx0208.1978")
       ("ksc5601.1989" "ksx1001.1992" "ksc5601.1987")
-      ("muletibetan-2" "muletibetan-0")))
+      ("muletibetan-2" "muletibetan-0"))))
   "Alist of alternative font registry names.
 Each element has the form (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...).
 If fonts of registry REGISTRY can be loaded, font selection
@@ -284,6 +286,11 @@ If FRAME is omitted or nil, use the selected frame."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defcustom face-x-resources
+  (mapcar
+   (lambda (arg)
+     ;; FIXME; can we purecopy some of the conses too?
+     (cons (car arg)
+          (cons (purecopy (car (cdr arg))) (purecopy (cdr (cdr arg))))))
   '((:family (".attributeFamily" . "Face.AttributeFamily"))
     (:foundry (".attributeFoundry" . "Face.AttributeFoundry"))
     (:width (".attributeWidth" . "Face.AttributeWidth"))
@@ -303,7 +310,7 @@ If FRAME is omitted or nil, use the selected frame."
     (:bold (".attributeBold" . "Face.AttributeBold"))
     (:italic (".attributeItalic" . "Face.AttributeItalic"))
     (:font (".attributeFont" . "Face.AttributeFont"))
-    (:inherit (".attributeInherit" . "Face.AttributeInherit")))
+    (:inherit (".attributeInherit" . "Face.AttributeInherit"))))
   "List of X resources and classes for face attributes.
 Each element has the form (ATTRIBUTE ENTRY1 ENTRY2...) where ATTRIBUTE is
 the name of a face attribute, and each ENTRY is a cons of the form
@@ -583,7 +590,7 @@ the default for new frames (this is done automatically each time an
 attribute is changed on all frames).
 
 ARGS must come in pairs ATTRIBUTE VALUE.  ATTRIBUTE must be a valid
-face attribute name. All attributes can be set to `unspecified';
+face attribute name.  All attributes can be set to `unspecified';
 this fact is not further mentioned below.
 
 The following attributes are recognized:
@@ -728,10 +735,10 @@ like an underlying face would be, with higher priority than underlying faces."
        (unless foundry
          (setq foundry (match-string 1 family)))
        (setq family (match-string 2 family)))
-      (when (stringp family)
+      (when (or (stringp family) (eq family 'unspecified))
        (internal-set-lisp-face-attribute face :family (purecopy family)
                                          where))
-      (when (stringp foundry)
+      (when (or (stringp foundry) (eq foundry 'unspecified))
        (internal-set-lisp-face-attribute face :foundry (purecopy foundry)
                                          where)))
     (while args
@@ -981,9 +988,9 @@ Otherwise, return a single face."
 (defun face-valid-attribute-values (attribute &optional frame)
   "Return valid values for face attribute ATTRIBUTE.
 The optional argument FRAME is used to determine available fonts
-and colors.  If it is nil or not specified, the selected frame is
-used.  Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value
-out of a set of discrete values.  Value is `integerp' if ATTRIBUTE expects
+and colors.  If it is nil or not specified, the selected frame is used.
+Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value out
+of a set of discrete values.  Value is `integerp' if ATTRIBUTE expects
 an integer value."
   (let ((valid
          (case attribute
@@ -1040,7 +1047,7 @@ an integer value."
       valid)))
 
 
-(defvar face-attribute-name-alist
+(defconst face-attribute-name-alist
   '((:family . "font family")
     (:foundry . "font foundry")
     (:width . "character set width")
@@ -1228,7 +1235,7 @@ Value is a list (FACE NEW-VALUE) where FACE is the face read
 ;;; Listing faces.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defvar list-faces-sample-text
+(defconst list-faces-sample-text
   "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   "*Text string to display as the sample text for `list-faces-display'.")
 
@@ -1266,8 +1273,7 @@ arg, prompt for a regular expression."
     (setq max-length (1+ max-length)
          line-format (format "%%-%ds" max-length))
     (with-help-window "*Faces*"
-      (save-excursion
-       (set-buffer standard-output)
+      (with-current-buffer standard-output
        (setq truncate-lines t)
        (insert
         (substitute-command-keys
@@ -1355,8 +1361,7 @@ If FRAME is omitted or nil, use the selected frame."
     (if (not (listp face))
        (setq face (list face)))
     (with-help-window (help-buffer)
-      (save-excursion
-       (set-buffer standard-output)
+      (with-current-buffer standard-output
        (dolist (f face)
          (if (stringp f) (setq f (intern f)))
          ;; We may get called for anonymous faces (i.e., faces
@@ -2031,7 +2036,7 @@ Calculate the face definitions using the face specs, custom theme
 settings, X resources, and `face-new-frame-defaults'.
 Finally, apply any relevant face attributes found amongst the
 frame parameters in PARAMETERS and `default-frame-alist'."
-  (dolist (face (nreverse (face-list)))
+  (dolist (face (nreverse (face-list))) ;Why reverse?  --Stef
     (condition-case ()
        (progn
          ;; Initialize faces from face spec and custom theme.
@@ -2578,16 +2583,16 @@ Note: Other faces cannot inherit from the cursor face."
       (encoding                "[^-]+")
       )
   (setq x-font-regexp
-       (concat "\\`\\*?[-?*]"
+       (purecopy (concat "\\`\\*?[-?*]"
                foundry - family - weight\? - slant\? - swidth - adstyle -
                pixelsize - pointsize - resx - resy - spacing - avgwidth -
                registry - encoding "\\*?\\'"
-               ))
+               )))
   (setq x-font-regexp-head
-       (concat "\\`[-?*]" foundry - family - weight\? - slant\?
-               "\\([-*?]\\|\\'\\)"))
-  (setq x-font-regexp-slant (concat - slant -))
-  (setq x-font-regexp-weight (concat - weight -))
+       (purecopy (concat "\\`[-?*]" foundry - family - weight\? - slant\?
+               "\\([-*?]\\|\\'\\)")))
+  (setq x-font-regexp-slant (purecopy (concat - slant -)))
+  (setq x-font-regexp-weight (purecopy (concat - weight -)))
   nil)