{-# OPTIONS_HADDOCK hide #-}

{-# LANGUAGE OverloadedStrings #-}

module Text.XHtml.Transitional.Attributes where

import Text.XHtml.Internals

-- * Extra attributes in XHTML Transitional

{-# DEPRECATED alink "This attribute is deprecated in XHTML 1.0" #-}
alink               :: LText -> HtmlAttr
alink :: LText -> HtmlAttr
alink               =   Builder -> LText -> HtmlAttr
strAttr Builder
"alink"

{-# DEPRECATED background "This attribute is deprecated in XHTML 1.0" #-}
background          :: LText -> HtmlAttr
background :: LText -> HtmlAttr
background          =   Builder -> LText -> HtmlAttr
strAttr Builder
"background"

{-# DEPRECATED bgcolor "This attribute is deprecated in XHTML 1.0" #-}
bgcolor             :: LText -> HtmlAttr
bgcolor :: LText -> HtmlAttr
bgcolor             =   Builder -> LText -> HtmlAttr
strAttr Builder
"bgcolor"

{-# DEPRECATED clear "This attribute is deprecated in XHTML 1.0" #-}
clear               :: LText -> HtmlAttr
clear :: LText -> HtmlAttr
clear               =   Builder -> LText -> HtmlAttr
strAttr Builder
"clear"

{-# DEPRECATED code "This attribute is deprecated in XHTML 1.0" #-}
code                :: LText -> HtmlAttr
code :: LText -> HtmlAttr
code                =   Builder -> LText -> HtmlAttr
strAttr Builder
"code"

{-# DEPRECATED color "This attribute is deprecated in XHTML 1.0" #-}
color               :: LText -> HtmlAttr
color :: LText -> HtmlAttr
color               =   Builder -> LText -> HtmlAttr
strAttr Builder
"color"

{-# DEPRECATED compact "This attribute is deprecated in XHTML 1.0" #-}
compact             ::           HtmlAttr
compact :: HtmlAttr
compact             = Builder -> HtmlAttr
emptyAttr Builder
"compact"

{-# DEPRECATED face "This attribute is deprecated in XHTML 1.0" #-}
face                :: LText -> HtmlAttr
face :: LText -> HtmlAttr
face                =   Builder -> LText -> HtmlAttr
strAttr Builder
"face"

{-# DEPRECATED hspace "This attribute is deprecated in XHTML 1.0" #-}
hspace              :: Int    -> HtmlAttr
hspace :: Int -> HtmlAttr
hspace              =   Builder -> Int -> HtmlAttr
intAttr Builder
"hspace"

{-# DEPRECATED link "This attribute is deprecated in XHTML 1.0" #-}
link                :: LText -> HtmlAttr
link :: LText -> HtmlAttr
link                =   Builder -> LText -> HtmlAttr
strAttr Builder
"link"

{-# DEPRECATED noshade "This attribute is deprecated in XHTML 1.0" #-}
noshade             ::           HtmlAttr
noshade :: HtmlAttr
noshade             = Builder -> HtmlAttr
emptyAttr Builder
"noshade"

{-# DEPRECATED nowrap "This attribute is deprecated in XHTML 1.0" #-}
nowrap              ::           HtmlAttr
nowrap :: HtmlAttr
nowrap              = Builder -> HtmlAttr
emptyAttr Builder
"nowrap"

{-# DEPRECATED start "This attribute is deprecated in XHTML 1.0" #-}
start               :: Int    -> HtmlAttr
start :: Int -> HtmlAttr
start               =   Builder -> Int -> HtmlAttr
intAttr Builder
"start"

target              :: LText -> HtmlAttr
target :: LText -> HtmlAttr
target              =   Builder -> LText -> HtmlAttr
strAttr Builder
"target"

{-# DEPRECATED text "This attribute is deprecated in XHTML 1.0" #-}
text                :: LText -> HtmlAttr
text :: LText -> HtmlAttr
text                =   Builder -> LText -> HtmlAttr
strAttr Builder
"text"

{-# DEPRECATED version "This attribute is deprecated in XHTML 1.0" #-}
version             :: LText -> HtmlAttr
version :: LText -> HtmlAttr
version             =   Builder -> LText -> HtmlAttr
strAttr Builder
"version"

{-# DEPRECATED vlink "This attribute is deprecated in XHTML 1.0" #-}
vlink               :: LText -> HtmlAttr
vlink :: LText -> HtmlAttr
vlink               =   Builder -> LText -> HtmlAttr
strAttr Builder
"vlink"

{-# DEPRECATED vspace "This attribute is deprecated in XHTML 1.0" #-}
vspace              :: Int    -> HtmlAttr
vspace :: Int -> HtmlAttr
vspace              =   Builder -> Int -> HtmlAttr
intAttr Builder
"vspace"



--
-- * Html colors
--

{-# DEPRECATED aqua,black,blue,fuchsia,gray,green,lime,maroon,navy,olive,purple,red,silver,teal,yellow,white "The use of color attibutes is deprecated in XHTML 1.0" #-}
aqua          :: LText
black         :: LText
blue          :: LText
fuchsia       :: LText
gray          :: LText
green         :: LText
lime          :: LText
maroon        :: LText
navy          :: LText
olive         :: LText
purple        :: LText
red           :: LText
silver        :: LText
teal          :: LText
yellow        :: LText
white         :: LText

aqua :: LText
aqua          = LText
"aqua"
black :: LText
black         = LText
"black"
blue :: LText
blue          = LText
"blue"
fuchsia :: LText
fuchsia       = LText
"fuchsia"
gray :: LText
gray          = LText
"gray"
green :: LText
green         = LText
"green"
lime :: LText
lime          = LText
"lime"
maroon :: LText
maroon        = LText
"maroon"
navy :: LText
navy          = LText
"navy"
olive :: LText
olive         = LText
"olive"
purple :: LText
purple        = LText
"purple"
red :: LText
red           = LText
"red"
silver :: LText
silver        = LText
"silver"
teal :: LText
teal          = LText
"teal"
yellow :: LText
yellow        = LText
"yellow"
white :: LText
white         = LText
"white"