SubscriptSymbols Package

Annotations

(* :History: 
Version 1.0 was completed and posted on MathSourceon 10 April 2002.

Version 1.1 was completed and posted on MathSourceon about 25 April 2002.
The following changes made for Version 1.1 . 
- Version 1.0 would fail when one tried to do the following.
   Clear[x];
	   SubscriptSymbols[Off];
	    x = 4.3;
    	SubscriptSymbols[On];
		Head[Subscript[x, 1]]
    This was a bug and has been fixed . 

- The package has a new function  NotationPalette[] which is used to open the Notation palette.
*)

BeginPackage

MakeBoxes[HoldPattern[Power[x_Subscript, n_]], 
          form_] := 
SuperscriptBox[MakeBoxes[x, form], 
          MakeBoxes[n, form]];

\(\(\(\ \)\( (*\ 
      Ensure\ the\ TraditionalForm\ of\ symbolized\ subscripts\ looks\ \(\(good\)\(.\)\)\ *) \)\(
\)\(MakeBoxes[
        symb_Symbol?
\((With[{str = ToString[#]}, 
                StringMatchQ[
                    str, "*⎵Subscript⎵*"] && 
                  StringLength[str] > 
                    12] &)\), 
TraditionalForm] := 

      With[{
st = ToString[symb], 
p1 = 
            Part[StringPosition[ToString[symb], "⎵", 1], 1, 
              1], 
p2 = 
            StringPosition[
              ToString[
                symb], "$"]
}, 
If[
          p2 === {}, 
SubscriptBox[
            StringTake[st, {1, p1 - 1}], 
            StringTake[
              st, {p1 + 11, \(-1\)}]], 
SubscriptBox[
            StringTake[st, {1, p1 - 1}], 
            StringTake[
              st, {p1 + 11, 
                Part[p2, \(-1\), 1] - 
                  1}]]
]
]\)\)\)

SetAttributes[Subscript, {HoldFirst, NHoldRest}];

Utilities`Notation`AutoLoadNotationPalette = False;

\(\(BeginPackage["Utilities`SubscriptSymbols`", "Utilities`Notation`"];\)\)

Off[Symbolize::boxSymbolExists, 
        NotationBoxTag::overShadw];

\(\(Unprotect["SubscriptSymbols", "GetSubscript", "MapSubscript", \ "SymbolizedSubscriptQ", "ApplySubscript", "NotationPalette"];\)\)

\(\(ClearAll["SubscriptSymbols", "GetSubscript", "MapSubscript", \ "SymbolizedSubscriptQ", "ApplySubscript", "NotationPalette"];\)\)

Attributes[SubscriptSymbols] = {HoldFirst};

Usage Messages

SubscriptSymbols::usage = "SubscriptSymbols[x,On] ensures x \
with a NonNegative integer subscript is considered a symbol. \
SubscriptSymbols[x,Off] restores the default behavior for x subscripts. \
SubscriptSymbols[{x,y,...},On] and SubscriptSymbols[{x,y,...},Off] apply to \
several symbols. SubscriptSymbols[On] and SubscriptSymbols[Off] apply to all \
subscripted variables.\n \n  When the first argument of SubscriptSymbols is a \
subscript expression only that subscript is affected. When the first argument \
of SubscriptSymbols is a list of subscript expressions only the listed \
subscripts are affected.\n \n The second argument of SubscriptSymbols can be \
True or False and the result will be the same as if the argument was On or \
Off respectively";

GetSubscript::usage = "GetSubscript[sub] returns the subscript of \
sub when sub is a symbolized subscript or a subscript expression.";

MapSubscript::usage = "MapSubscript[f,sub] is only defined when sub \
is a symbolized subscript or subscript expression. When MapSubscript[f,sub] \
is defined it maps f to the subscript of sub. For example \
MapSubscript[f,Subscript[x,n]] returns Subscript[x,f[n]].";

ApplySubscript::usage = "ApplySubscript[f,sub] is only defined when \
sub is a symbolized subscript or a subscript expression.  When the operation \
is defined Subscript[x,n] is changed to f[x,n].";

SymbolizedSubscriptQ::usage = "SymbolizedSubscriptQ[x] returns True \
if x is a symbolized subscript, and False in all other cases.";

NotationPalette::usage = "Evaluating NotationPalette[] opens the \
Notation palette which is not used by features in the SubscriptSymbols \
package.";

Clear::usage = Clear::usage;

Begin Private and Define Error Mesages

Begin["`Private`"];
WasProτected = Unprotect[Clear];
$EnhancϵClear = True;
$SymbolizeAll𝔖ubscripts = False;

SubscriptSymbols::AllOn = "SubscriptSymbols can not turn off \
symbolization of `1` subscripts using this form because they were symbolized \
using SubscriptSymbols[On]. Symbolization of `1` subscripts must be turned \
off using SubscriptSymbols[Off].";

SubscriptSymbols::Sub1 = "SubscriptSymbols can not turn off \
symbolization of `1` using this form because it was symbolized using \
SubscriptSymbols[On]. Symbolization of `1` must be turned off using \
SubscriptSymbols[Off].";

SubscriptSymbols::Sub2 = "SubscriptSymbols can not turn off \
symbolization of `1` using this form because it was symbolized using \
SubscriptSymbols[`2`,On]. Symbolization of `1` must be turned off using \
SubscriptSymbols[`2`,Off] or SubscriptSymbols[Off].";

SubscriptSymbols::expr = "SubscriptSymbols was given two arguments \
and the first argument did not meet the requirement of being a variable,  a \
subscripted variable, a list of variables, or a list of subscripted \
variables.";

SubscriptSymbols::list = "The subscript specification list given to \
SubscriptSymbols must be a list of variables, or a list of subscripted \
variables. They can't be mixed.";

SubscriptSymbols::boole2 = "SubscriptSymbols was given two \
arguments and the second argument was not On, Off, True, or False as \
required.";

SubscriptSymbols::boole1 = "SubscriptSymbols was given one argument \
which was not On, Off, True, or False as required.";

SubscriptSymbols::argt = "SubscriptSymbols called with `1` \
arguments; 1 or 2 arguments are expected";

Private Functions

Attributes[
          Subscripts𝒮ymbolizedQ] = {HoldAll};
Subscripts𝒮ymbolizedQ[_] := False;

IntegerΤϵst[
          n_String] := 
ToExpression[n, StandardForm, 
          IntegerQ[#] && NonNegative[#] &];

IntegerΤϵst[n_] := 
        IntegerQ[n] && NonNegative[n];

Attributes[
          SymbolΤϵst] = {HoldAll};
SymbolΤϵst[s_String] := 
        ToExpression[s, 
          StandardForm, (Head[#] === 
                  Symbol && ! NumericQ[#]) &];
SymbolΤϵst[n_] := 
        TrueQ[Head[Unevaluated@n] === 
              Symbol && ! NumericQ[Unevaluated@n]];

\(\(VarıablϵQ = 
        Function[{arg}, 
\((Head[Unevaluated@arg] === 
                  Symbol && \(! NumericQ[
                    Unevaluated@
                      arg]\))\) || 
\((\ \ \((Part[
                      ToExpression[arg, StandardForm, Hold], 1, 0] === 
                    Symbol)\) && 
\((\ 
                  Intersection[{arg}, {"π", "E", "°", "Indeterminate"}] === {}\ )\)\ )\)
, {HoldAll}];\)\)

AτomΤest = 
        Function[{s}, AtomQ[ToBoxes[Unevaluated@s]], {HoldAll}];

\(\(SubscrıpτMatch2 = 
        Function[{base, whole}, 
          StringMatchQ[ToString[Unevaluated@whole], 
            ToString[
                Unevaluated@
                  base] <> "⎵Subscript⎵*"], {HoldAll}];\)\)

IntϵgerSubscrıptQ = 
        Function[{x}, 
          MatchQ[ToBoxes[Unevaluated@x], 
            SubscriptBox[_String, _?(ToExpression[#, StandardForm, 
                        IntegerQ] && 
                      ToExpression[#, StandardForm, 
                        NonNegative] &)]], {HoldAll}];

Subscript[x_, n_] /; $FixSubscripτSymbolsBug := 
      Block[{$FixSubscripτSymbolsBug}, 
        ToExpression[ToBoxes[Subscript[x, n]]]]

SubscrıptΤest = 
        Function[{x}, 
MatchQ[ToBoxes[Unevaluated[x]], 
              SubscriptBox[_String, _String]] && 
            FreeQ[Unevaluated[x], Verbatim[Blank]], {HoldAll}];

SubscrıptCheck = 
        Function[{x}, 
          MatchQ[ToBoxes[Unevaluated[x]], 
            SubscriptBox[_String, _String]], {HoldAll}];

Attributes[GeτBase] = {HoldAll};
GeτBase[symb_Symbol] := 
      Module[{str = ToString@Unevaluated@symb, 
          posn1}, 
posn1 = 
          StringPosition[str, "⎵"]; 
If[
          posn1 === {}, 
          symb, 
ToExpression[
            StringTake[str, Part[posn1, 1, 1] - 1], StandardForm, 
            HoldForm] 
]
]

SubscriptSymbols

SubscriptSymbols[On|True]

SubscriptSymbols[
            On | True] /; $SymbolizeAll𝔖ubscripts := 
        Null;

SubscriptSymbols[On | True] := 
        Module[{dv1, sv1, lst1, 
            lst2}, (
{dv1, sv1} = {DownValues[Subscript], 
                SubValues[
                  Subscript]}; 

lst1 = {First[#]} & /@ 
                Position[First /@ dv1, 
                  Subscript[_, _?(NonNegative[#] && 
                            IntegerQ[#] &)]]; 

lst2 = {First[#]} & /@ 
                Position[First /@ sv1, 
                  Subscript[_, _?(NonNegative[#] && IntegerQ[#] &)], 
                  Heads -> 
                    True]; 

DownValues[
                Subscript] = 
              ReplacePart[dv1, Unevaluated[Sequence[]], 
                lst1]; 

SubValues[
                Subscript] = 
              ReplacePart[sv1, Unevaluated[Sequence[]], 
                lst2]; 

 
            DownValues[
                Utilities`Notation`NotationMakeExpression] = 
{HoldPattern[
                    NotationMakeExpression[
                      TagBox[Utilities`Notation`Private`𝒷ℴ𝓍ℯ𝓈_, Utilities`Notation`NotationBoxTag, 
                        Utilities`Notation`Private`ℴ𝓅𝓉𝓈___], 
                      Utilities`Notation`Private`𝒶𝓃𝓎_]] :> 
                  HoldComplete[
                    NotationBoxTag[
                      Utilities`Notation`Private`𝒷ℴ𝓍ℯ𝓈]], 
                HoldPattern[
                    NotationMakeExpression[
                      Utilities`Notation`Private`𝓂𝒶𝓉𝒸𝒽ℯ𝒹ℬℴ𝓍ℯ𝓈 : 
                        SubscriptBox[_?VarıablϵQ, _?
                            IntegerΤϵst], 
                      StandardForm]] :> (Utilities`Notation`Private`createSymbolizeSingleInstance[
                      Utilities`Notation`Private`𝓂𝒶𝓉𝒸𝒽ℯ𝒹ℬℴ𝓍ℯ𝓈]; 
                    MakeExpression[
                      Utilities`Notation`Private`𝓂𝒶𝓉𝒸𝒽ℯ𝒹ℬℴ𝓍ℯ𝓈, 
                      StandardForm])}; 

Subscript[symb_?VarıablϵQ, 
                i_?IntegerΤϵst] := 
              ToExpression @ 
                MakeBoxes[
                  Subscript[symb, 
                    i]]; 
$SymbolizeAll𝔖ubscripts = True;
)
];

SubscriptSymbols[Off|False]

\(\(SubscriptSymbols[Off | False] := 
        Module[{dv1, dv2, dv3, lst1, lst2, lst3, lst4, 
            WillRemove}, 
\((
dv1 = 
              DownValues[
                Utilities`Notation`NotationMakeBoxes]; 
dv2 = DownValues[
                Utilities`Notation`NotationMakeExpression]; 
dv3 = 
              DownValues[
                Subscript]; 

lst1 = 
\({First[#]} &\) /@ 
                Position[
                  dv1, 
SubscriptBox[_, _?\((IntegerQ @@ 
                            MakeExpression[#, 
                              StandardForm] &)\)]]; 

lst2 = \({First[#]} &\) /@ 
                Position[
                  dv2, _SubscriptBox]; 
\ 
lst3 = \({First[#]} &\) /@ 
                Position[
                  dv2, _SubscriptBox]; 

WillRemove = 
              Union[lst2, 
                lst3]; 

ClearAll @@ 
              Select[Names[Context[] <> "*"], 
                SymbolizedSubscriptQ[#] &]; 

DownValues[
                Utilities`Notation`NotationMakeBoxes] = 
ReplacePart[dv1, Unevaluated[Sequence[]], 
                lst1]; 

DownValues[
                Utilities`Notation`NotationMakeExpression] = 
ReplacePart[dv2, Unevaluated[Sequence[]], 
                WillRemove]; 

DownValues[
                Utilities`Notation`Private`symbolizedTable] = {}; 

lst4 = \({First[#]} &\) /@ 
                Union[Position[First /@ dv3, 
                    IntegerΤϵst], 
Position[
                    First /@ dv3, _?
                      SubscrıptΤest]
]; 

DownValues[Subscript] = 
              ReplacePart[dv3, Unevaluated[Sequence[]], 
                lst4]; 
$SymbolizeAll𝔖ubscripts = False; 

DownValues[
                Subscripts𝒮ymbolizedQ] = 
{HoldPattern[
                    Subscripts𝒮ymbolizedQ[_]] :> 
                  
                  False};
)\)
];\)\)

SubscriptSymbols[_?SymbolizedSubscriptQ, On|True]

SubscriptSymbols[_?Subscripts𝒮ymbolizedQ, On | True] := 
        Null;

SubscriptSymbols[x_?SymbolTest, On|True]

\(SubscriptSymbols[x_?SymbolΤϵst, 
        On | True] := 
Module[{dv1, sv1, lst1, 
          lst2}, 
\((
{dv1, 
              sv1} = {DownValues[Subscript], 
              SubValues[
                Subscript]}; 

lst1 = \({First[#]} &\) /@ 
              Position[First /@ dv1, 
                Subscript[
                  x, _?\((NonNegative[#] && 
                          IntegerQ[#] &)\)]]; 

lst2 = \({First[#]} &\) /@ 
              Position[First /@ sv1, 
                Subscript[x, _?\((NonNegative[#] && IntegerQ[#] &)\)], 
                Heads -> 
                  True]; 

DownValues[
              Subscript] = 
            ReplacePart[dv1, Unevaluated[Sequence[]], 
              lst1]; 

SubValues[
              Subscript] = 
            ReplacePart[sv1, Unevaluated[Sequence[]], 
              lst2]; 

s𝓎mβol\_\(n_?IntegerΤϵst\) := 
            ToExpression[
              MakeBoxes[
                s𝓎mβol\_n]]; 

Utilities`Notation`NotationMakeExpression[
              Utilities`Notation`Private`𝓂𝒶𝓉𝒸𝒽ℯ𝒹ℬℴ𝓍ℯ𝓈 : 
                SubscriptBox["s𝓎mβol", _?
                    IntegerΤϵst], 
              StandardForm] := \((Utilities`Notation`Private`createSymbolizeSingleInstance[
                Utilities`Notation`Private`𝓂𝒶𝓉𝒸𝒽ℯ𝒹ℬℴ𝓍ℯ𝓈]; 
              MakeExpression[
                Utilities`Notation`Private`𝓂𝒶𝓉𝒸𝒽ℯ𝒹ℬℴ𝓍ℯ𝓈, 
                StandardForm]
)\); 

DownValues[
              Subscript] = 
DownValues[
                Subscript] /. {s𝓎mβol :> 
                  x, "s𝓎mβol" -> 
                  ToString[
                    Unevaluated@
                      x]}; 

DownValues[
              Utilities`Notation`NotationMakeExpression] = 
DownValues[
                Utilities`Notation`NotationMakeExpression] /. {s𝓎mβol :> x, "s𝓎mβol" -> 
                  ToString[
                    Unevaluated@
                      x]}; 

Subscripts𝒮ymbolizedQ[x] = 
            True;
)\)
]\)

SubscriptSymbols[x_Symbol?(AtomQ[ToBoxes[#]]&),Off|False]

HoldPattern[
          SubscriptSymbols[
              x_Symbol?(Function[{s}, 
                    AtomQ[ToBoxes[Unevaluated@s]], {HoldAll}]), 
              Off | False] /; $SymbolizeAll𝔖ubscripts] := 
        Message[SubscriptSymbols::AllOn, HoldForm@x];

\(\(HoldPattern[
          SubscriptSymbols[
            x_Symbol?\((Function[{s}, 
                  AtomQ[ToBoxes[Unevaluated@s]], {HoldAll}])\), 
            Off | False]] := 
        Module[{lst1, lst2, lst3, lst4, lst5, lst6, vars, 
            messg}, 

lst1 = \({First[#]} &\) /@ Position[DownValues[Utilities`Notation`NotationMakeExpression], 
                SubscriptBox[
                  ToString@\(Unevaluated@
                      x\), _]]; 

lst2 = \({First[#]} &\) /@ 
              Position[DownValues[Utilities`Notation`NotationMakeBoxes], 
                SubscriptBox[
                  ToString@\(Unevaluated@
                      x\), _]]; 

lst3 = \({First[#]} &\) /@ 
              Position[
                DownValues[Utilities`Notation`Private`symbolizedTable], 
                SubscriptBox[
                  ToString@\(Unevaluated@
                      x\), _]]; 

lst4 = 
            Union[\({First[#]} &\) /@ 
                Position[
                  DownValues[Subscript], 
HoldPattern[
                    Subscript[x, 
                      Verbatim[
                        n_?IntegerΤϵst]]]]]; 

lst5 = \({First[#]} &\) /@ 
              Position[
                DownValues[Subscript], 
HoldPattern[
                  Subscript[
                    x, _?IntegerΤϵst]]]; 

 (*\(lst6 = 
                Union[lst4, lst5];\)*) 
lst6 = 
            Union[\({First[#]} &\) /@ 
                Position[DownValues[Subscript], 
                  HoldPattern[
                    Subscript[
                      x, _]]]]; 

vars = 
            Select[Names[Context[] <> "*"], 
              SubscrıpτMatch2[
                  x, #] &]; 

If[\((lst1 =!= {})\) && \((lst2 =!= {})\) && \((lst3 =!= {})\) && \((lst6 =!= {})\), 
            ClearAll @@ 
              vars
]; 

DownValues[
              Utilities`Notation`NotationMakeExpression] = 
            ReplacePart[
              DownValues[Utilities`Notation`NotationMakeExpression], 
              Unevaluated[Sequence[]], 
              lst1]; 

DownValues[
              Utilities`Notation`NotationMakeBoxes] = 
            ReplacePart[DownValues[Utilities`Notation`NotationMakeBoxes], 
              Unevaluated[Sequence[]], 
              lst2]; 

DownValues[
              Utilities`Notation`Private`symbolizedTable] = 
            ReplacePart[
              DownValues[Utilities`Notation`Private`symbolizedTable], 
              Unevaluated[Sequence[]], 
              lst3]; 

DownValues[
              Subscript] = 
            ReplacePart[DownValues[Subscript], Unevaluated[Sequence[]], 
              lst6]; 

DownValues[
              Subscripts𝒮ymbolizedQ] = 
{HoldPattern[
                  Subscripts𝒮ymbolizedQ[_]] :> 
                False};
];\)\)

SubscriptSymbols[Subscript[x_Subscript, n_?SubscriptTest],On|True]

\(HoldPattern[
        SubscriptSymbols[s_?SubscrıptΤest, 
          On | True]] := 

      Module[{dv1, sv1, lst1, 
          lst2}, 
\((
{dv1, 
              sv1} = {DownValues[Subscript], 
              SubValues[
                Subscript]}; 

lst1 = \({First[#]} &\) /@ 
              Position[First /@ dv1, 
                Unevaluated@
                  s]; 

lst2 = \({First[#]} &\) /@ 
              Position[First /@ sv1, Unevaluated@s, 
                Heads -> 
                  True]; 

DownValues[
              Subscript] = 
            ReplacePart[dv1, Unevaluated[Sequence[]], 
              lst1]; 

SubValues[
              Subscript] = 
            ReplacePart[sv1, Unevaluated[Sequence[]], 
              lst2]; 
\ 
s𝓎mβol\_n𝓃 := 
            ToExpression[
              MakeBoxes[
                s𝓎mβol\_n𝓃]]; 
Utilities`Notation`NotationMakeExpression[
              Utilities`Notation`Private`𝓂𝒶𝓉𝒸𝒽ℯ𝒹ℬℴ𝓍ℯ𝓈 : 
                SubscriptBox["s𝓎mβol", "n𝓃"], 
              StandardForm] := \((Utilities`Notation`Private`createSymbolizeSingleInstance[
                Utilities`Notation`Private`𝓂𝒶𝓉𝒸𝒽ℯ𝒹ℬℴ𝓍ℯ𝓈]; 
              MakeExpression[
                Utilities`Notation`Private`𝓂𝒶𝓉𝒸𝒽ℯ𝒹ℬℴ𝓍ℯ𝓈, 
                StandardForm]
)\); 

DownValues[
              Utilities`Notation`NotationMakeExpression] = 
DownValues[
                Utilities`Notation`NotationMakeExpression] /. 
{SubscriptBox["s𝓎mβol", "n𝓃"] -> ToBoxes[s], _[s𝓎mβol, _] -> 
                  s}; 
DownValues[
              Subscript] = 
DownValues[
                Subscript] /. _[s𝓎mβol, _] -> 
                s;
)\)
]\)

SubscriptSymbols[x_?IntegerSubscriptQ, Off|False]

SubscriptSymbols[_Subscript, Off | False] := Null;

HoldPattern[
          SubscriptSymbols[x_?IntϵgerSubscrıptQ, 
              Off | False] /; $SymbolizeAll𝔖ubscripts] := 
        Message[SubscriptSymbols::Sub1, HoldForm@x];

Attributes[suβ𝓈cript] = {HoldFirst, 
          NHoldRest};

HoldPattern[
          SubscriptSymbols[x_?SubscrıptCheck, 
            Off | False]] := 
If[
TrueQ[(Subscripts𝒮ymbolizedQ @@ 
                  GeτBase[x]) && 
With[{sub = 
                    GetSubscript[x]}, 
                IntegerQ[sub] && 
                  NonNegative[
                    sub]]
], 
Message[
            SubscriptSymbols::Sub2, HoldForm@x, 
            GeτBase@x], 

 (* 
            else *) 
Module[{lst1, lst2, lst3, lst4, dv, 
              posn, w1}, 

lst1 = {First[#]} & /@ 
                Position[
                  DownValues[Utilities`Notation`NotationMakeExpression], 
                  ToBoxes[
                    Unevaluated@
                      x]]; 

lst2 = {First[#]} & /@ 
                Position[DownValues[Utilities`Notation`NotationMakeBoxes], 
                  ToBoxes[
                    Unevaluated@
                      x]]; 

lst3 = {First[#]} & /@ 
                Position[
                  DownValues[Utilities`Notation`Private`symbolizedTable], 
                  ToBoxes[
                    Unevaluated@
                      x]]; 

dv = 
              DownValues[Subscript]; 
posn = 
              Position[dv, _Subscript, -1]; 
w1 = 
              Transpose[{Extract[dv, posn], posn}]; 
lst4 = 
              List /@ Union@
                  Cases[w1, {x, index_} :> 
                      First@index]; 

If[(lst1 =!= {}) && (lst2 =!= {}) && (lst3 =!= {}) && (lst4 =!= {}), ClearAll[x] ]; 

DownValues[
                Utilities`Notation`NotationMakeExpression] = 
              ReplacePart[
                DownValues[Utilities`Notation`NotationMakeExpression], 
                Unevaluated[Sequence[]], 
                lst1]; 

DownValues[
                Utilities`Notation`NotationMakeBoxes] = 
              ReplacePart[DownValues[Utilities`Notation`NotationMakeBoxes], 
                Unevaluated[Sequence[]], 
                lst2]; 

DownValues[
                Utilities`Notation`Private`symbolizedTable] = 
              ReplacePart[
                DownValues[Utilities`Notation`Private`symbolizedTable], 
                Unevaluated[Sequence[]], 
                lst3]; 

DownValues[
                Subscript] = 
              ReplacePart[DownValues[Subscript], Unevaluated[Sequence[]], 
                lst4];
]];

SubscriptSymbols over lists of symbols

HoldPattern[
        SubscriptSymbols[
          HoldPattern[lst : {__Symbol?AτomΤest}], 
          Off | False]] := 
(Function[{s}, (SubscriptSymbols[s, Off]), {HoldAll}] /@ 
            Unevaluated[lst];)

HoldPattern[
        SubscriptSymbols[
          HoldPattern[lst : {__Symbol?AτomΤest}], 
          On | True]] := 
(Function[{s}, (SubscriptSymbols[s, On]), {HoldAll}] /@ 
            Unevaluated[lst];)

HoldPattern[
        SubscriptSymbols[
          HoldPattern[lst : {__?(Head[ToBoxes[#]] === SubscriptBox &)}], 
          Off | False]] := (Function[{x}, 
              SubscriptSymbols[x, Off], {HoldAll}] /@ 
            Unevaluated[lst];)

HoldPattern[
        SubscriptSymbols[
          HoldPattern[lst : {__?(Head[ToBoxes[#]] === SubscriptBox &)}], 
          On | True]] := (Function[{x}, 
              SubscriptSymbols[x, On], {HoldAll}] /@ 
            Unevaluated[lst];)

Messages for illegal cases

SubscriptSymbols[
            x_?(Function[{a}, (Head[Unevaluated@a] =!= 
                        List) || (Head[Unevaluated@a] =!= 
                          Symbol) && (NumericQ[
                          Unevaluated@a]), {HoldAll}]), 
            On | Off | True | False] /; 
          Message[SubscriptSymbols::expr] := "Never Get Here";

SubscriptSymbols[_List, On | Off | True | False] /; 
          Message[SubscriptSymbols::list] := "Never Get Here";

SubscriptSymbols[_, _?(! MatchQ[#,  
                      On | Off | True | False ] &)] /; 
          Message[SubscriptSymbols::boole2] := "Never Get Here";

SubscriptSymbols[_?(! MatchQ[#,  
                      On | Off | True | False ] &)] /; 
          Message[SubscriptSymbols::boole1] := "Never Get Here";

SubscriptSymbols[args__] /; (Length[{args}] > 2) && 
            Message[SubscriptSymbols::argt, 
              Length[{args}]] := "Never Get Here";

SymbolizedSubscriptQ

\(\(SymbolizedSubscriptQ[symb_Symbol] := 
StringMatchQ[
          ToString[
            Unevaluated@
              symb], "*" <> "⎵Subscript⎵*"];\)\)

SymbolizedSubscriptQ[_] := False;

GetSubscript

GetSubscript[symb_?SymbolizedSubscriptQ] := 
        ToExpression[Last@ToBoxes@Unevaluated@symb];

GetSubscript[s_Subscript] := Last[Unevaluated@s]

MapSubscript

MapSubscript[f_, 
          symb_?SymbolizedSubscriptQ] := 
Module[{boxes = 
              ToBoxes[Unevaluated@symb], NewSub}, 
NewSub = 
            f[ToExpression[Last[boxes]]];  
ToExpression@
            ReplacePart[boxes, ToBoxes[NewSub], 
              2]
];

MapSubscript[f_, s_Subscript] := MapAt[f, s, 2];

MapSubscript[_, symb_, __] := symb;

ApplySubscript

ApplySubscript[f_, 
          symb_?SymbolizedSubscriptQ] := 
Module[{BoxList = 
              List @@ ToBoxes[Unevaluated@symb], 
            temp}, 
temp = 
            Thread[ToExpression[#, StandardForm, Hold] & /@ BoxList, 
              Hold]; 
Part[temp, 1, 0] = 
            Sequence; 
f @@ 
            temp
];

ApplySubscript[f_, symb_Subscript] := f @@ symb;

Enhance Clear

\(\(\(Clear[
          s_Subscript] := 
\((
lst1 = \({First[#]} &\) /@ 
              Position[First /@ DownValues[Subscript], 
                Unevaluated[
                  s]]; 

lst2 = \({First[#]} &\) /@ 
              Position[First /@ SubValues[Subscript], Unevaluated[s], 
                Heads -> True]; 


          DownValues[Subscript] = 
            ReplacePart[DownValues[Subscript], Unevaluated[Sequence[]], 
              lst1]; 

SubValues[
              Subscript] = 
            ReplacePart[SubValues[Subscript], Unevaluated[Sequence[]], 
              lst2];
)\);\)\(
\)
    \)\)
Clear[
          symbs__?(Function[{s}, 
                MatchQ[Unevaluated[
                    s], _Symbol | _Subscript], {HoldAll}]) ] /; $EnhancϵClear := 
Block[{$EnhancϵClear}, 
CompoundExpression @@ (Clear /@ 
              Hold[symbs])
]

NotationPalette

\(NotationPalette[] := \((
\(NotebookOpen[
            FrontEnd`FileName[
{$TopDirectory, "AddOns", "ExtraPackages", "Utilities"}, "NotationPalette.nb"]\ ];\))\)\)

End

Protect[Evaluate[WasProτected]];

End[];

\(\(Protect["SubscriptSymbols", "GetSubscript", "MapSubscript", \ "SymbolizedSubscriptQ", "ApplySubscript", "NotationPalette"];\)\)

EndPackage[];