;;; faces.el --- Lisp faces
-;; Copyright (C) 1992-1996, 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1996, 1998-2014 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
"Define a new face with name FACE, a symbol.
Do not call this directly from Lisp code; use `defface' instead.
-If NO-INIT-FROM-RESOURCES is non-nil, don't initialize face
-attributes from X resources. If FACE is already known as a face,
-leave it unmodified. Return FACE."
+If FACE is already known as a face, leave it unmodified. Return FACE.
+
+NO-INIT-FROM-RESOURCES has been deprecated and is no longer used
+and will go away. Handling of conditional X resources application
+has been pushed down to make-x-resource-internal itself."
(interactive (list (read-from-minibuffer
"Make face: " nil nil t 'face-name-history)))
(unless (facep face)
(when (fboundp 'facemenu-add-new-face)
(facemenu-add-new-face face))
;; Define frame-local faces for all frames from X resources.
- (unless no-init-from-resources
- (make-face-x-resource-internal face)))
+ (make-face-x-resource-internal face))
face)
+;; Handling of whether to apply X resources or not, has been pushed down
+;; to make-face-x-resource-internal itself, thus the optional arg is no
+;; longer evaluated at all and going away.
+(set-advertised-calling-convention 'make-face '(face) "24.4")
+
(defun make-empty-face (face)
"Define a new, empty face with name FACE.
Do not call this directly from Lisp code; use `defface' instead."
(interactive (list (read-from-minibuffer
"Make empty face: " nil nil t 'face-name-history)))
- (make-face face 'no-init-from-resources))
+ (make-face face))
(defun copy-face (old-face new-face &optional frame new-frame)
"Define a face named NEW-FACE, which is a copy of OLD-FACE.
(:weight (".attributeWeight" . "Face.AttributeWeight"))
(:slant (".attributeSlant" . "Face.AttributeSlant"))
(:foreground (".attributeForeground" . "Face.AttributeForeground"))
+ (:distant-foreground
+ (".attributeDistantForeground" . "Face.AttributeDistantForeground"))
(:background (".attributeBackground" . "Face.AttributeBackground"))
(:overline (".attributeOverline" . "Face.AttributeOverline"))
(:strike-through (".attributeStrikeThrough" . "Face.AttributeStrikeThrough"))
(declare-function internal-face-x-get-resource "xfaces.c"
- (resource class frame))
+ (resource class &optional frame))
(declare-function internal-set-lisp-face-attribute-from-resource "xfaces.c"
(face attr value &optional frame))
(defun make-face-x-resource-internal (face &optional frame)
"Fill frame-local FACE on FRAME from X resources.
-FRAME nil or not specified means do it for all frames."
- (if (null frame)
- (dolist (frame (frame-list))
- (set-face-attributes-from-resources face frame))
- (set-face-attributes-from-resources face frame)))
+FRAME nil or not specified means do it for all frames.
+
+If `inhibit-x-resources' is non-nil, this function does nothing."
+ (unless inhibit-x-resources
+ (dolist (frame (if (null frame) (frame-list) (list frame)))
+ ;; `x-create-frame' already took care of correctly handling
+ ;; the reverse video case-- do _not_ touch the default face
+ (unless (and (eq face 'default)
+ (frame-parameter frame 'reverse))
+ (set-face-attributes-from-resources face frame)))))
\f
(defun face-documentation (face)
"Get the documentation string for FACE.
If FACE is a face-alias, get the documentation for the target face."
- (let ((alias (get face 'face-alias))
- doc)
+ (let ((alias (get face 'face-alias)))
(if alias
- (progn
- (setq doc (get alias 'face-documentation))
+ (let ((doc (get alias 'face-documentation)))
(format "%s is an alias for the face `%s'.%s" face alias
(if doc (format "\n%s" doc)
"")))
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility.
Use `set-face-attribute' for finer control of the font weight."
- (interactive (list (read-face-name "Make which face bold")))
+ (interactive (list (read-face-name "Make which face bold"
+ (face-at-point t))))
(set-face-attribute face frame :weight 'bold))
"Make the font of FACE be non-bold, if possible.
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility."
- (interactive (list (read-face-name "Make which face non-bold")))
+ (interactive (list (read-face-name "Make which face non-bold"
+ (face-at-point t))))
(set-face-attribute face frame :weight 'normal))
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility.
Use `set-face-attribute' for finer control of the font slant."
- (interactive (list (read-face-name "Make which face italic")))
+ (interactive (list (read-face-name "Make which face italic"
+ (face-at-point t))))
(set-face-attribute face frame :slant 'italic))
"Make the font of FACE be non-italic, if possible.
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility."
- (interactive (list (read-face-name "Make which face non-italic")))
+ (interactive (list (read-face-name "Make which face non-italic"
+ (face-at-point t))))
(set-face-attribute face frame :slant 'normal))
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility.
Use `set-face-attribute' for finer control of font weight and slant."
- (interactive (list (read-face-name "Make which face bold-italic")))
+ (interactive (list (read-face-name "Make which face bold-italic"
+ (face-at-point t))))
(set-face-attribute face frame :weight 'bold :slant 'italic))
If FACE specifies neither foreground nor background color,
set its foreground and background to the background and foreground
of the default face. Value is FACE."
- (interactive (list (read-face-name "Invert face")))
+ (interactive (list (read-face-name "Invert face" (face-at-point t))))
(let ((fg (face-attribute face :foreground frame))
(bg (face-attribute face :background frame)))
(if (not (and (eq fg 'unspecified) (eq bg 'unspecified)))
;;; Interactively modifying faces.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar crm-separator) ; from crm.el
+
(defun read-face-name (prompt &optional default multiple)
- "Read one or more face names, defaulting to the face(s) at point.
-PROMPT should be a prompt string; it should not end in a space or
-a colon.
-
-The optional argument DEFAULT specifies the default face name(s)
-to return if the user just types RET. If its value is non-nil,
-it should be a list of face names (symbols or strings); in that case,
-the default return value is the `car' of DEFAULT (if the argument
-MULTIPLE is non-nil), or DEFAULT (if MULTIPLE is nil). See below
-for the meaning of MULTIPLE.
-
-If DEFAULT is nil, the list of default face names is taken from
-the symbol at point and the `read-face-name' property of the text at point,
-or, if that is nil, from the `face' property of the text at point.
-
-This function uses `completing-read-multiple' with \"[ \\t]*,[ \\t]*\"
-as the separator regexp. Thus, the user may enter multiple face
-names, separated by commas. The optional argument MULTIPLE
-specifies the form of the return value. If MULTIPLE is non-nil,
-return a list of face names; if the user entered just one face
-name, the return value would be a list of one face name.
-Otherwise, return a single face name; if the user entered more
-than one face name, return only the first one."
- ;; Should we better not generate automagically a value for DEFAULT
- ;; when `read-face-name' was called with DEFAULT being nil?
- ;; Such magic is somewhat unusual for a function `read-...'.
- ;; Also, one cannot skip this magic by means of a suitable
- ;; value of DEFAULT. It would be cleaner to use
- ;; (read-face-name prompt (face-at-point)).
- (unless default
- ;; Try to get a default face name from the buffer.
- (let ((thing (intern-soft (thing-at-point 'symbol))))
- (if (memq thing (face-list))
- (setq default (list thing))))
- ;; Add the named faces that the `read-face-name' or `face' property uses.
- (let ((faceprop (or (get-char-property (point) 'read-face-name)
- (get-char-property (point) 'face))))
- (if (and (listp faceprop)
- ;; Don't treat an attribute spec as a list of faces.
- (not (keywordp (car faceprop)))
- (not (memq (car faceprop) '(foreground-color background-color))))
- (dolist (face faceprop)
- (if (symbolp face)
- (push face default)))
- (if (symbolp faceprop)
- (push faceprop default)))
- (delete-dups default)))
-
- ;; If we only want one, and the default is more than one,
- ;; discard the unwanted ones now.
- (if (and default (not multiple))
- (setq default (list (car default))))
-
- (if default
- (setq default (mapconcat (lambda (f)
- (if (symbolp f) (symbol-name f) f))
- default ", ")))
-
- ;; Build up the completion tables.
- (let (aliasfaces nonaliasfaces)
+ "Read one or more face names, prompting with PROMPT.
+PROMPT should not end in a space or a colon.
+
+Return DEFAULT if the user enters the empty string.
+If DEFAULT is non-nil, it should be a single face or a list of face names
+\(symbols or strings). In the latter case, return the `car' of DEFAULT
+\(if MULTIPLE is nil, see below), or DEFAULT (if MULTIPLE is non-nil).
+
+If MULTIPLE is non-nil, this function uses `completing-read-multiple'
+to read multiple faces with \"[ \\t]*,[ \\t]*\" as the separator regexp
+and it returns a list of face names. Otherwise, it reads and returns
+a single face name."
+ (if (and default (not (stringp default)))
+ (setq default
+ (cond ((symbolp default)
+ (symbol-name default))
+ (multiple
+ (mapconcat (lambda (f) (if (symbolp f) (symbol-name f) f))
+ default ", "))
+ ;; If we only want one, and the default is more than one,
+ ;; discard the unwanted ones.
+ (t (symbol-name (car default))))))
+ (when (and default (not multiple))
+ (require 'crm)
+ ;; For compatibility with `completing-read-multiple' use `crm-separator'
+ ;; to define DEFAULT if MULTIPLE is nil.
+ (setq default (car (split-string default crm-separator t))))
+
+ (let ((prompt (if default
+ (format "%s (default `%s'): " prompt default)
+ (format "%s: " prompt)))
+ aliasfaces nonaliasfaces faces)
+ ;; Build up the completion tables.
(mapatoms (lambda (s)
- (if (custom-facep s)
+ (if (facep s)
(if (get s 'face-alias)
(push (symbol-name s) aliasfaces)
(push (symbol-name s) nonaliasfaces)))))
-
- (let ((faces
- ;; Read the faces.
- (mapcar 'intern
- (completing-read-multiple
- (if default
- (format "%s (default `%s'): " prompt default)
- (format "%s: " prompt))
- (completion-table-in-turn nonaliasfaces aliasfaces)
- nil t nil 'face-name-history default))))
- ;; Return either a list of faces or just one face.
- (if multiple
- faces
- (car faces)))))
+ (if multiple
+ (progn
+ (dolist (face (completing-read-multiple
+ prompt
+ (completion-table-in-turn nonaliasfaces aliasfaces)
+ nil t nil 'face-name-history default))
+ ;; Ignore elements that are not faces
+ ;; (for example, because DEFAULT was "all faces")
+ (if (facep face) (push (intern face) faces)))
+ (nreverse faces))
+ (let ((face (completing-read
+ prompt
+ (completion-table-in-turn nonaliasfaces aliasfaces)
+ nil t nil 'face-name-history default)))
+ (if (facep face) (intern face))))))
;; Not defined without X, but behind window-system test.
(defvar x-bitmap-file-path)
;; pixmap file name won't start with an open-paren.
(and (memq attribute '(:stipple :box :underline))
(stringp new-value)
- (string-match "^[[(]" new-value)
+ (string-match-p "^[[(]" new-value)
(setq new-value (read new-value)))
new-value))
:slant (if italic-p 'italic 'normal)
:underline underline
:inverse-video inverse-p)
- (setq face (read-face-name "Modify face"))
+ (setq face (read-face-name "Modify face" (face-at-point t)))
(apply #'set-face-attribute face frame
(read-all-face-attributes face frame))))
\(a symbol), and NEW-VALUE is value read."
(cond ((eq attribute :font)
(let* ((prompt "Set font-related attributes of face")
- (face (read-face-name prompt))
+ (face (read-face-name prompt (face-at-point t)))
(font (read-face-font face frame)))
(list face font)))
(t
(let* ((attribute-name (face-descriptive-attribute-name attribute))
(prompt (format "Set %s of face" attribute-name))
- (face (read-face-name prompt))
+ (face (read-face-name prompt (face-at-point t)))
(new-value (read-face-attribute face attribute frame)))
(list face new-value)))))
If REGEXP is non-nil, list only those faces with names matching
this regular expression. When called interactively with a prefix
-arg, prompt for a regular expression."
+argument, prompt for a regular expression using `read-regexp'."
(interactive (list (and current-prefix-arg
(read-regexp "List faces matching regexp"))))
(let ((all-faces (zerop (length regexp)))
(delq nil
(mapcar (lambda (f)
(let ((s (symbol-name f)))
- (when (or all-faces (string-match regexp s))
+ (when (or all-faces (string-match-p regexp s))
(setq max-length (max (length s) max-length))
f)))
(sort (face-list) #'string-lessp))))
(setq disp-frame (if window (window-frame window)
(car (frame-list))))
(or (eq frame disp-frame)
- (let ((faces (face-list)))
- (while faces
- (copy-face (car faces) (car faces) frame disp-frame)
- (setq faces (cdr faces)))))))
+ (dolist (face (face-list))
+ (copy-face face face frame disp-frame)))))
(defun describe-face (face &optional frame)
If FRAME is t, report on the defaults for face FACE (for new frames).
If FRAME is omitted or nil, use the selected frame."
(interactive (list (read-face-name "Describe face"
- (if (eq 'default (face-at-point))
- '(default))
+ (or (face-at-point t) 'default)
t)))
(let* ((attrs '((:family . "Family")
(:foundry . "Foundry")
(:weight . "Weight")
(:slant . "Slant")
(:foreground . "Foreground")
+ (:distant-foreground . "DistantForeground")
(:background . "Background")
(:underline . "Underline")
(:overline . "Overline")
match))
-(defun face-spec-choose (spec &optional frame)
- "Choose the proper attributes for FRAME, out of SPEC.
-If SPEC is nil, return nil."
+(defun face-spec-choose (spec &optional frame no-match-retval)
+ "Return the proper attributes for FRAME, out of SPEC.
+
+If no match is found or SPEC is nil, return nil, unless NO-MATCH-RETVAL
+is given, in which case return its value instead."
(unless frame
(setq frame (selected-frame)))
(let ((tail spec)
- result defaults)
+ result defaults match-found)
(while tail
(let* ((entry (pop tail))
(display (car entry))
(setq defaults thisval)
;; Otherwise, if it matches, use it.
(when (face-spec-set-match-display display frame)
- (setq result thisval)
- (setq tail nil)))))
- (if defaults (append result defaults) result)))
+ (setq result thisval
+ tail nil
+ match-found t)))))
+ ;; If defaults have been found, it's safe to just append those to the result
+ ;; list (which at this point will be either nil or contain actual specs) and
+ ;; return it to the caller. Since there will most definitely be something to
+ ;; return in this case, there's no need to know/check if a match was found.
+ (if defaults
+ (append result defaults)
+ (if match-found
+ result
+ no-match-retval))))
(defun face-spec-reset-face (face &optional frame)
:box nil :inverse-video nil :stipple nil :inherit nil)
;; `display-graphic-p' is unavailable when running
;; temacs, prior to loading frame.el.
- (unless (and (fboundp 'display-graphic-p)
- (display-graphic-p frame))
- `(:family "default" :foundry "default" :width normal
- :height 1 :weight normal :slant normal
- :foreground ,(if (frame-parameter nil 'reverse)
- "unspecified-bg"
- "unspecified-fg")
- :background ,(if (frame-parameter nil 'reverse)
- "unspecified-fg"
- "unspecified-bg"))))
+ (when (fboundp 'display-graphic-p)
+ (unless (display-graphic-p frame)
+ `(:family "default" :foundry "default" :width normal
+ :height 1 :weight normal :slant normal
+ :foreground ,(if (frame-parameter nil 'reverse)
+ "unspecified-bg"
+ "unspecified-fg")
+ :background ,(if (frame-parameter nil 'reverse)
+ "unspecified-fg"
+ "unspecified-bg")))))
;; For all other faces, unspecify all attributes.
(apply 'append
(mapcar (lambda (x) (list (car x) 'unspecified))
"Set the face spec SPEC for FACE.
See `defface' for the format of SPEC.
-The appearance of each face is controlled by its spec, and by the
-internal face attributes (which can be frame-specific and can be
-set via `set-face-attribute').
+The appearance of each face is controlled by its specs (set via
+this function), and by the internal frame-specific face
+attributes (set via `set-face-attribute').
+
+This function also defines FACE as a valid face name if it is not
+already one, and (re)calculates its attributes on existing
+frames.
The argument SPEC-TYPE determines which spec to set:
nil or `face-override-spec' means the override spec (which is
`reset' means to ignore SPEC, but clear the `customized-face'
and `face-override-spec' specs;
Any other value means not to set any spec, but to run the
-function for its other effects.
-
-In addition to setting the face spec, this function defines FACE
-as a valid face name if it is not already one, and (re)calculates
-the face's attributes on existing frames."
+function for its other effects."
(if (get face 'face-alias)
(setq face (get face 'face-alias)))
;; Save SPEC to the relevant symbol property.
;; as far as Custom is concerned.
(unless (eq face 'face-override-spec)
(put face 'face-modified nil))
- (if (facep face)
- ;; If the face already exists, recalculate it.
- (dolist (frame (frame-list))
- (face-spec-recalc face frame))
- ;; Otherwise, initialize it on all frames.
- (make-empty-face face)
- (let ((value (face-user-default-spec face))
- (have-window-system (memq initial-window-system '(x w32 ns))))
- (dolist (frame (frame-list))
- (face-spec-set-2 face frame value)
- (when (memq (window-system frame) '(x w32 ns))
- (setq have-window-system t)))
- (if have-window-system
- (make-face-x-resource-internal face)))))
+ ;; Initialize the face if it does not exist, then recalculate.
+ (make-empty-face face)
+ (dolist (frame (frame-list))
+ (face-spec-recalc face frame)))
(defun face-spec-recalc (face frame)
"Reset the face attributes of FACE on FRAME according to its specs.
-This applies the defface/custom spec first, then the custom theme specs,
-then the override spec."
+The following sources are applied in this order:
+
+ face reset to default values if it's the default face, otherwise set
+ to unspecified (through `face-spec-reset-face')
+ |
+ (theme and user customization)
+ or: if none of the above exist, and none match the current frame or
+ inherited from the defface spec instead of overwriting it
+ entirely, the following is applied instead:
+ (defface default spec)
+ (X resources (if applicable))
+ |
+ defface override spec"
(while (get face 'face-alias)
(setq face (get face 'face-alias)))
(face-spec-reset-face face frame)
;; If FACE is customized or themed, set the custom spec from
- ;; `theme-face' records, which completely replace the defface spec
- ;; rather than inheriting from it.
- (let ((theme-faces (get face 'theme-face)))
+ ;; `theme-face' records.
+ (let ((theme-faces (get face 'theme-face))
+ (no-match-found 0)
+ spec theme-face-applied)
(if theme-faces
- (dolist (spec (reverse theme-faces))
- (face-spec-set-2 face frame (cadr spec)))
- (face-spec-set-2 face frame (face-default-spec face))))
- (face-spec-set-2 face frame (get face 'face-override-spec)))
+ (dolist (elt (reverse theme-faces))
+ (setq spec (face-spec-choose (cadr elt) frame no-match-found))
+ (unless (eq spec no-match-found)
+ (face-spec-set-2 face frame spec)
+ (setq theme-face-applied t))))
+ ;; If there was a spec applicable to FRAME, that overrides the
+ ;; defface spec entirely (rather than inheriting from it). If
+ ;; there was no spec applicable to FRAME, apply the defface spec
+ ;; as well as any applicable X resources.
+ (unless theme-face-applied
+ (setq spec (face-spec-choose (face-default-spec face) frame))
+ (face-spec-set-2 face frame spec)
+ (make-face-x-resource-internal face frame))
+ (setq spec (face-spec-choose (get face 'face-override-spec) frame))
+ (face-spec-set-2 face frame spec)))
(defun face-spec-set-2 (face frame spec)
"Set the face attributes of FACE on FRAME according to SPEC."
- (let* ((spec (face-spec-choose spec frame))
- attrs)
+ (let (attrs)
(while spec
(when (assq (car spec) face-x-resources)
(push (car spec) attrs)
(if (color-defined-p string)
(list string))))
((eq flag 'lambda) ; Test completion.
- (or (memq string colors)
+ (or (member string colors)
(color-defined-p string)))))
nil t)))
(when (and convert-to-RGB
(not (string-equal color "")))
(let ((components (x-color-values color)))
- (unless (string-match "^#\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color)
+ (unless (string-match-p "^#\\(?:[a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color)
(setq color (format "#%04X%04X%04X"
(logand 65535 (nth 0 components))
(logand 65535 (nth 1 components))
(when msg (message "Color: `%s'" color))
color))
-
-(defun face-at-point ()
+(defun face-at-point (&optional thing multiple)
"Return the face of the character after point.
If it has more than one face, return the first one.
-Return nil if it has no specified face."
- (let* ((faceprop (or (get-char-property (point) 'read-face-name)
- (get-char-property (point) 'face)
- 'default))
- (face (cond ((symbolp faceprop) faceprop)
- ;; List of faces (don't treat an attribute spec).
- ;; Just use the first face.
- ((and (consp faceprop) (not (keywordp (car faceprop)))
- (not (memq (car faceprop)
- '(foreground-color background-color))))
- (car faceprop))
- (t nil)))) ; Invalid face value.
- (if (facep face) face nil)))
+If THING is non-nil try first to get a face name from the buffer.
+IF MULTIPLE is non-nil, return a list of all faces.
+Return nil if there is no face."
+ (let (faces)
+ (if thing
+ ;; Try to get a face name from the buffer.
+ (let ((face (intern-soft (thing-at-point 'symbol))))
+ (if (facep face)
+ (push face faces))))
+ ;; Add the named faces that the `read-face-name' or `face' property uses.
+ (let ((faceprop (or (get-char-property (point) 'read-face-name)
+ (get-char-property (point) 'face))))
+ (cond ((facep faceprop)
+ (push faceprop faces))
+ ((and (listp faceprop)
+ ;; Don't treat an attribute spec as a list of faces.
+ (not (keywordp (car faceprop)))
+ (not (memq (car faceprop)
+ '(foreground-color background-color))))
+ (dolist (face faceprop)
+ (if (facep face)
+ (push face faces))))))
+ (setq faces (delete-dups (nreverse faces)))
+ (if multiple faces (car faces))))
(defun foreground-color-at-point ()
"Return the foreground color of the character after point."
;;; Frame creation.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(declare-function x-display-list "xfns.c" ())
+(declare-function x-open-connection "xfns.c"
+ (display &optional xrm-string must-succeed))
+(declare-function x-get-resource "frame.c"
+ (attribute class &optional component subclass))
(declare-function x-parse-geometry "frame.c" (string))
(defvar x-display-name)
(progn
;; Initialize faces from face spec and custom theme.
(face-spec-recalc face frame)
- ;; X resources for the default face are applied during
- ;; `x-create-frame'.
- (and (not (eq face 'default)) window-system-p
- (make-face-x-resource-internal face frame))
;; Apply attributes specified by face-new-frame-defaults
(internal-merge-in-global-face face frame))
;; Don't let invalid specs prevent frame creation.
(unless (terminal-parameter frame 'terminal-initted)
(set-terminal-parameter frame 'terminal-initted t)
(set-locale-environment nil frame)
- (tty-run-terminal-initialization frame))
+ (tty-run-terminal-initialization frame nil t))
(frame-set-background-mode frame t)
(face-set-after-frame-default frame parameters)
(setq success t))
(not (funcall pred type)))
;; Strip off last hyphen and what follows, then try again
(setq type
- (if (setq hyphend (string-match "[-_][^-_]+$" type))
+ (if (setq hyphend (string-match-p "[-_][^-_]+$" type))
(substring type 0 hyphend)
nil))))
type)
-(defun tty-run-terminal-initialization (frame &optional type)
+(defvar tty-setup-hook nil
+ "Hook run after running the initialization function of a new text terminal.
+Specifically, `tty-run-terminal-initialization' runs this.
+This can be used to fine tune the `input-decode-map', for example.")
+
+(defun tty-run-terminal-initialization (frame &optional type run-hook)
"Run the special initialization code for the terminal type of FRAME.
The optional TYPE parameter may be used to override the autodetected
-terminal type to a different value."
+terminal type to a different value.
+
+If optional argument RUN-HOOK is non-nil, then as a final step,
+this runs the hook `tty-setup-hook'.
+
+If you set `term-file-prefix' to nil, this function does nothing."
(setq type (or type (tty-type frame)))
;; Load library for our terminal type.
;; User init file can set term-file-prefix to nil to prevent this.
type)
(when (fboundp term-init-func)
(funcall term-init-func))
- (set-terminal-parameter frame 'terminal-initted term-init-func)))))
+ (set-terminal-parameter frame 'terminal-initted term-init-func)
+ (if run-hook (run-hooks 'tty-setup-hook))))))
;; Called from C function init_display to initialize faces of the
;; dumped terminal frame on startup.
(frame-set-background-mode frame t)
(face-set-after-frame-default frame)))
-
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Standard faces.
'((((class color) (min-colors 88) (background dark))
:background "blue3")
(((class color) (min-colors 88) (background light) (type gtk))
- :foreground "gtk_selection_fg_color"
+ :distant-foreground "gtk_selection_fg_color"
:background "gtk_selection_bg_color")
(((class color) (min-colors 88) (background light) (type ns))
- :background "ns_selection_color")
+ :distant-foreground "ns_selection_fg_color"
+ :background "ns_selection_bg_color")
(((class color) (min-colors 88) (background light))
:background "lightgoldenrod2")
(((class color) (min-colors 16) (background dark))
(t :inverse-video t))
"Basic face for highlighting trailing whitespace."
:version "21.1"
- :group 'whitespace-faces ; like `show-trailing-whitespace'
:group 'basic-faces)
(defface escape-glyph
:version "22.1"
:group 'basic-faces)
+(defface window-divider '((t :foreground "gray60"))
+ "Basic face for window dividers.
+When a divider is less than 3 pixels wide, it is drawn solidly
+with the foreground of this face. For larger dividers this face
+is used for the inner part while the first pixel line/column is
+drawn with the `window-divider-first-pixel' face and the last
+pixel line/column with the `window-divider-last-pixel' face."
+ :version "24.4"
+ :group 'frames
+ :group 'basic-faces)
+
+(defface window-divider-first-pixel
+ '((t :foreground "gray80"))
+ "Basic face for first pixel line/column of window dividers.
+When a divider is at least 3 pixels wide, its first pixel
+line/column is drawn with the foreground of this face. If you do
+not want to accentuate the first pixel line/column, set this to
+the same as `window-divider' face."
+ :version "24.4"
+ :group 'frames
+ :group 'basic-faces)
+
+(defface window-divider-last-pixel
+ '((t :foreground "gray40"))
+ "Basic face for last pixel line/column of window dividers.
+When a divider is at least 3 pixels wide, its last pixel
+line/column is drawn with the foreground of this face. If you do
+not want to accentuate the last pixel line/column, set this to
+the same as `window-divider' face."
+ :version "24.4"
+ :group 'frames
+ :group 'basic-faces)
+
(defface minibuffer-prompt
'((((background dark)) :foreground "cyan")
;; Don't use blue because many users of the MS-DOS port customize
:version "24.1"
:group 'basic-faces)
+;; Faces for TTY menus.
+(defface tty-menu-enabled-face
+ '((t
+ :foreground "yellow" :background "blue" :weight bold))
+ "Face for displaying enabled items in TTY menus."
+ :group 'basic-faces)
+
+(defface tty-menu-disabled-face
+ '((((class color) (min-colors 16))
+ :foreground "lightgray" :background "blue")
+ (t
+ :foreground "white" :background "blue"))
+ "Face for displaying disabled items in TTY menus."
+ :group 'basic-faces)
+
+(defface tty-menu-selected-face
+ '((t :background "red"))
+ "Face for displaying the currently selected item in TTY menus."
+ :group 'basic-faces)
+
+(defgroup paren-showing-faces nil
+ "Faces used to highlight paren matches."
+ :group 'paren-showing
+ :group 'faces
+ :version "22.1")
+
+(defface show-paren-match
+ '((((class color) (background light))
+ :background "turquoise") ; looks OK on tty (becomes cyan)
+ (((class color) (background dark))
+ :background "steelblue3") ; looks OK on tty (becomes blue)
+ (((background dark))
+ :background "grey50")
+ (t
+ :background "gray"))
+ "Face used for a matching paren."
+ :group 'paren-showing-faces)
+
+(defface show-paren-mismatch
+ '((((class color)) (:foreground "white" :background "purple"))
+ (t (:inverse-video t)))
+ "Face used for a mismatching paren."
+ :group 'paren-showing-faces)
+
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Manipulating font names.
(let ((fonts (x-list-fonts pattern face frame 1)))
(or fonts
(if face
- (if (string-match "\\*" pattern)
+ (if (string-match-p "\\*" pattern)
(if (null (face-font face))
(error "No matching fonts are the same height as the frame default font")
(error "No matching fonts are the same height as face `%s'" face))