]> code.delx.au - gnu-emacs/blobdiff - lisp/faces.el
Prefer ‘format’ to ‘substitute-command-keys’
[gnu-emacs] / lisp / faces.el
index 22bf26267222da7a47e38d42c3910264eb4dd628..125b14d8085e2387bc97ef0b4ce7968fbdf8a77b 100644 (file)
@@ -273,6 +273,17 @@ If FRAME is omitted or nil, use the selected frame."
   (not (internal-lisp-face-empty-p face frame)))
 
 
+(defun face-list-p (face-or-list)
+  "True if FACE-OR-LIST is a list of faces.
+Return nil if FACE-OR-LIST is a non-nil atom, or a cons cell whose car
+is either 'foreground-color, 'background-color, or a keyword."
+  ;; The logic of merge_face_ref (xfaces.c) is recreated here.
+  (and (listp face-or-list)
+       (not (memq (car face-or-list)
+                 '(foreground-color background-color)))
+       (not (keywordp (car face-or-list)))))
+
+
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Setting face attributes from X resources.
@@ -608,7 +619,7 @@ VALUE must be a string specifying the font family
 `:foundry'
 
 VALUE must be a string specifying the font foundry,
-e.g. ``adobe''.  If a font foundry is specified, wild-cards `*'
+e.g., \"adobe\".  If a font foundry is specified, wild-cards `*'
 and `?' are allowed.
 
 `:width'
@@ -742,7 +753,7 @@ is specified, `:italic' is ignored."
   (setq args (purecopy args))
   (let ((where (if (null frame) 0 frame))
        (spec args)
-       family foundry)
+       family foundry orig-family orig-foundry)
     ;; If we set the new-frame defaults, this face is modified outside Custom.
     (if (memq where '(0 t))
        (put (or (get face 'face-alias) face) 'face-modified t))
@@ -758,9 +769,16 @@ is specified, `:italic' is ignored."
     (when (or family foundry)
       (when (and (stringp family)
                 (string-match "\\([^-]*\\)-\\([^-]*\\)" family))
+        (setq orig-foundry foundry
+              orig-family family)
        (unless foundry
          (setq foundry (match-string 1 family)))
-       (setq family (match-string 2 family)))
+       (setq family (match-string 2 family))
+        ;; Reject bogus "families" that are all-digits -- those are some
+        ;; weird font names, like Foobar-12, that end in a number.
+        (when (string-match "\\`[0-9]*\\'" family)
+          (setq family orig-family)
+          (setq foundry orig-foundry)))
       (when (or (stringp family) (eq family 'unspecified))
        (internal-set-lisp-face-attribute face :family (purecopy family)
                                          where))
@@ -881,7 +899,7 @@ where COLOR is a string or `foreground-color', and STYLE is either
 foreground color.  :style may be omitted, which means to use a line.
 
 FRAME nil or not specified means change face on all frames.
-Use `set-face-attribute' to ``unspecify'' underlining."
+Use `set-face-attribute' to \"unspecify\" underlining."
   (interactive (read-face-and-attribute :underline))
   (set-face-attribute face frame :underline underline))
 
@@ -894,7 +912,7 @@ Use `set-face-attribute' to ``unspecify'' underlining."
 INVERSE-VIDEO-P non-nil means FACE displays explicitly in inverse video.
 INVERSE-VIDEO-P nil means FACE explicitly is not in inverse video.
 FRAME nil or not specified means change face on all frames.
-Use `set-face-attribute' to ``unspecify'' the inverse video attribute."
+Use `set-face-attribute' to \"unspecify\" the inverse video attribute."
   (interactive
    (let ((list (read-face-and-attribute :inverse-video)))
      (list (car list) (if (cadr list) t))))
@@ -1417,18 +1435,19 @@ If FRAME is omitted or nil, use the selected frame."
                  (when alias
                    (setq face alias)
                    (insert
-                    (format "\n  %s is an alias for the face `%s'.\n%s"
+                    (format "\n  %s is an alias for the face ‘%s’.\n%s"
                             f alias
                             (if (setq obsolete (get f 'obsolete-face))
-                                (format "  This face is obsolete%s; use `%s' instead.\n"
+                                (format "  This face is obsolete%s; use ‘%s’ instead.\n"
                                         (if (stringp obsolete)
                                             (format " since %s" obsolete)
                                           "")
                                         alias)
                               ""))))
                  (insert "\nDocumentation:\n"
-                         (or (face-documentation face)
-                             "Not documented as a face.")
+                          (substitute-command-keys
+                           (or (face-documentation face)
+                               "Not documented as a face."))
                          "\n\n"))
                (with-current-buffer standard-output
                  (save-excursion
@@ -1437,12 +1456,11 @@ If FRAME is omitted or nil, use the selected frame."
                    (help-xref-button 1 'help-customize-face f)))
                (setq file-name (find-lisp-object-file-name f 'defface))
                (when file-name
-                 (princ "Defined in `")
-                 (princ (file-name-nondirectory file-name))
-                 (princ "'")
+                 (princ (format "Defined in ‘%s’"
+                                 (file-name-nondirectory file-name)))
                  ;; Make a hyperlink to the library.
                  (save-excursion
-                   (re-search-backward "`\\([^`']+\\)'" nil t)
+                   (re-search-backward (format "‘\\([^‘’]+\\)’") nil t)
                    (help-xref-button 1 'help-face-def f file-name))
                  (princ ".")
                  (terpri)
@@ -1922,16 +1940,13 @@ Return nil if there is no face."
                         (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))))
+            ((face-list-p faceprop)
              (dolist (face faceprop)
                (if (facep face)
                    (push face faces))))))
-    (setq faces (delete-dups (nreverse faces)))
-    (if multiple faces (car faces))))
+    (if multiple
+        (delete-dups (nreverse faces))
+      (car (last faces)))))
 
 (defun foreground-color-at-point ()
   "Return the foreground color of the character after point."
@@ -2035,7 +2050,7 @@ Value is the new parameter list."
   "Create and return a frame with frame parameters PARAMETERS.
 If PARAMETERS specify a frame name, handle X geometry resources
 for that name.  If PARAMETERS includes a `reverse' parameter, or
-the X resource ``reverseVideo'' is present, handle that."
+the X resource \"reverseVideo\" is present, handle that."
   (setq parameters (x-handle-named-frame-geometry parameters))
   (let* ((params (copy-tree parameters))
         (visibility-spec (assq 'visibility parameters))
@@ -2092,8 +2107,7 @@ frame parameters in PARAMETERS."
             (value (cdr (assq param-name parameters))))
        (if value
            (set-face-attribute (nth 1 param) frame
-                               (nth 2 param) value))))
-    (frame-can-run-window-configuration-change-hook frame t)))
+                               (nth 2 param) value))))))
 
 (defun tty-handle-reverse-video (frame parameters)
   "Handle the reverse-video frame parameter for terminal frames."
@@ -2488,7 +2502,7 @@ 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 'window-divider
   :group 'basic-faces)
 
 (defface window-divider-first-pixel
@@ -2499,7 +2513,7 @@ 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 'window-divider
   :group 'basic-faces)
 
 (defface window-divider-last-pixel
@@ -2510,7 +2524,7 @@ 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 'window-divider
   :group 'basic-faces)
 
 (defface minibuffer-prompt