Added face parameter :extend.

This is an initial change to add a parameter :extend that will be used
in the display engine later.

3 files changed, 43 insertions, 11 deletions

diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index d73bce42c3e..5a49a810434 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -233,7 +233,11 @@
              (file :tag "File"
                    :help-echo "Name of bitmap file."
                    :must-match t)))
-
+    (:extend
+     (choice :tag "Extend"
+             :help-echo "Control whether attributes should be extended after EOL."
+             (const :tag "Off" nil)
+             (const :tag "On" t)))
     (:inherit
      (repeat :tag "Inherit"
              :help-echo "List of faces to inherit attributes from."
diff --git a/lisp/faces.el b/lisp/faces.el
index c789d3729e0..36fc69895dd 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -342,6 +342,7 @@ is either `foreground-color', `background-color', or a keyword."
     (:box (".attributeBox" . "Face.AttributeBox"))
     (:underline (".attributeUnderline" . "Face.AttributeUnderline"))
     (:inverse-video (".attributeInverse" . "Face.AttributeInverse"))
+    (:extend (".attributeExtend" . "Face.AttributeExtend"))
     (:stipple
      (".attributeStipple" . "Face.AttributeStipple")
      (".attributeBackgroundPixmap" . "Face.AttributeBackgroundPixmap"))
@@ -594,6 +595,13 @@ Use `face-attribute' for finer control."
   (let ((italic (face-attribute face :slant frame inherit)))
     (memq italic '(italic oblique))))
 
+(defun face-extend-p (face &optional frame inherit)
+ "Return non-nil if FACE specifies a non-nil extend.
+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.
+Optional argument INHERIT is passed to `face-attribute'."
+ (eq (face-attribute face :extend frame inherit) t))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -760,6 +768,11 @@ For convenience, attributes `:family', `:foundry', `:width',
 `:height', `:weight', and `:slant' may also be set in one step
 from an X font name:
 
+`:extend'
+
+VALUE specifies whether the FACE should be extended after EOL.
+VALUE must be one of t or nil.
+
 `:font'
 
 Set font-related face attributes from VALUE.
@@ -979,6 +992,18 @@ Use `set-face-attribute' or `modify-face' for finer control."
 
 (define-obsolete-function-alias 'set-face-italic-p 'set-face-italic "24.4")
 
+(defun set-face-extend (face extend-p &optional frame)
+  "Specify whether face FACE should be extended.
+EXTEND-P nil means FACE explicitly doesn't extend after EOL.
+EXTEND-P t means FACE extends after EOL.
+
+FRAME nil or not specified means change face on all frames.
+Use `set-face-attribute' to \"unspecify\" underlining."
+  (interactive
+   (let ((list (read-face-and-attribute :extend)))
+     (list (car list) (if (cadr list) t))))
+  (set-face-attribute face frame :extend extend-p))
+
 
 (defalias 'set-face-background-pixmap 'set-face-stipple)
 
@@ -1102,7 +1127,7 @@ an integer value."
            (:slant
             (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
                     font-slant-table))
-           (:inverse-video
+           ((or :inverse-video :extend)
             (mapcar #'(lambda (x) (cons (symbol-name x) x))
                     (internal-lisp-face-attribute-values attribute)))
            ((or :underline :overline :strike-through :box)
@@ -1147,6 +1172,7 @@ an integer value."
     (:slant . "slant")
     (:underline . "underline")
     (:overline . "overline")
+    (:extend . "extend")
     (:strike-through . "strike-through")
     (:box . "box")
     (:inverse-video . "inverse-video display")
@@ -1549,7 +1575,8 @@ is given, in which case return its value instead."
              ;; (see also realize_default_face in xfaces.c).
              (append
               '(:underline nil :overline nil :strike-through nil
-                :box nil :inverse-video nil :stipple nil :inherit nil)
+                :box nil :inverse-video nil :stipple nil :inherit nil
+                :extend nil)
               ;; `display-graphic-p' is unavailable when running
               ;; temacs, prior to loading frame.el.
               (when (fboundp 'display-graphic-p)
@@ -2314,24 +2341,24 @@ If you set `term-file-prefix' to nil, this function does nothing."
 ;; if background is light.
 (defface region
   '((((class color) (min-colors 88) (background dark))
-     :background "blue3")
+     :background "blue3" :extend t)
     (((class color) (min-colors 88) (background light) (type gtk))
      :distant-foreground "gtk_selection_fg_color"
-     :background "gtk_selection_bg_color")
+     :background "gtk_selection_bg_color" :extend t)
     (((class color) (min-colors 88) (background light) (type ns))
      :distant-foreground "ns_selection_fg_color"
-     :background "ns_selection_bg_color")
+     :background "ns_selection_bg_color" :extend t)
     (((class color) (min-colors 88) (background light))
-     :background "lightgoldenrod2")
+     :background "lightgoldenrod2" :extend t)
     (((class color) (min-colors 16) (background dark))
-     :background "blue3")
+     :background "blue3" :extend t)
     (((class color) (min-colors 16) (background light))
-     :background "lightgoldenrod2")
+     :background "lightgoldenrod2" :extend t)
     (((class color) (min-colors 8))
-     :background "blue" :foreground "white")
+     :background "blue" :foreground "white" :extend t)
     (((type tty) (class mono))
      :inverse-video t)
-    (t :background "gray"))
+    (t :background "gray" :extend t))
   "Basic face for highlighting the region."
   :version "21.1"
   :group 'basic-faces)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 5e55240daba..235aa9a6e19 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1385,6 +1385,7 @@ If FRAME is omitted or nil, use the selected frame."
                   (:stipple . "Stipple")
                   (:font . "Font")
                   (:fontset . "Fontset")
+                  (:extend . "Extend")
                   (:inherit . "Inherit")))
          (max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x)))
                                          attrs))))