X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ac3232837188f7e1c4ffe34b76edede0ccb54f5e..b336bfcdf39f1e4d35bff4a7bd01d3b4bca8f516:/lisp/faces.el?ds=sidebyside diff --git a/lisp/faces.el b/lisp/faces.el index 4151885819..900e96ed04 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1,7 +1,8 @@ ;;; faces.el --- Lisp faces ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -49,7 +50,7 @@ of `history-length', which see.") (defcustom face-font-selection-order '(:width :height :weight :slant) - "*A list specifying how face font selection chooses fonts. + "A list specifying how face font selection chooses fonts. Each of the four symbols `:width', `:height', `:weight', and `:slant' must appear once in the list, and the list must not contain any other elements. Font selection first tries to find a best matching font @@ -69,11 +70,12 @@ 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" "fixed") + ("courier" "CMU Typewriter Text" "fixed") ("Sans Serif" "helv" "helvetica" "arial" "fixed") - ("helv" "helvetica" "arial" "fixed")) - "*Alist of alternative font family names. + ("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 ALTERNATIVE2 etc." @@ -87,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") @@ -96,8 +99,8 @@ 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"))) - "*Alist of alternative font registry names. + ("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 tries to find a best matching font among all fonts of registry @@ -283,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")) @@ -302,8 +310,8 @@ 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"))) - "*List of X resources and classes for face attributes. + (: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 \(RESOURCE . CLASS) with RESOURCE being the resource and CLASS being the @@ -338,7 +346,7 @@ specifies an invalid attribute." (defun set-face-attributes-from-resources (face frame) "Set attributes of FACE from X resources for FRAME." - (when (memq (framep frame) '(x w32 ns)) + (when (memq (framep frame) '(x w32)) (dolist (definition face-x-resources) (let ((attribute (car definition))) (dolist (entry (cdr definition)) @@ -552,7 +560,7 @@ If FACE is a face-alias, get the documentation for the target face." (if alias (progn (setq doc (get alias 'face-documentation)) - (format "%s is an alias for the face `%s'.%s" face alias + (format "%s is an alias for the face `%s'.%s" face alias (if doc (format "\n%s" doc) ""))) (get face 'face-documentation)))) @@ -582,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: @@ -705,30 +713,40 @@ must be t or nil in that case. A value of `unspecified' is not allowed. VALUE is the name of a face from which to inherit attributes, or a list of face names. Attributes from inherited faces are merged into the face like an underlying face would be, with higher priority than underlying faces." - (let ((where (if (null frame) 0 frame))) - (setq args (purecopy args)) + (setq args (purecopy args)) + (let ((where (if (null frame) 0 frame)) + (spec args) + family foundry) ;; If we set the new-frame defaults, this face is modified outside Custom. (if (memq where '(0 t)) (put (or (get face 'face-alias) face) 'face-modified t)) + ;; If family and/or foundry are specified, set it first. Certain + ;; face attributes, e.g. :weight semi-condensed, are not supported + ;; in every font. See bug#1127. + (while spec + (cond ((eq (car spec) :family) + (setq family (cadr spec))) + ((eq (car spec) :foundry) + (setq foundry (cadr spec)))) + (setq spec (cddr spec))) + (when (or family foundry) + (when (and (stringp family) + (string-match "\\([^-]*\\)-\\([^-]*\\)" family)) + (unless foundry + (setq foundry (match-string 1 family))) + (setq family (match-string 2 family))) + (when (or (stringp family) (eq family 'unspecified)) + (internal-set-lisp-face-attribute face :family (purecopy family) + where)) + (when (or (stringp foundry) (eq foundry 'unspecified)) + (internal-set-lisp-face-attribute face :foundry (purecopy foundry) + where))) (while args - ;; Don't recursively set the attributes from the frame's font param - ;; when we update the frame's font param from the attributes. - (if (and (eq (car args) :family) - (stringp (cadr args)) - (string-match "\\([^-]*\\)-\\([^-]*\\)" (cadr args))) - (let ((foundry (match-string 1 (cadr args))) - (family (match-string 2 (cadr args)))) - (internal-set-lisp-face-attribute face :foundry - (purecopy foundry) - where) - (internal-set-lisp-face-attribute face :family - (purecopy family) - where)) + (unless (memq (car args) '(:family :foundry)) (internal-set-lisp-face-attribute face (car args) (purecopy (cadr args)) where)) - (setq args (cdr (cdr args)))))) - + (setq args (cddr args))))) (defun make-face-bold (face &optional frame noerror) "Make the font of FACE be bold, if possible. @@ -970,15 +988,15 @@ 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 (:family (if (window-system frame) - (mapcar #'(lambda (x) (cons (symbol-name x) x)) + (mapcar (lambda (x) (cons x x)) (font-family-list)) ;; Only one font on TTYs. (list (cons "default" "default")))) @@ -1010,7 +1028,7 @@ an integer value." ((:height) 'integerp) (:stipple - (and (memq (window-system frame) '(x w32 ns)) + (and (memq (window-system frame) '(x ns)) ; No stipple on w32 (mapcar #'list (apply #'nconc (mapcar (lambda (dir) @@ -1029,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") @@ -1217,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'.") @@ -1255,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 @@ -1337,59 +1354,79 @@ If FRAME is omitted or nil, use the selected frame." (:inherit . "Inherit"))) (max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x))) attrs)))) - (help-setup-xref (list #'describe-face face) (interactive-p)) + (help-setup-xref (list #'describe-face face) + (called-interactively-p 'interactive)) (unless face (setq face 'default)) (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))) - (insert "Face: " (symbol-name f)) - (if (not (facep f)) - (insert " undefined face.\n") - (let ((customize-label "customize this face") - file-name) - (insert (concat " (" (propertize "sample" 'font-lock-face f) ")")) - (princ (concat " (" customize-label ")\n")) - (insert "Documentation: " - (or (face-documentation f) - "Not documented as a face.") - "\n") - (with-current-buffer standard-output - (save-excursion - (re-search-backward - (concat "\\(" customize-label "\\)") nil t) - (help-xref-button 1 'help-customize-face f))) - ;; The next 4 sexps are copied from describe-function-1 - ;; and simplified. - (setq file-name (symbol-file f 'defface)) - (setq file-name (describe-simplify-lib-file-name file-name)) - (when file-name - (princ "Defined in `") - (princ file-name) - (princ "'") - ;; Make a hyperlink to the library. - (save-excursion - (re-search-backward "`\\([^`']+\\)'" nil t) - (help-xref-button 1 'help-face-def f file-name)) - (princ ".") - (terpri) - (terpri)) - (dolist (a attrs) - (let ((attr (face-attribute f (car a) frame))) - (insert (make-string (- max-width (length (cdr a))) ?\s) - (cdr a) ": " (format "%s" attr)) - (if (and (eq (car a) :inherit) - (not (eq attr 'unspecified))) - ;; Make a hyperlink to the parent face. - (save-excursion - (re-search-backward ": \\([^:]+\\)" nil t) - (help-xref-button 1 'help-face attr))) - (insert "\n"))))) - (terpri)))))) + ;; We may get called for anonymous faces (i.e., faces + ;; expressed using prop-value plists). Those can't be + ;; usefully customized, so ignore them. + (when (symbolp f) + (insert "Face: " (symbol-name f)) + (if (not (facep f)) + (insert " undefined face.\n") + (let ((customize-label "customize this face") + file-name) + (insert (concat " (" (propertize "sample" 'font-lock-face f) ")")) + (princ (concat " (" customize-label ")\n")) + ;; FIXME not sure how much of this belongs here, and + ;; how much in `face-documentation'. The latter is + ;; not used much, but needs to return nil for + ;; undocumented faces. + (let ((alias (get f 'face-alias)) + (face f) + obsolete) + (when alias + (setq face alias) + (insert + (format "\n %s is an alias for the face `%s'.\n%s" + f alias + (if (setq obsolete (get f 'obsolete-face)) + (format " This face is obsolete%s; use `%s' instead.\n" + (if (stringp obsolete) + (format " since %s" obsolete) + "") + alias) + "")))) + (insert "\nDocumentation:\n" + (or (face-documentation face) + "Not documented as a face.") + "\n\n")) + (with-current-buffer standard-output + (save-excursion + (re-search-backward + (concat "\\(" customize-label "\\)") nil t) + (help-xref-button 1 'help-customize-face f))) + (setq file-name (find-lisp-object-file-name f 'defface)) + (when file-name + (princ "Defined in `") + (princ (file-name-nondirectory file-name)) + (princ "'") + ;; Make a hyperlink to the library. + (save-excursion + (re-search-backward "`\\([^`']+\\)'" nil t) + (help-xref-button 1 'help-face-def f file-name)) + (princ ".") + (terpri) + (terpri)) + (dolist (a attrs) + (let ((attr (face-attribute f (car a) frame))) + (insert (make-string (- max-width (length (cdr a))) ?\s) + (cdr a) ": " (format "%s" attr)) + (if (and (eq (car a) :inherit) + (not (eq attr 'unspecified))) + ;; Make a hyperlink to the parent face. + (save-excursion + (re-search-backward ": \\([^:]+\\)" nil t) + (help-xref-button 1 'help-face attr))) + (insert "\n"))))) + (terpri))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1529,16 +1566,6 @@ See `defface' for information about the format and meaning of SPEC." ;; When we change a face based on a spec from outside custom, ;; record it for future frames. (put (or (get face 'face-alias) face) 'face-override-spec spec)) -;;; RMS 29 dec 2007: Perhaps this code should be reinstated. -;;; That depends on whether the overriding spec -;;; or the default face attributes -;;; should take priority. -;;; ;; Clear all the new-frame default attributes for this face. -;;; ;; face-spec-reset-face won't do it right. -;;; (let ((facevec (cdr (assq face face-new-frame-defaults)))) -;;; (dotimes (i (length facevec)) -;;; (unless (= i 0) -;;; (aset facevec i 'unspecified)))) ;; Reset each frame according to the rules implied by all its specs. (dolist (frame (frame-list)) (face-spec-recalc face frame)))) @@ -1559,23 +1586,14 @@ then the override spec." (defun face-spec-set-2 (face frame spec) "Set the face attributes of FACE on FRAME according to SPEC." - (let* ((attrs (face-spec-choose spec frame))) - (while attrs - (let ((attribute (car attrs)) - (value (car (cdr attrs)))) - ;; Support some old-style attribute names and values. - (case attribute - (:bold (setq attribute :weight value (if value 'bold 'normal))) - (:italic (setq attribute :slant value (if value 'italic 'normal))) - ((:foreground :background) - ;; Compatibility with 20.x. Some bogus face specs seem to - ;; exist containing things like `:foreground nil'. - (if (null value) (setq value 'unspecified))) - (t (unless (assq attribute face-x-resources) - (setq attribute nil)))) - (when attribute - (set-face-attribute face frame attribute value))) - (setq attrs (cdr (cdr attrs)))))) + (let* ((spec (face-spec-choose spec frame)) + attrs) + (while spec + (when (assq (car spec) face-x-resources) + (push (car spec) attrs) + (push (cadr spec) attrs)) + (setq spec (cddr spec))) + (apply 'set-face-attribute face frame (nreverse attrs)))) (defun face-attr-match-p (face attrs &optional frame) "Return t if attributes of FACE match values in plist ATTRS. @@ -1824,7 +1842,7 @@ Return nil if it has no specified face." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defcustom frame-background-mode nil - "*The brightness of the background. + "The brightness of the background. Set this to the symbol `dark' if your background color is dark, `light' if your background is light, or nil (automatic by default) if you want Emacs to examine the brightness for you. Don't set this @@ -1842,82 +1860,82 @@ variable with `setq'; this won't have the expected effect." (declare-function x-get-resource "frame.c" (attribute class &optional component subclass)) +(defvar inhibit-frame-set-background-mode nil) + (defun frame-set-background-mode (frame) "Set up display-dependent faces on FRAME. Display-dependent faces are those which have different definitions according to the `background-mode' and `display-type' frame parameters." - (let* ((bg-resource - (and (window-system frame) - (x-get-resource "backgroundMode" "BackgroundMode"))) - (bg-color (frame-parameter frame 'background-color)) - (terminal-bg-mode (terminal-parameter frame 'background-mode)) - (tty-type (tty-type frame)) - (bg-mode - (cond (frame-background-mode) - (bg-resource - (intern (downcase bg-resource))) - (terminal-bg-mode) - ((and (null (window-system frame)) - ;; Unspecified frame background color can only - ;; happen on tty's. - (member bg-color '(nil unspecified "unspecified-bg"))) - ;; There is no way to determine the background mode - ;; automatically, so we make a guess based on the - ;; terminal type. - (if (and tty-type - (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" - tty-type)) - 'light - 'dark)) - ((equal bg-color "unspecified-fg") ; inverted colors - (if (and tty-type - (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" - tty-type)) - 'dark - 'light)) - ((>= (apply '+ (color-values bg-color frame)) - ;; Just looking at the screen, colors whose - ;; values add up to .6 of the white total - ;; still look dark to me. - (* (apply '+ (color-values "white" frame)) .6)) - 'light) - (t 'dark))) - (display-type - (cond ((null (window-system frame)) - (if (tty-display-color-p frame) 'color 'mono)) - ((display-color-p frame) - 'color) - ((x-display-grayscale-p frame) - 'grayscale) - (t 'mono))) - (old-bg-mode - (frame-parameter frame 'background-mode)) - (old-display-type - (frame-parameter frame 'display-type))) - - (unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type)) - (let ((locally-modified-faces nil)) - ;; Before modifying the frame parameters, we collect a list of - ;; faces that don't match what their face-spec says they should - ;; look like; we then avoid changing these faces below. - ;; These are the faces whose attributes were modified on FRAME. - ;; We use a negative list on the assumption that most faces will - ;; be unmodified, so we can avoid consing in the common case. - (dolist (face (face-list)) - (and (not (get face 'face-override-spec)) - (not (face-spec-match-p face - (face-user-default-spec face) - (selected-frame))) - (push face locally-modified-faces))) - ;; Now change to the new frame parameters - (modify-frame-parameters frame - (list (cons 'background-mode bg-mode) - (cons 'display-type display-type))) - ;; For all named faces, choose face specs matching the new frame - ;; parameters, unless they have been locally modified. - (dolist (face (face-list)) - (unless (memq face locally-modified-faces) - (face-spec-recalc face frame))))))) + (unless inhibit-frame-set-background-mode + (let* ((bg-resource + (and (window-system frame) + (x-get-resource "backgroundMode" "BackgroundMode"))) + (bg-color (frame-parameter frame 'background-color)) + (terminal-bg-mode (terminal-parameter frame 'background-mode)) + (tty-type (tty-type frame)) + (default-bg-mode + (if (or (window-system frame) + (and tty-type + (string-match "^\\(xterm\\|\\rxvt\\|dtterm\\|eterm\\)" + tty-type))) + 'light + 'dark)) + (non-default-bg-mode (if (eq default-bg-mode 'light) 'dark 'light)) + (bg-mode + (cond (frame-background-mode) + (bg-resource (intern (downcase bg-resource))) + (terminal-bg-mode) + ((equal bg-color "unspecified-fg") ; inverted colors + non-default-bg-mode) + ((not (color-values bg-color frame)) + default-bg-mode) + ((>= (apply '+ (color-values bg-color frame)) + ;; Just looking at the screen, colors whose + ;; values add up to .6 of the white total + ;; still look dark to me. + (* (apply '+ (color-values "white" frame)) .6)) + 'light) + (t 'dark))) + (display-type + (cond ((null (window-system frame)) + (if (tty-display-color-p frame) 'color 'mono)) + ((display-color-p frame) + 'color) + ((x-display-grayscale-p frame) + 'grayscale) + (t 'mono))) + (old-bg-mode + (frame-parameter frame 'background-mode)) + (old-display-type + (frame-parameter frame 'display-type))) + + (unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type)) + (let ((locally-modified-faces nil) + ;; Prevent face-spec-recalc from calling this function + ;; again, resulting in a loop (bug#911). + (inhibit-frame-set-background-mode t)) + ;; Before modifying the frame parameters, collect a list of + ;; faces that don't match what their face-spec says they + ;; should look like. We then avoid changing these faces + ;; below. These are the faces whose attributes were + ;; modified on FRAME. We use a negative list on the + ;; assumption that most faces will be unmodified, so we can + ;; avoid consing in the common case. + (dolist (face (face-list)) + (and (not (get face 'face-override-spec)) + (not (face-spec-match-p face + (face-user-default-spec face) + (selected-frame))) + (push face locally-modified-faces))) + ;; Now change to the new frame parameters + (modify-frame-parameters frame + (list (cons 'background-mode bg-mode) + (cons 'display-type display-type))) + ;; For all named faces, choose face specs matching the new frame + ;; parameters, unless they have been locally modified. + (dolist (face (face-list)) + (unless (memq face locally-modified-faces) + (face-spec-recalc face frame)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1929,21 +1947,25 @@ according to the `background-mode' and `display-type' frame parameters." (defun x-handle-named-frame-geometry (parameters) "Add geometry parameters for a named frame to parameter list PARAMETERS. Value is the new parameter list." - (let* ((name (or (cdr (assq 'name parameters)) - (cdr (assq 'name default-frame-alist)))) - (x-resource-name name) - (res-geometry (if name (x-get-resource "geometry" "Geometry")))) - (when res-geometry - (let ((parsed (x-parse-geometry res-geometry))) - ;; If the resource specifies a position, call the position - ;; and size "user-specified". - (when (or (assq 'top parsed) - (assq 'left parsed)) - (setq parsed (append '((user-position . t) (user-size . t)) parsed))) - ;; Put the geometry parameters at the end. Copy - ;; default-frame-alist so that they go after it. - (setq parameters (append parameters default-frame-alist parsed)))) - parameters)) + ;; Note that `x-resource-name' has a global meaning. + (let ((x-resource-name (or (cdr (assq 'name parameters)) + (cdr (assq 'name default-frame-alist))))) + (when x-resource-name + ;; Before checking X resources, we must have an X connection. + (or (window-system) + (x-display-list) + (x-open-connection (or (cdr (assq 'display parameters)) + x-display-name))) + (let (res-geometry parsed) + (and (setq res-geometry (x-get-resource "geometry" "Geometry")) + (setq parsed (x-parse-geometry res-geometry)) + (setq parameters + (append parameters default-frame-alist parsed + ;; If the resource specifies a position, + ;; take note of that. + (if (or (assq 'top parsed) (assq 'left parsed)) + '((user-position . t) (user-size . t))))))))) + parameters) (defun x-handle-reverse-video (frame parameters) @@ -1974,7 +1996,6 @@ Value is the new parameter list." (declare-function x-create-frame "xfns.c" (parms)) (declare-function x-setup-function-keys "term/x-win" (frame)) -(declare-function tool-bar-setup "tool-bar" (&optional frame)) (defun x-create-frame-with-faces (&optional parameters) "Create a frame from optional frame parameters PARAMETERS. @@ -2001,10 +2022,6 @@ Value is the new frame created." (x-handle-reverse-video frame parameters) (frame-set-background-mode frame) (face-set-after-frame-default frame parameters) - ;; Make sure the tool-bar is ready to be enabled. The - ;; `tool-bar-lines' frame parameter will not take effect - ;; without this call. - (tool-bar-setup frame) (if (null visibility-spec) (make-frame-visible frame) (modify-frame-parameters frame (list visibility-spec))) @@ -2019,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. @@ -2027,7 +2044,7 @@ frame parameters in PARAMETERS and `default-frame-alist'." ;; X resouces for the default face are applied during ;; x-create-frame. (and (not (eq face 'default)) - (memq (window-system frame) '(x w32 ns)) + (memq (window-system frame) '(x w32)) (make-face-x-resource-internal face frame)) ;; Apply attributes specified by face-new-frame-defaults (internal-merge-in-global-face face frame)) @@ -2147,7 +2164,7 @@ terminal type to a different value." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Compatiblity with 20.2 +;;; Compatibility with 20.2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update a frame's faces when we change its default font. @@ -2267,9 +2284,14 @@ terminal type to a different value." "Basic face for highlighting." :group 'basic-faces) +;; Region face: under NS, default to the system-defined selection +;; color (optimized for the fixed white background of other apps), +;; if background is light. (defface region '((((class color) (min-colors 88) (background dark)) :background "blue3") + (((class color) (min-colors 88) (background light) (type ns)) + :background "ns_selection_color") (((class color) (min-colors 88) (background light)) :background "lightgoldenrod2") (((class color) (min-colors 16) (background dark)) @@ -2347,6 +2369,8 @@ terminal type to a different value." :version "21.1" :group 'mode-line-faces :group 'basic-faces) +;; No need to define aliases of this form for new faces. +(define-obsolete-face-alias 'modeline 'mode-line "21.1") (defface mode-line-inactive '((default @@ -2363,6 +2387,7 @@ terminal type to a different value." :version "22.1" :group 'mode-line-faces :group 'basic-faces) +(define-obsolete-face-alias 'modeline-inactive 'mode-line-inactive "22.1") (defface mode-line-highlight '((((class color) (min-colors 88)) @@ -2373,6 +2398,7 @@ terminal type to a different value." :version "22.1" :group 'mode-line-faces :group 'basic-faces) +(define-obsolete-face-alias 'modeline-highlight 'mode-line-highlight "22.1") (defface mode-line-emphasis '((t (:weight bold))) @@ -2388,12 +2414,7 @@ Use the face `mode-line-highlight' for features that can be selected." :version "22.1" :group 'mode-line-faces :group 'basic-faces) - -;; Make `modeline' an alias for `mode-line', for compatibility. -(put 'modeline 'face-alias 'mode-line) -(put 'modeline-inactive 'face-alias 'mode-line-inactive) -(put 'modeline-highlight 'face-alias 'mode-line-highlight) -(put 'modeline-buffer-id 'face-alias 'mode-line-buffer-id) +(define-obsolete-face-alias 'modeline-buffer-id 'mode-line-buffer-id "22.1") (defface header-line '((default @@ -2515,6 +2536,9 @@ Note: Other faces cannot inherit from the cursor face." :group 'menu :group 'basic-faces) +(defface help-argument-name '((((supports :slant italic)) :inherit italic)) + "Face to highlight argument names in *Help* buffers." + :group 'help) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Manipulating font names. @@ -2559,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)