;;; 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(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); 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 `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 \",\" as the
-separator character. 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."
- (let ((faceprop (or (get-char-property (point) 'read-face-name)
- (get-char-property (point) 'face)))
- (aliasfaces nil)
- (nonaliasfaces nil)
- faces)
- ;; Try to get a face name from the buffer.
- (if (memq (intern-soft (thing-at-point 'symbol)) (face-list))
- (setq faces (list (intern-soft (thing-at-point 'symbol)))))
- ;; Add the named faces that the `face' property uses.
- (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 (f faceprop)
- (if (symbolp f)
- (push f faces)))
- (if (symbolp faceprop)
- (push faceprop faces)))
- (delete-dups faces)
+(defvar crm-separator) ; from crm.el
+(defun read-face-name (prompt &optional default multiple)
+ "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)))))
-
- ;; If we only want one, and the default is more than one,
- ;; discard the unwanted ones now.
- (unless multiple
- (if faces
- (setq faces (list (car faces)))))
- (require 'crm)
- (let* ((input
- ;; Read the input.
- (completing-read-multiple
- (if (or faces default)
- (format "%s (default `%s'): " prompt
- (if faces (mapconcat 'symbol-name faces ",")
- default))
- (format "%s: " prompt))
- (completion-table-in-turn nonaliasfaces aliasfaces)
- nil t nil 'face-name-history
- (if faces (mapconcat 'symbol-name faces ","))))
- ;; Canonicalize the output.
- (output
- (cond ((or (equal input "") (equal input '("")))
- (or faces (unless (stringp default) default)))
- ((stringp input)
- (mapcar 'intern (split-string input ", *" t)))
- ((listp input)
- (mapcar 'intern input))
- (input))))
- ;; Return either a list of faces or just one face.
- (if multiple
- output
- (car output)))))
+ (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 the optional argument FRAME is given, report on face FACE in that 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" 'default t)))
+ (interactive (list (read-face-name "Describe face"
+ (or (face-at-point t) 'default)
+ t)))
(let* ((attrs '((:family . "Family")
(:foundry . "Foundry")
(:width . "Width")
(: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))
HCoop / bpt / emacs.git / blobdiff