color - A better "VisibleSpectrum" function?

Since ColorData["VisibleSpectrum"] is wrong, I would like to have a more accurate function to use.
Can this information be extracted from Mathematica itself?

Answer

Notice:

Simon Woods did just this months ago for an answer I missed:

---

It seems that it can. By spelunking ChromaticityPlot I found:

Image`ColorOperationsDump`$wavelengths

Image`ColorOperationsDump`tris

These are a list of wavelengths and their corresponding XYZ color values used by this plot command:

ChromaticityPlot["sRGB", Appearance -> {"VisibleSpectrum", "Wavelengths" -> True}]

We can therefore use them to generate a new color function:

ChromaticityPlot;  (* pre-load internals *)

newVisibleSpectrum =
  With[
    {colors =
      {Image`ColorOperationsDump`$wavelengths,
       XYZColor @@@ Image`ColorOperationsDump`tris}\[Transpose]},

    Blend[colors, #] &
  ];

A comparison with the old function:

ArrayPlot[
 {Range[385, 745]},
 ImageSize -> 400,
 AspectRatio -> 0.1,
 ColorFunctionScaling -> False,
 ColorFunction -> #

] & /@
  {"VisibleSpectrum", newVisibleSpectrum} // Column

589nm is now the bright sodium yellow that it should be:

Graphics[{newVisibleSpectrum @ 589, Disk[]}]

If you wish to integrate this into ColorData see:

---

As requested by J.M. red-green-blue plots for each function:

old = List @@@ Array[ColorData["VisibleSpectrum"], 361, 385];

new = List @@@ ColorConvert[Array[newVisibleSpectrum, 361, 385], "RGB"];

ListLinePlot[Transpose @ #,
   PlotStyle -> {Red, Green, Blue},
   DataRange -> {385, 745}
] & /@ {old, new}

Clipping occurs during conversion to screen RGB; the newVisibleSpectrum function actually produces unclipped XYZColor data. For example projected over gray:

newVSgray = 
  With[{colors = 
     Array[{#, Blend[{newVisibleSpectrum@#, ColorConvert[GrayLevel[.66], "XYZ"]}, 
         0.715]} &, 361, 385]}, Blend[colors, #] &];

ListLinePlot[
 List @@@ ColorConvert[Array[newVSgray, 361, 385], "RGB"] // Transpose, 

 PlotStyle -> {Red, Green, Blue}, DataRange -> {385, 745}, ImageSize -> 400]

Which corresponds to the plot:

ArrayPlot[{Range[385, 745]}, ImageSize -> 400, AspectRatio -> 0.1, 
 ColorFunctionScaling -> False, ColorFunction -> newVSgray, 
 Background -> GrayLevel[0.567]]

cf. "VisibleSpectrum" similarly over gray blended in XYZColor and RGBColor respectively:

Note that neither rendering of this spectrum has the vibrancy of newVisibleSpectrum.