BeginPackage["Miscellaneous`ChemicalElements`",
   "Miscellaneous`Units`", "Miscellaneous`SIUnits`"]
ElementReport::usage = "ElementReport[element] outputs a formatted
report on the named element to the current input notebook.
ElementReport[notebook, element] outputs the report to the named notebook.";
Begin["`Private`"]
spf1 = (Head[General::spell]=!=$Off);
spf2 = (Head[General::spell1]=!=$Off);
Off[General::spell];Off[General::spell1];
AtomicWeightUnstable[name_Symbol, number_] :=
    If[TrueQ[$PeriodicTableDemo],
       {StyleBox[
       RowBox[{"(", integerizeToString[number], ")"}],
       FontColor -> RGBColor[0.6,0,0]], number},
    Message[AtomicWeight::unstable, name]; number
    ];
MeltingPointException[name_Symbol, mp_, form_?StringQ] :=
    If[TrueQ[$PeriodicTableDemo],
       {RowBox[{integerizeToString[mp], " ", "K", " ", 
       StyleBox[RowBox[{"(", form, " ", "form", ")"}],
         FontColor -> RGBColor[0.4,0.2,0.6]]}], mp Kelvin},
    (Message[MeltingPoint::form, name, form]; mp Kelvin)
    ];
BoilingPointException[name_Symbol, bp_, form_?StringQ] :=
    If[TrueQ[$PeriodicTableDemo],
        {RowBox[{integerizeToString[bp], " ", "K", " ", 
        StyleBox[RowBox[{"(", form," ", "form ", ")"}],
        FontColor -> RGBColor[0.4,0.2,0.6]]}], mp Kelvin},
    (Message[BoilingPoint::form, name, form]; bp Kelvin)
    ];
HeatOfFusionException[name_Symbol, hof_, form_?StringQ] :=
    If[TrueQ[$PeriodicTableDemo],
        {RowBox[{integerizeToString[hof], "×", SuperscriptBox["10","3"], " ",
            "J", " ", SuperscriptBox["M", RowBox[{"-", "1"}]], " ",
            StyleBox[RowBox[{"(", form, " ", "form", ")"}],
         FontColor -> RGBColor[0.4,0.2,0.6]]}], hof Kilo Joule / Mole},
    (Message[HeatOfFusion::form, name, form]; hof Kilo Joule / Mole)
    ];
HeatOfVaporizationException[name_Symbol, hov_, form_?StringQ] :=
    If[TrueQ[$PeriodicTableDemo],
        {RowBox[{integerizeToString[hov], "×", SuperscriptBox["10","3"], " ",
            "J", " ", SuperscriptBox["M", RowBox[{"-", "1"}]], " ",
            StyleBox[RowBox[{"(", form," ", "form", ")"}],
         FontColor -> RGBColor[0.4,0.2,0.6]]}], hov Kilo Joule / Mole},
    (Message[HeatOfVaporization::form, name, form]; hov Kilo Joule / Mole)
    ];
DensityException[name_Symbol, den_, temp_?NumberQ] :=
    If[TrueQ[$PeriodicTableDemo],
    {RowBox[{integerizeToString[den], " ", "kg", " ", SuperscriptBox["m",
      RowBox[{"-", "3"}]], " ", StyleBox[RowBox[{
      "(", "at", integerizeToString[temp], " ", "K", ")"}],
         FontColor -> RGBColor[0.4,0.2,0.6]]}],
      den Kilogram/(Meter)^3},
    (Message[Density::temp, name, temp]; den Kilogram/(Meter)^3)
    ];
DensityException[name_Symbol, den_, form_?StringQ] :=
    If[TrueQ[$PeriodicTableDemo],
    {RowBox[{integerizeToString[den], " ", "kg", " ", SuperscriptBox["m",
      RowBox[{"-", "3"}]], " ", StyleBox[RowBox[{"(", form, " ", "form", ")"}],
         FontColor -> RGBColor[0.4,0.2,0.6]]}],
      den Kilogram/(Meter)^3},
    (Message[Density::form, name, form]; den Kilogram/(Meter)^3)
    ];
DensityException[name_Symbol, den_, temp_?NumberQ, form_?StringQ] :=
    If[TrueQ[$PeriodicTableDemo],
     {RowBox[{integerizeToString[den], " ", "kg", " ", SuperscriptBox["m",
      RowBox[{"-", "3"}]], " ", 
      StyleBox[RowBox[{"(",form, "form", " ", "at",
         integerizeToString[temp], " ", "K", ")"}],
         FontColor -> RGBColor[0.4,0.2,0.6]]}],
      den Kilogram/(Meter)^3},
     (Message[Density::tempform, name, temp, form]; den Kilogram/(Meter)^3)
    ];
ThermalConductivityException[name_Symbol, tc_, form_?StringQ] :=
    If[TrueQ[$PeriodicTableDemo],
    {RowBox[{integerizeToString[tc], " ", "W", SuperscriptBox["m",
        RowBox[{"-", "1"}]], SuperscriptBox["K",
        RowBox[{"-", "1"}]], " ", StyleBox[RowBox[{
         "(", form, " ", "form", ")"}],
         FontColor -> RGBColor[0.4,0.2,0.6]]}], tc Watt/(Meter Kelvin)},
    (Message[ThermalConductivity::form, name, form]; tc Watt/(Meter Kelvin))
    ];
integerizeToString[n_] := ToString[If[Round[n] == n, Round[n], n]];
BuildBoxes[value:{__Integer}] := RowBox[Join[{"{"},
    Drop[Flatten[value/.s_Integer :> Sequence @@
    {ToString[s], ","}], -1], {"}"}]];
BuildBoxes[Unknown] = Unknown;
BuildBoxes[{}] = RowBox[{"{","}"}];
BuildBoxes[{value:(_RowBox | _StyleBox), _}] := value;
BuildBoxes[value_String] := value;
BuildBoxes[value:(_Integer | _Real)] := ToString[If[Round[value] == value,
    Round[value], value]];
BuildBoxes[value_] := 
    RowBox[{integerizeToString[
        First[Cases[value, _Real | _Integer, Infinity]]],
    If[Not[FreeQ[value, Kilo]], Sequence @@ {"×", SuperscriptBox["10",
      "3"], " "}, " "], FormatUnits[value/.{p_Power :> p,
      _Real -> 1, _Integer -> 1, Kilo -> 1}]}];
FormatUnits[s_Symbol] := s/.{Watt -> "W", Meter -> "m", Kilogram -> "kg",
    Kelvin -> "K", Joule -> "J", Mole -> "mol"};
FormatUnits[HoldPattern[Times[s__Symbol, p__Power]]] :=
RowBox[Drop[Flatten[{Map[Sequence @@ {FormatUnits[#], " "}&, {s}],
   Apply[(Sequence @@ {SuperscriptBox[FormatUnits[#1], ToString[#2]], " "})&,
   {p}, {1}]}], -1]];
FormatUnits[HoldPattern[Times[s__Symbol]]] :=
RowBox[Drop[Flatten[Map[Sequence @@ {FormatUnits[#], " "}&, {s}]], -1]];
FormatElectronConfiguration[Unknown] := Unknown;
FormatElectronConfiguration[config_] :=
  RowBox[MapIndexed[Function[{c, l}, 
      RowBox[Append[MapThread[RowBox[{ToString[First[l]],
         SuperscriptBox[#1, ToString[#2]]}]&,
         {Take[{"s","p","d","f"},Length[c]], c}],
        " "]]], config]];
ElementReport[theElement_] :=
   ElementReport[InputNotebook[], theElement];
ElementReport[nb_NotebookObject, theElement_Symbol] :=
Block[{$MessageFlags,$PeriodicTableValues, $UnknownMessages},
$UnknownMessages = {Unevaluated[MeltingPoint::unknown],
    Unevaluated[BoilingPoint::unknown],
    Unevaluated[HeatOfFusion::unknown],
    Unevaluated[HeatOfVaporization::unknown],
    Unevaluated[Density::unknown],
    Unevaluated[ThermalConductivity::unknown],
    Unevaluated[ElectronConfiguration::unknown],
    Unevaluated[AtomicWeight::unknown]};
$MessageFlags = Map[TrueQ[Head[Evaluate[#]] =!= $Off]&,
   $UnknownMessages];
Map[Off, $UnknownMessages];
$PeriodicTableDemo = True;
 $PeriodicTableValues = MapThread[Rule, {#,Map[(#[theElement])&, #]}&[
   {Abbreviation, AtomicNumber, AtomicWeight, StableIsotopes,
    ElectronConfiguration, MeltingPoint, BoilingPoint, HeatOfFusion,
    HeatOfVaporization, Density, ThermalConductivity}]
];
SelectionMove[nb, After, Cell];
NotebookWrite[nb, BoxData[InterpretationBox @@ {StyleBox[
GridBox[{
   {GridBox[{{AdjustmentBox[StyleBox[
     RowBox[{ToString[theElement], " ", "(",
       Abbreviation/.$PeriodicTableValues, ")"}],
     FontFamily -> Helvetica, FontWeight -> "Bold",
     FontColor -> GrayLevel[1]],
     BoxMargins->{{0.3, 0.2}, {0, 0.6}}],
     AdjustmentBox[StyleBox[
       ToString[AtomicNumber/.$PeriodicTableValues],
     FontFamily -> Helvetica, FontWeight -> "Bold",
     FontColor -> GrayLevel[1]],
     BoxMargins->{{0.3, 0.2}, {0, 0.6}}]}},
     System`ColumnWidths -> {15, 5},
     ColumnAlignments -> {Left, Right}
     ]},
{
StyleBox[GridBox[Join[
 {{StyleBox[GridBox[Join[
     Apply[{AdjustmentBox[StyleBox[RowBox[Append[#1, BuildBoxes[#2]]],
              FontFamily -> "Helvetica", FontWeight -> "Plain",
              FontSize -> Smaller], BoxMargins -> {{0.3, 0.2},{0,0.5}}]}&,
     Select[
       {{{"Atomic", " ", "Number"," ", ":", " "}, AtomicNumber},
        {{"Atomic"," ","Weight", " ", ":", " "}, AtomicWeight},
        {{"Stable"," ","Isotopes"," ", ":"," "}, StableIsotopes}}/.
          $PeriodicTableValues,
        (Last[#] =!= Unknown)&],
      {1}],
 If[(ElectronConfiguration/.$PeriodicTableValues) =!= Unknown,
 {{StyleBox[GridBox[
     {{AdjustmentBox[StyleBox[RowBox[{"Electron", " ", "Configuration"}],
         FontFamily -> "Helvetica", FontWeight -> "Plain",
              FontSize -> Smaller], BoxMargins -> {{0.3, 0.2},{0,0.6}}]},
      {AdjustmentBox[
      StyleBox[Insert[FormatElectronConfiguration[ElectronConfiguration/.
                   $PeriodicTableValues], "  ", {1,1}],
          FontFamily -> "Helvetica", FontWeight -> "Plain",
              FontSize -> Smaller], BoxMargins -> {{0.3, 0.2},{0.6, 0}}]}},
        System`ColumnWidths->22,
        ColumnAlignments->{Left}
   ], Background->RGBColor[0.8, 0.8, 1]]}},
   {}
  ]
      ],
                System`ColumnWidths->22,
                ColumnAlignments->{Left}
    ], Background->RGBColor[0.2, 0.8, 1]]}},
 Apply[{AdjustmentBox[StyleBox[RowBox[Append[#1, BuildBoxes[#2]]],
           FontFamily -> "Helvetica", FontWeight -> "Plain",
              FontSize -> Smaller], BoxMargins -> {{0.3, 0.2},{0.4,0.1}}]}&,
 Select[
   {{{"Density", " ", ":", " "}, Density},
    {{"Thermal"," ","Conductivity", " ", ":", " "}, ThermalConductivity},
    {{"Melting"," ","Point"," ", ":"," "}, MeltingPoint},
    {{"Heat", " ", "of", " ", "Fusion", " ", ":", " "}, HeatOfFusion},
    {{"Boiling"," ","Point"," ", ":"," "}, BoilingPoint},
    {{"Heat", " ", "of", " ", "Vaporization", " ", ":", " "}, HeatOfVaporization}}/.
      $PeriodicTableValues,
    (Last[#] =!= Unknown)&],
  {1}]
],
                System`ColumnWidths->22,
                ColumnAlignments->{Left},
                GridFrame -> False],
           Background -> RGBColor[0, 1, 1]]
}},
                System`ColumnWidths->22,
                ColumnAlignments->{Left},
                GridFrame -> {{3,0},{0,0}},
                System`GridFrameMargins -> {{0,0},{0,0}}],
FontFamily->"Courier", Background -> GrayLevel[0]],
 $PeriodicTableValues/.{{_RowBox, v_} :> v, {_StyleBox, v_} :> v}}
]
];
$PeriodicTableDemo = False;
SelectionMove[nb, After, Cell];
MapThread[If[#1, On[#2]]&, {$MessageFlags, $UnknownMessages}];
];
ElementReport[nb_, x_String] := Module[
           {i=Flatten[Position[ElementAbbreviations,ToString[x]]]},
                   ElementReport[nb, Elements[[ i[[1]] ]] ] /;
               !SameQ[i,{}]
                 ];
$PeriodicTableDemoCodePatch = True;
If[spf1, On[General::spell]];
If[spf2, On[General::spell1]];
End[]
EndPackage[]