

Begin["System`"]

(* NProt.m : to be loaded at dump time : drg *)

NProtect::usage =
"NProtect[args] in a held expression protects args from being affected by
an N[ ] inside of which NProtect[args] appears.  This does not affect any
N[ ] appearing within NProtect[ ].  NProtect[args] in a unheld expression
is evaluated to args."

Begin["`Private`"]

NProtect[args___] := args
Attributes[NProtect] = {NProtectedAll}

Protect[ NProtect]

nprot[f_, attr_] :=
    Module[{prot = MemberQ[Attributes[f], Protected]},
	If[prot, Unprotect[f]];
	AppendTo[Attributes[f], attr];
	If[prot, Protect[f]]
	]

Map[nprot[#, NProtectedAll]&,
{Accuracy, AlgebraicRules, Binimial, Blank, BlankNullSequence, BlankSequence,
Block, ByteCount, C, Cancel, Cases, Catch, Cform, Check, CheckAbort, Chop,
ClearAttributes, ClebschGordan, CompiledFunction, Complement, Continuation,
Definition, Derivative, DialogIndent, DigitQ, DirectedInfinity,
Divisors, DivisorSigma,
DownValues,  Eliminate, EngineeringForm, EulerPhi, EvenQ, ExtendedGCD, Factor,
Factorial2, FactorInteger, FactorList, FactorSquareFree, FactorSquareFreeList,
FactorTerms, FactorTermsList, FontForm, Format, FortranForm, FromCharacterCode,
FromDate, FullDefinition, FullForm, FullOptions, GCD, Get, GrayLevel,
GroebnerBasis, IdentityMatrix, In, Indent, Information, InputForm, InputStream,
InputString, Install, InString, IntegerDigits, IntegerQ, InterpolatingFunction,
InverseFunction, JacobiSymbol, LCM, LeafCount, Length, LineBreak, Literal,
LowerCaseQ, MachineNumberQ, MainSolve, MatchQ, MatrixQ, MemberQ, Message,
MessageList, MessageName, Messages, Module, MoebiusMu, NameQ, Names, Needs,
NumberForm, NumberQ, OddQ, Off, On, OpenAppend, OpenRead, OpenWrite,
Optional, Options, OrderedQ, Out, OutputForm, OutputStream, PaddedForm,
PartitionsP, PartitionsQ, Pattern, PatternTest, PolynomialGCD, PolynomialLCM,
PolynomialMod, PolynomialQ, PostScript, PowerMod, PrecedenceForm, Precision,
Prime, PrimeQ, PrintForm, Protect, Put, PutAppend, Quotient, Range, Raw,
Read, ReadList, RealDigits, Reduce, ReleaseHold, Remove, RenameDirectory,
Repeated, RepeatedNull, ResetDirectory, Resultant, (* Rule, RuleDelayed, *)
Run, RunThrough, Save, ScientificForm, SeedRandom, SequenceForm, SetAttributes,
SetDirectory, SetFileDate, SetOptions, SetStreamPosition, Shallow, Share,
(* Short, *) Show, Signature, SixJSymbol, Skeleton, Skip, Slot,
SlotSequence, Solve,
SolveAlways, Splice, Stack, StirlingS1, StirlingS2, StreamPosition, Streams,
String, StringBreak, StringByteCount, StringDrop, StringForm, StringInsert,
StringJoin, StringLength, StringMatchQ, StringPosition, StringReplace,
StringReverse, StringSkeleton, StringTake, StringToStream, Subscript,
Superscript, SyntaxLength, SyntaxQ, TagSet, TagSetDelayed, TagUnset, TeXForm,
Text, TextForm, ThreeJSymbol, Throw, ToCharacterCode, ToExpression,
ToHeldExpression, ToLowerCase, ToUpperCase, Trace, TraceAbove, TraceDialog,
TracePrint, TraceScan, TreeForm, Unevaluated, Uninstall, Unique, Unprotect,
Unset, Update, UpperCaseQ, ValueQ, Variables, VectorQ, Write, WriteString}]
 
Map[nprot[#, NProtectedAll]&,
{NDSolve, NIntegrate, NProduct, NRoots, NSum}]

Map[nprot[#, NProtectedFirst]&,
{BernoulliB, Cyclotomic, EllipticTheta, EulerE, NBernoulliB, Set,
SetDelayed, UpSet, UpSetDelayed, UpValues}]
 
Map[nprot[#, NProtectedRest]&,
{Array, BaseForm, Coefficient, D, Default, Delete, DeleteCases,
Dimensions, Do, Drop, Dt, Exponent, Fit, Flatten, FlattenAt, FreeQ,
FullGraphics, HeldPart, Level, MatrixPower, MemoryConstrained, Minors, N,
Part, Partition, Position, ReplaceHeldPart, RotateLeft, RotateRight,
SetAccuracy, SetPrecision, Take, Thread, Transpose}]

Clear[nprot, prot];
Remove[nprot, prot];

End[ ]  (* "`Private`" *)

End[]  (* "System`" *)
