(: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"))
(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)
"")))
;; If we only want one, and the default is more than one,
;; discard the unwanted ones.
(t (symbol-name (car default))))))
- (if (and default (not multiple))
- ;; 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))))
+ (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)
;; 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))
(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)
(:weight . "Weight")
(:slant . "Slant")
(:foreground . "Foreground")
+ (:distant-foreground . "DistantForeground")
(:background . "Background")
(:underline . "Underline")
(:overline . "Overline")
: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.
(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))
+ 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))
+ (when spec
+ (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.
+ (unless theme-face-applied
+ (setq spec (face-spec-choose (face-default-spec face) frame))
+ (face-spec-set-2 face frame spec))
+ (setq spec (face-spec-choose (get face 'face-override-spec) frame))
+ (face-spec-set-2 face frame spec))
+ (make-face-x-resource-internal face frame))
(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))
;;; 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)
(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)
+(defvar tty-setup-hook nil
+ "Hook run after running the initialization function of a new text terminal.
+This can be used to fine tune the `input-decode-map', for example.")
+
(defun tty-run-terminal-initialization (frame &optional type)
"Run the special initialization code for the terminal type of FRAME.
The optional TYPE parameter may be used to override the autodetected
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)
+ (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 "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