(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)
"")))
;;; Interactively modifying 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 list of face names (symbols or strings).
-In that case, return the `car' of DEFAULT (if MULTIPLE is non-nil),
-or DEFAULT (if MULTIPLE is nil). See below for the meaning of MULTIPLE.
-DEFAULT can also be a single face.
-
-This function uses `completing-read-multiple' with \"[ \\t]*,[ \\t]*\"
-as the separator regexp. Thus, the user may enter multiple face names,
-separated by commas.
-
-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,
-return 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."
+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)
;; If we only want one, and the default is more than one,
;; discard the unwanted ones.
(t (symbol-name (car default))))))
-
- (let (aliasfaces nonaliasfaces faces)
+ (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 (facep s)
(if (get s 'face-alias)
(push (symbol-name s) aliasfaces)
(push (symbol-name s) nonaliasfaces)))))
- (dolist (face (completing-read-multiple
- (if default
- (format "%s (default `%s'): " prompt default)
- (format "%s: " prompt))
+ (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))
- ;; Ignore elements that are not faces
- ;; (for example, because DEFAULT was "all faces")
- (if (facep face) (push (intern face) faces)))
- ;; Return either a list of faces or just one face.
- (setq faces (nreverse faces))
- (if multiple faces (car faces))))
+ 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))
(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)
(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))
(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.
(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
(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