diff options
Diffstat (limited to 'lisp/faces.el')
| -rw-r--r-- | lisp/faces.el | 125 |
1 files changed, 101 insertions, 24 deletions
diff --git a/lisp/faces.el b/lisp/faces.el index 90f11bbe3bb..a3a6f1b78dd 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -46,7 +46,7 @@ the terminal-initialization file to be loaded." ("vt320" . "vt200") ("vt400" . "vt200") ("vt420" . "vt200") - ) + ("alacritty" . "xterm")) "Alist of terminal type aliases. Entries are of the form (TYPE . ALIAS), where both elements are strings. This means to treat a terminal of type TYPE as if it were of type ALIAS." @@ -176,10 +176,28 @@ REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc." ;;; Creation, copying. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(make-obsolete-variable 'face-new-frame-defaults + "use `face--new-frame-defaults' or `face-alist' instead." "28.1") + +(defun frame-face-alist (&optional frame) + "Return an alist of frame-local faces defined on FRAME. +This alist is a copy of the contents of `frame--face-hash-table'. +For internal use only." + (declare (obsolete frame--face-hash-table "28.1")) + (let (faces) + (maphash (lambda (face spec) + (let ((face-id (car (gethash face face--new-frame-defaults)))) + (push `(,face-id ,face . ,spec) faces))) + (frame--face-hash-table frame)) + (mapcar #'cdr (sort faces (lambda (f1 f2) (< (car f1) (car f2))))))) (defun face-list () "Return a list of all defined faces." - (mapcar #'car face-new-frame-defaults)) + (let (faces) + (maphash (lambda (face spec) + (push `(,(car spec) . ,face) faces)) + face--new-frame-defaults) + (mapcar #'cdr (sort faces (lambda (f1 f2) (< (car f1) (car f2))))))) (defun make-face (face) "Define a new face with name FACE, a symbol. @@ -503,7 +521,8 @@ If INHERIT is t, and FACE doesn't define a foreground color, then any foreground color that FACE inherits through its `:inherit' attribute is considered as well; however the return value may still be nil. If INHERIT is a face or a list of faces, then it is used to try to - resolve an unspecified foreground color. + resolve an unspecified foreground color, in addition to using any +inherited color. To ensure that a valid color is always returned, use a value of `default' for INHERIT; this will resolve any unspecified values by @@ -523,7 +542,8 @@ If INHERIT is t, and FACE doesn't define a background color, then any background color that FACE inherits through its `:inherit' attribute is considered as well; however the return value may still be nil. If INHERIT is a face or a list of faces, then it is used to try to - resolve an unspecified background color. + resolve an unspecified background color, in addition to using any +inherited color. To ensure that a valid color is always returned, use a value of `default' for INHERIT; this will resolve any unspecified values by @@ -1259,7 +1279,15 @@ of a global face. Value is the new attribute value." (or (car (rassoc old-value valid)) (format "%s" old-value)))) (setq new-value - (face-read-string face default attribute-name valid)) + (if (memq attribute '(:foreground :background)) + (let ((color + (read-color + (format-prompt "%s for face `%s'" + default attribute-name face)))) + (if (equal (string-trim color) "") + default + color)) + (face-read-string face default attribute-name valid))) (if (equal new-value default) ;; Nothing changed, so don't bother with all the stuff ;; below. In particular, this avoids a non-tty color @@ -1917,12 +1945,11 @@ Interactively, or with optional arg MSG non-nil, print the resulting color name in the echo area." (interactive "i\np\ni\np") ; Always convert to RGB interactively. (let* ((completion-ignore-case t) - (colors (or facemenu-color-alist - (append '("foreground at point" "background at point") - (if allow-empty-name '("")) - (if (display-color-p) - (defined-colors-with-face-attributes) - (defined-colors))))) + (colors (append '("foreground at point" "background at point") + (if allow-empty-name '("")) + (if (display-color-p) + (defined-colors-with-face-attributes) + (defined-colors)))) (color (completing-read (or prompt "Color (name or #RGB triplet): ") ;; Completing function for reading colors, accepting @@ -2106,10 +2133,28 @@ the X resource \"reverseVideo\" is present, handle that." (unwind-protect (progn (x-setup-function-keys frame) + (dolist (face (nreverse (face-list))) + (face-spec-recalc face frame)) (x-handle-reverse-video frame parameters) (frame-set-background-mode frame t) (face-set-after-frame-default frame parameters) - (if (null visibility-spec) + ;; Mark frame as 'was-invisible' when it was created as + ;; invisible or iconified and PARAMETERS contains either a + ;; width or height specification. This should be sufficient + ;; to handle Bug#24526 (where a frame is initially iconified + ;; to allow manipulating its size in a non-obtrusive way) and + ;; avoid that a tiling window manager for GTK3 gets a resize + ;; request it cannot handle (Bug#48268). The 'was-invisible' + ;; flag is eventually processed in xterm.c after we receive a + ;; MapNotify event; non-X builds ignore it. + (frame--set-was-invisible + frame + (and visibility-spec + (memq (cdr visibility-spec) '(nil icon)) + (or (assq 'width parameters) + (assq 'height parameters)))) + + (if (null visibility-spec) (make-frame-visible frame) (modify-frame-parameters frame (list visibility-spec))) (setq success t)) @@ -2120,7 +2165,7 @@ the X resource \"reverseVideo\" is present, handle that." (defun face-set-after-frame-default (frame &optional parameters) "Initialize the frame-local faces of FRAME. Calculate the face definitions using the face specs, custom theme -settings, X resources, and `face-new-frame-defaults'. +settings, X resources, and `face--new-frame-defaults'. Finally, apply any relevant face attributes found amongst the frame parameters in PARAMETERS." ;; The `reverse' is so that `default' goes first. @@ -2129,7 +2174,7 @@ frame parameters in PARAMETERS." (progn ;; Initialize faces from face spec and custom theme. (face-spec-recalc face frame) - ;; Apply attributes specified by face-new-frame-defaults + ;; Apply attributes specified by face--new-frame-defaults (internal-merge-in-global-face face frame)) ;; Don't let invalid specs prevent frame creation. (error nil))) @@ -2235,7 +2280,8 @@ If you set `term-file-prefix' to nil, this function does nothing." (let ((file (locate-library (concat term-file-prefix type)))) (and file (or (assoc file load-history) - (load file t t))))) + (load (file-name-sans-extension file) + t t))))) type) ;; Next, try to find a matching initialization function, and call it. (tty-find-type #'(lambda (type) @@ -2815,6 +2861,30 @@ Note: Other faces cannot inherit from the cursor face." "Face to highlight argument names in *Help* buffers." :group 'help) +(defface help-key-binding + '((((class color) (min-colors 88) (background light)) + :background "grey96" :foreground "DarkBlue" + ;; We use negative thickness of the horizontal box border line to + ;; avoid enlarging the height of the echo-area display, which + ;; would then move the mode line a few pixels up. + :box (:line-width (1 . -1) :color "grey80")) + (((class color) (min-colors 88) (background dark)) + :background "grey19" :foreground "LightBlue" + :box (:line-width (1 . -1) :color "grey35")) + (((class color grayscale) (background light)) :background "grey90") + (((class color grayscale) (background dark)) :background "grey25") + (t :background "grey90")) + "Face for keybindings in *Help* buffers. + +This face is added by `substitute-command-keys', which see. + +Note that this face will also be used for key bindings in +tooltips. This means that, for example, changing the :height of +this face will increase the height of any tooltip containing key +bindings. See also the face `tooltip'." + :version "28.1" + :group 'help) + (defface glyphless-char '((((type tty)) :inherit underline) (((type pc)) :inherit escape-glyph) @@ -2863,23 +2933,30 @@ It is used for characters of no fonts too." ;; Faces for TTY menus. (defface tty-menu-enabled-face - '((t - :foreground "yellow" :background "blue" :weight bold)) + '((((class color)) + :foreground "yellow" :background "blue" :weight bold) + (t :weight bold)) "Face for displaying enabled items in TTY menus." - :group 'basic-faces) + :group 'basic-faces + :version "28.1") (defface tty-menu-disabled-face '((((class color) (min-colors 16)) :foreground "lightgray" :background "blue") - (t - :foreground "white" :background "blue")) + (((class color)) + :foreground "white" :background "blue") + (t :inherit shadow)) "Face for displaying disabled items in TTY menus." - :group 'basic-faces) + :group 'basic-faces + :version "28.1") (defface tty-menu-selected-face - '((t :background "red")) + '((((class color)) + :background "red") + (t :inverse-video t)) "Face for displaying the currently selected item in TTY menus." - :group 'basic-faces) + :group 'basic-faces + :version "28.1") (defgroup paren-showing-faces nil "Faces used to highlight paren matches." @@ -2985,7 +3062,7 @@ also the same size as FACE on FRAME, or fail." (let ((fonts (x-list-fonts pattern face frame 1))) (or fonts (if face - (if (string-match-p "\\*" pattern) + (if (string-search "*" 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)) |