(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 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 a face, defaulting to the face or faces at point.
-If the text at point has the property `read-face-name', that
-overrides the `face' property for determining the default.
-
-PROMPT should be a string that describes what the caller will do
-with the face; it should not end in a space.
-
-
-This function uses `completing-read-multiple' with \",\" as the
-separator character, i.e.
-
-
-
-
-
-The optional argument DEFAULT provides the value to display in the
-minibuffer prompt that is returned if the user just types RET
-unless DEFAULT is a string (in which case nil is returned).
-
-If MULTIPLE is non-nil, return a list of faces (possibly only one).
-Otherwise, return a single face."
- (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))))))
+ (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))))
+
+ (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)))))
(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")
(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)
(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.
:foreground "gtk_selection_fg_color"
:background "gtk_selection_bg_color")
(((class color) (min-colors 88) (background light) (type ns))
- :background "ns_selection_color")
+ :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)
+
\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