calc-ext.el 129 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511
  1. ;;; calc-ext.el --- various extension functions for Calc
  2. ;; Copyright (C) 1990-1993, 2001-2017 Free Software Foundation, Inc.
  3. ;; Author: David Gillespie <daveg@synaptics.com>
  4. ;; This file is part of GNU Emacs.
  5. ;; GNU Emacs is free software: you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation, either version 3 of the License, or
  8. ;; (at your option) any later version.
  9. ;; GNU Emacs is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;; You should have received a copy of the GNU General Public License
  14. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  15. ;;; Commentary:
  16. ;;; Code:
  17. (require 'calc)
  18. (require 'calc-macs)
  19. ;; Declare functions which are defined elsewhere.
  20. (declare-function math-clip "calc-bin" (a &optional w))
  21. (declare-function math-round "calc-arith" (a &optional prec))
  22. (declare-function math-simplify "calc-alg" (top-expr))
  23. (declare-function math-simplify-extended "calc-alg" (a))
  24. (declare-function math-simplify-units "calc-units" (a))
  25. (declare-function calc-set-language "calc-lang" (lang &optional option no-refresh))
  26. (declare-function calc-flush-caches "calc-stuff" (&optional inhibit-msg))
  27. (declare-function calc-save-modes "calc-mode" ())
  28. (declare-function calc-embedded-modes-change "calc-embed" (vars))
  29. (declare-function calc-embedded-var-change "calc-embed" (var &optional buf))
  30. (declare-function math-mul-float "calc-arith" (a b))
  31. (declare-function math-arctan-raw "calc-math" (x))
  32. (declare-function math-sqrt-raw "calc-math" (a &optional guess))
  33. (declare-function math-sqrt-float "calc-math" (a &optional guess))
  34. (declare-function math-exp-minus-1-raw "calc-math" (x))
  35. (declare-function math-normalize-polar "calc-cplx" (a))
  36. (declare-function math-normalize-hms "calc-forms" (a))
  37. (declare-function math-normalize-mod "calc-forms" (a))
  38. (declare-function math-make-sdev "calc-forms" (x sigma))
  39. (declare-function math-make-intv "calc-forms" (mask lo hi))
  40. (declare-function math-normalize-logical-op "calc-prog" (a))
  41. (declare-function math-possible-signs "calc-arith" (a &optional origin))
  42. (declare-function math-infinite-dir "calc-math" (a &optional inf))
  43. (declare-function math-calcFunc-to-var "calc-map" (f))
  44. (declare-function calc-embedded-evaluate-expr "calc-embed" (x))
  45. (declare-function math-known-nonzerop "calc-arith" (a))
  46. (declare-function math-read-expr-level "calc-aent" (exp-prec &optional exp-term))
  47. (declare-function math-read-big-rec "calc-lang" (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2 &optional baseline prec short))
  48. (declare-function math-read-big-balance "calc-lang" (h v what &optional commas))
  49. (declare-function math-format-date "calc-forms" (math-fd-date))
  50. (declare-function math-vector-is-string "calccomp" (a))
  51. (declare-function math-vector-to-string "calccomp" (a &optional quoted))
  52. (declare-function math-format-radix-float "calc-bin" (a prec))
  53. (declare-function math-compose-expr "calccomp" (a prec &optional div))
  54. (declare-function math-abs "calc-arith" (a))
  55. (declare-function math-format-bignum-binary "calc-bin" (a))
  56. (declare-function math-format-bignum-octal "calc-bin" (a))
  57. (declare-function math-format-bignum-hex "calc-bin" (a))
  58. (declare-function math-format-bignum-radix "calc-bin" (a))
  59. (declare-function math-compute-max-digits "calc-bin" (w r))
  60. (declare-function math-map-vec "calc-vec" (f a))
  61. (declare-function math-make-frac "calc-frac" (num den))
  62. (defvar math-simplifying nil)
  63. (defvar math-living-dangerously nil) ; true if unsafe simplifications are okay.
  64. (defvar math-integrating nil)
  65. (defvar math-rewrite-selections nil)
  66. (defvar math-compose-level 0)
  67. (defvar math-comp-selected nil)
  68. (defvar math-comp-tagged nil)
  69. (defvar math-comp-sel-hpos nil)
  70. (defvar math-comp-sel-vpos nil)
  71. (defvar math-comp-sel-cpos nil)
  72. (defvar math-compose-hash-args nil)
  73. (defvar calc-alg-map)
  74. (defvar calc-alg-esc-map)
  75. ;;; The following was made a function so that it could be byte-compiled.
  76. (defun calc-init-extensions ()
  77. (define-key calc-mode-map ":" 'calc-fdiv)
  78. (define-key calc-mode-map "\\" 'calc-idiv)
  79. (define-key calc-mode-map "|" 'calc-concat)
  80. (define-key calc-mode-map "!" 'calc-factorial)
  81. (define-key calc-mode-map "C" 'calc-cos)
  82. (define-key calc-mode-map "E" 'calc-exp)
  83. (define-key calc-mode-map "H" 'calc-hyperbolic)
  84. (define-key calc-mode-map "I" 'calc-inverse)
  85. (define-key calc-mode-map "J" 'calc-conj)
  86. (define-key calc-mode-map "L" 'calc-ln)
  87. (define-key calc-mode-map "N" 'calc-eval-num)
  88. (define-key calc-mode-map "O" 'calc-option)
  89. (define-key calc-mode-map "P" 'calc-pi)
  90. (define-key calc-mode-map "Q" 'calc-sqrt)
  91. (define-key calc-mode-map "R" 'calc-round)
  92. (define-key calc-mode-map "S" 'calc-sin)
  93. (define-key calc-mode-map "T" 'calc-tan)
  94. (define-key calc-mode-map "U" 'calc-undo)
  95. (define-key calc-mode-map "X" 'calc-call-last-kbd-macro)
  96. (define-key calc-mode-map "o" 'calc-realign)
  97. (define-key calc-mode-map "p" 'calc-precision)
  98. (define-key calc-mode-map "w" 'calc-why)
  99. (define-key calc-mode-map "x" 'calc-execute-extended-command)
  100. (define-key calc-mode-map "y" 'calc-copy-to-buffer)
  101. (define-key calc-mode-map "(" 'calc-begin-complex)
  102. (define-key calc-mode-map ")" 'calc-end-complex)
  103. (define-key calc-mode-map "[" 'calc-begin-vector)
  104. (define-key calc-mode-map "]" 'calc-end-vector)
  105. (define-key calc-mode-map "," 'calc-comma)
  106. (define-key calc-mode-map ";" 'calc-semi)
  107. (define-key calc-mode-map "`" 'calc-edit)
  108. (define-key calc-mode-map "=" 'calc-evaluate)
  109. (define-key calc-mode-map "~" 'calc-num-prefix)
  110. (define-key calc-mode-map "<" 'calc-scroll-left)
  111. (define-key calc-mode-map ">" 'calc-scroll-right)
  112. (define-key calc-mode-map "{" 'calc-scroll-down)
  113. (define-key calc-mode-map "}" 'calc-scroll-up)
  114. (define-key calc-mode-map "\C-k" 'calc-kill)
  115. (define-key calc-mode-map "\M-k" 'calc-copy-as-kill)
  116. (define-key calc-mode-map "\C-w" 'calc-kill-region)
  117. (define-key calc-mode-map "\M-w" 'calc-copy-region-as-kill)
  118. (define-key calc-mode-map "\M-\C-w" 'kill-ring-save)
  119. (define-key calc-mode-map "\M-\C-m" 'calc-last-args)
  120. (define-key calc-mode-map "a" nil)
  121. (define-key calc-mode-map "a?" 'calc-a-prefix-help)
  122. (define-key calc-mode-map "aa" 'calc-apart)
  123. (define-key calc-mode-map "ab" 'calc-substitute)
  124. (define-key calc-mode-map "ac" 'calc-collect)
  125. (define-key calc-mode-map "ad" 'calc-derivative)
  126. (define-key calc-mode-map "ae" 'calc-simplify-extended)
  127. (define-key calc-mode-map "af" 'calc-factor)
  128. (define-key calc-mode-map "ag" 'calc-poly-gcd)
  129. (define-key calc-mode-map "ai" 'calc-integral)
  130. (define-key calc-mode-map "am" 'calc-match)
  131. (define-key calc-mode-map "an" 'calc-normalize-rat)
  132. (define-key calc-mode-map "ap" 'calc-poly-interp)
  133. (define-key calc-mode-map "ar" 'calc-rewrite)
  134. (define-key calc-mode-map "as" 'calc-simplify)
  135. (define-key calc-mode-map "at" 'calc-taylor)
  136. (define-key calc-mode-map "av" 'calc-alg-evaluate)
  137. (define-key calc-mode-map "ax" 'calc-expand)
  138. (define-key calc-mode-map "aA" 'calc-abs)
  139. (define-key calc-mode-map "aF" 'calc-curve-fit)
  140. (define-key calc-mode-map "aI" 'calc-num-integral)
  141. (define-key calc-mode-map "aM" 'calc-map-equation)
  142. (define-key calc-mode-map "aN" 'calc-find-minimum)
  143. (define-key calc-mode-map "aP" 'calc-poly-roots)
  144. (define-key calc-mode-map "aS" 'calc-solve-for)
  145. (define-key calc-mode-map "aR" 'calc-find-root)
  146. (define-key calc-mode-map "aT" 'calc-tabulate)
  147. (define-key calc-mode-map "aX" 'calc-find-maximum)
  148. (define-key calc-mode-map "a+" 'calc-summation)
  149. (define-key calc-mode-map "a-" 'calc-alt-summation)
  150. (define-key calc-mode-map "a*" 'calc-product)
  151. (define-key calc-mode-map "a\\" 'calc-poly-div)
  152. (define-key calc-mode-map "a%" 'calc-poly-rem)
  153. (define-key calc-mode-map "a/" 'calc-poly-div-rem)
  154. (define-key calc-mode-map "a=" 'calc-equal-to)
  155. (define-key calc-mode-map "a#" 'calc-not-equal-to)
  156. (define-key calc-mode-map "a<" 'calc-less-than)
  157. (define-key calc-mode-map "a>" 'calc-greater-than)
  158. (define-key calc-mode-map "a[" 'calc-less-equal)
  159. (define-key calc-mode-map "a]" 'calc-greater-equal)
  160. (define-key calc-mode-map "a." 'calc-remove-equal)
  161. (define-key calc-mode-map "a{" 'calc-in-set)
  162. (define-key calc-mode-map "a&" 'calc-logical-and)
  163. (define-key calc-mode-map "a|" 'calc-logical-or)
  164. (define-key calc-mode-map "a!" 'calc-logical-not)
  165. (define-key calc-mode-map "a:" 'calc-logical-if)
  166. (define-key calc-mode-map "a_" 'calc-subscript)
  167. (define-key calc-mode-map "a\"" 'calc-expand-formula)
  168. (define-key calc-mode-map "b" nil)
  169. (define-key calc-mode-map "b?" 'calc-b-prefix-help)
  170. (define-key calc-mode-map "ba" 'calc-and)
  171. (define-key calc-mode-map "bc" 'calc-clip)
  172. (define-key calc-mode-map "bd" 'calc-diff)
  173. (define-key calc-mode-map "bl" 'calc-lshift-binary)
  174. (define-key calc-mode-map "bn" 'calc-not)
  175. (define-key calc-mode-map "bo" 'calc-or)
  176. (define-key calc-mode-map "bp" 'calc-pack-bits)
  177. (define-key calc-mode-map "br" 'calc-rshift-binary)
  178. (define-key calc-mode-map "bt" 'calc-rotate-binary)
  179. (define-key calc-mode-map "bu" 'calc-unpack-bits)
  180. (define-key calc-mode-map "bw" 'calc-word-size)
  181. (define-key calc-mode-map "bx" 'calc-xor)
  182. (define-key calc-mode-map "bB" 'calc-log)
  183. (define-key calc-mode-map "bD" 'calc-fin-ddb)
  184. (define-key calc-mode-map "bF" 'calc-fin-fv)
  185. (define-key calc-mode-map "bI" 'calc-fin-irr)
  186. (define-key calc-mode-map "bL" 'calc-lshift-arith)
  187. (define-key calc-mode-map "bM" 'calc-fin-pmt)
  188. (define-key calc-mode-map "bN" 'calc-fin-npv)
  189. (define-key calc-mode-map "bP" 'calc-fin-pv)
  190. (define-key calc-mode-map "bR" 'calc-rshift-arith)
  191. (define-key calc-mode-map "bS" 'calc-fin-sln)
  192. (define-key calc-mode-map "bT" 'calc-fin-rate)
  193. (define-key calc-mode-map "bY" 'calc-fin-syd)
  194. (define-key calc-mode-map "b#" 'calc-fin-nper)
  195. (define-key calc-mode-map "b%" 'calc-percent-change)
  196. (define-key calc-mode-map "c" nil)
  197. (define-key calc-mode-map "c?" 'calc-c-prefix-help)
  198. (define-key calc-mode-map "cc" 'calc-clean)
  199. (define-key calc-mode-map "cd" 'calc-to-degrees)
  200. (define-key calc-mode-map "cf" 'calc-float)
  201. (define-key calc-mode-map "ch" 'calc-to-hms)
  202. (define-key calc-mode-map "cp" 'calc-polar)
  203. (define-key calc-mode-map "cr" 'calc-to-radians)
  204. (define-key calc-mode-map "cC" 'calc-cos)
  205. (define-key calc-mode-map "cF" 'calc-fraction)
  206. (define-key calc-mode-map "c%" 'calc-convert-percent)
  207. (define-key calc-mode-map "d" nil)
  208. (define-key calc-mode-map "d?" 'calc-d-prefix-help)
  209. (define-key calc-mode-map "d0" 'calc-decimal-radix)
  210. (define-key calc-mode-map "d2" 'calc-binary-radix)
  211. (define-key calc-mode-map "d6" 'calc-hex-radix)
  212. (define-key calc-mode-map "d8" 'calc-octal-radix)
  213. (define-key calc-mode-map "db" 'calc-line-breaking)
  214. (define-key calc-mode-map "dc" 'calc-complex-notation)
  215. (define-key calc-mode-map "dd" 'calc-date-notation)
  216. (define-key calc-mode-map "de" 'calc-eng-notation)
  217. (define-key calc-mode-map "df" 'calc-fix-notation)
  218. (define-key calc-mode-map "dg" 'calc-group-digits)
  219. (define-key calc-mode-map "dh" 'calc-hms-notation)
  220. (define-key calc-mode-map "di" 'calc-i-notation)
  221. (define-key calc-mode-map "dj" 'calc-j-notation)
  222. (define-key calc-mode-map "dl" 'calc-line-numbering)
  223. (define-key calc-mode-map "dn" 'calc-normal-notation)
  224. (define-key calc-mode-map "do" 'calc-over-notation)
  225. (define-key calc-mode-map "dp" 'calc-show-plain)
  226. (define-key calc-mode-map "dr" 'calc-radix)
  227. (define-key calc-mode-map "ds" 'calc-sci-notation)
  228. (define-key calc-mode-map "dt" 'calc-truncate-stack)
  229. (define-key calc-mode-map "dw" 'calc-auto-why)
  230. (define-key calc-mode-map "dz" 'calc-leading-zeros)
  231. (define-key calc-mode-map "dA" 'calc-giac-language)
  232. (define-key calc-mode-map "dB" 'calc-big-language)
  233. (define-key calc-mode-map "dD" 'calc-redo)
  234. (define-key calc-mode-map "dC" 'calc-c-language)
  235. (define-key calc-mode-map "dE" 'calc-eqn-language)
  236. (define-key calc-mode-map "dF" 'calc-fortran-language)
  237. (define-key calc-mode-map "dM" 'calc-mathematica-language)
  238. (define-key calc-mode-map "dN" 'calc-normal-language)
  239. (define-key calc-mode-map "dO" 'calc-flat-language)
  240. (define-key calc-mode-map "dP" 'calc-pascal-language)
  241. (define-key calc-mode-map "dT" 'calc-tex-language)
  242. (define-key calc-mode-map "dL" 'calc-latex-language)
  243. (define-key calc-mode-map "dU" 'calc-unformatted-language)
  244. (define-key calc-mode-map "dW" 'calc-maple-language)
  245. (define-key calc-mode-map "dX" 'calc-maxima-language)
  246. (define-key calc-mode-map "dY" 'calc-yacas-language)
  247. (define-key calc-mode-map "d[" 'calc-truncate-up)
  248. (define-key calc-mode-map "d]" 'calc-truncate-down)
  249. (define-key calc-mode-map "d." 'calc-point-char)
  250. (define-key calc-mode-map "d," 'calc-group-char)
  251. (define-key calc-mode-map "d\"" 'calc-display-strings)
  252. (define-key calc-mode-map "d<" 'calc-left-justify)
  253. (define-key calc-mode-map "d=" 'calc-center-justify)
  254. (define-key calc-mode-map "d>" 'calc-right-justify)
  255. (define-key calc-mode-map "d{" 'calc-left-label)
  256. (define-key calc-mode-map "d}" 'calc-right-label)
  257. (define-key calc-mode-map "d'" 'calc-display-raw)
  258. (define-key calc-mode-map "d " 'calc-refresh)
  259. (define-key calc-mode-map "d\r" 'calc-refresh-top)
  260. (define-key calc-mode-map "d@" 'calc-toggle-banner)
  261. (define-key calc-mode-map "f" nil)
  262. (define-key calc-mode-map "f?" 'calc-f-prefix-help)
  263. (define-key calc-mode-map "fb" 'calc-beta)
  264. (define-key calc-mode-map "fe" 'calc-erf)
  265. (define-key calc-mode-map "fg" 'calc-gamma)
  266. (define-key calc-mode-map "fh" 'calc-hypot)
  267. (define-key calc-mode-map "fi" 'calc-im)
  268. (define-key calc-mode-map "fj" 'calc-bessel-J)
  269. (define-key calc-mode-map "fn" 'calc-min)
  270. (define-key calc-mode-map "fr" 'calc-re)
  271. (define-key calc-mode-map "fs" 'calc-sign)
  272. (define-key calc-mode-map "fx" 'calc-max)
  273. (define-key calc-mode-map "fy" 'calc-bessel-Y)
  274. (define-key calc-mode-map "fA" 'calc-abssqr)
  275. (define-key calc-mode-map "fB" 'calc-inc-beta)
  276. (define-key calc-mode-map "fE" 'calc-expm1)
  277. (define-key calc-mode-map "fF" 'calc-floor)
  278. (define-key calc-mode-map "fG" 'calc-inc-gamma)
  279. (define-key calc-mode-map "fI" 'calc-ilog)
  280. (define-key calc-mode-map "fL" 'calc-lnp1)
  281. (define-key calc-mode-map "fM" 'calc-mant-part)
  282. (define-key calc-mode-map "fQ" 'calc-isqrt)
  283. (define-key calc-mode-map "fS" 'calc-scale-float)
  284. (define-key calc-mode-map "fT" 'calc-arctan2)
  285. (define-key calc-mode-map "fX" 'calc-xpon-part)
  286. (define-key calc-mode-map "f[" 'calc-decrement)
  287. (define-key calc-mode-map "f]" 'calc-increment)
  288. (define-key calc-mode-map "g" nil)
  289. (define-key calc-mode-map "g?" 'calc-g-prefix-help)
  290. (define-key calc-mode-map "ga" 'calc-graph-add)
  291. (define-key calc-mode-map "gb" 'calc-graph-border)
  292. (define-key calc-mode-map "gc" 'calc-graph-clear)
  293. (define-key calc-mode-map "gd" 'calc-graph-delete)
  294. (define-key calc-mode-map "gf" 'calc-graph-fast)
  295. (define-key calc-mode-map "gg" 'calc-graph-grid)
  296. (define-key calc-mode-map "gh" 'calc-graph-header)
  297. (define-key calc-mode-map "gk" 'calc-graph-key)
  298. (define-key calc-mode-map "gj" 'calc-graph-juggle)
  299. (define-key calc-mode-map "gl" 'calc-graph-log-x)
  300. (define-key calc-mode-map "gn" 'calc-graph-name)
  301. (define-key calc-mode-map "gp" 'calc-graph-plot)
  302. (define-key calc-mode-map "gq" 'calc-graph-quit)
  303. (define-key calc-mode-map "gr" 'calc-graph-range-x)
  304. (define-key calc-mode-map "gs" 'calc-graph-line-style)
  305. (define-key calc-mode-map "gt" 'calc-graph-title-x)
  306. (define-key calc-mode-map "gv" 'calc-graph-view-commands)
  307. (define-key calc-mode-map "gx" 'calc-graph-display)
  308. (define-key calc-mode-map "gz" 'calc-graph-zero-x)
  309. (define-key calc-mode-map "gA" 'calc-graph-add-3d)
  310. (define-key calc-mode-map "gC" 'calc-graph-command)
  311. (define-key calc-mode-map "gD" 'calc-graph-device)
  312. (define-key calc-mode-map "gF" 'calc-graph-fast-3d)
  313. (define-key calc-mode-map "gG" 'calc-argument)
  314. (define-key calc-mode-map "gH" 'calc-graph-hide)
  315. (define-key calc-mode-map "gK" 'calc-graph-kill)
  316. (define-key calc-mode-map "gL" 'calc-graph-log-y)
  317. (define-key calc-mode-map "gN" 'calc-graph-num-points)
  318. (define-key calc-mode-map "gO" 'calc-graph-output)
  319. (define-key calc-mode-map "gP" 'calc-graph-print)
  320. (define-key calc-mode-map "gR" 'calc-graph-range-y)
  321. (define-key calc-mode-map "gS" 'calc-graph-point-style)
  322. (define-key calc-mode-map "gT" 'calc-graph-title-y)
  323. (define-key calc-mode-map "gV" 'calc-graph-view-trail)
  324. (define-key calc-mode-map "gX" 'calc-graph-geometry)
  325. (define-key calc-mode-map "gZ" 'calc-graph-zero-y)
  326. (define-key calc-mode-map "g\C-l" 'calc-graph-log-z)
  327. (define-key calc-mode-map "g\C-r" 'calc-graph-range-z)
  328. (define-key calc-mode-map "g\C-t" 'calc-graph-title-z)
  329. (define-key calc-mode-map "h" 'calc-help-prefix)
  330. (define-key calc-mode-map "j" nil)
  331. (define-key calc-mode-map "j?" 'calc-j-prefix-help)
  332. (define-key calc-mode-map "ja" 'calc-select-additional)
  333. (define-key calc-mode-map "jb" 'calc-break-selections)
  334. (define-key calc-mode-map "jc" 'calc-clear-selections)
  335. (define-key calc-mode-map "jd" 'calc-show-selections)
  336. (define-key calc-mode-map "je" 'calc-enable-selections)
  337. (define-key calc-mode-map "jl" 'calc-select-less)
  338. (define-key calc-mode-map "jm" 'calc-select-more)
  339. (define-key calc-mode-map "jn" 'calc-select-next)
  340. (define-key calc-mode-map "jo" 'calc-select-once)
  341. (define-key calc-mode-map "jp" 'calc-select-previous)
  342. (define-key calc-mode-map "jr" 'calc-rewrite-selection)
  343. (define-key calc-mode-map "js" 'calc-select-here)
  344. (define-key calc-mode-map "jv" 'calc-sel-evaluate)
  345. (define-key calc-mode-map "ju" 'calc-unselect)
  346. (define-key calc-mode-map "jC" 'calc-sel-commute)
  347. (define-key calc-mode-map "jD" 'calc-sel-distribute)
  348. (define-key calc-mode-map "jE" 'calc-sel-jump-equals)
  349. (define-key calc-mode-map "jI" 'calc-sel-isolate)
  350. (define-key calc-mode-map "jJ" 'calc-conj)
  351. (define-key calc-mode-map "jL" 'calc-commute-left)
  352. (define-key calc-mode-map "jM" 'calc-sel-merge)
  353. (define-key calc-mode-map "jN" 'calc-sel-negate)
  354. (define-key calc-mode-map "jO" 'calc-select-once-maybe)
  355. (define-key calc-mode-map "jR" 'calc-commute-right)
  356. (define-key calc-mode-map "jS" 'calc-select-here-maybe)
  357. (define-key calc-mode-map "jU" 'calc-sel-unpack)
  358. (define-key calc-mode-map "j&" 'calc-sel-invert)
  359. (define-key calc-mode-map "j\r" 'calc-copy-selection)
  360. (define-key calc-mode-map "j\n" 'calc-copy-selection)
  361. (define-key calc-mode-map "j\010" 'calc-del-selection)
  362. (define-key calc-mode-map "j\177" 'calc-del-selection)
  363. (define-key calc-mode-map "j'" 'calc-enter-selection)
  364. (define-key calc-mode-map "j`" 'calc-edit-selection)
  365. (define-key calc-mode-map "j+" 'calc-sel-add-both-sides)
  366. (define-key calc-mode-map "j-" 'calc-sel-sub-both-sides)
  367. (define-key calc-mode-map "j*" 'calc-sel-mult-both-sides)
  368. (define-key calc-mode-map "j/" 'calc-sel-div-both-sides)
  369. (define-key calc-mode-map "j\"" 'calc-sel-expand-formula)
  370. (define-key calc-mode-map "k" nil)
  371. (define-key calc-mode-map "k?" 'calc-k-prefix-help)
  372. (define-key calc-mode-map "ka" 'calc-random-again)
  373. (define-key calc-mode-map "kb" 'calc-bernoulli-number)
  374. (define-key calc-mode-map "kc" 'calc-choose)
  375. (define-key calc-mode-map "kd" 'calc-double-factorial)
  376. (define-key calc-mode-map "ke" 'calc-euler-number)
  377. (define-key calc-mode-map "kf" 'calc-prime-factors)
  378. (define-key calc-mode-map "kg" 'calc-gcd)
  379. (define-key calc-mode-map "kh" 'calc-shuffle)
  380. (define-key calc-mode-map "kl" 'calc-lcm)
  381. (define-key calc-mode-map "km" 'calc-moebius)
  382. (define-key calc-mode-map "kn" 'calc-next-prime)
  383. (define-key calc-mode-map "kp" 'calc-prime-test)
  384. (define-key calc-mode-map "kr" 'calc-random)
  385. (define-key calc-mode-map "ks" 'calc-stirling-number)
  386. (define-key calc-mode-map "kt" 'calc-totient)
  387. (define-key calc-mode-map "kB" 'calc-utpb)
  388. (define-key calc-mode-map "kC" 'calc-utpc)
  389. (define-key calc-mode-map "kE" 'calc-extended-gcd)
  390. (define-key calc-mode-map "kF" 'calc-utpf)
  391. (define-key calc-mode-map "kK" 'calc-keep-args)
  392. (define-key calc-mode-map "kN" 'calc-utpn)
  393. (define-key calc-mode-map "kP" 'calc-utpp)
  394. (define-key calc-mode-map "kT" 'calc-utpt)
  395. (define-key calc-mode-map "l" nil)
  396. (define-key calc-mode-map "lq" 'calc-lu-quant)
  397. (define-key calc-mode-map "ld" 'calc-db)
  398. (define-key calc-mode-map "ln" 'calc-np)
  399. (define-key calc-mode-map "l+" 'calc-lu-plus)
  400. (define-key calc-mode-map "l-" 'calc-lu-minus)
  401. (define-key calc-mode-map "l*" 'calc-lu-times)
  402. (define-key calc-mode-map "l/" 'calc-lu-divide)
  403. (define-key calc-mode-map "ls" 'calc-spn)
  404. (define-key calc-mode-map "lm" 'calc-midi)
  405. (define-key calc-mode-map "lf" 'calc-freq)
  406. (define-key calc-mode-map "l?" 'calc-l-prefix-help)
  407. (define-key calc-mode-map "m" nil)
  408. (define-key calc-mode-map "m?" 'calc-m-prefix-help)
  409. (define-key calc-mode-map "ma" 'calc-algebraic-mode)
  410. (define-key calc-mode-map "md" 'calc-degrees-mode)
  411. (define-key calc-mode-map "me" 'calc-embedded-preserve-modes)
  412. (define-key calc-mode-map "mf" 'calc-frac-mode)
  413. (define-key calc-mode-map "mg" 'calc-get-modes)
  414. (define-key calc-mode-map "mh" 'calc-hms-mode)
  415. (define-key calc-mode-map "mi" 'calc-infinite-mode)
  416. (define-key calc-mode-map "mm" 'calc-save-modes)
  417. (define-key calc-mode-map "mp" 'calc-polar-mode)
  418. (define-key calc-mode-map "mr" 'calc-radians-mode)
  419. (define-key calc-mode-map "ms" 'calc-symbolic-mode)
  420. (define-key calc-mode-map "mt" 'calc-total-algebraic-mode)
  421. (define-key calc-mode-map "\emt" 'calc-total-algebraic-mode)
  422. (define-key calc-mode-map "\em\et" 'calc-total-algebraic-mode)
  423. (define-key calc-mode-map "mv" 'calc-matrix-mode)
  424. (define-key calc-mode-map "mw" 'calc-working)
  425. (define-key calc-mode-map "mx" 'calc-always-load-extensions)
  426. (define-key calc-mode-map "mA" 'calc-alg-simplify-mode)
  427. (define-key calc-mode-map "mB" 'calc-bin-simplify-mode)
  428. (define-key calc-mode-map "mC" 'calc-auto-recompute)
  429. (define-key calc-mode-map "mD" 'calc-default-simplify-mode)
  430. (define-key calc-mode-map "mE" 'calc-ext-simplify-mode)
  431. (define-key calc-mode-map "mF" 'calc-settings-file-name)
  432. (define-key calc-mode-map "mI" 'calc-basic-simplify-mode)
  433. (define-key calc-mode-map "mM" 'calc-more-recursion-depth)
  434. (define-key calc-mode-map "mN" 'calc-num-simplify-mode)
  435. (define-key calc-mode-map "mO" 'calc-no-simplify-mode)
  436. (define-key calc-mode-map "mR" 'calc-mode-record-mode)
  437. (define-key calc-mode-map "mS" 'calc-shift-prefix)
  438. (define-key calc-mode-map "mU" 'calc-units-simplify-mode)
  439. (define-key calc-mode-map "mX" 'calc-load-everything)
  440. (define-key calc-mode-map "r" nil)
  441. (define-key calc-mode-map "ri" 'calc-insert-register)
  442. (define-key calc-mode-map "rs" 'calc-copy-to-register)
  443. (define-key calc-mode-map "r?" 'calc-r-prefix-help)
  444. (define-key calc-mode-map "s" nil)
  445. (define-key calc-mode-map "s?" 'calc-s-prefix-help)
  446. (define-key calc-mode-map "sc" 'calc-copy-variable)
  447. (define-key calc-mode-map "sd" 'calc-declare-variable)
  448. (define-key calc-mode-map "se" 'calc-edit-variable)
  449. (define-key calc-mode-map "si" 'calc-insert-variables)
  450. (define-key calc-mode-map "sk" 'calc-copy-special-constant)
  451. (define-key calc-mode-map "sl" 'calc-let)
  452. (define-key calc-mode-map "sm" 'calc-store-map)
  453. (define-key calc-mode-map "sn" 'calc-store-neg)
  454. (define-key calc-mode-map "sp" 'calc-permanent-variable)
  455. (define-key calc-mode-map "sr" 'calc-recall)
  456. (define-key calc-mode-map "ss" 'calc-store)
  457. (define-key calc-mode-map "st" 'calc-store-into)
  458. (define-key calc-mode-map "su" 'calc-unstore)
  459. (define-key calc-mode-map "sx" 'calc-store-exchange)
  460. (define-key calc-mode-map "sA" 'calc-edit-AlgSimpRules)
  461. (define-key calc-mode-map "sD" 'calc-edit-Decls)
  462. (define-key calc-mode-map "sE" 'calc-edit-EvalRules)
  463. (define-key calc-mode-map "sF" 'calc-edit-FitRules)
  464. (define-key calc-mode-map "sG" 'calc-edit-GenCount)
  465. (define-key calc-mode-map "sH" 'calc-edit-Holidays)
  466. (define-key calc-mode-map "sI" 'calc-edit-IntegLimit)
  467. (define-key calc-mode-map "sL" 'calc-edit-LineStyles)
  468. (define-key calc-mode-map "sP" 'calc-edit-PointStyles)
  469. (define-key calc-mode-map "sR" 'calc-edit-PlotRejects)
  470. (define-key calc-mode-map "sS" 'calc-sin)
  471. (define-key calc-mode-map "sT" 'calc-edit-TimeZone)
  472. (define-key calc-mode-map "sU" 'calc-edit-Units)
  473. (define-key calc-mode-map "sX" 'calc-edit-ExtSimpRules)
  474. (define-key calc-mode-map "s+" 'calc-store-plus)
  475. (define-key calc-mode-map "s-" 'calc-store-minus)
  476. (define-key calc-mode-map "s*" 'calc-store-times)
  477. (define-key calc-mode-map "s/" 'calc-store-div)
  478. (define-key calc-mode-map "s^" 'calc-store-power)
  479. (define-key calc-mode-map "s|" 'calc-store-concat)
  480. (define-key calc-mode-map "s&" 'calc-store-inv)
  481. (define-key calc-mode-map "s[" 'calc-store-decr)
  482. (define-key calc-mode-map "s]" 'calc-store-incr)
  483. (define-key calc-mode-map "s:" 'calc-assign)
  484. (define-key calc-mode-map "s=" 'calc-evalto)
  485. (define-key calc-mode-map "t" nil)
  486. (define-key calc-mode-map "t?" 'calc-t-prefix-help)
  487. (define-key calc-mode-map "tb" 'calc-trail-backward)
  488. (define-key calc-mode-map "td" 'calc-trail-display)
  489. (define-key calc-mode-map "tf" 'calc-trail-forward)
  490. (define-key calc-mode-map "th" 'calc-trail-here)
  491. (define-key calc-mode-map "ti" 'calc-trail-in)
  492. (define-key calc-mode-map "tk" 'calc-trail-kill)
  493. (define-key calc-mode-map "tm" 'calc-trail-marker)
  494. (define-key calc-mode-map "tn" 'calc-trail-next)
  495. (define-key calc-mode-map "to" 'calc-trail-out)
  496. (define-key calc-mode-map "tp" 'calc-trail-previous)
  497. (define-key calc-mode-map "tr" 'calc-trail-isearch-backward)
  498. (define-key calc-mode-map "ts" 'calc-trail-isearch-forward)
  499. (define-key calc-mode-map "ty" 'calc-trail-yank)
  500. (define-key calc-mode-map "t[" 'calc-trail-first)
  501. (define-key calc-mode-map "t]" 'calc-trail-last)
  502. (define-key calc-mode-map "t<" 'calc-trail-scroll-left)
  503. (define-key calc-mode-map "t>" 'calc-trail-scroll-right)
  504. (define-key calc-mode-map "t{" 'calc-trail-backward)
  505. (define-key calc-mode-map "t}" 'calc-trail-forward)
  506. (define-key calc-mode-map "t." 'calc-full-trail-vectors)
  507. (define-key calc-mode-map "tC" 'calc-convert-time-zones)
  508. (define-key calc-mode-map "tD" 'calc-date)
  509. (define-key calc-mode-map "tI" 'calc-inc-month)
  510. (define-key calc-mode-map "tJ" 'calc-julian)
  511. (define-key calc-mode-map "tM" 'calc-new-month)
  512. (define-key calc-mode-map "tN" 'calc-now)
  513. (define-key calc-mode-map "tP" 'calc-date-part)
  514. (define-key calc-mode-map "tT" 'calc-tan)
  515. (define-key calc-mode-map "tU" 'calc-unix-time)
  516. (define-key calc-mode-map "tW" 'calc-new-week)
  517. (define-key calc-mode-map "tY" 'calc-new-year)
  518. (define-key calc-mode-map "tZ" 'calc-time-zone)
  519. (define-key calc-mode-map "t+" 'calc-business-days-plus)
  520. (define-key calc-mode-map "t-" 'calc-business-days-minus)
  521. (define-key calc-mode-map "u" 'nil)
  522. (define-key calc-mode-map "u?" 'calc-u-prefix-help)
  523. (define-key calc-mode-map "ua" 'calc-autorange-units)
  524. (define-key calc-mode-map "ub" 'calc-base-units)
  525. (define-key calc-mode-map "uc" 'calc-convert-units)
  526. (define-key calc-mode-map "ud" 'calc-define-unit)
  527. (define-key calc-mode-map "ue" 'calc-explain-units)
  528. (define-key calc-mode-map "ug" 'calc-get-unit-definition)
  529. (define-key calc-mode-map "un" 'calc-convert-exact-units)
  530. (define-key calc-mode-map "up" 'calc-permanent-units)
  531. (define-key calc-mode-map "ur" 'calc-remove-units)
  532. (define-key calc-mode-map "us" 'calc-simplify-units)
  533. (define-key calc-mode-map "ut" 'calc-convert-temperature)
  534. (define-key calc-mode-map "uu" 'calc-undefine-unit)
  535. (define-key calc-mode-map "uv" 'calc-enter-units-table)
  536. (define-key calc-mode-map "ux" 'calc-extract-units)
  537. (define-key calc-mode-map "uV" 'calc-view-units-table)
  538. (define-key calc-mode-map "uC" 'calc-vector-covariance)
  539. (define-key calc-mode-map "uG" 'calc-vector-geometric-mean)
  540. (define-key calc-mode-map "uM" 'calc-vector-mean)
  541. (define-key calc-mode-map "uN" 'calc-vector-min)
  542. (define-key calc-mode-map "uR" 'calc-vector-rms)
  543. (define-key calc-mode-map "uS" 'calc-vector-sdev)
  544. (define-key calc-mode-map "uU" 'calc-undo)
  545. (define-key calc-mode-map "uX" 'calc-vector-max)
  546. (define-key calc-mode-map "u#" 'calc-vector-count)
  547. (define-key calc-mode-map "u+" 'calc-vector-sum)
  548. (define-key calc-mode-map "u*" 'calc-vector-product)
  549. (define-key calc-mode-map "v" 'nil)
  550. (define-key calc-mode-map "v?" 'calc-v-prefix-help)
  551. (define-key calc-mode-map "va" 'calc-arrange-vector)
  552. (define-key calc-mode-map "vb" 'calc-build-vector)
  553. (define-key calc-mode-map "vc" 'calc-mcol)
  554. (define-key calc-mode-map "vd" 'calc-diag)
  555. (define-key calc-mode-map "ve" 'calc-expand-vector)
  556. (define-key calc-mode-map "vf" 'calc-vector-find)
  557. (define-key calc-mode-map "vh" 'calc-head)
  558. (define-key calc-mode-map "vi" 'calc-ident)
  559. (define-key calc-mode-map "vk" 'calc-cons)
  560. (define-key calc-mode-map "vl" 'calc-vlength)
  561. (define-key calc-mode-map "vm" 'calc-mask-vector)
  562. (define-key calc-mode-map "vn" 'calc-rnorm)
  563. (define-key calc-mode-map "vp" 'calc-pack)
  564. (define-key calc-mode-map "vr" 'calc-mrow)
  565. (define-key calc-mode-map "vs" 'calc-subvector)
  566. (define-key calc-mode-map "vt" 'calc-transpose)
  567. (define-key calc-mode-map "vu" 'calc-unpack)
  568. (define-key calc-mode-map "vv" 'calc-reverse-vector)
  569. (define-key calc-mode-map "vx" 'calc-index)
  570. (define-key calc-mode-map "vA" 'calc-apply)
  571. (define-key calc-mode-map "vC" 'calc-cross)
  572. (define-key calc-mode-map "vK" 'calc-kron)
  573. (define-key calc-mode-map "vD" 'calc-mdet)
  574. (define-key calc-mode-map "vE" 'calc-set-enumerate)
  575. (define-key calc-mode-map "vF" 'calc-set-floor)
  576. (define-key calc-mode-map "vG" 'calc-grade)
  577. (define-key calc-mode-map "vH" 'calc-histogram)
  578. (define-key calc-mode-map "vI" 'calc-inner-product)
  579. (define-key calc-mode-map "vJ" 'calc-conj-transpose)
  580. (define-key calc-mode-map "vL" 'calc-mlud)
  581. (define-key calc-mode-map "vM" 'calc-map)
  582. (define-key calc-mode-map "vN" 'calc-cnorm)
  583. (define-key calc-mode-map "vO" 'calc-outer-product)
  584. (define-key calc-mode-map "vR" 'calc-reduce)
  585. (define-key calc-mode-map "vS" 'calc-sort)
  586. (define-key calc-mode-map "vT" 'calc-mtrace)
  587. (define-key calc-mode-map "vU" 'calc-accumulate)
  588. (define-key calc-mode-map "vV" 'calc-set-union)
  589. (define-key calc-mode-map "vX" 'calc-set-xor)
  590. (define-key calc-mode-map "v^" 'calc-set-intersect)
  591. (define-key calc-mode-map "v-" 'calc-set-difference)
  592. (define-key calc-mode-map "v~" 'calc-set-complement)
  593. (define-key calc-mode-map "v:" 'calc-set-span)
  594. (define-key calc-mode-map "v#" 'calc-set-cardinality)
  595. (define-key calc-mode-map "v+" 'calc-remove-duplicates)
  596. (define-key calc-mode-map "v&" 'calc-inv)
  597. (define-key calc-mode-map "v<" 'calc-matrix-left-justify)
  598. (define-key calc-mode-map "v=" 'calc-matrix-center-justify)
  599. (define-key calc-mode-map "v>" 'calc-matrix-right-justify)
  600. (define-key calc-mode-map "v." 'calc-full-vectors)
  601. (define-key calc-mode-map "v/" 'calc-break-vectors)
  602. (define-key calc-mode-map "v," 'calc-vector-commas)
  603. (define-key calc-mode-map "v[" 'calc-vector-brackets)
  604. (define-key calc-mode-map "v]" 'calc-matrix-brackets)
  605. (define-key calc-mode-map "v{" 'calc-vector-braces)
  606. (define-key calc-mode-map "v}" 'calc-matrix-brackets)
  607. (define-key calc-mode-map "v(" 'calc-vector-parens)
  608. (define-key calc-mode-map "v)" 'calc-matrix-brackets)
  609. ;; We can't rely on the automatic upper->lower conversion because
  610. ;; in the global map V is explicitly bound, so we need to bind it
  611. ;; explicitly as well :-( --stef
  612. (define-key calc-mode-map "V" (lookup-key calc-mode-map "v"))
  613. (define-key calc-mode-map "z" 'nil)
  614. (define-key calc-mode-map "z?" 'calc-z-prefix-help)
  615. (define-key calc-mode-map "Z" 'nil)
  616. (define-key calc-mode-map "Z?" 'calc-shift-Z-prefix-help)
  617. (define-key calc-mode-map "ZC" 'calc-user-define-composition)
  618. (define-key calc-mode-map "ZD" 'calc-user-define)
  619. (define-key calc-mode-map "ZE" 'calc-user-define-edit)
  620. (define-key calc-mode-map "ZF" 'calc-user-define-formula)
  621. (define-key calc-mode-map "ZG" 'calc-get-user-defn)
  622. (define-key calc-mode-map "ZI" 'calc-user-define-invocation)
  623. (define-key calc-mode-map "ZK" 'calc-user-define-kbd-macro)
  624. (define-key calc-mode-map "ZP" 'calc-user-define-permanent)
  625. (define-key calc-mode-map "ZS" 'calc-edit-user-syntax)
  626. (define-key calc-mode-map "ZT" 'calc-timing)
  627. (define-key calc-mode-map "ZU" 'calc-user-undefine)
  628. (define-key calc-mode-map "Z[" 'calc-kbd-if)
  629. (define-key calc-mode-map "Z:" 'calc-kbd-else)
  630. (define-key calc-mode-map "Z|" 'calc-kbd-else-if)
  631. (define-key calc-mode-map "Z]" 'calc-kbd-end-if)
  632. (define-key calc-mode-map "Z<" 'calc-kbd-repeat)
  633. (define-key calc-mode-map "Z>" 'calc-kbd-end-repeat)
  634. (define-key calc-mode-map "Z(" 'calc-kbd-for)
  635. (define-key calc-mode-map "Z)" 'calc-kbd-end-for)
  636. (define-key calc-mode-map "Z{" 'calc-kbd-loop)
  637. (define-key calc-mode-map "Z}" 'calc-kbd-end-loop)
  638. (define-key calc-mode-map "Z/" 'calc-kbd-break)
  639. (define-key calc-mode-map "Z`" 'calc-kbd-push)
  640. (define-key calc-mode-map "Z'" 'calc-kbd-pop)
  641. (define-key calc-mode-map "Z=" 'calc-kbd-report)
  642. (define-key calc-mode-map "Z#" 'calc-kbd-query)
  643. (calc-init-prefixes)
  644. (mapc (function
  645. (lambda (x)
  646. (define-key calc-mode-map (format "c%c" x) 'calc-clean-num)
  647. (define-key calc-mode-map (format "j%c" x) 'calc-select-part)
  648. (define-key calc-mode-map (format "r%c" x) 'calc-recall-quick)
  649. (define-key calc-mode-map (format "s%c" x) 'calc-store-quick)
  650. (define-key calc-mode-map (format "t%c" x) 'calc-store-into-quick)
  651. (define-key calc-mode-map (format "u%c" x) 'calc-quick-units)))
  652. "0123456789")
  653. (let ((i ?A))
  654. (while (<= i ?z)
  655. (if (eq (car-safe (aref (nth 1 calc-mode-map) i)) 'keymap)
  656. (aset (nth 1 calc-mode-map) i
  657. (cons 'keymap (cons (cons ?\e (aref (nth 1 calc-mode-map) i))
  658. (cdr (aref (nth 1 calc-mode-map) i))))))
  659. (setq i (1+ i))))
  660. (setq calc-alg-map (copy-keymap calc-mode-map)
  661. calc-alg-esc-map (copy-keymap esc-map))
  662. (let ((i 32))
  663. (while (< i 127)
  664. (or (memq i '(?' ?` ?= ??))
  665. (aset (nth 1 calc-alg-map) i 'calc-auto-algebraic-entry))
  666. (or (memq i '(?# ?x ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
  667. (aset (nth 1 calc-alg-esc-map) i (aref (nth 1 calc-mode-map) i)))
  668. (setq i (1+ i))))
  669. (define-key calc-alg-map "\e" calc-alg-esc-map)
  670. (define-key calc-alg-map "\e\t" 'calc-roll-up)
  671. (define-key calc-alg-map "\e\C-m" 'calc-last-args-stub)
  672. (define-key calc-alg-map "\e\177" 'calc-pop-above)
  673. ;;;; (Autoloads here)
  674. (mapc (function (lambda (x)
  675. (mapcar (function (lambda (func)
  676. (autoload func (car x)))) (cdr x))))
  677. '(
  678. ("calc-alg" calc-has-rules math-defsimplify
  679. calc-modify-simplify-mode calcFunc-collect calcFunc-esimplify
  680. calcFunc-islin calcFunc-islinnt calcFunc-lin calcFunc-linnt
  681. calcFunc-simplify calcFunc-subst calcFunc-powerexpand math-beforep
  682. math-build-polynomial-expr math-expand-formula math-expr-contains
  683. math-expr-contains-count math-expr-depends math-expr-height
  684. math-expr-subst math-expr-weight math-integer-plus math-is-linear
  685. math-is-multiple math-is-polynomial math-linear-in math-multiple-of
  686. math-poly-depends math-poly-mix math-poly-mul
  687. math-poly-simplify math-poly-zerop math-polynomial-base
  688. math-polynomial-p math-recompile-eval-rules math-simplify
  689. math-simplify-exp math-simplify-extended math-simplify-sqrt
  690. math-to-simple-fraction)
  691. ("calcalg2" calcFunc-asum calcFunc-deriv
  692. calcFunc-ffinv calcFunc-finv calcFunc-fsolve calcFunc-gpoly
  693. calcFunc-integ calcFunc-poly calcFunc-prod calcFunc-roots
  694. calcFunc-solve calcFunc-sum calcFunc-table calcFunc-taylor
  695. calcFunc-tderiv math-expr-calls math-integral-q02 math-integral-q12
  696. math-integral-rational-funcs math-lcm-denoms math-looks-evenp
  697. math-poly-all-roots math-prod-rec math-reject-solution math-solve-eqn
  698. math-solve-for math-sum-rec math-try-integral)
  699. ("calcalg3" calcFunc-efit calcFunc-fit
  700. calcFunc-fitdummy calcFunc-fitparam calcFunc-fitvar
  701. calcFunc-hasfitparams calcFunc-hasfitvars calcFunc-maximize
  702. calcFunc-minimize calcFunc-ninteg calcFunc-polint calcFunc-ratint
  703. calcFunc-root calcFunc-wmaximize calcFunc-wminimize calcFunc-wroot
  704. calcFunc-xfit math-find-minimum math-find-root math-ninteg-evaluate
  705. math-ninteg-midpoint math-ninteg-romberg math-poly-interp)
  706. ("calc-arith" calcFunc-abs calcFunc-abssqr
  707. calcFunc-add calcFunc-ceil calcFunc-decr calcFunc-deven calcFunc-dimag
  708. calcFunc-dint calcFunc-div calcFunc-dnatnum calcFunc-dneg
  709. calcFunc-dnonneg calcFunc-dnonzero calcFunc-dnumint calcFunc-dodd
  710. calcFunc-dpos calcFunc-drange calcFunc-drat calcFunc-dreal
  711. calcFunc-dscalar calcFunc-fceil calcFunc-ffloor calcFunc-float
  712. calcFunc-fround calcFunc-frounde calcFunc-froundu calcFunc-ftrunc
  713. calcFunc-idiv calcFunc-incr calcFunc-ldiv calcFunc-mant calcFunc-max calcFunc-min
  714. calcFunc-mod calcFunc-mul calcFunc-neg calcFunc-percent calcFunc-pow
  715. calcFunc-relch calcFunc-round calcFunc-rounde calcFunc-roundu
  716. calcFunc-scf calcFunc-sub calcFunc-xpon math-abs math-abs-approx
  717. math-add-objects-fancy math-add-or-sub math-add-symb-fancy
  718. math-ceiling math-combine-prod math-combine-sum math-div-by-zero
  719. math-div-objects-fancy math-div-symb-fancy math-div-zero
  720. math-float-fancy math-floor-fancy math-floor-special math-guess-if-neg
  721. math-intv-constp math-known-evenp math-known-imagp math-known-integerp
  722. math-known-matrixp math-known-negp math-known-nonnegp
  723. math-known-nonposp math-known-nonzerop math-known-num-integerp
  724. math-known-oddp math-known-posp math-known-realp math-known-scalarp
  725. math-max math-min math-mod-fancy math-mul-float math-mul-objects-fancy
  726. math-mul-or-div math-mul-symb-fancy math-mul-zero math-neg-fancy
  727. math-neg-float math-okay-neg math-possible-signs math-possible-types
  728. math-pow-fancy math-pow-mod math-pow-of-zero math-pow-zero
  729. math-quarter-integer math-round math-setup-declarations math-sqr
  730. math-sqr-float math-trunc-fancy math-trunc-special)
  731. ("calc-bin" calcFunc-and calcFunc-ash
  732. calcFunc-clip calcFunc-diff calcFunc-lsh calcFunc-not calcFunc-or
  733. calcFunc-rash calcFunc-rot calcFunc-rsh calcFunc-xor math-clip
  734. math-compute-max-digits math-convert-radix-digits math-float-parts
  735. math-format-bignum-binary math-format-bignum-hex
  736. math-format-bignum-octal math-format-bignum-radix math-format-binary
  737. math-format-radix math-format-radix-float math-integer-log2
  738. math-power-of-2 math-radix-float-power)
  739. ("calc-comb" calc-report-prime-test
  740. calcFunc-choose calcFunc-dfact calcFunc-egcd calcFunc-fact
  741. calcFunc-gcd calcFunc-lcm calcFunc-moebius calcFunc-nextprime
  742. calcFunc-perm calcFunc-prevprime calcFunc-prfac calcFunc-prime
  743. calcFunc-random calcFunc-shuffle calcFunc-stir1 calcFunc-stir2
  744. calcFunc-totient math-init-random-base math-member math-prime-test
  745. math-random-base)
  746. ("calccomp" calcFunc-cascent calcFunc-cdescent
  747. calcFunc-cheight calcFunc-cwidth math-comp-ascent math-comp-descent
  748. math-comp-height math-comp-width math-compose-expr
  749. math-composition-to-string math-stack-value-offset-fancy
  750. math-vector-is-string math-vector-to-string)
  751. ("calc-cplx" calcFunc-arg calcFunc-conj
  752. calcFunc-im calcFunc-polar calcFunc-re calcFunc-rect math-complex
  753. math-fix-circular math-imaginary math-imaginary-i math-normalize-polar
  754. math-polar math-want-polar)
  755. ("calc-embed" calc-do-embedded
  756. calc-do-embedded-activate calc-embedded-evaluate-expr
  757. calc-embedded-modes-change calc-embedded-var-change
  758. calc-embedded-preserve-modes)
  759. ("calc-fin" calc-to-percentage calcFunc-ddb
  760. calcFunc-fv calcFunc-fvb calcFunc-fvl calcFunc-irr calcFunc-irrb
  761. calcFunc-nper calcFunc-nperb calcFunc-nperl calcFunc-npv calcFunc-npvb
  762. calcFunc-pmt calcFunc-pmtb calcFunc-pv calcFunc-pvb calcFunc-pvl
  763. calcFunc-rate calcFunc-rateb calcFunc-ratel calcFunc-sln calcFunc-syd)
  764. ("calc-forms" calcFunc-badd calcFunc-bsub
  765. calcFunc-date calcFunc-day calcFunc-dsadj calcFunc-hms
  766. calcFunc-holiday calcFunc-hour calcFunc-incmonth calcFunc-incyear
  767. calcFunc-intv calcFunc-julian calcFunc-makemod calcFunc-minute
  768. calcFunc-month calcFunc-newmonth calcFunc-newweek calcFunc-newyear
  769. calcFunc-now calcFunc-pwday calcFunc-sdev calcFunc-second
  770. calcFunc-time calcFunc-tzconv calcFunc-tzone calcFunc-unixtime
  771. calcFunc-weekday calcFunc-year calcFunc-yearday math-combine-intervals
  772. math-date-parts math-date-to-dt math-div-mod math-dt-to-date
  773. math-format-date math-from-business-day math-from-hms math-make-intv
  774. math-make-mod math-make-sdev math-mod-intv math-normalize-hms
  775. math-normalize-mod math-parse-date math-read-angle-brackets
  776. math-setup-add-holidays math-setup-holidays math-setup-year-holidays
  777. math-sort-intv math-to-business-day math-to-hms)
  778. ("calc-frac" calc-add-fractions
  779. calc-div-fractions calc-mul-fractions calcFunc-fdiv calcFunc-frac
  780. math-make-frac)
  781. ("calc-funcs" calc-prob-dist calcFunc-bern
  782. calcFunc-besJ calcFunc-besY calcFunc-beta calcFunc-betaB
  783. calcFunc-betaI calcFunc-erf calcFunc-erfc calcFunc-euler
  784. calcFunc-gamma calcFunc-gammaG calcFunc-gammaP calcFunc-gammaQ
  785. calcFunc-gammag calcFunc-ltpb calcFunc-ltpc calcFunc-ltpf
  786. calcFunc-ltpn calcFunc-ltpp calcFunc-ltpt calcFunc-utpb calcFunc-utpc
  787. calcFunc-utpf calcFunc-utpn calcFunc-utpp calcFunc-utpt
  788. math-bernoulli-number math-gammap1-raw)
  789. ("calc-graph" calc-graph-show-tty)
  790. ("calc-incom" calc-digit-dots)
  791. ("calc-keypd" calc-do-keypad
  792. calc-keypad-x-left-click calc-keypad-x-middle-click
  793. calc-keypad-x-right-click)
  794. ("calc-lang" calc-set-language
  795. math-read-big-balance math-read-big-rec)
  796. ("calc-map" calc-get-operator calcFunc-accum
  797. calcFunc-afixp calcFunc-anest calcFunc-apply calcFunc-call
  798. calcFunc-fixp calcFunc-inner calcFunc-map calcFunc-mapa calcFunc-mapc
  799. calcFunc-mapd calcFunc-mapeq calcFunc-mapeqp calcFunc-mapeqr
  800. calcFunc-mapr calcFunc-nest calcFunc-outer calcFunc-raccum
  801. calcFunc-reduce calcFunc-reducea calcFunc-reducec calcFunc-reduced
  802. calcFunc-reducer calcFunc-rreduce calcFunc-rreducea calcFunc-rreducec
  803. calcFunc-rreduced calcFunc-rreducer math-build-call
  804. math-calcFunc-to-var math-multi-subst math-multi-subst-rec
  805. math-var-to-calcFunc)
  806. ("calc-mtx" calcFunc-det calcFunc-lud calcFunc-tr
  807. math-col-matrix math-lud-solve math-matrix-inv-raw math-matrix-lud
  808. math-mul-mat-vec math-mul-mats math-row-matrix)
  809. ("calc-math" calcFunc-alog calcFunc-arccos
  810. calcFunc-arccosh calcFunc-arcsin calcFunc-arcsincos calcFunc-arcsinh
  811. calcFunc-arctan calcFunc-arctan2 calcFunc-arctanh calcFunc-csc
  812. calcFunc-csch calcFunc-cos calcFunc-cosh calcFunc-cot calcFunc-coth
  813. calcFunc-deg calcFunc-exp calcFunc-exp10 calcFunc-expm1
  814. calcFunc-hypot calcFunc-ilog calcFunc-isqrt calcFunc-ln calcFunc-lnp1
  815. calcFunc-log calcFunc-log10 calcFunc-nroot calcFunc-rad calcFunc-sec
  816. calcFunc-sech calcFunc-sin
  817. calcFunc-sincos calcFunc-sinh calcFunc-sqr calcFunc-sqrt calcFunc-tan
  818. calcFunc-tanh math-arccos-raw math-arcsin-raw math-arctan-raw
  819. math-arctan2-raw math-cos-raw math-cot-raw math-csc-raw
  820. math-exp-minus-1-raw math-exp-raw
  821. math-from-radians math-from-radians-2 math-hypot math-infinite-dir
  822. math-isqrt-small math-ln-raw math-nearly-equal math-nearly-equal-float
  823. math-nearly-zerop math-nearly-zerop-float math-nth-root
  824. math-sin-cos-raw math-sin-raw math-sqrt math-sqrt-float math-sqrt-raw
  825. math-tan-raw math-to-radians math-to-radians-2)
  826. ("calc-mode" math-get-modes-vec)
  827. ("calc-poly" calcFunc-apart calcFunc-expand
  828. calcFunc-expandpow calcFunc-factor calcFunc-factors calcFunc-nrat
  829. calcFunc-pcont calcFunc-pdeg calcFunc-pdiv calcFunc-pdivide
  830. calcFunc-pdivrem calcFunc-pgcd calcFunc-plead calcFunc-pprim
  831. calcFunc-prem math-accum-factors math-atomic-factorp
  832. math-div-poly-const math-div-thru math-expand-power math-expand-term
  833. math-factor-contains math-factor-expr math-factor-expr-part
  834. math-factor-expr-try math-factor-finish math-factor-poly-coefs
  835. math-factor-protect math-mul-thru math-padded-polynomial
  836. math-partial-fractions math-poly-degree math-poly-deriv-coefs
  837. math-poly-gcd-frac-list math-poly-modulus-rec math-ratpoly-p
  838. math-to-ratpoly math-to-ratpoly-rec)
  839. ("calc-prog" calc-default-formula-arglist
  840. calc-execute-kbd-macro calc-finish-user-syntax-edit
  841. calc-fix-token-name calc-fix-user-formula calc-read-parse-table
  842. calc-read-parse-table-part calc-subsetp calc-write-parse-table
  843. calc-write-parse-table-part calcFunc-constant calcFunc-eq calcFunc-geq
  844. calcFunc-gt calcFunc-if calcFunc-in calcFunc-integer calcFunc-istrue
  845. calcFunc-land calcFunc-leq calcFunc-lnot calcFunc-lor calcFunc-lt
  846. calcFunc-negative calcFunc-neq calcFunc-nonvar calcFunc-real
  847. calcFunc-refers calcFunc-rmeq calcFunc-typeof calcFunc-variable
  848. math-body-refers-to math-break math-composite-inequalities
  849. math-do-defmath math-handle-for math-handle-foreach
  850. math-normalize-logical-op math-return)
  851. ("calc-rewr" calcFunc-match calcFunc-matches
  852. calcFunc-matchnot calcFunc-rewrite calcFunc-vmatches
  853. math-apply-rewrites math-compile-patterns math-compile-rewrites
  854. math-flatten-lands math-match-patterns math-rewrite
  855. math-rewrite-heads)
  856. ("calc-rules" calc-CommuteRules calc-DistribRules calc-FactorRules
  857. calc-FitRules calc-IntegAfterRules calc-InvertRules calc-JumpRules
  858. calc-MergeRules calc-NegateRules
  859. calc-compile-rule-set)
  860. ("calc-sel" calc-auto-selection
  861. calc-delete-selection calc-encase-atoms calc-find-assoc-parent-formula
  862. calc-find-parent-formula calc-find-sub-formula calc-prepare-selection
  863. calc-preserve-point calc-replace-selections calc-replace-sub-formula
  864. calc-roll-down-with-selections calc-roll-up-with-selections
  865. calc-sel-error)
  866. ("calc-stat" calc-vector-op calcFunc-agmean calcFunc-rms
  867. calcFunc-vcorr calcFunc-vcount calcFunc-vcov calcFunc-vflat
  868. calcFunc-vgmean calcFunc-vhmean calcFunc-vmax calcFunc-vmean
  869. calcFunc-vmeane calcFunc-vmedian calcFunc-vmin calcFunc-vpcov
  870. calcFunc-vprod calcFunc-vpsdev calcFunc-vpvar calcFunc-vsdev
  871. calcFunc-vsum calcFunc-vvar math-flatten-many-vecs)
  872. ("calc-store" calc-read-var-name
  873. calc-store-value calc-var-name)
  874. ("calc-stuff" calc-explain-why calcFunc-clean
  875. calcFunc-pclean calcFunc-pfloat calcFunc-pfrac)
  876. ("calc-units" calcFunc-usimplify calcFunc-lufadd calcFunc-lupadd
  877. calcFunc-lufsub calcFunc-lupsub calcFunc-lufmul calcFunc-lupmul
  878. calcFunc-lufdiv calcFunc-lupdiv calcFunc-lufquant calcFunc-lupquant
  879. calcFunc-dbfield calcFunc-dbpower calcFunc-npfield
  880. calcFunc-nppower calcFunc-spn calcFunc-midi calcFunc-freq
  881. math-build-units-table math-build-units-table-buffer
  882. math-check-unit-name math-convert-temperature math-convert-units
  883. math-extract-units math-remove-units math-simplify-units
  884. math-single-units-in-expr-p math-to-standard-units
  885. math-units-in-expr-p)
  886. ("calc-vec" calcFunc-append calcFunc-appendrev
  887. calcFunc-arrange calcFunc-cnorm calcFunc-cons calcFunc-cross
  888. calcFunc-kron calcFunc-ctrn calcFunc-cvec calcFunc-diag calcFunc-find
  889. calcFunc-getdiag calcFunc-grade calcFunc-head calcFunc-histogram
  890. calcFunc-idn calcFunc-index calcFunc-mcol calcFunc-mdims
  891. calcFunc-mrcol calcFunc-mrow calcFunc-mrrow calcFunc-pack
  892. calcFunc-rcons calcFunc-rdup calcFunc-rev calcFunc-rgrade
  893. calcFunc-rhead calcFunc-rnorm calcFunc-rsort calcFunc-rsubvec
  894. calcFunc-rtail calcFunc-sort calcFunc-subscr calcFunc-subvec
  895. calcFunc-tail calcFunc-trn calcFunc-unpack calcFunc-unpackt
  896. calcFunc-vcard calcFunc-vcompl calcFunc-vconcat calcFunc-vconcatrev
  897. calcFunc-vdiff calcFunc-vec calcFunc-venum calcFunc-vexp
  898. calcFunc-vfloor calcFunc-vint calcFunc-vlen calcFunc-vmask
  899. calcFunc-vpack calcFunc-vspan calcFunc-vunion calcFunc-vunpack
  900. calcFunc-vxor math-check-for-commas math-clean-set math-copy-matrix
  901. math-dimension-error math-dot-product math-flatten-vector math-map-vec
  902. math-map-vec-2 math-mat-col math-mimic-ident math-prepare-set
  903. math-read-brackets math-reduce-cols math-reduce-vec math-transpose)
  904. ("calc-yank" calc-alg-edit calc-clean-newlines
  905. calc-do-grab-rectangle calc-do-grab-region calc-finish-stack-edit
  906. calc-copy-to-register calc-insert-register
  907. calc-append-to-register calc-prepend-to-register
  908. calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer)
  909. ))
  910. (mapcar (function (lambda (x)
  911. (mapcar (function (lambda (cmd)
  912. (autoload cmd (car x) nil t))) (cdr x))))
  913. '(
  914. ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand
  915. calc-expand-formula calc-factor calc-normalize-rat calc-poly-div
  916. calc-poly-div-rem calc-poly-gcd calc-poly-rem calc-simplify
  917. calc-simplify-extended calc-substitute calc-powerexpand)
  918. ("calcalg2" calc-alt-summation calc-derivative
  919. calc-dump-integral-cache calc-integral calc-num-integral
  920. calc-poly-roots calc-product calc-solve-for calc-summation
  921. calc-tabulate calc-taylor)
  922. ("calcalg3" calc-curve-fit calc-find-maximum calc-find-minimum
  923. calc-find-root calc-poly-interp)
  924. ("calc-arith" calc-abs calc-abssqr calc-ceiling calc-decrement
  925. calc-floor calc-idiv calc-increment calc-mant-part calc-max calc-min
  926. calc-round calc-scale-float calc-sign calc-trunc calc-xpon-part)
  927. ("calc-bin" calc-and calc-binary-radix calc-clip calc-twos-complement-mode
  928. calc-decimal-radix calc-diff calc-hex-radix calc-leading-zeros
  929. calc-lshift-arith calc-lshift-binary calc-not calc-octal-radix calc-or calc-radix
  930. calc-rotate-binary calc-rshift-arith calc-rshift-binary calc-word-size
  931. calc-xor)
  932. ("calc-comb" calc-choose calc-double-factorial calc-extended-gcd
  933. calc-factorial calc-gamma calc-gcd calc-lcm calc-moebius
  934. calc-next-prime calc-perm calc-prev-prime calc-prime-factors
  935. calc-prime-test calc-random calc-random-again calc-rrandom
  936. calc-shuffle calc-totient)
  937. ("calc-cplx" calc-argument calc-complex-notation calc-i-notation
  938. calc-im calc-j-notation calc-polar calc-polar-mode calc-re)
  939. ("calc-embed" calc-embedded-copy-formula-as-kill
  940. calc-embedded-duplicate calc-embedded-edit calc-embedded-forget
  941. calc-embedded-kill-formula calc-embedded-mark-formula
  942. calc-embedded-new-formula calc-embedded-next calc-embedded-previous
  943. calc-embedded-select calc-embedded-update-formula calc-embedded-word
  944. calc-find-globals calc-show-plain)
  945. ("calc-fin" calc-convert-percent calc-fin-ddb calc-fin-fv
  946. calc-fin-irr calc-fin-nper calc-fin-npv calc-fin-pmt calc-fin-pv
  947. calc-fin-rate calc-fin-sln calc-fin-syd calc-percent-change)
  948. ("calc-forms" calc-business-days-minus calc-business-days-plus
  949. calc-convert-time-zones calc-date calc-date-notation calc-date-part
  950. calc-from-hms calc-hms-mode calc-hms-notation calc-inc-month
  951. calc-julian calc-new-month calc-new-week calc-new-year calc-now
  952. calc-time calc-time-zone calc-to-hms calc-unix-time)
  953. ("calc-frac" calc-fdiv calc-frac-mode calc-fraction
  954. calc-over-notation calc-slash-notation)
  955. ("calc-funcs" calc-bernoulli-number calc-bessel-J calc-bessel-Y
  956. calc-beta calc-erf calc-erfc calc-euler-number calc-inc-beta
  957. calc-inc-gamma calc-stirling-number calc-utpb calc-utpc calc-utpf
  958. calc-utpn calc-utpp calc-utpt)
  959. ("calc-graph" calc-graph-add calc-graph-add-3d calc-graph-border
  960. calc-graph-clear calc-graph-command calc-graph-delete
  961. calc-graph-device calc-graph-display calc-graph-fast
  962. calc-graph-fast-3d calc-graph-geometry calc-graph-grid
  963. calc-graph-header calc-graph-hide calc-graph-juggle calc-graph-key
  964. calc-graph-kill calc-graph-line-style calc-graph-log-x
  965. calc-graph-log-y calc-graph-log-z calc-graph-name
  966. calc-graph-num-points calc-graph-output calc-graph-plot
  967. calc-graph-point-style calc-graph-print calc-graph-quit
  968. calc-graph-range-x calc-graph-range-y calc-graph-range-z
  969. calc-graph-show-dumb calc-graph-title-x calc-graph-title-y
  970. calc-graph-title-z calc-graph-view-commands calc-graph-view-trail
  971. calc-graph-zero-x calc-graph-zero-y)
  972. ("calc-help" calc-a-prefix-help calc-b-prefix-help calc-c-prefix-help
  973. calc-d-prefix-help calc-describe-function calc-describe-key
  974. calc-describe-key-briefly calc-describe-variable calc-f-prefix-help
  975. calc-full-help calc-g-prefix-help calc-help-prefix
  976. calc-hyperbolic-prefix-help calc-inv-hyp-prefix-help calc-option-prefix-help
  977. calc-inverse-prefix-help calc-j-prefix-help calc-k-prefix-help
  978. calc-m-prefix-help calc-r-prefix-help calc-s-prefix-help
  979. calc-t-prefix-help calc-u-prefix-help calc-l-prefix-help
  980. calc-v-prefix-help)
  981. ("calc-incom" calc-begin-complex calc-begin-vector calc-comma
  982. calc-dots calc-end-complex calc-end-vector calc-semi)
  983. ("calc-keypd" calc-keypad-menu calc-keypad-menu-back
  984. calc-keypad-press)
  985. ("calc-lang" calc-big-language calc-c-language calc-eqn-language
  986. calc-flat-language calc-fortran-language calc-maple-language
  987. calc-yacas-language calc-maxima-language calc-giac-language
  988. calc-mathematica-language calc-normal-language calc-pascal-language
  989. calc-tex-language calc-latex-language calc-unformatted-language)
  990. ("calc-map" calc-accumulate calc-apply calc-inner-product calc-map
  991. calc-map-equation calc-map-stack calc-outer-product calc-reduce)
  992. ("calc-mtx" calc-mdet calc-mlud calc-mtrace)
  993. ("calc-math" calc-arccos calc-arccosh calc-arcsin calc-arcsinh
  994. calc-arctan calc-arctan2 calc-arctanh calc-conj calc-cos calc-cosh
  995. calc-cot calc-coth calc-csc calc-csch
  996. calc-degrees-mode calc-exp calc-expm1 calc-hypot calc-ilog
  997. calc-imaginary calc-isqrt calc-ln calc-lnp1 calc-log calc-log10
  998. calc-pi calc-radians-mode calc-sec calc-sech
  999. calc-sin calc-sincos calc-sinh calc-sqrt
  1000. calc-tan calc-tanh calc-to-degrees calc-to-radians)
  1001. ("calc-mode" calc-alg-simplify-mode calc-algebraic-mode
  1002. calc-always-load-extensions calc-auto-recompute calc-auto-why
  1003. calc-basic-simplify-mode calc-bin-simplify-mode calc-break-vectors
  1004. calc-center-justify calc-default-simplify-mode calc-display-raw
  1005. calc-eng-notation calc-ext-simplify-mode calc-fix-notation
  1006. calc-full-trail-vectors calc-full-vectors calc-get-modes calc-group-char
  1007. calc-group-digits calc-infinite-mode calc-left-justify calc-left-label
  1008. calc-line-breaking calc-line-numbering calc-matrix-brackets
  1009. calc-matrix-center-justify calc-matrix-left-justify calc-matrix-mode
  1010. calc-matrix-right-justify calc-mode-record-mode calc-no-simplify-mode
  1011. calc-normal-notation calc-num-simplify-mode calc-point-char
  1012. calc-right-justify calc-right-label calc-save-modes calc-sci-notation
  1013. calc-settings-file-name calc-shift-prefix calc-symbolic-mode
  1014. calc-total-algebraic-mode calc-truncate-down calc-truncate-stack
  1015. calc-truncate-up calc-units-simplify-mode calc-vector-braces
  1016. calc-vector-brackets calc-vector-commas calc-vector-parens
  1017. calc-working)
  1018. ("calc-prog" calc-call-last-kbd-macro calc-edit-user-syntax
  1019. calc-equal-to calc-get-user-defn calc-greater-equal calc-greater-than
  1020. calc-in-set calc-kbd-break calc-kbd-else calc-kbd-else-if
  1021. calc-kbd-end-for calc-kbd-end-if calc-kbd-end-loop calc-kbd-end-repeat
  1022. calc-kbd-for calc-kbd-if calc-kbd-loop calc-kbd-pop calc-kbd-push
  1023. calc-kbd-query calc-kbd-repeat calc-kbd-report calc-less-equal
  1024. calc-less-than calc-logical-and calc-logical-if calc-logical-not
  1025. calc-logical-or calc-not-equal-to calc-pass-errors calc-remove-equal
  1026. calc-timing calc-user-define calc-user-define-composition
  1027. calc-user-define-edit calc-user-define-formula
  1028. calc-user-define-invocation calc-user-define-kbd-macro
  1029. calc-user-define-permanent calc-user-undefine)
  1030. ("calc-rewr" calc-match calc-rewrite calc-rewrite-selection)
  1031. ("calc-sel" calc-break-selections calc-clear-selections
  1032. calc-copy-selection calc-del-selection calc-edit-selection
  1033. calc-enable-selections calc-enter-selection calc-sel-add-both-sides
  1034. calc-sel-div-both-sides calc-sel-evaluate calc-sel-expand-formula
  1035. calc-sel-mult-both-sides calc-sel-sub-both-sides
  1036. calc-select-additional calc-select-here calc-select-here-maybe
  1037. calc-select-less calc-select-more calc-select-next calc-select-once
  1038. calc-select-once-maybe calc-select-part calc-select-previous
  1039. calc-show-selections calc-unselect)
  1040. ("calcsel2" calc-commute-left calc-commute-right calc-sel-commute
  1041. calc-sel-distribute calc-sel-invert calc-sel-isolate
  1042. calc-sel-jump-equals calc-sel-merge calc-sel-negate calc-sel-unpack)
  1043. ("calc-stat" calc-vector-correlation calc-vector-count
  1044. calc-vector-covariance calc-vector-geometric-mean
  1045. calc-vector-harmonic-mean calc-vector-max calc-vector-mean
  1046. calc-vector-mean-error calc-vector-median calc-vector-min
  1047. calc-vector-pop-covariance calc-vector-pop-sdev
  1048. calc-vector-pop-variance calc-vector-product calc-vector-rms
  1049. calc-vector-sdev calc-vector-sum calc-vector-variance)
  1050. ("calc-store" calc-assign calc-copy-special-constant
  1051. calc-copy-variable calc-declare-variable
  1052. calc-edit-AlgSimpRules calc-edit-Decls calc-edit-EvalRules
  1053. calc-edit-ExtSimpRules calc-edit-FitRules calc-edit-GenCount
  1054. calc-edit-Holidays calc-edit-IntegLimit calc-edit-LineStyles
  1055. calc-edit-PlotRejects calc-edit-PointStyles calc-edit-TimeZone
  1056. calc-edit-Units calc-edit-variable calc-evalto calc-insert-variables
  1057. calc-let calc-permanent-variable calc-recall calc-recall-quick
  1058. calc-store calc-store-concat calc-store-decr calc-store-div
  1059. calc-store-exchange calc-store-incr calc-store-into
  1060. calc-store-into-quick calc-store-inv calc-store-map calc-store-minus
  1061. calc-store-neg calc-store-plus calc-store-power calc-store-quick
  1062. calc-store-times calc-subscript calc-unstore)
  1063. ("calc-stuff" calc-clean calc-clean-num calc-flush-caches
  1064. calc-less-recursion-depth calc-more-recursion-depth calc-num-prefix
  1065. calc-why)
  1066. ("calc-trail" calc-trail-backward calc-trail-first calc-trail-forward
  1067. calc-trail-in calc-trail-isearch-backward calc-trail-isearch-forward
  1068. calc-trail-kill calc-trail-last calc-trail-marker calc-trail-next
  1069. calc-trail-out calc-trail-previous calc-trail-scroll-left
  1070. calc-trail-scroll-right calc-trail-yank)
  1071. ("calc-undo" calc-last-args calc-redo)
  1072. ("calc-units" calc-autorange-units calc-base-units
  1073. calc-convert-temperature calc-convert-units
  1074. calc-convert-exact-units calc-define-unit
  1075. calc-enter-units-table calc-explain-units calc-extract-units
  1076. calc-get-unit-definition calc-permanent-units calc-quick-units
  1077. calc-remove-units calc-simplify-units calc-undefine-unit
  1078. calc-view-units-table calc-lu-quant calc-db
  1079. calc-np calc-lu-plus calc-lu-minus
  1080. calc-lu-times calc-lu-divide calc-spn calc-midi
  1081. calc-freq)
  1082. ("calc-vec" calc-arrange-vector calc-build-vector calc-cnorm
  1083. calc-conj-transpose calc-cons calc-cross calc-kron calc-diag
  1084. calc-display-strings calc-expand-vector calc-grade calc-head
  1085. calc-histogram calc-ident calc-index calc-mask-vector calc-mcol
  1086. calc-mrow calc-pack calc-pack-bits calc-remove-duplicates
  1087. calc-reverse-vector calc-rnorm calc-set-cardinality
  1088. calc-set-complement calc-set-difference calc-set-enumerate
  1089. calc-set-floor calc-set-intersect calc-set-span calc-set-union
  1090. calc-set-xor calc-sort calc-subvector calc-tail calc-transpose
  1091. calc-unpack calc-unpack-bits calc-vector-find calc-vlength)
  1092. ("calc-yank" calc-copy-as-kill calc-copy-region-as-kill
  1093. calc-copy-to-buffer calc-edit calc-edit-cancel calc-edit-mode
  1094. calc-kill calc-kill-region calc-yank))))
  1095. (defun calc-init-prefixes ()
  1096. (if calc-shift-prefix
  1097. (progn
  1098. (define-key calc-mode-map "A" (lookup-key calc-mode-map "a"))
  1099. (define-key calc-mode-map "B" (lookup-key calc-mode-map "b"))
  1100. (define-key calc-mode-map "C" (lookup-key calc-mode-map "c"))
  1101. (define-key calc-mode-map "D" (lookup-key calc-mode-map "d"))
  1102. (define-key calc-mode-map "F" (lookup-key calc-mode-map "f"))
  1103. (define-key calc-mode-map "G" (lookup-key calc-mode-map "g"))
  1104. (define-key calc-mode-map "J" (lookup-key calc-mode-map "j"))
  1105. (define-key calc-mode-map "K" (lookup-key calc-mode-map "k"))
  1106. (define-key calc-mode-map "M" (lookup-key calc-mode-map "m"))
  1107. (define-key calc-mode-map "S" (lookup-key calc-mode-map "s"))
  1108. (define-key calc-mode-map "T" (lookup-key calc-mode-map "t"))
  1109. (define-key calc-mode-map "U" (lookup-key calc-mode-map "u")))
  1110. (define-key calc-mode-map "A" 'calc-abs)
  1111. (define-key calc-mode-map "B" 'calc-log)
  1112. (define-key calc-mode-map "C" 'calc-cos)
  1113. (define-key calc-mode-map "D" 'calc-redo)
  1114. (define-key calc-mode-map "F" 'calc-floor)
  1115. (define-key calc-mode-map "G" 'calc-argument)
  1116. (define-key calc-mode-map "J" 'calc-conj)
  1117. (define-key calc-mode-map "K" 'calc-keep-args)
  1118. (define-key calc-mode-map "M" 'calc-more-recursion-depth)
  1119. (define-key calc-mode-map "S" 'calc-sin)
  1120. (define-key calc-mode-map "T" 'calc-tan)
  1121. (define-key calc-mode-map "U" 'calc-undo)))
  1122. (calc-init-extensions)
  1123. ;;;; Miscellaneous.
  1124. ;; calc-command-flags is declared in calc.el
  1125. (defvar calc-command-flags)
  1126. (defun calc-clear-command-flag (f)
  1127. (setq calc-command-flags (delq f calc-command-flags)))
  1128. (defun calc-record-message (tag &rest args)
  1129. (let ((msg (apply #'format-message args)))
  1130. (message "%s" msg)
  1131. (calc-record msg tag))
  1132. (calc-clear-command-flag 'clear-message))
  1133. (defun calc-normalize-fancy (val)
  1134. (let ((simp (if (consp calc-simplify-mode)
  1135. (car calc-simplify-mode)
  1136. calc-simplify-mode)))
  1137. (cond ((eq simp 'binary)
  1138. (let ((s (math-normalize val)))
  1139. (if (math-realp s)
  1140. (math-clip (math-round s))
  1141. s)))
  1142. ((eq simp 'alg)
  1143. (math-simplify val))
  1144. ((eq simp 'ext)
  1145. (math-simplify-extended val))
  1146. ((eq simp 'units)
  1147. (math-simplify-units val))
  1148. (t ; nil, none, num
  1149. (math-normalize val)))))
  1150. (defvar calc-help-map nil)
  1151. (if calc-help-map
  1152. nil
  1153. (setq calc-help-map (make-keymap))
  1154. (define-key calc-help-map "b" 'calc-describe-bindings)
  1155. (define-key calc-help-map "c" 'calc-describe-key-briefly)
  1156. (define-key calc-help-map "f" 'calc-describe-function)
  1157. (define-key calc-help-map "h" 'calc-full-help)
  1158. (define-key calc-help-map "i" 'calc-info)
  1159. (define-key calc-help-map "k" 'calc-describe-key)
  1160. (define-key calc-help-map "n" 'calc-view-news)
  1161. (define-key calc-help-map "s" 'calc-info-summary)
  1162. (define-key calc-help-map "t" 'calc-tutorial)
  1163. (define-key calc-help-map "v" 'calc-describe-variable)
  1164. (define-key calc-help-map "\C-c" 'calc-describe-copying)
  1165. (define-key calc-help-map "\C-d" 'calc-describe-distribution)
  1166. (define-key calc-help-map "\C-n" 'calc-view-news)
  1167. (define-key calc-help-map "\C-w" 'calc-describe-no-warranty)
  1168. (define-key calc-help-map "?" 'calc-help-for-help)
  1169. (define-key calc-help-map "\C-h" 'calc-help-for-help))
  1170. (defvar calc-prefix-help-retry nil)
  1171. (defvar calc-prefix-help-phase 0)
  1172. (defun calc-do-prefix-help (msgs group key)
  1173. (if calc-full-help-flag
  1174. (list msgs group key)
  1175. (if (cdr msgs)
  1176. (progn
  1177. (setq calc-prefix-help-phase
  1178. (if calc-prefix-help-retry
  1179. (% (1+ calc-prefix-help-phase) (1+ (length msgs)))
  1180. 0))
  1181. (let ((msg (nth calc-prefix-help-phase msgs)))
  1182. (message "%s" (if msg
  1183. (concat group ": " msg ":"
  1184. (make-string
  1185. (- (apply 'max (mapcar 'length msgs))
  1186. (length msg)) 32)
  1187. " [MORE]"
  1188. (if key
  1189. (concat " " (char-to-string key)
  1190. "-")
  1191. ""))
  1192. (if key (format "%c-" key) "")))))
  1193. (setq calc-prefix-help-phase 0)
  1194. (if key
  1195. (if msgs
  1196. (message "%s: %s: %c-" group (car msgs) key)
  1197. (message "%s: (none) %c-" group key))
  1198. (message "%s: %s" group (car msgs))))
  1199. (let* ((chr (read-char))
  1200. (bnd (local-key-binding (if key (string key chr) (string chr)))))
  1201. (setq calc-prefix-help-retry (= chr ??))
  1202. (if bnd
  1203. (call-interactively bnd)
  1204. (message "%s is undefined"
  1205. (key-description (if key (vector key chr) (vector chr))))))))
  1206. ;;;; Commands.
  1207. ;;; General.
  1208. (defun calc-reset (arg)
  1209. (interactive "P")
  1210. (setq arg (if arg (prefix-numeric-value arg) nil))
  1211. (cond
  1212. ((and
  1213. calc-embedded-info
  1214. (equal (aref calc-embedded-info 0) (current-buffer))
  1215. (<= (point) (aref calc-embedded-info 5))
  1216. (>= (point) (aref calc-embedded-info 4)))
  1217. (let ((cbuf (aref calc-embedded-info 1))
  1218. (calc-embedded-quiet t))
  1219. (save-window-excursion
  1220. (calc-embedded nil)
  1221. (set-buffer cbuf)
  1222. (calc-reset arg))
  1223. (calc-embedded nil)))
  1224. ((eq major-mode 'calc-mode)
  1225. (save-excursion
  1226. (unless (and arg (> (abs arg) 0))
  1227. (setq calc-stack nil))
  1228. (setq calc-undo-list nil
  1229. calc-redo-list nil)
  1230. (let (calc-stack calc-user-parse-tables calc-standard-date-formats
  1231. calc-invocation-macro)
  1232. (mapc (function (lambda (v) (set v nil))) calc-local-var-list)
  1233. (if (and arg (<= arg 0))
  1234. (calc-mode-var-list-restore-default-values)
  1235. (calc-mode-var-list-restore-saved-values)))
  1236. (calc-set-language nil nil t)
  1237. (calc-mode)
  1238. (calc-flush-caches t)
  1239. (run-hooks 'calc-reset-hook))
  1240. (calc-wrapper
  1241. (let ((win (get-buffer-window (current-buffer))))
  1242. (calc-realign 0)
  1243. ;; Adjust the window height if the window is visible, but doesn't
  1244. ;; take up the whole height of the frame.
  1245. (if (and
  1246. win
  1247. (not (window-full-height-p)))
  1248. (let ((height (- (window-height win) 2)))
  1249. (set-window-point win (point))
  1250. (or (= height calc-window-height)
  1251. (let ((swin (selected-window)))
  1252. (select-window win)
  1253. (enlarge-window (- calc-window-height height))
  1254. (select-window swin)))))))
  1255. (message "(Calculator reset)"))
  1256. (t
  1257. (message "(Not inside a Calc buffer)"))))
  1258. ;; What a pain; scroll-left behaves differently when called non-interactively.
  1259. (defun calc-scroll-left (n)
  1260. (interactive "P")
  1261. (setq prefix-arg (or n (/ (window-width) 2)))
  1262. (call-interactively #'scroll-left))
  1263. (defun calc-scroll-right (n)
  1264. (interactive "P")
  1265. (setq prefix-arg (or n (/ (window-width) 2)))
  1266. (call-interactively #'scroll-right))
  1267. (defun calc-scroll-up (n)
  1268. (interactive "P")
  1269. (condition-case err
  1270. (scroll-up (or n (/ (window-height) 2)))
  1271. (error nil))
  1272. (if (pos-visible-in-window-p (max 1 (- (point-max) 2)))
  1273. (if (eq major-mode 'calc-mode)
  1274. (calc-realign)
  1275. (goto-char (point-max))
  1276. (set-window-start (selected-window)
  1277. (save-excursion
  1278. (forward-line (- (1- (window-height))))
  1279. (point)))
  1280. (forward-line -1))))
  1281. (defun calc-scroll-down (n)
  1282. (interactive "P")
  1283. (or (pos-visible-in-window-p 1)
  1284. (scroll-down (or n (/ (window-height) 2)))))
  1285. (defun calc-precision (n)
  1286. (interactive "NPrecision: ")
  1287. (calc-wrapper
  1288. (if (< (prefix-numeric-value n) 3)
  1289. (error "Precision must be at least 3 digits")
  1290. (calc-change-mode 'calc-internal-prec (prefix-numeric-value n)
  1291. (and (memq (car calc-float-format) '(float sci eng))
  1292. (< (nth 1 calc-float-format)
  1293. (if (= calc-number-radix 10) 0 1))))
  1294. (calc-record calc-internal-prec "prec"))
  1295. (message "Floating-point precision is %d digits" calc-internal-prec)))
  1296. (defun calc-inverse (&optional n)
  1297. (interactive "P")
  1298. (let* ((hyp-flag (if (or
  1299. (eq major-mode 'calc-keypad-mode)
  1300. (eq major-mode 'calc-trail-mode))
  1301. (with-current-buffer calc-main-buffer
  1302. calc-hyperbolic-flag)
  1303. calc-hyperbolic-flag))
  1304. (opt-flag (if (or
  1305. (eq major-mode 'calc-keypad-mode)
  1306. (eq major-mode 'calc-trail-mode))
  1307. (with-current-buffer calc-main-buffer
  1308. calc-option-flag)
  1309. calc-option-flag))
  1310. (msg
  1311. (cond
  1312. ((and opt-flag hyp-flag) "Option Inverse Hyperbolic...")
  1313. (hyp-flag "Inverse Hyperbolic...")
  1314. (opt-flag "Option Inverse...")
  1315. (t "Inverse..."))))
  1316. (calc-fancy-prefix 'calc-inverse-flag msg n)))
  1317. (defconst calc-fancy-prefix-map
  1318. (let ((map (make-sparse-keymap)))
  1319. (define-key map [t] 'calc-fancy-prefix-other-key)
  1320. (define-key map (vector meta-prefix-char t) 'calc-fancy-prefix-other-key)
  1321. (define-key map [switch-frame] nil)
  1322. (define-key map [?\C-u] 'universal-argument)
  1323. (define-key map [?0] 'digit-argument)
  1324. (define-key map [?1] 'digit-argument)
  1325. (define-key map [?2] 'digit-argument)
  1326. (define-key map [?3] 'digit-argument)
  1327. (define-key map [?4] 'digit-argument)
  1328. (define-key map [?5] 'digit-argument)
  1329. (define-key map [?6] 'digit-argument)
  1330. (define-key map [?7] 'digit-argument)
  1331. (define-key map [?8] 'digit-argument)
  1332. (define-key map [?9] 'digit-argument)
  1333. map)
  1334. "Keymap used while processing calc-fancy-prefix.")
  1335. (defvar calc-is-keypad-press nil)
  1336. (defun calc-fancy-prefix (flag msg n)
  1337. (let (prefix)
  1338. (calc-wrapper
  1339. (calc-set-command-flag 'keep-flags)
  1340. (calc-set-command-flag 'no-align)
  1341. (setq prefix (set flag (not (symbol-value flag)))
  1342. prefix-arg n)
  1343. (message "%s" (if prefix msg "")))
  1344. (and prefix
  1345. (not calc-is-keypad-press)
  1346. (if (boundp 'overriding-terminal-local-map)
  1347. (setq overriding-terminal-local-map calc-fancy-prefix-map)
  1348. (let ((event (calc-read-key t)))
  1349. (if (eq (setq last-command-event (car event)) ?\C-u)
  1350. (universal-argument)
  1351. (if (or (not (integerp last-command-event))
  1352. (and (>= last-command-event 0) (< last-command-event ? )
  1353. (not (memq last-command-event '(?\e)))))
  1354. (calc-wrapper)) ; clear flags if not a Calc command.
  1355. (setq last-command-event (cdr event))
  1356. (if (or (not (integerp last-command-event))
  1357. (eq last-command-event ?-))
  1358. (calc-unread-command)
  1359. (digit-argument n))))))))
  1360. (defun calc-fancy-prefix-other-key (arg)
  1361. (interactive "P")
  1362. (if (and
  1363. (not (eq last-command-event 'tab))
  1364. (not (eq last-command-event 'M-tab))
  1365. (or (not (integerp last-command-event))
  1366. (and (>= last-command-event 0) (< last-command-event ? )
  1367. (not (eq last-command-event meta-prefix-char)))))
  1368. (calc-wrapper)) ; clear flags if not a Calc command.
  1369. (setq prefix-arg arg)
  1370. (calc-unread-command)
  1371. (setq overriding-terminal-local-map nil))
  1372. (defun calc-invert-func ()
  1373. (save-excursion
  1374. (calc-select-buffer)
  1375. (setq calc-inverse-flag (not (calc-is-inverse))
  1376. calc-hyperbolic-flag (calc-is-hyperbolic)
  1377. current-prefix-arg nil)))
  1378. (defun calc-is-inverse ()
  1379. calc-inverse-flag)
  1380. (defun calc-hyperbolic (&optional n)
  1381. (interactive "P")
  1382. (let* ((inv-flag (if (or
  1383. (eq major-mode 'calc-keypad-mode)
  1384. (eq major-mode 'calc-trail-mode))
  1385. (with-current-buffer calc-main-buffer
  1386. calc-inverse-flag)
  1387. calc-inverse-flag))
  1388. (opt-flag (if (or
  1389. (eq major-mode 'calc-keypad-mode)
  1390. (eq major-mode 'calc-trail-mode))
  1391. (with-current-buffer calc-main-buffer
  1392. calc-option-flag)
  1393. calc-option-flag))
  1394. (msg
  1395. (cond
  1396. ((and opt-flag inv-flag) "Option Inverse Hyperbolic...")
  1397. (opt-flag "Option Hyperbolic...")
  1398. (inv-flag "Inverse Hyperbolic...")
  1399. (t "Hyperbolic..."))))
  1400. (calc-fancy-prefix 'calc-hyperbolic-flag msg n)))
  1401. (defun calc-hyperbolic-func ()
  1402. (save-excursion
  1403. (calc-select-buffer)
  1404. (setq calc-inverse-flag (calc-is-inverse)
  1405. calc-hyperbolic-flag (not (calc-is-hyperbolic))
  1406. current-prefix-arg nil)))
  1407. (defun calc-is-hyperbolic ()
  1408. calc-hyperbolic-flag)
  1409. (defun calc-option (&optional n)
  1410. (interactive "P")
  1411. (let* ((inv-flag (if (or
  1412. (eq major-mode 'calc-keypad-mode)
  1413. (eq major-mode 'calc-trail-mode))
  1414. (with-current-buffer calc-main-buffer
  1415. calc-inverse-flag)
  1416. calc-inverse-flag))
  1417. (hyp-flag (if (or
  1418. (eq major-mode 'calc-keypad-mode)
  1419. (eq major-mode 'calc-trail-mode))
  1420. (with-current-buffer calc-main-buffer
  1421. calc-hyperbolic-flag)
  1422. calc-hyperbolic-flag))
  1423. (msg
  1424. (cond
  1425. ((and hyp-flag inv-flag) "Option Inverse Hyperbolic...")
  1426. (hyp-flag "Option Hyperbolic...")
  1427. (inv-flag "Option Inverse...")
  1428. (t "Option..."))))
  1429. (calc-fancy-prefix 'calc-option-flag msg n)))
  1430. (defun calc-is-option ()
  1431. calc-option-flag)
  1432. (defun calc-keep-args (&optional n)
  1433. (interactive "P")
  1434. (calc-fancy-prefix 'calc-keep-args-flag "Keep args..." n))
  1435. (defun calc-change-mode (var value &optional refresh option)
  1436. (if option
  1437. (setq value (if value
  1438. (> (prefix-numeric-value value) 0)
  1439. (not (symbol-value var)))))
  1440. (or (consp var) (setq var (list var) value (list value)))
  1441. (if calc-inverse-flag
  1442. (let ((old nil))
  1443. (or refresh (error "Not a display-mode command"))
  1444. (calc-check-stack 1)
  1445. (unwind-protect
  1446. (let ((v var))
  1447. (while v
  1448. (setq old (cons (symbol-value (car v)) old))
  1449. (set (car v) (car value))
  1450. (setq v (cdr v)
  1451. value (cdr value)))
  1452. (calc-refresh-top 1)
  1453. (calc-refresh-evaltos)
  1454. (symbol-value (car var)))
  1455. (let ((v var))
  1456. (setq old (nreverse old))
  1457. (while v
  1458. (set (car v) (car old))
  1459. (setq v (cdr v)
  1460. old (cdr old)))
  1461. (if (eq (car var) 'calc-language)
  1462. (calc-set-language calc-language calc-language-option t)))))
  1463. (let ((chg nil)
  1464. (v var))
  1465. (while v
  1466. (or (equal (symbol-value (car v)) (car value))
  1467. (progn
  1468. (set (car v) (car value))
  1469. (if (eq (car v) 'calc-float-format)
  1470. (setq calc-full-float-format
  1471. (list (if (eq (car (car value)) 'fix)
  1472. 'float
  1473. (car (car value)))
  1474. 0)))
  1475. (setq chg t)))
  1476. (setq v (cdr v)
  1477. value (cdr value)))
  1478. (if chg
  1479. (progn
  1480. (or (and refresh (calc-do-refresh))
  1481. (calc-refresh-evaltos))
  1482. (and (eq calc-mode-save-mode 'save)
  1483. (not (equal var '(calc-mode-save-mode)))
  1484. (calc-save-modes))))
  1485. (if calc-embedded-info (calc-embedded-modes-change var))
  1486. (calc-set-mode-line)
  1487. (symbol-value (car var)))))
  1488. (defun calc-toggle-banner ()
  1489. "Toggle display of the friendly greeting calc normally shows above the stack."
  1490. (interactive)
  1491. (setq calc-show-banner (not calc-show-banner))
  1492. (calc-refresh))
  1493. (defun calc-refresh-top (n)
  1494. (interactive "p")
  1495. (calc-wrapper
  1496. (cond ((< n 0)
  1497. (setq n (- n))
  1498. (let ((entry (calc-top n 'entry))
  1499. (calc-undo-list nil) (calc-redo-list nil))
  1500. (calc-pop-stack 1 n t)
  1501. (calc-push-list (list (car entry)) n (list (nth 2 entry)))))
  1502. ((= n 0)
  1503. (calc-refresh))
  1504. (t
  1505. (let ((entries (calc-top-list n 1 'entry))
  1506. (calc-undo-list nil) (calc-redo-list nil))
  1507. (calc-pop-stack n 1 t)
  1508. (calc-push-list (mapcar 'car entries)
  1509. 1
  1510. (mapcar (function (lambda (x) (nth 2 x)))
  1511. entries)))))))
  1512. (defvar calc-refreshing-evaltos nil)
  1513. (defvar calc-no-refresh-evaltos nil)
  1514. (defun calc-refresh-evaltos (&optional which-var)
  1515. (and calc-any-evaltos calc-auto-recompute (not calc-no-refresh-evaltos)
  1516. (let ((calc-refreshing-evaltos t)
  1517. (num (calc-stack-size))
  1518. (calc-undo-list nil) (calc-redo-list nil)
  1519. value new-val)
  1520. (while (> num 0)
  1521. (setq value (calc-top num 'entry))
  1522. (if (and (not (nth 2 value))
  1523. (setq value (car value))
  1524. (or (eq (car-safe value) 'calcFunc-evalto)
  1525. (and (eq (car-safe value) 'vec)
  1526. (eq (car-safe (nth 1 value)) 'calcFunc-evalto))))
  1527. (progn
  1528. (setq new-val (math-normalize value))
  1529. (or (equal new-val value)
  1530. (progn
  1531. (calc-push-list (list new-val) num)
  1532. (calc-pop-stack 1 (1+ num) t)))))
  1533. (setq num (1- num)))))
  1534. (and calc-embedded-active which-var
  1535. (calc-embedded-var-change which-var)))
  1536. (defun calc-push (&rest vals)
  1537. (calc-push-list vals))
  1538. (defun calc-pop-push (n &rest vals)
  1539. (calc-pop-push-list n vals))
  1540. (defun calc-pop-push-record (n prefix &rest vals)
  1541. (calc-pop-push-record-list n prefix vals))
  1542. (defun calc-evaluate (n)
  1543. (interactive "p")
  1544. (calc-slow-wrapper
  1545. (if (= n 0)
  1546. (setq n (calc-stack-size)))
  1547. (calc-with-default-simplification
  1548. (if (< n 0)
  1549. (calc-pop-push-record-list 1 "eval"
  1550. (math-evaluate-expr (calc-top (- n)))
  1551. (- n))
  1552. (calc-pop-push-record-list n "eval" (mapcar 'math-evaluate-expr
  1553. (calc-top-list n)))))
  1554. (calc-handle-whys)))
  1555. (defun calc-eval-num (n)
  1556. (interactive "P")
  1557. (calc-slow-wrapper
  1558. (let* ((nn (prefix-numeric-value n))
  1559. (calc-internal-prec (cond ((>= nn 3) nn)
  1560. ((< nn 0) (max (+ calc-internal-prec nn)
  1561. 3))
  1562. (t calc-internal-prec)))
  1563. (calc-symbolic-mode nil))
  1564. (calc-with-default-simplification
  1565. (calc-pop-push-record 1 "num" (math-evaluate-expr (calc-top 1)))))
  1566. (calc-handle-whys)))
  1567. (defvar calc-extended-command-history nil
  1568. "The history list for calc-execute-extended-command.")
  1569. (defun calc-execute-extended-command (n)
  1570. (interactive "P")
  1571. (let* ((prompt (concat (calc-num-prefix-name n) "M-x "))
  1572. (cmd (intern
  1573. (completing-read prompt obarray 'commandp t "calc-"
  1574. 'calc-extended-command-history))))
  1575. (setq prefix-arg n)
  1576. (command-execute cmd)))
  1577. (defun calc-realign (&optional num)
  1578. (interactive "P")
  1579. (if (and num (eq major-mode 'calc-mode))
  1580. (progn
  1581. (calc-check-stack num)
  1582. (calc-cursor-stack-index num)
  1583. (and calc-line-numbering
  1584. (forward-char 4)))
  1585. (if (and calc-embedded-info
  1586. (eq (current-buffer) (aref calc-embedded-info 0)))
  1587. (progn
  1588. (goto-char (aref calc-embedded-info 2))
  1589. (if (with-current-buffer (aref calc-embedded-info 1)
  1590. calc-show-plain)
  1591. (forward-line 1)))
  1592. (calc-wrapper
  1593. (if (get-buffer-window (current-buffer))
  1594. (set-window-hscroll (get-buffer-window (current-buffer)) 0))))))
  1595. (defvar math-cache-list nil)
  1596. (defun calc-var-value (v)
  1597. (and (symbolp v)
  1598. (boundp v)
  1599. (symbol-value v)
  1600. (if (symbolp (symbol-value v))
  1601. (set v (funcall (symbol-value v)))
  1602. (if (stringp (symbol-value v))
  1603. (let ((val (math-read-expr (symbol-value v))))
  1604. (if (eq (car-safe val) 'error)
  1605. (error "Bad format in variable contents: %s" (nth 2 val))
  1606. (set v val)))
  1607. (symbol-value v)))))
  1608. ;;; In the following table, ( OP LOPS ROPS ) means that if an OP
  1609. ;;; term appears as the first argument to any LOPS term, or as the
  1610. ;;; second argument to any ROPS term, then they should be treated
  1611. ;;; as one large term for purposes of associative selection.
  1612. (defconst calc-assoc-ops '( ( + ( + - ) ( + ) )
  1613. ( - ( + - ) ( + ) )
  1614. ( * ( * ) ( * ) )
  1615. ( / ( / ) ( ) )
  1616. ( | ( | ) ( | ) )
  1617. ( calcFunc-land ( calcFunc-land )
  1618. ( calcFunc-land ) )
  1619. ( calcFunc-lor ( calcFunc-lor )
  1620. ( calcFunc-lor ) ) ))
  1621. (defvar var-CommuteRules 'calc-CommuteRules)
  1622. (defvar var-JumpRules 'calc-JumpRules)
  1623. (defvar var-DistribRules 'calc-DistribRules)
  1624. (defvar var-MergeRules 'calc-MergeRules)
  1625. (defvar var-NegateRules 'calc-NegateRules)
  1626. (defvar var-InvertRules 'calc-InvertRules)
  1627. (defconst calc-tweak-eqn-table '( ( calcFunc-eq calcFunc-eq calcFunc-neq )
  1628. ( calcFunc-neq calcFunc-neq calcFunc-eq )
  1629. ( calcFunc-lt calcFunc-gt calcFunc-geq )
  1630. ( calcFunc-gt calcFunc-lt calcFunc-leq )
  1631. ( calcFunc-leq calcFunc-geq calcFunc-gt )
  1632. ( calcFunc-geq calcFunc-leq calcFunc-lt ) ))
  1633. (defun calc-float (arg)
  1634. (interactive "P")
  1635. (calc-slow-wrapper
  1636. (calc-unary-op "flt"
  1637. (if (calc-is-hyperbolic) 'calcFunc-float 'calcFunc-pfloat)
  1638. arg)))
  1639. (defvar calc-gnuplot-process nil)
  1640. (defvar calc-gnuplot-input)
  1641. (defvar calc-gnuplot-buffer)
  1642. (defun calc-gnuplot-alive ()
  1643. (and calc-gnuplot-process
  1644. calc-gnuplot-buffer
  1645. (buffer-name calc-gnuplot-buffer)
  1646. calc-gnuplot-input
  1647. (buffer-name calc-gnuplot-input)
  1648. (memq (process-status calc-gnuplot-process) '(run stop))))
  1649. (defun calc-load-everything ()
  1650. (interactive)
  1651. (require 'calc-aent)
  1652. (require 'calc-alg)
  1653. (require 'calc-arith)
  1654. (require 'calc-bin)
  1655. (require 'calc-comb)
  1656. (require 'calc-cplx)
  1657. (require 'calc-embed)
  1658. (require 'calc-fin)
  1659. (require 'calc-forms)
  1660. (require 'calc-frac)
  1661. (require 'calc-funcs)
  1662. (require 'calc-graph)
  1663. (require 'calc-help)
  1664. (require 'calc-incom)
  1665. (require 'calc-keypd)
  1666. (require 'calc-lang)
  1667. (require 'calc-macs)
  1668. (require 'calc-map)
  1669. (require 'calc-math)
  1670. (require 'calc-misc)
  1671. (require 'calc-mode)
  1672. (require 'calc-mtx)
  1673. (require 'calc-poly)
  1674. (require 'calc-prog)
  1675. (require 'calc-rewr)
  1676. (require 'calc-rules)
  1677. (require 'calc-sel)
  1678. (require 'calc-stat)
  1679. (require 'calc-store)
  1680. (require 'calc-stuff)
  1681. (require 'calc-trail)
  1682. (require 'calc-undo)
  1683. (require 'calc-units)
  1684. (require 'calc-vec)
  1685. (require 'calc-yank)
  1686. (require 'calcalg2)
  1687. (require 'calcalg3)
  1688. (require 'calccomp)
  1689. (require 'calcsel2)
  1690. (message "All parts of Calc are now loaded"))
  1691. ;;; Vector commands.
  1692. (defun calc-concat (arg)
  1693. (interactive "P")
  1694. (calc-wrapper
  1695. (if (calc-is-inverse)
  1696. (if (calc-is-hyperbolic)
  1697. (calc-enter-result 2 "apnd" (list 'calcFunc-append
  1698. (calc-top 1) (calc-top 2)))
  1699. (calc-enter-result 2 "|" (list 'calcFunc-vconcat
  1700. (calc-top 1) (calc-top 2))))
  1701. (if (calc-is-hyperbolic)
  1702. (calc-binary-op "apnd" 'calcFunc-append arg '(vec))
  1703. (calc-binary-op "|" 'calcFunc-vconcat arg '(vec) nil '|)))))
  1704. (defun calc-append (arg)
  1705. (interactive "P")
  1706. (calc-hyperbolic-func)
  1707. (calc-concat arg))
  1708. (defconst calc-arg-values '( ( var ArgA var-ArgA ) ( var ArgB var-ArgB )
  1709. ( var ArgC var-ArgC ) ( var ArgD var-ArgD )
  1710. ( var ArgE var-ArgE ) ( var ArgF var-ArgF )
  1711. ( var ArgG var-ArgG ) ( var ArgH var-ArgH )
  1712. ( var ArgI var-ArgI ) ( var ArgJ var-ArgJ )
  1713. ))
  1714. (defun calc-invent-args (n)
  1715. (nreverse (nthcdr (- (length calc-arg-values) n) (reverse calc-arg-values))))
  1716. ;;; User menu.
  1717. (defun calc-user-key-map ()
  1718. (if (featurep 'xemacs)
  1719. (error "User-defined keys are not supported in XEmacs"))
  1720. (let ((res (cdr (lookup-key calc-mode-map "z"))))
  1721. (if (eq (car (car res)) 27)
  1722. (cdr res)
  1723. res)))
  1724. (defvar calc-z-prefix-buf nil)
  1725. (defvar calc-z-prefix-msgs nil)
  1726. (defun calc-z-prefix-help ()
  1727. (interactive)
  1728. (let* ((calc-z-prefix-msgs nil)
  1729. (calc-z-prefix-buf "")
  1730. (kmap (sort (copy-sequence (calc-user-key-map))
  1731. (function (lambda (x y) (< (car x) (car y))))))
  1732. (flags (apply 'logior
  1733. (mapcar (function
  1734. (lambda (k)
  1735. (calc-user-function-classify (car k))))
  1736. kmap))))
  1737. (if (= (logand flags 8) 0)
  1738. (calc-user-function-list kmap 7)
  1739. (calc-user-function-list kmap 1)
  1740. (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs)
  1741. calc-z-prefix-buf "")
  1742. (calc-user-function-list kmap 6))
  1743. (if (/= flags 0)
  1744. (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs)))
  1745. (calc-do-prefix-help (nreverse calc-z-prefix-msgs) "user" ?z)))
  1746. (defun calc-user-function-classify (key)
  1747. (cond ((/= key (downcase key)) ; upper-case
  1748. (if (assq (downcase key) (calc-user-key-map)) 9 1))
  1749. ((/= key (upcase key)) 2) ; lower-case
  1750. ((= key ??) 0)
  1751. (t 4))) ; other
  1752. (defun calc-user-function-list (map flags)
  1753. (and map
  1754. (let* ((key (car (car map)))
  1755. (kind (calc-user-function-classify key))
  1756. (func (cdr (car map))))
  1757. (if (or (= (logand kind flags) 0)
  1758. (not (symbolp func)))
  1759. ()
  1760. (let* ((name (symbol-name func))
  1761. (name (if (string-match "\\`calc-" name)
  1762. (substring name 5) name))
  1763. (pos (string-match (char-to-string key) name))
  1764. (desc
  1765. (if (symbolp func)
  1766. (if (= (logand kind 3) 0)
  1767. (format-message "`%c' = %s" key name)
  1768. (if pos
  1769. (format "%s%c%s"
  1770. (downcase (substring name 0 pos))
  1771. (upcase key)
  1772. (downcase (substring name (1+ pos))))
  1773. (format "%c = %s"
  1774. (upcase key)
  1775. (downcase name))))
  1776. (char-to-string (upcase key)))))
  1777. (if (= (length calc-z-prefix-buf) 0)
  1778. (setq calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "")
  1779. desc))
  1780. (if (> (+ (length calc-z-prefix-buf) (length desc)) 58)
  1781. (setq calc-z-prefix-msgs
  1782. (cons calc-z-prefix-buf calc-z-prefix-msgs)
  1783. calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "")
  1784. desc))
  1785. (setq calc-z-prefix-buf (concat calc-z-prefix-buf ", " desc))))))
  1786. (calc-user-function-list (cdr map) flags))))
  1787. (defun calc-shift-Z-prefix-help ()
  1788. (interactive)
  1789. (calc-do-prefix-help
  1790. '("Define, Undefine, Formula, Kbd-macro, Edit, Get-defn"
  1791. "Composition, Syntax; Invocation; Permanent; Timing"
  1792. "kbd-macros: [ (if), : (else), | (else-if), ] (end-if)"
  1793. "kbd-macros: < > (repeat), ( ) (for), { } (loop)"
  1794. "kbd-macros: / (break)"
  1795. "kbd-macros: \\=` (save), \\=' (restore)")
  1796. "user" ?Z))
  1797. ;;;; Caches.
  1798. (defmacro math-defcache (name init form)
  1799. (let ((cache-prec (intern (concat (symbol-name name) "-cache-prec")))
  1800. (cache-val (intern (concat (symbol-name name) "-cache")))
  1801. (last-prec (intern (concat (symbol-name name) "-last-prec")))
  1802. (last-val (intern (concat (symbol-name name) "-last"))))
  1803. `(progn
  1804. ; (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100))
  1805. (defvar ,cache-prec (cond
  1806. ((consp ,init) (math-numdigs (nth 1 ,init)))
  1807. (,init
  1808. (nth 1 (math-numdigs (eval ,init))))
  1809. (t
  1810. -100)))
  1811. (defvar ,cache-val (cond ((consp ,init) ,init)
  1812. (,init (eval ,init))
  1813. (t ,init)))
  1814. (defvar ,last-prec -100)
  1815. (defvar ,last-val nil)
  1816. (setq math-cache-list
  1817. (cons ',cache-prec
  1818. (cons ',last-prec
  1819. math-cache-list)))
  1820. (defun ,name ()
  1821. (or (= ,last-prec calc-internal-prec)
  1822. (setq ,last-val
  1823. (math-normalize
  1824. (progn (or (>= ,cache-prec calc-internal-prec)
  1825. (setq ,cache-val
  1826. (let ((calc-internal-prec
  1827. (+ calc-internal-prec 4)))
  1828. ,form)
  1829. ,cache-prec (+ calc-internal-prec 2)))
  1830. ,cache-val))
  1831. ,last-prec calc-internal-prec))
  1832. ,last-val))))
  1833. (put 'math-defcache 'lisp-indent-hook 2)
  1834. ;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public]
  1835. (defconst math-approx-pi
  1836. (math-read-number-simple "3.141592653589793238463")
  1837. "An approximation for pi.")
  1838. (math-defcache math-pi math-approx-pi
  1839. (math-add-float (math-mul-float '(float 16 0)
  1840. (math-arctan-raw '(float 2 -1)))
  1841. (math-mul-float '(float -4 0)
  1842. (math-arctan-raw
  1843. (math-float '(frac 1 239))))))
  1844. (math-defcache math-two-pi nil
  1845. (math-mul-float (math-pi) '(float 2 0)))
  1846. (math-defcache math-pi-over-2 nil
  1847. (math-mul-float (math-pi) '(float 5 -1)))
  1848. (math-defcache math-pi-over-4 nil
  1849. (math-mul-float (math-pi) '(float 25 -2)))
  1850. (math-defcache math-pi-over-180 nil
  1851. (math-div-float (math-pi) '(float 18 1)))
  1852. (math-defcache math-sqrt-pi nil
  1853. (math-sqrt-float (math-pi)))
  1854. (math-defcache math-sqrt-2 nil
  1855. (math-sqrt-float '(float 2 0)))
  1856. (math-defcache math-sqrt-12 nil
  1857. (math-sqrt-float '(float 12 0)))
  1858. (math-defcache math-sqrt-two-pi nil
  1859. (math-sqrt-float (math-two-pi)))
  1860. (defconst math-approx-sqrt-e
  1861. (math-read-number-simple "1.648721270700128146849")
  1862. "An approximation for sqrt(3).")
  1863. (math-defcache math-sqrt-e math-approx-sqrt-e
  1864. (math-add-float '(float 1 0) (math-exp-minus-1-raw '(float 5 -1))))
  1865. (math-defcache math-e nil
  1866. (math-pow (math-sqrt-e) 2))
  1867. (math-defcache math-phi nil
  1868. (math-mul-float (math-add-float (math-sqrt-raw '(float 5 0)) '(float 1 0))
  1869. '(float 5 -1)))
  1870. (defconst math-approx-gamma-const
  1871. (math-read-number-simple
  1872. "0.5772156649015328606065120900824024310421593359399235988057672348848677267776646709369470632917467495")
  1873. "An approximation for gamma.")
  1874. (math-defcache math-gamma-const nil
  1875. math-approx-gamma-const)
  1876. (defun math-half-circle (symb)
  1877. (if (eq calc-angle-mode 'rad)
  1878. (if symb
  1879. '(var pi var-pi)
  1880. (math-pi))
  1881. 180))
  1882. (defun math-full-circle (symb)
  1883. (math-mul 2 (math-half-circle symb)))
  1884. (defun math-quarter-circle (symb)
  1885. (math-div (math-half-circle symb) 2))
  1886. (defvar math-expand-formulas nil)
  1887. ;;;; Miscellaneous math routines.
  1888. ;;; True if A is an odd integer. [P R R] [Public]
  1889. (defun math-oddp (a)
  1890. (if (consp a)
  1891. (and (memq (car a) '(bigpos bigneg))
  1892. (= (% (nth 1 a) 2) 1))
  1893. (/= (% a 2) 0)))
  1894. ;;; True if A is a small or big integer. [P x] [Public]
  1895. (defun math-integerp (a)
  1896. (or (integerp a)
  1897. (memq (car-safe a) '(bigpos bigneg))))
  1898. ;;; True if A is (numerically) a non-negative integer. [P N] [Public]
  1899. (defun math-natnump (a)
  1900. (or (natnump a)
  1901. (eq (car-safe a) 'bigpos)))
  1902. ;;; True if A is a rational (or integer). [P x] [Public]
  1903. (defun math-ratp (a)
  1904. (or (integerp a)
  1905. (memq (car-safe a) '(bigpos bigneg frac))))
  1906. ;;; True if A is a real (or rational). [P x] [Public]
  1907. (defun math-realp (a)
  1908. (or (integerp a)
  1909. (memq (car-safe a) '(bigpos bigneg frac float))))
  1910. ;;; True if A is a real or HMS form. [P x] [Public]
  1911. (defun math-anglep (a)
  1912. (or (integerp a)
  1913. (memq (car-safe a) '(bigpos bigneg frac float hms))))
  1914. ;;; True if A is a number of any kind. [P x] [Public]
  1915. (defun math-numberp (a)
  1916. (or (integerp a)
  1917. (memq (car-safe a) '(bigpos bigneg frac float cplx polar))))
  1918. ;;; True if A is a complex number or angle. [P x] [Public]
  1919. (defun math-scalarp (a)
  1920. (or (integerp a)
  1921. (memq (car-safe a) '(bigpos bigneg frac float cplx polar hms))))
  1922. ;;; True if A is a vector. [P x] [Public]
  1923. (defun math-vectorp (a)
  1924. (eq (car-safe a) 'vec))
  1925. ;;; True if A is any vector or scalar data object. [P x]
  1926. (defun math-objvecp (a) ; [Public]
  1927. (or (integerp a)
  1928. (memq (car-safe a) '(bigpos bigneg frac float cplx polar
  1929. hms date sdev intv mod vec incomplete))))
  1930. ;;; True if A is an object not composed of sub-formulas . [P x] [Public]
  1931. (defun math-primp (a)
  1932. (or (integerp a)
  1933. (memq (car-safe a) '(bigpos bigneg frac float cplx polar
  1934. hms date mod var))))
  1935. ;;; True if A is numerically (but not literally) an integer. [P x] [Public]
  1936. (defun math-messy-integerp (a)
  1937. (cond
  1938. ((eq (car-safe a) 'float) (>= (nth 2 a) 0))
  1939. ((eq (car-safe a) 'frac) (Math-integerp (math-normalize a)))))
  1940. ;;; True if A is numerically an integer. [P x] [Public]
  1941. (defun math-num-integerp (a)
  1942. (or (Math-integerp a)
  1943. (Math-messy-integerp a)))
  1944. ;;; True if A is (numerically) a non-negative integer. [P N] [Public]
  1945. (defun math-num-natnump (a)
  1946. (or (natnump a)
  1947. (eq (car-safe a) 'bigpos)
  1948. (and (eq (car-safe a) 'float)
  1949. (Math-natnump (nth 1 a))
  1950. (>= (nth 2 a) 0))))
  1951. ;;; True if A is an integer or will evaluate to an integer. [P x] [Public]
  1952. (defun math-provably-integerp (a)
  1953. (or (Math-integerp a)
  1954. (and (memq (car-safe a) '(calcFunc-trunc
  1955. calcFunc-round
  1956. calcFunc-rounde
  1957. calcFunc-roundu
  1958. calcFunc-floor
  1959. calcFunc-ceil))
  1960. (= (length a) 2))))
  1961. ;;; True if A is a real or will evaluate to a real. [P x] [Public]
  1962. (defun math-provably-realp (a)
  1963. (or (Math-realp a)
  1964. (math-provably-integerp a)
  1965. (memq (car-safe a) '(abs arg))))
  1966. ;;; True if A is a non-real, complex number. [P x] [Public]
  1967. (defun math-complexp (a)
  1968. (memq (car-safe a) '(cplx polar)))
  1969. ;;; True if A is a non-real, rectangular complex number. [P x] [Public]
  1970. (defun math-rect-complexp (a)
  1971. (eq (car-safe a) 'cplx))
  1972. ;;; True if A is a non-real, polar complex number. [P x] [Public]
  1973. (defun math-polar-complexp (a)
  1974. (eq (car-safe a) 'polar))
  1975. ;;; True if A is a matrix. [P x] [Public]
  1976. (defun math-matrixp (a)
  1977. (and (Math-vectorp a)
  1978. (Math-vectorp (nth 1 a))
  1979. (cdr (nth 1 a))
  1980. (let ((len (length (nth 1 a))))
  1981. (setq a (cdr a))
  1982. (while (and (setq a (cdr a))
  1983. (Math-vectorp (car a))
  1984. (= (length (car a)) len)))
  1985. (null a))))
  1986. (defun math-matrixp-step (a len) ; [P L]
  1987. (or (null a)
  1988. (and (Math-vectorp (car a))
  1989. (= (length (car a)) len)
  1990. (math-matrixp-step (cdr a) len))))
  1991. ;;; True if A is a square matrix. [P V] [Public]
  1992. (defun math-square-matrixp (a)
  1993. (let ((dims (math-mat-dimens a)))
  1994. (and (cdr dims)
  1995. (= (car dims) (nth 1 dims)))))
  1996. ;;; True if MAT is an identity matrix.
  1997. (defun math-identity-matrix-p (mat &optional mul)
  1998. (if (math-square-matrixp mat)
  1999. (let ((a (if mul
  2000. (nth 1 (nth 1 mat))
  2001. 1))
  2002. (n (1- (length mat)))
  2003. (i 1))
  2004. (while (and (<= i n)
  2005. (math-ident-row-p (nth i mat) i a))
  2006. (setq i (1+ i)))
  2007. (if (> i n)
  2008. a
  2009. nil))))
  2010. (defun math-ident-row-p (row n &optional a)
  2011. (unless a
  2012. (setq a 1))
  2013. (and
  2014. (not (memq nil (mapcar
  2015. (lambda (x) (eq x 0))
  2016. (nthcdr (1+ n) row))))
  2017. (not (memq nil (mapcar
  2018. (lambda (x) (eq x 0))
  2019. (butlast
  2020. (cdr row)
  2021. (- (length row) n)))))
  2022. (eq (elt row n) a)))
  2023. ;;; True if A is any scalar data object. [P x]
  2024. (defun math-objectp (a) ; [Public]
  2025. (or (integerp a)
  2026. (memq (car-safe a) '(bigpos bigneg frac float cplx
  2027. polar hms date sdev intv mod))))
  2028. ;;; Verify that A is an integer and return A in integer form. [I N; - x]
  2029. (defun math-check-integer (a) ; [Public]
  2030. (cond ((integerp a) a) ; for speed
  2031. ((math-integerp a) a)
  2032. ((math-messy-integerp a)
  2033. (math-trunc a))
  2034. (t (math-reject-arg a 'integerp))))
  2035. ;;; Verify that A is a small integer and return A in integer form. [S N; - x]
  2036. (defun math-check-fixnum (a &optional allow-inf) ; [Public]
  2037. (cond ((integerp a) a) ; for speed
  2038. ((Math-num-integerp a)
  2039. (let ((a (math-trunc a)))
  2040. (if (integerp a)
  2041. a
  2042. (if (or (Math-lessp (lsh -1 -1) a)
  2043. (Math-lessp a (- (lsh -1 -1))))
  2044. (math-reject-arg a 'fixnump)
  2045. (math-fixnum a)))))
  2046. ((and allow-inf (equal a '(var inf var-inf)))
  2047. (lsh -1 -1))
  2048. ((and allow-inf (equal a '(neg (var inf var-inf))))
  2049. (- (lsh -1 -1)))
  2050. (t (math-reject-arg a 'fixnump))))
  2051. ;;; Verify that A is an integer >= 0 and return A in integer form. [I N; - x]
  2052. (defun math-check-natnum (a) ; [Public]
  2053. (cond ((natnump a) a)
  2054. ((and (not (math-negp a))
  2055. (Math-num-integerp a))
  2056. (math-trunc a))
  2057. (t (math-reject-arg a 'natnump))))
  2058. ;;; Verify that A is in floating-point form, or force it to be a float. [F N]
  2059. (defun math-check-float (a) ; [Public]
  2060. (cond ((eq (car-safe a) 'float) a)
  2061. ((Math-vectorp a) (math-map-vec 'math-check-float a))
  2062. ((Math-objectp a) (math-float a))
  2063. (t a)))
  2064. ;;; Verify that A is a constant.
  2065. (defun math-check-const (a &optional exp-ok)
  2066. (if (or (math-constp a)
  2067. (and exp-ok math-expand-formulas))
  2068. a
  2069. (math-reject-arg a 'constp)))
  2070. ;;; Some functions for working with error forms.
  2071. (defun math-get-value (x)
  2072. "Get the mean value of the error form X.
  2073. If X is not an error form, return X."
  2074. (if (eq (car-safe x) 'sdev)
  2075. (nth 1 x)
  2076. x))
  2077. (defun math-get-sdev (x &optional one)
  2078. "Get the standard deviation of the error form X.
  2079. If X is not an error form, return 1."
  2080. (if (eq (car-safe x) 'sdev)
  2081. (nth 2 x)
  2082. (if one 1 0)))
  2083. (defun math-contains-sdev-p (ls)
  2084. "Non-nil if the list LS contains an error form."
  2085. (let ((ls (if (eq (car-safe ls) 'vec) (cdr ls) ls)))
  2086. (memq t (mapcar (lambda (x) (eq (car-safe x) 'sdev)) ls))))
  2087. ;;; Coerce integer A to be a small integer. [S I]
  2088. (defun math-fixnum (a)
  2089. (if (consp a)
  2090. (if (cdr a)
  2091. (if (eq (car a) 'bigneg)
  2092. (- (math-fixnum-big (cdr a)))
  2093. (math-fixnum-big (cdr a)))
  2094. 0)
  2095. a))
  2096. (defun math-fixnum-big (a)
  2097. (if (cdr a)
  2098. (+ (car a) (* (math-fixnum-big (cdr a)) math-bignum-digit-size))
  2099. (car a)))
  2100. (defvar math-simplify-only nil)
  2101. (defun math-normalize-fancy (a)
  2102. (cond ((eq (car a) 'frac)
  2103. (math-make-frac (math-normalize (nth 1 a))
  2104. (math-normalize (nth 2 a))))
  2105. ((eq (car a) 'cplx)
  2106. (let ((real (math-normalize (nth 1 a)))
  2107. (imag (math-normalize (nth 2 a))))
  2108. (if (and (math-zerop imag)
  2109. (not math-simplify-only)) ; oh, what a kludge!
  2110. real
  2111. (list 'cplx real imag))))
  2112. ((eq (car a) 'polar)
  2113. (math-normalize-polar a))
  2114. ((eq (car a) 'hms)
  2115. (math-normalize-hms a))
  2116. ((eq (car a) 'date)
  2117. (list 'date (math-normalize (nth 1 a))))
  2118. ((eq (car a) 'mod)
  2119. (math-normalize-mod a))
  2120. ((eq (car a) 'sdev)
  2121. (let ((x (math-normalize (nth 1 a)))
  2122. (s (math-normalize (nth 2 a))))
  2123. (if (or (and (Math-objectp x) (not (Math-scalarp x)))
  2124. (and (Math-objectp s) (not (Math-scalarp s))))
  2125. (list 'calcFunc-sdev x s)
  2126. (math-make-sdev x s))))
  2127. ((eq (car a) 'intv)
  2128. (let ((mask (math-normalize (nth 1 a)))
  2129. (lo (math-normalize (nth 2 a)))
  2130. (hi (math-normalize (nth 3 a))))
  2131. (if (if (eq (car-safe lo) 'date)
  2132. (not (eq (car-safe hi) 'date))
  2133. (or (and (Math-objectp lo) (not (Math-anglep lo)))
  2134. (and (Math-objectp hi) (not (Math-anglep hi)))))
  2135. (list 'calcFunc-intv mask lo hi)
  2136. (math-make-intv mask lo hi))))
  2137. ((eq (car a) 'vec)
  2138. (cons 'vec (mapcar 'math-normalize (cdr a))))
  2139. ((eq (car a) 'quote)
  2140. (math-normalize (nth 1 a)))
  2141. ((eq (car a) 'special-const)
  2142. (calc-with-default-simplification
  2143. (math-normalize (nth 1 a))))
  2144. ((eq (car a) 'var)
  2145. (cons 'var (cdr a))) ; need to re-cons for selection routines
  2146. ((eq (car a) 'calcFunc-if)
  2147. (math-normalize-logical-op a))
  2148. ((memq (car a) '(calcFunc-lambda calcFunc-quote calcFunc-condition))
  2149. (let ((calc-simplify-mode 'none))
  2150. (cons (car a) (mapcar 'math-normalize (cdr a)))))
  2151. ((eq (car a) 'calcFunc-evalto)
  2152. (setq a (or (nth 1 a) 0))
  2153. (or calc-refreshing-evaltos
  2154. (setq a (let ((calc-simplify-mode 'none)) (math-normalize a))))
  2155. (let ((b (if (and (eq (car-safe a) 'calcFunc-assign)
  2156. (= (length a) 3))
  2157. (nth 2 a)
  2158. a)))
  2159. (list 'calcFunc-evalto
  2160. a
  2161. (if (eq calc-simplify-mode 'none)
  2162. (math-normalize b)
  2163. (calc-with-default-simplification
  2164. (math-evaluate-expr b))))))
  2165. ((or (integerp (car a)) (consp (car a)))
  2166. (if (null (cdr a))
  2167. (math-normalize (car a))
  2168. (error "Can't use multi-valued function in an expression")))))
  2169. ;; The variable math-normalize-a is local to math-normalize in calc.el,
  2170. ;; but is used by math-normalize-nonstandard, which is called by
  2171. ;; math-normalize.
  2172. (defvar math-normalize-a)
  2173. (defun math-normalize-nonstandard ()
  2174. (if (consp calc-simplify-mode)
  2175. (progn
  2176. (setq calc-simplify-mode 'none
  2177. math-simplify-only (car-safe (cdr-safe math-normalize-a)))
  2178. nil)
  2179. (and (symbolp (car math-normalize-a))
  2180. (or (eq calc-simplify-mode 'none)
  2181. (and (eq calc-simplify-mode 'num)
  2182. (let ((aptr (setq math-normalize-a
  2183. (cons
  2184. (car math-normalize-a)
  2185. (mapcar 'math-normalize
  2186. (cdr math-normalize-a))))))
  2187. (while (and aptr (math-constp (car aptr)))
  2188. (setq aptr (cdr aptr)))
  2189. aptr)))
  2190. (cons (car math-normalize-a)
  2191. (mapcar 'math-normalize (cdr math-normalize-a))))))
  2192. ;;; Normalize a bignum digit list by trimming high-end zeros. [L l]
  2193. (defun math-norm-bignum (a)
  2194. (let ((digs a) (last nil))
  2195. (while digs
  2196. (or (eq (car digs) 0) (setq last digs))
  2197. (setq digs (cdr digs)))
  2198. (and last
  2199. (progn
  2200. (setcdr last nil)
  2201. a))))
  2202. (defun math-bignum-test (a) ; [B N; B s; b b]
  2203. (if (consp a)
  2204. a
  2205. (math-bignum a)))
  2206. ;;; Return 0 for zero, -1 for negative, 1 for positive. [S n] [Public]
  2207. (defun calcFunc-sign (a &optional x)
  2208. (let ((signs (math-possible-signs a)))
  2209. (cond ((eq signs 4) (or x 1))
  2210. ((eq signs 2) 0)
  2211. ((eq signs 1) (if x (math-neg x) -1))
  2212. ((math-looks-negp a) (math-neg (calcFunc-sign (math-neg a))))
  2213. (t (calc-record-why 'realp a)
  2214. (if x
  2215. (list 'calcFunc-sign a x)
  2216. (list 'calcFunc-sign a))))))
  2217. ;;; Return 0 if A is numerically equal to B, <0 if less, >0 if more.
  2218. ;;; Arguments must be normalized! [S N N]
  2219. (defun math-compare (a b)
  2220. (cond ((equal a b)
  2221. (if (and (consp a)
  2222. (memq (car a) '(var neg * /))
  2223. (math-infinitep a))
  2224. 2
  2225. 0))
  2226. ((and (integerp a) (Math-integerp b))
  2227. (if (consp b)
  2228. (if (eq (car b) 'bigpos) -1 1)
  2229. (if (< a b) -1 1)))
  2230. ((and (eq (car-safe a) 'bigpos) (Math-integerp b))
  2231. (if (eq (car-safe b) 'bigpos)
  2232. (math-compare-bignum (cdr a) (cdr b))
  2233. 1))
  2234. ((and (eq (car-safe a) 'bigneg) (Math-integerp b))
  2235. (if (eq (car-safe b) 'bigneg)
  2236. (math-compare-bignum (cdr b) (cdr a))
  2237. -1))
  2238. ((eq (car-safe a) 'frac)
  2239. (if (eq (car-safe b) 'frac)
  2240. (math-compare (math-mul (nth 1 a) (nth 2 b))
  2241. (math-mul (nth 1 b) (nth 2 a)))
  2242. (math-compare (nth 1 a) (math-mul b (nth 2 a)))))
  2243. ((eq (car-safe b) 'frac)
  2244. (math-compare (math-mul a (nth 2 b)) (nth 1 b)))
  2245. ((and (eq (car-safe a) 'float) (eq (car-safe b) 'float))
  2246. (if (math-lessp-float a b) -1 1))
  2247. ((and (eq (car-safe a) 'date) (eq (car-safe b) 'date))
  2248. (math-compare (nth 1 a) (nth 1 b)))
  2249. ((and (or (Math-anglep a)
  2250. (and (eq (car a) 'cplx) (eq (nth 2 a) 0)))
  2251. (or (Math-anglep b)
  2252. (and (eq (car b) 'cplx) (eq (nth 2 b) 0))))
  2253. (calcFunc-sign (math-add a (math-neg b))))
  2254. ((and (eq (car-safe a) 'intv)
  2255. (or (Math-anglep b) (eq (car-safe b) 'date)))
  2256. (let ((res (math-compare (nth 2 a) b)))
  2257. (cond ((eq res 1) 1)
  2258. ((and (eq res 0) (memq (nth 1 a) '(0 1))) 1)
  2259. ((eq (setq res (math-compare (nth 3 a) b)) -1) -1)
  2260. ((and (eq res 0) (memq (nth 1 a) '(0 2))) -1)
  2261. (t 2))))
  2262. ((and (eq (car-safe b) 'intv)
  2263. (or (Math-anglep a) (eq (car-safe a) 'date)))
  2264. (let ((res (math-compare a (nth 2 b))))
  2265. (cond ((eq res -1) -1)
  2266. ((and (eq res 0) (memq (nth 1 b) '(0 1))) -1)
  2267. ((eq (setq res (math-compare a (nth 3 b))) 1) 1)
  2268. ((and (eq res 0) (memq (nth 1 b) '(0 2))) 1)
  2269. (t 2))))
  2270. ((and (eq (car-safe a) 'intv) (eq (car-safe b) 'intv))
  2271. (let ((res (math-compare (nth 3 a) (nth 2 b))))
  2272. (cond ((eq res -1) -1)
  2273. ((and (eq res 0) (or (memq (nth 1 a) '(0 2))
  2274. (memq (nth 1 b) '(0 1)))) -1)
  2275. ((eq (setq res (math-compare (nth 2 a) (nth 3 b))) 1) 1)
  2276. ((and (eq res 0) (or (memq (nth 1 a) '(0 1))
  2277. (memq (nth 1 b) '(0 2)))) 1)
  2278. (t 2))))
  2279. ((math-infinitep a)
  2280. (if (or (equal a '(var uinf var-uinf))
  2281. (equal a '(var nan var-nan)))
  2282. 2
  2283. (let ((dira (math-infinite-dir a)))
  2284. (if (math-infinitep b)
  2285. (if (or (equal b '(var uinf var-uinf))
  2286. (equal b '(var nan var-nan)))
  2287. 2
  2288. (let ((dirb (math-infinite-dir b)))
  2289. (cond ((and (eq dira 1) (eq dirb -1)) 1)
  2290. ((and (eq dira -1) (eq dirb 1)) -1)
  2291. (t 2))))
  2292. (cond ((eq dira 1) 1)
  2293. ((eq dira -1) -1)
  2294. (t 2))))))
  2295. ((math-infinitep b)
  2296. (if (or (equal b '(var uinf var-uinf))
  2297. (equal b '(var nan var-nan)))
  2298. 2
  2299. (let ((dirb (math-infinite-dir b)))
  2300. (cond ((eq dirb 1) -1)
  2301. ((eq dirb -1) 1)
  2302. (t 2)))))
  2303. ((and (eq (car-safe a) 'calcFunc-exp)
  2304. (eq (car-safe b) '^)
  2305. (equal (nth 1 b) '(var e var-e)))
  2306. (math-compare (nth 1 a) (nth 2 b)))
  2307. ((and (eq (car-safe b) 'calcFunc-exp)
  2308. (eq (car-safe a) '^)
  2309. (equal (nth 1 a) '(var e var-e)))
  2310. (math-compare (nth 2 a) (nth 1 b)))
  2311. ((or (and (eq (car-safe a) 'calcFunc-sqrt)
  2312. (eq (car-safe b) '^)
  2313. (or (equal (nth 2 b) '(frac 1 2))
  2314. (equal (nth 2 b) '(float 5 -1))))
  2315. (and (eq (car-safe b) 'calcFunc-sqrt)
  2316. (eq (car-safe a) '^)
  2317. (or (equal (nth 2 a) '(frac 1 2))
  2318. (equal (nth 2 a) '(float 5 -1)))))
  2319. (math-compare (nth 1 a) (nth 1 b)))
  2320. ((eq (car-safe a) 'var)
  2321. 2)
  2322. (t
  2323. (if (and (consp a) (consp b)
  2324. (eq (car a) (car b))
  2325. (math-compare-lists (cdr a) (cdr b)))
  2326. 0
  2327. 2))))
  2328. ;;; Compare two bignum digit lists, return -1 for A<B, 0 for A=B, 1 for A>B.
  2329. (defun math-compare-bignum (a b) ; [S l l]
  2330. (let ((res 0))
  2331. (while (and a b)
  2332. (if (< (car a) (car b))
  2333. (setq res -1)
  2334. (if (> (car a) (car b))
  2335. (setq res 1)))
  2336. (setq a (cdr a)
  2337. b (cdr b)))
  2338. (if a
  2339. (progn
  2340. (while (eq (car a) 0) (setq a (cdr a)))
  2341. (if a 1 res))
  2342. (while (eq (car b) 0) (setq b (cdr b)))
  2343. (if b -1 res))))
  2344. (defun math-compare-lists (a b)
  2345. (cond ((null a) (null b))
  2346. ((null b) nil)
  2347. (t (and (Math-equal (car a) (car b))
  2348. (math-compare-lists (cdr a) (cdr b))))))
  2349. (defun math-lessp-float (a b) ; [P F F]
  2350. (let ((ediff (- (nth 2 a) (nth 2 b))))
  2351. (if (>= ediff 0)
  2352. (if (>= ediff (+ calc-internal-prec calc-internal-prec))
  2353. (if (eq (nth 1 a) 0)
  2354. (Math-integer-posp (nth 1 b))
  2355. (Math-integer-negp (nth 1 a)))
  2356. (Math-lessp (math-scale-int (nth 1 a) ediff)
  2357. (nth 1 b)))
  2358. (if (>= (setq ediff (- ediff))
  2359. (+ calc-internal-prec calc-internal-prec))
  2360. (if (eq (nth 1 b) 0)
  2361. (Math-integer-negp (nth 1 a))
  2362. (Math-integer-posp (nth 1 b)))
  2363. (Math-lessp (nth 1 a)
  2364. (math-scale-int (nth 1 b) ediff))))))
  2365. ;;; True if A is numerically equal to B. [P N N] [Public]
  2366. (defun math-equal (a b)
  2367. (= (math-compare a b) 0))
  2368. ;;; True if A is numerically less than B. [P R R] [Public]
  2369. (defun math-lessp (a b)
  2370. (= (math-compare a b) -1))
  2371. ;;; True if A is numerically equal to the integer B. [P N S] [Public]
  2372. ;;; B must not be a multiple of 10.
  2373. (defun math-equal-int (a b)
  2374. (or (eq a b)
  2375. (and (eq (car-safe a) 'float)
  2376. (eq (nth 1 a) b)
  2377. (= (nth 2 a) 0))))
  2378. ;;; Return the dimensions of a matrix as a list. [l x] [Public]
  2379. (defun math-mat-dimens (m)
  2380. (if (math-vectorp m)
  2381. (if (math-matrixp m)
  2382. (cons (1- (length m))
  2383. (math-mat-dimens (nth 1 m)))
  2384. (list (1- (length m))))
  2385. nil))
  2386. (defun calc-binary-op-fancy (name func arg ident unary)
  2387. (let ((n (prefix-numeric-value arg)))
  2388. (cond ((> n 1)
  2389. (calc-enter-result n
  2390. name
  2391. (list 'calcFunc-reduce
  2392. (math-calcFunc-to-var func)
  2393. (cons 'vec (calc-top-list-n n)))))
  2394. ((= n 1)
  2395. (if unary
  2396. (calc-enter-result 1 name (list unary (calc-top-n 1)))))
  2397. ((= n 0)
  2398. (if ident
  2399. (calc-enter-result 0 name ident)
  2400. (error "Argument must be nonzero")))
  2401. (t
  2402. (let ((rhs (calc-top-n 1)))
  2403. (calc-enter-result (- 1 n)
  2404. name
  2405. (mapcar (function
  2406. (lambda (x)
  2407. (list func x rhs)))
  2408. (calc-top-list-n (- n) 2))))))))
  2409. (defun calc-unary-op-fancy (name func arg)
  2410. (let ((n (prefix-numeric-value arg)))
  2411. (if (= n 0) (setq n (calc-stack-size)))
  2412. (cond ((> n 0)
  2413. (calc-enter-result n
  2414. name
  2415. (mapcar (function
  2416. (lambda (x)
  2417. (list func x)))
  2418. (calc-top-list-n n))))
  2419. ((< n 0)
  2420. (calc-enter-result 1
  2421. name
  2422. (list func (calc-top-n (- n)))
  2423. (- n))))))
  2424. (defvar var-Holidays '(vec (var sat var-sat) (var sun var-sun)))
  2425. (defvar var-Decls (list 'vec))
  2426. (defun math-inexact-result ()
  2427. (and calc-symbolic-mode
  2428. (signal 'inexact-result nil)))
  2429. (defun math-overflow (&optional exp)
  2430. (if (and exp (math-negp exp))
  2431. (math-underflow)
  2432. (signal 'math-overflow nil)))
  2433. (defun math-underflow ()
  2434. (signal 'math-underflow nil))
  2435. ;;; Compute the greatest common divisor of A and B. [I I I] [Public]
  2436. (defun math-gcd (a b)
  2437. (cond ((not (or (consp a) (consp b)))
  2438. (if (< a 0) (setq a (- a)))
  2439. (if (< b 0) (setq b (- b)))
  2440. (let (c)
  2441. (if (< a b)
  2442. (setq c b b a a c))
  2443. (while (> b 0)
  2444. (setq c b
  2445. b (% a b)
  2446. a c))
  2447. a))
  2448. ((eq a 0) b)
  2449. ((eq b 0) a)
  2450. (t
  2451. (if (Math-integer-negp a) (setq a (math-neg a)))
  2452. (if (Math-integer-negp b) (setq b (math-neg b)))
  2453. (let (c)
  2454. (if (Math-natnum-lessp a b)
  2455. (setq c b b a a c))
  2456. (while (and (consp a) (not (eq b 0)))
  2457. (setq c b
  2458. b (math-imod a b)
  2459. a c))
  2460. (while (> b 0)
  2461. (setq c b
  2462. b (% a b)
  2463. a c))
  2464. a))))
  2465. ;;;; Algebra.
  2466. ;;; Evaluate variables in an expression.
  2467. (defun math-evaluate-expr (x) ; [Public]
  2468. (if calc-embedded-info
  2469. (calc-embedded-evaluate-expr x)
  2470. (calc-normalize (math-evaluate-expr-rec x))))
  2471. (defalias 'calcFunc-evalv 'math-evaluate-expr)
  2472. (defun calcFunc-evalvn (x &optional prec)
  2473. (if prec
  2474. (progn
  2475. (or (math-num-integerp prec)
  2476. (if (and (math-vectorp prec)
  2477. (= (length prec) 2)
  2478. (math-num-integerp (nth 1 prec)))
  2479. (setq prec (math-add (nth 1 prec) calc-internal-prec))
  2480. (math-reject-arg prec 'integerp)))
  2481. (setq prec (math-trunc prec))
  2482. (if (< prec 3) (setq prec 3))
  2483. (if (> prec calc-internal-prec)
  2484. (math-normalize
  2485. (let ((calc-internal-prec prec))
  2486. (calcFunc-evalvn x)))
  2487. (let ((calc-internal-prec prec))
  2488. (calcFunc-evalvn x))))
  2489. (let ((calc-symbolic-mode nil))
  2490. (math-evaluate-expr x))))
  2491. (defun math-evaluate-expr-rec (x)
  2492. (if (consp x)
  2493. (if (memq (car x) '(calcFunc-quote calcFunc-condition
  2494. calcFunc-evalto calcFunc-assign))
  2495. (if (and (eq (car x) 'calcFunc-assign)
  2496. (= (length x) 3))
  2497. (list (car x) (nth 1 x) (math-evaluate-expr-rec (nth 2 x)))
  2498. x)
  2499. (if (eq (car x) 'var)
  2500. (if (and (calc-var-value (nth 2 x))
  2501. (not (eq (car-safe (symbol-value (nth 2 x)))
  2502. 'incomplete)))
  2503. (let ((val (symbol-value (nth 2 x))))
  2504. (if (eq (car-safe val) 'special-const)
  2505. (if calc-symbolic-mode
  2506. x
  2507. val)
  2508. val))
  2509. x)
  2510. (if (Math-primp x)
  2511. x
  2512. (cons (car x) (mapcar 'math-evaluate-expr-rec (cdr x))))))
  2513. x))
  2514. (defun math-any-floats (expr)
  2515. (if (Math-primp expr)
  2516. (math-floatp expr)
  2517. (while (and (setq expr (cdr expr)) (not (math-any-floats (car expr)))))
  2518. expr))
  2519. (defvar var-FactorRules 'calc-FactorRules)
  2520. (defvar math-mt-many nil)
  2521. (defvar math-mt-func nil)
  2522. (defun math-map-tree (math-mt-func mmt-expr &optional math-mt-many)
  2523. (or math-mt-many (setq math-mt-many 1000000))
  2524. (math-map-tree-rec mmt-expr))
  2525. (defun math-map-tree-rec (mmt-expr)
  2526. (or (= math-mt-many 0)
  2527. (let ((mmt-done nil)
  2528. mmt-nextval)
  2529. (while (not mmt-done)
  2530. (while (and (/= math-mt-many 0)
  2531. (setq mmt-nextval (funcall math-mt-func mmt-expr))
  2532. (not (equal mmt-expr mmt-nextval)))
  2533. (setq mmt-expr mmt-nextval
  2534. math-mt-many (if (> math-mt-many 0)
  2535. (1- math-mt-many)
  2536. (1+ math-mt-many))))
  2537. (if (or (Math-primp mmt-expr)
  2538. (<= math-mt-many 0))
  2539. (setq mmt-done t)
  2540. (setq mmt-nextval (cons (car mmt-expr)
  2541. (mapcar 'math-map-tree-rec
  2542. (cdr mmt-expr))))
  2543. (if (equal mmt-nextval mmt-expr)
  2544. (setq mmt-done t)
  2545. (setq mmt-expr mmt-nextval))))))
  2546. mmt-expr)
  2547. (defun math-is-true (expr)
  2548. (if (Math-numberp expr)
  2549. (not (Math-zerop expr))
  2550. (math-known-nonzerop expr)))
  2551. (defun math-const-var (expr)
  2552. (and (consp expr)
  2553. (eq (car expr) 'var)
  2554. (or (and (symbolp (nth 2 expr))
  2555. (boundp (nth 2 expr))
  2556. (eq (car-safe (symbol-value (nth 2 expr))) 'special-const))
  2557. (memq (nth 2 expr) '(var-inf var-uinf var-nan)))))
  2558. ;; The variable math-integral-cache is originally declared in calcalg2.el,
  2559. ;; but is set by math-defintegral and math-defintegral-2.
  2560. (defvar math-integral-cache)
  2561. (defmacro math-defintegral (funcs &rest code)
  2562. (setq math-integral-cache nil)
  2563. (cons 'progn
  2564. (mapcar #'(lambda (func)
  2565. `(put ',func 'math-integral
  2566. (nconc
  2567. (get ',func 'math-integral)
  2568. (list
  2569. #'(lambda (u) ,@code)))))
  2570. (if (symbolp funcs) (list funcs) funcs))))
  2571. (put 'math-defintegral 'lisp-indent-hook 1)
  2572. (defmacro math-defintegral-2 (funcs &rest code)
  2573. (setq math-integral-cache nil)
  2574. (cons 'progn
  2575. (mapcar #'(lambda (func)
  2576. `(put ',func 'math-integral-2
  2577. (nconc
  2578. (get ',func 'math-integral-2)
  2579. (list #'(lambda (u v) ,@code)))))
  2580. (if (symbolp funcs) (list funcs) funcs))))
  2581. (put 'math-defintegral-2 'lisp-indent-hook 1)
  2582. (defvar var-IntegAfterRules 'calc-IntegAfterRules)
  2583. (defvar var-FitRules 'calc-FitRules)
  2584. (defvar math-poly-base-variable nil)
  2585. (defvar math-poly-neg-powers nil)
  2586. (defvar math-poly-mult-powers 1)
  2587. (defvar math-poly-frac-powers nil)
  2588. (defvar math-poly-exp-base nil)
  2589. (defun math-build-var-name (name)
  2590. (if (stringp name)
  2591. (setq name (intern name)))
  2592. (if (string-match "\\`var-." (symbol-name name))
  2593. (list 'var (intern (substring (symbol-name name) 4)) name)
  2594. (list 'var name (intern (concat "var-" (symbol-name name))))))
  2595. (defvar math-simplifying-units nil)
  2596. (defvar math-combining-units t)
  2597. ;;; Nontrivial number parsing.
  2598. (defun math-read-number-fancy (s)
  2599. (cond
  2600. ;; Integer+fractions
  2601. ((string-match "^\\([0-9]*\\)[:/]\\([0-9]*\\)[:/]\\([0-9]*\\)$" s)
  2602. (let ((int (math-match-substring s 1))
  2603. (num (math-match-substring s 2))
  2604. (den (math-match-substring s 3)))
  2605. (let ((int (if (> (length int) 0) (math-read-number int) 0))
  2606. (num (if (> (length num) 0) (math-read-number num) 1))
  2607. (den (if (> (length num) 0) (math-read-number den) 1)))
  2608. (and int num den
  2609. (math-integerp int) (math-integerp num) (math-integerp den)
  2610. (not (math-zerop den))
  2611. (list 'frac (math-add num (math-mul int den)) den)))))
  2612. ;; Fractions
  2613. ((string-match "^\\([0-9]*\\)[:/]\\([0-9]*\\)$" s)
  2614. (let ((num (math-match-substring s 1))
  2615. (den (math-match-substring s 2)))
  2616. (let ((num (if (> (length num) 0) (math-read-number num) 1))
  2617. (den (if (> (length num) 0) (math-read-number den) 1)))
  2618. (and num den (math-integerp num) (math-integerp den)
  2619. (not (math-zerop den))
  2620. (list 'frac num den)))))
  2621. ;; Modulo forms
  2622. ((string-match "^\\(.*\\) *mod *\\(.*\\)$" s)
  2623. (let* ((n (math-match-substring s 1))
  2624. (m (math-match-substring s 2))
  2625. (n (math-read-number n))
  2626. (m (math-read-number m)))
  2627. (and n m (math-anglep n) (math-anglep m)
  2628. (list 'mod n m))))
  2629. ;; Error forms
  2630. ((string-match "^\\(.*\\) *\\+/- *\\(.*\\)$" s)
  2631. (let* ((x (math-match-substring s 1))
  2632. (sigma (math-match-substring s 2))
  2633. (x (math-read-number x))
  2634. (sigma (math-read-number sigma)))
  2635. (and x sigma (math-scalarp x) (math-anglep sigma)
  2636. (list 'sdev x sigma))))
  2637. ;; Integer+fraction with explicit radix
  2638. ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]\\)$" s)
  2639. (let ((radix (string-to-number (math-match-substring s 1)))
  2640. (int (math-match-substring s 3))
  2641. (num (math-match-substring s 4))
  2642. (den (math-match-substring s 5)))
  2643. (let ((int (if (> (length int) 0) (math-read-radix int radix) 0))
  2644. (num (if (> (length num) 0) (math-read-radix num radix) 1))
  2645. (den (if (> (length den) 0) (math-read-radix den radix) 1)))
  2646. (and int num den (not (math-zerop den))
  2647. (list 'frac
  2648. (math-add num (math-mul int den))
  2649. den)))))
  2650. ;; Fraction with explicit radix
  2651. ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)$" s)
  2652. (let ((radix (string-to-number (math-match-substring s 1)))
  2653. (num (math-match-substring s 3))
  2654. (den (math-match-substring s 4)))
  2655. (let ((num (if (> (length num) 0) (math-read-radix num radix) 1))
  2656. (den (if (> (length den) 0) (math-read-radix den radix) 1)))
  2657. (and num den (not (math-zerop den)) (list 'frac num den)))))
  2658. ;; Float with explicit radix and exponent
  2659. ((or (string-match "^0*\\(\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+\\)[eE]\\([-+]?[0-9]+\\)$" s)
  2660. (string-match "^\\(\\([0-9]+\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z.]+\\) *\\* *\\2\\.? *\\^ *\\([-+]?[0-9]+\\)$" s))
  2661. (let ((radix (string-to-number (math-match-substring s 2)))
  2662. (mant (math-match-substring s 1))
  2663. (exp (math-match-substring s 4)))
  2664. (let ((mant (math-read-number mant))
  2665. (exp (math-read-number exp)))
  2666. (and mant exp
  2667. (math-mul mant (math-pow (math-float radix) exp))))))
  2668. ;; Float with explicit radix, no exponent
  2669. ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)\\.\\([0-9a-zA-Z]*\\)$" s)
  2670. (let ((radix (string-to-number (math-match-substring s 1)))
  2671. (int (math-match-substring s 3))
  2672. (fracs (math-match-substring s 4)))
  2673. (let ((int (if (> (length int) 0) (math-read-radix int radix) 0))
  2674. (frac (if (> (length fracs) 0) (math-read-radix fracs radix) 0))
  2675. (calc-prefer-frac nil))
  2676. (and int frac
  2677. (math-add int (math-div frac (math-pow radix (length fracs))))))))
  2678. ;; Integer with explicit radix
  2679. ((string-match "^\\([0-9]+\\)\\(#&?\\|\\^\\^\\)\\([0-9a-zA-Z]+\\)$" s)
  2680. (math-read-radix (math-match-substring s 3)
  2681. (string-to-number (math-match-substring s 1))))
  2682. ;; Two's complement with explicit radix
  2683. ((string-match "^\\([0-9]+\\)\\(##\\)\\([0-9a-zA-Z]+\\)$" s)
  2684. (let ((num (math-read-radix (math-match-substring s 3)
  2685. (string-to-number (math-match-substring s 1)))))
  2686. (if (and
  2687. (Math-lessp num math-2-word-size)
  2688. (<= (math-compare math-half-2-word-size num) 0))
  2689. (math-sub num math-2-word-size)
  2690. num)))
  2691. ;; C language hexadecimal notation
  2692. ((and (eq calc-language 'c)
  2693. (string-match "^0[xX]\\([0-9a-fA-F]+\\)$" s))
  2694. (let ((digs (math-match-substring s 1)))
  2695. (math-read-radix digs 16)))
  2696. ;; Pascal language hexadecimal notation
  2697. ((and (eq calc-language 'pascal)
  2698. (string-match "^\\$\\([0-9a-fA-F]+\\)$" s))
  2699. (let ((digs (math-match-substring s 1)))
  2700. (math-read-radix digs 16)))
  2701. ;; Hours (or degrees)
  2702. ((or (string-match "^\\([^#^]+\\)[@oOhH]\\(.*\\)$" s)
  2703. (string-match "^\\([^#^]+\\)[dD][eE]?[gG]?\\(.*\\)$" s))
  2704. (let* ((hours (math-match-substring s 1))
  2705. (minsec (math-match-substring s 2))
  2706. (hours (math-read-number hours))
  2707. (minsec (if (> (length minsec) 0) (math-read-number minsec) 0)))
  2708. (and hours minsec
  2709. (math-num-integerp hours)
  2710. (not (math-negp hours)) (not (math-negp minsec))
  2711. (cond ((math-num-integerp minsec)
  2712. (and (Math-lessp minsec 60)
  2713. (list 'hms hours minsec 0)))
  2714. ((and (eq (car-safe minsec) 'hms)
  2715. (math-zerop (nth 1 minsec)))
  2716. (math-add (list 'hms hours 0 0) minsec))
  2717. (t nil)))))
  2718. ;; Minutes
  2719. ((string-match "^\\([^'#^]+\\)[mM']\\(.*\\)$" s)
  2720. (let* ((minutes (math-match-substring s 1))
  2721. (seconds (math-match-substring s 2))
  2722. (minutes (math-read-number minutes))
  2723. (seconds (if (> (length seconds) 0) (math-read-number seconds) 0)))
  2724. (and minutes seconds
  2725. (math-num-integerp minutes)
  2726. (not (math-negp minutes)) (not (math-negp seconds))
  2727. (cond ((math-realp seconds)
  2728. (and (Math-lessp minutes 60)
  2729. (list 'hms 0 minutes seconds)))
  2730. ((and (eq (car-safe seconds) 'hms)
  2731. (math-zerop (nth 1 seconds))
  2732. (math-zerop (nth 2 seconds)))
  2733. (math-add (list 'hms 0 minutes 0) seconds))
  2734. (t nil)))))
  2735. ;; Seconds
  2736. ((string-match "^\\([^\"#^]+\\)[sS\"]$" s)
  2737. (let ((seconds (math-read-number (math-match-substring s 1))))
  2738. (and seconds (math-realp seconds)
  2739. (not (math-negp seconds))
  2740. (Math-lessp seconds 60)
  2741. (list 'hms 0 0 seconds))))
  2742. ;; Fraction using "/" instead of ":"
  2743. ((string-match "^\\([0-9]+\\)/\\([0-9/]+\\)$" s)
  2744. (math-read-number (concat (math-match-substring s 1) ":"
  2745. (math-match-substring s 2))))
  2746. ;; Syntax error!
  2747. (t nil)))
  2748. (defun math-read-radix (s r) ; [I X D]
  2749. (setq s (upcase s))
  2750. (let ((i 0)
  2751. (res 0)
  2752. dig)
  2753. (while (and (< i (length s))
  2754. (setq dig (math-read-radix-digit (elt s i)))
  2755. (< dig r))
  2756. (setq res (math-add (math-mul res r) dig)
  2757. i (1+ i)))
  2758. (and (= i (length s))
  2759. res)))
  2760. ;;; Expression parsing.
  2761. (defvar math-expr-data)
  2762. (defun math-read-expr (math-exp-str)
  2763. (let ((math-exp-pos 0)
  2764. (math-exp-old-pos 0)
  2765. (math-exp-keep-spaces nil)
  2766. math-exp-token math-expr-data)
  2767. (setq math-exp-str (math-read-preprocess-string math-exp-str))
  2768. (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str))
  2769. (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) "\\dots"
  2770. (substring math-exp-str (+ math-exp-token 2)))))
  2771. (math-build-parse-table)
  2772. (math-read-token)
  2773. (let ((val (catch 'syntax (math-read-expr-level 0))))
  2774. (if (stringp val)
  2775. (list 'error math-exp-old-pos val)
  2776. (if (equal math-exp-token 'end)
  2777. val
  2778. (list 'error math-exp-old-pos "Syntax error"))))))
  2779. (defun math-read-plain-expr (exp-str &optional error-check)
  2780. (let* ((calc-language nil)
  2781. (math-expr-opers (math-standard-ops))
  2782. (val (math-read-expr exp-str)))
  2783. (and error-check
  2784. (eq (car-safe val) 'error)
  2785. (error "%s: %s" (nth 2 val) exp-str))
  2786. val))
  2787. (defun math-read-string ()
  2788. (let ((str (read-from-string (concat math-expr-data "\""))))
  2789. (or (and (= (cdr str) (1+ (length math-expr-data)))
  2790. (stringp (car str)))
  2791. (throw 'syntax "Error in string constant"))
  2792. (math-read-token)
  2793. (append '(vec) (car str) nil)))
  2794. ;;; They said it couldn't be done...
  2795. (defun math-read-big-expr (str)
  2796. (and (> (length calc-left-label) 0)
  2797. (string-match (concat "^" (regexp-quote calc-left-label)) str)
  2798. (setq str (concat (substring str 0 (match-beginning 0))
  2799. (substring str (match-end 0)))))
  2800. (and (> (length calc-right-label) 0)
  2801. (string-match (concat (regexp-quote calc-right-label) " *$") str)
  2802. (setq str (concat (substring str 0 (match-beginning 0))
  2803. (substring str (match-end 0)))))
  2804. (if (string-match "\\\\[^ \n|]" str)
  2805. (if (eq calc-language 'latex)
  2806. (math-read-expr str)
  2807. (let ((calc-language 'latex)
  2808. (calc-language-option nil)
  2809. (math-expr-opers (get 'latex 'math-oper-table))
  2810. (math-expr-function-mapping (get 'latex 'math-function-table))
  2811. (math-expr-variable-mapping (get 'latex 'math-variable-table)))
  2812. (math-read-expr str)))
  2813. (let ((math-read-big-lines nil)
  2814. (pos 0)
  2815. (width 0)
  2816. (math-read-big-err-msg nil)
  2817. math-read-big-baseline math-read-big-h2
  2818. new-pos p)
  2819. (while (setq new-pos (string-match "\n" str pos))
  2820. (setq math-read-big-lines
  2821. (cons (substring str pos new-pos) math-read-big-lines)
  2822. pos (1+ new-pos)))
  2823. (setq math-read-big-lines
  2824. (nreverse (cons (substring str pos) math-read-big-lines))
  2825. p math-read-big-lines)
  2826. (while p
  2827. (setq width (max width (length (car p)))
  2828. p (cdr p)))
  2829. (if (math-read-big-bigp math-read-big-lines)
  2830. (or (catch 'syntax
  2831. (math-read-big-rec 0 0 width (length math-read-big-lines)))
  2832. math-read-big-err-msg
  2833. '(error 0 "Syntax error"))
  2834. (math-read-expr str)))))
  2835. (defun math-read-big-bigp (math-read-big-lines)
  2836. (and (cdr math-read-big-lines)
  2837. (let ((matrix nil)
  2838. (v 0)
  2839. (height (if (> (length (car math-read-big-lines)) 0) 1 0)))
  2840. (while (and (cdr math-read-big-lines)
  2841. (let* ((i 0)
  2842. j
  2843. (l1 (car math-read-big-lines))
  2844. (l2 (nth 1 math-read-big-lines))
  2845. (len (min (length l1) (length l2))))
  2846. (if (> (length l2) 0)
  2847. (setq height (1+ height)))
  2848. (while (and (< i len)
  2849. (or (memq (aref l1 i) '(?\ ?\- ?\_))
  2850. (memq (aref l2 i) '(?\ ?\-))
  2851. (and (memq (aref l1 i) '(?\| ?\,))
  2852. (= (aref l2 i) (aref l1 i)))
  2853. (and (eq (aref l1 i) ?\[)
  2854. (eq (aref l2 i) ?\[)
  2855. (let ((math-rb-h2 (length l1)))
  2856. (setq j (math-read-big-balance
  2857. (1+ i) v "[")))
  2858. (setq i (1- j)))))
  2859. (setq i (1+ i)))
  2860. (or (= i len)
  2861. (and (eq (aref l1 i) ?\[)
  2862. (eq (aref l2 i) ?\[)
  2863. (setq matrix t)
  2864. nil))))
  2865. (setq math-read-big-lines (cdr math-read-big-lines)
  2866. v (1+ v)))
  2867. (or (and (> height 1)
  2868. (not (cdr math-read-big-lines)))
  2869. matrix))))
  2870. ;;; Nontrivial "flat" formatting.
  2871. (defvar math-format-hash-args nil)
  2872. (defvar calc-can-abbrev-vectors nil)
  2873. (defun math-format-flat-expr-fancy (a prec)
  2874. (cond
  2875. ((eq (car a) 'incomplete)
  2876. (format "<incomplete %s>" (nth 1 a)))
  2877. ((eq (car a) 'vec)
  2878. (if (or calc-full-trail-vectors (not calc-can-abbrev-vectors)
  2879. (< (length a) 7))
  2880. (concat "[" (math-format-flat-vector (cdr a) ", "
  2881. (if (cdr (cdr a)) 0 1000)) "]")
  2882. (concat "["
  2883. (math-format-flat-expr (nth 1 a) 0) ", "
  2884. (math-format-flat-expr (nth 2 a) 0) ", "
  2885. (math-format-flat-expr (nth 3 a) 0) ", ..., "
  2886. (math-format-flat-expr (nth (1- (length a)) a) 0) "]")))
  2887. ((eq (car a) 'intv)
  2888. (concat (if (memq (nth 1 a) '(0 1)) "(" "[")
  2889. (math-format-flat-expr (nth 2 a) 1000)
  2890. " .. "
  2891. (math-format-flat-expr (nth 3 a) 1000)
  2892. (if (memq (nth 1 a) '(0 2)) ")" "]")))
  2893. ((eq (car a) 'date)
  2894. (concat "<" (math-format-date a) ">"))
  2895. ((and (eq (car a) 'calcFunc-lambda) (> (length a) 2))
  2896. (let ((p (cdr a))
  2897. (ap calc-arg-values)
  2898. (math-format-hash-args (if (= (length a) 3) 1 t)))
  2899. (while (and (cdr p) (equal (car p) (car ap)))
  2900. (setq p (cdr p) ap (cdr ap)))
  2901. (concat "<"
  2902. (if (cdr p)
  2903. (concat (math-format-flat-vector
  2904. (nreverse (cdr (reverse (cdr a)))) ", " 0)
  2905. " : ")
  2906. "")
  2907. (math-format-flat-expr (nth (1- (length a)) a) 0)
  2908. ">")))
  2909. ((eq (car a) 'var)
  2910. (or (and math-format-hash-args
  2911. (let ((p calc-arg-values) (v 1))
  2912. (while (and p (not (equal (car p) a)))
  2913. (setq p (and (eq math-format-hash-args t) (cdr p))
  2914. v (1+ v)))
  2915. (and p
  2916. (if (eq math-format-hash-args 1)
  2917. "#"
  2918. (format "#%d" v)))))
  2919. (symbol-name (nth 1 a))))
  2920. ((and (memq (car a) '(calcFunc-string calcFunc-bstring))
  2921. (= (length a) 2)
  2922. (math-vectorp (nth 1 a))
  2923. (math-vector-is-string (nth 1 a)))
  2924. (concat (substring (symbol-name (car a)) 9)
  2925. "(" (math-vector-to-string (nth 1 a) t) ")"))
  2926. (t
  2927. (let ((op (math-assq2 (car a) (math-standard-ops))))
  2928. (cond ((and op (= (length a) 3))
  2929. (if (> prec (min (nth 2 op) (nth 3 op)))
  2930. (concat "(" (math-format-flat-expr a 0) ")")
  2931. (let ((lhs (math-format-flat-expr (nth 1 a) (nth 2 op)))
  2932. (rhs (math-format-flat-expr (nth 2 a) (nth 3 op))))
  2933. (setq op (car op))
  2934. (if (or (equal op "^") (equal op "_"))
  2935. (if (= (aref lhs 0) ?-)
  2936. (setq lhs (concat "(" lhs ")")))
  2937. (setq op (concat " " op " ")))
  2938. (concat lhs op rhs))))
  2939. ((eq (car a) 'neg)
  2940. (concat "-" (math-format-flat-expr (nth 1 a) 1000)))
  2941. (t
  2942. (concat (math-remove-dashes
  2943. (if (string-match "\\`calcFunc-\\([a-zA-Zα-ωΑ-Ω0-9']+\\)\\'"
  2944. (symbol-name (car a)))
  2945. (math-match-substring (symbol-name (car a)) 1)
  2946. (symbol-name (car a))))
  2947. "("
  2948. (math-format-flat-vector (cdr a) ", " 0)
  2949. ")")))))))
  2950. (defun math-format-flat-vector (vec sep prec)
  2951. (if vec
  2952. (let ((buf (math-format-flat-expr (car vec) prec)))
  2953. (while (setq vec (cdr vec))
  2954. (setq buf (concat buf sep (math-format-flat-expr (car vec) prec))))
  2955. buf)
  2956. ""))
  2957. (defun math-format-nice-expr (x w)
  2958. (cond ((and (eq (car-safe x) 'vec)
  2959. (cdr (cdr x))
  2960. (let ((ops '(vec calcFunc-assign calcFunc-condition
  2961. calcFunc-schedule calcFunc-iterations
  2962. calcFunc-phase)))
  2963. (or (memq (car-safe (nth 1 x)) ops)
  2964. (memq (car-safe (nth 2 x)) ops)
  2965. (memq (car-safe (nth 3 x)) ops)
  2966. calc-break-vectors)))
  2967. (concat "[ " (math-format-flat-vector (cdr x) ",\n " 0) " ]"))
  2968. (t
  2969. (let ((str (math-format-flat-expr x 0))
  2970. (pos 0) p)
  2971. (or (string-match "\"" str)
  2972. (while (<= (setq p (+ pos w)) (length str))
  2973. (while (and (> (setq p (1- p)) pos)
  2974. (not (= (aref str p) ? ))))
  2975. (if (> p (+ pos 5))
  2976. (setq str (concat (substring str 0 p)
  2977. "\n "
  2978. (substring str p))
  2979. pos (1+ p))
  2980. (setq pos (+ pos w)))))
  2981. str))))
  2982. (defun math-assq2 (v a)
  2983. (while (and a (not (eq v (nth 1 (car a)))))
  2984. (setq a (cdr a)))
  2985. (car a))
  2986. (defun math-format-number-fancy (a prec)
  2987. (cond
  2988. ((eq (car a) 'float) ; non-decimal radix
  2989. (if (Math-integer-negp (nth 1 a))
  2990. (concat "-" (math-format-number (math-neg a)))
  2991. (let ((str (if (and calc-radix-formatter
  2992. (not (memq calc-language '(c pascal))))
  2993. (funcall calc-radix-formatter
  2994. calc-number-radix
  2995. (math-format-radix-float a prec))
  2996. (format "%d#%s" calc-number-radix
  2997. (math-format-radix-float a prec)))))
  2998. (if (and prec (> prec 191) (string-match "\\*" str))
  2999. (concat "(" str ")")
  3000. str))))
  3001. ((eq (car a) 'frac)
  3002. (setq a (math-adjust-fraction a))
  3003. (if (> (length (car calc-frac-format)) 1)
  3004. (if (Math-integer-negp (nth 1 a))
  3005. (concat "-" (math-format-number (math-neg a)))
  3006. (let ((q (math-idivmod (nth 1 a) (nth 2 a))))
  3007. (concat (let ((calc-frac-format nil))
  3008. (math-format-number (car q)))
  3009. (substring (car calc-frac-format) 0 1)
  3010. (let ((math-radix-explicit-format nil)
  3011. (calc-frac-format nil))
  3012. (math-format-number (cdr q)))
  3013. (substring (car calc-frac-format) 1 2)
  3014. (let ((math-radix-explicit-format nil)
  3015. (calc-frac-format nil))
  3016. (math-format-number (nth 2 a))))))
  3017. (concat (let ((calc-frac-format nil))
  3018. (math-format-number (nth 1 a)))
  3019. (car calc-frac-format)
  3020. (let ((math-radix-explicit-format nil)
  3021. (calc-frac-format nil))
  3022. (math-format-number (nth 2 a))))))
  3023. ((eq (car a) 'cplx)
  3024. (if (math-zerop (nth 2 a))
  3025. (math-format-number (nth 1 a))
  3026. (if (null calc-complex-format)
  3027. (concat "(" (math-format-number (nth 1 a))
  3028. ", " (math-format-number (nth 2 a)) ")")
  3029. (if (math-zerop (nth 1 a))
  3030. (if (math-equal-int (nth 2 a) 1)
  3031. (symbol-name calc-complex-format)
  3032. (if (math-equal-int (nth 2 a) -1)
  3033. (concat "-" (symbol-name calc-complex-format))
  3034. (if prec
  3035. (math-compose-expr (list '* (nth 2 a) '(cplx 0 1)) prec)
  3036. (concat (math-format-number (nth 2 a)) " "
  3037. (symbol-name calc-complex-format)))))
  3038. (if prec
  3039. (math-compose-expr (list (if (math-negp (nth 2 a)) '- '+)
  3040. (nth 1 a)
  3041. (list 'cplx 0 (math-abs (nth 2 a))))
  3042. prec)
  3043. (concat (math-format-number (nth 1 a))
  3044. (if (math-negp (nth 2 a)) " - " " + ")
  3045. (math-format-number
  3046. (list 'cplx 0 (math-abs (nth 2 a))))))))))
  3047. ((eq (car a) 'polar)
  3048. (concat "(" (math-format-number (nth 1 a))
  3049. "; " (math-format-number (nth 2 a)) ")"))
  3050. ((eq (car a) 'hms)
  3051. (if (math-negp a)
  3052. (concat "-" (math-format-number (math-neg a)))
  3053. (let ((calc-number-radix 10)
  3054. (calc-twos-complement-mode nil)
  3055. (calc-leading-zeros nil)
  3056. (calc-group-digits nil))
  3057. (format calc-hms-format
  3058. (let ((calc-frac-format '(":" nil)))
  3059. (math-format-number (nth 1 a)))
  3060. (let ((calc-frac-format '(":" nil)))
  3061. (math-format-number (nth 2 a)))
  3062. (math-format-number (nth 3 a))))))
  3063. ((eq (car a) 'intv)
  3064. (concat (if (memq (nth 1 a) '(0 1)) "(" "[")
  3065. (math-format-number (nth 2 a))
  3066. " .. "
  3067. (math-format-number (nth 3 a))
  3068. (if (memq (nth 1 a) '(0 2)) ")" "]")))
  3069. ((eq (car a) 'sdev)
  3070. (concat (math-format-number (nth 1 a))
  3071. " +/- "
  3072. (math-format-number (nth 2 a))))
  3073. ((eq (car a) 'vec)
  3074. (math-format-flat-expr a 0))
  3075. (t (format "%s" a))))
  3076. (defun math-adjust-fraction (a)
  3077. (if (nth 1 calc-frac-format)
  3078. (progn
  3079. (if (Math-integerp a) (setq a (list 'frac a 1)))
  3080. (let ((g (math-quotient (nth 1 calc-frac-format)
  3081. (math-gcd (nth 2 a)
  3082. (nth 1 calc-frac-format)))))
  3083. (list 'frac (math-mul (nth 1 a) g) (math-mul (nth 2 a) g))))
  3084. a))
  3085. (defun math-format-bignum-fancy (a) ; [X L]
  3086. (let ((str (cond ((= calc-number-radix 10)
  3087. (math-format-bignum-decimal a))
  3088. ((= calc-number-radix 2)
  3089. (math-format-bignum-binary a))
  3090. ((= calc-number-radix 8)
  3091. (math-format-bignum-octal a))
  3092. ((= calc-number-radix 16)
  3093. (math-format-bignum-hex a))
  3094. (t (math-format-bignum-radix a)))))
  3095. (if calc-leading-zeros
  3096. (let* ((calc-internal-prec 6)
  3097. (digs (math-compute-max-digits (math-abs calc-word-size)
  3098. calc-number-radix))
  3099. (len (length str)))
  3100. (if (< len digs)
  3101. (setq str (concat (make-string (- digs len) ?0) str)))))
  3102. (if calc-group-digits
  3103. (let ((i (length str))
  3104. (g (if (integerp calc-group-digits)
  3105. (math-abs calc-group-digits)
  3106. (if (memq calc-number-radix '(2 16)) 4 3))))
  3107. (while (> i g)
  3108. (setq i (- i g)
  3109. str (concat (substring str 0 i)
  3110. calc-group-char
  3111. (substring str i))))
  3112. str))
  3113. (if (and (/= calc-number-radix 10)
  3114. math-radix-explicit-format)
  3115. (if calc-radix-formatter
  3116. (funcall calc-radix-formatter calc-number-radix str)
  3117. (format "%d#%s" calc-number-radix str))
  3118. str)))
  3119. (defun math-group-float (str) ; [X X]
  3120. (let* ((pt (or (string-match "[^0-9a-zA-Z]" str) (length str)))
  3121. (g (if (integerp calc-group-digits) (math-abs calc-group-digits)
  3122. (if (memq calc-number-radix '(2 16)) 4 3)))
  3123. (i pt))
  3124. (if (and (integerp calc-group-digits) (< calc-group-digits 0))
  3125. (while (< (setq i (+ (1+ i) g)) (length str))
  3126. (setq str (concat (substring str 0 i)
  3127. calc-group-char
  3128. (substring str i))
  3129. i (+ i (1- (length calc-group-char))))))
  3130. (setq i pt)
  3131. (while (> i g)
  3132. (setq i (- i g)
  3133. str (concat (substring str 0 i)
  3134. calc-group-char
  3135. (substring str i))))
  3136. str))
  3137. ;;; Users can redefine this in their init files.
  3138. (defvar calc-keypad-user-menu nil
  3139. "If non-nil, this describes an additional menu for calc-keypad.
  3140. It should contain a list of three rows.
  3141. Each row should be a list of six keys.
  3142. Each key should be a list of a label string, plus a Calc command name spec.
  3143. A command spec is a command name symbol, a keyboard macro string, a
  3144. list containing a numeric entry string, or nil.
  3145. A key may contain additional specs for Inverse, Hyperbolic, and Inv+Hyp.")
  3146. (run-hooks 'calc-ext-load-hook)
  3147. (provide 'calc-ext)
  3148. ;;; calc-ext.el ends here